Re: I Want my own framework...

[liberte@cs.uiuc.edu (Daniel LaLiberte)]

One thing I needed in the direction of a MCL application framework was
support for multiple applications within the one MCL environment.  I
succeeded in getting what I needed, and perhaps it will be useful for
others, so I include it below.  I havent submitted it to the archive
yet because there is still more work to do on it, but I don't have
time to do that work now, so it is time to release it as is and let
others have a try at it.

Dan LaLiberte
liberte@cs.uiuc.edu
(Join the League for Programming Freedom: lpf@uunet.uu.net)
"If we don't succeed, we run the risk of failure.
		-- Vice President Dan Quayle."
--------------
;;; -*- Mode: LISP; Package: (CL-USER); Syntax:Common-Lisp; Lowercase: Yes -*-

#| multi-application class and window hooks

Daniel LaLiberte (liberte@ncsa.uiuc.edu)
National Center for Supercomputing Applications
University of Illinois, Urbana-Champaign
August 1992.

This file defines a multi-application class which is a subclass of the MCL
application class.   The MCL application object is promoted to a
multi-application.  *application* always holds the current multi-application
object.  (Hereafter, "application" means "multi-application".)
All applications, stored in the list *applications*, are added
to the Apple menu under the About ... item.

To use this package, load or eval it, preferrably soon after starting up
MCL.  You can define subclasses of multi-application, or use it as is.
Call make-instance with the :name of your application,
and an :about-action function to display the about dialog.
This application is made the current, active application.
While your application is current, define its menus, open any windows, etc. 
Don't bother changing the apple menu because multi-application does that
in set-apple-menu-applications.  There is an example at the bottom of this
file.
 
When you click on any window that is not in your application, your
application will be suspended and the other application, or the mcl 
application will be resumed.  Call application-quit to terminate the 
use of an application.

There are three ways in which a application can be activated
(or resumed).  When one is created, it is automatically activated
by the initialize-instance method.  The other two times are when a 
window in an application is selected, or when the application's name is
selected from the Apple menu.   An application may also be resumed
programmatically by calling application-select.  There is no need to
call application-suspend; the current application is automatically
suspended when another is resumed.

When an application is suspended, the current menus are saved; when
the application is later resumed, these menus are restored.  The Apple
menu is always updated to list the current applications.

When a window is deactivated, either another window will be activated
in the same or different application, or there are no more windows.
(If a window is being closed, another window in the same application
should be activated rather than the next one on the global window list.
This is not yet implemented.)
If another window in the same application is selected, then the
current application need not be suspended and resumed

The hooks into the window methods are done through advise so that we dont
redefine the kernel methods, and dont get redefined by someone elses methods.
Advise works for all the hooks except for initialize-instance. 

Windoids cause lots of extra activation events, so menus will flash more than
needed.  One way to reduce this, and it should be done anyway, is to require
applications that use windoids to hide them when the application
is suspended and show them when resumed.  (Could/should this be done 
automatically for windoids?)

When switching applications is via the apple menu,
if the current window is in a different application, it needs to
be deactivated and one of the windows in the selected application should
be activated, preferrably the last one that was active.  
What if there are no windows in the application?  Then
the menus for the new application would apply to a window in a different
application - this could be very confusing.  So currently I just
deactivate the front window (from the previous application) and leave
none selected.  However, there is a bad side effect: the deactivated 
window is not selectable until some other window is selected.  (How to fix?
I think window-selection needs to work also if the front-window is inactive.)

Future work
===========
to do on an as needed basis:
(the problems noted above...)

The Windows menu should be limited to windows in the current application.
Manually executing code for an application is cumbersome.  I do something
like:  (progn (application-select my-app)
              (set-menubar my-menus))

Looks like a bug when an error occurs during window creation.
The Listener gets selected but the application is not swapped.

When using Interface Tools, a dialog should be designed in MCL, and
used in the application that it is associated with.
Perhaps IFT should be its own application.  Menus are edited while being
used; a debatable policy.  A menubar could otherwise be associated
with an application.

How all this relates to apple-events, I dont know.  Ideally, all the
applications should be available to receive events even if not currently
active, and they should be able to send and receive events between them
as well as outside applications.

Need to think more about application quitting.  Could automatically
query to confirm quitting.  Could ask about unsaved windows and abort the
quit if user cancels.

Windoids still mess up the window selection business.  Sometimes a
window is selected automatically but its application is not resumed.

Could replace the window-list with the application specific window list.
I don't know what problems this might cause though.  Perhaps quitting from
MCL wouldnt close all windows.  That reminds me, quitting from MCL should
first quit all the multi-applications.

Could provide services to applications, like a Windows menu with just
its windows in it.

Bug: Suspending and resuming the MCL application (not the multi-application)
by clicking on a window in a different multi-application
doesn't catch the window select event to swap menus.

|#

;; To fix some window event anomalies, you need the following patch.
;; multi-application will work without it, but sometimes the wrong
;; window will be selected, or the menus may be switched incorrectly.
;; This patch should become part of MCL 2.0.
;; (load "ccl:patches;reactivate-window-patch")

(defvar *applications* nil "List of applications.")

(defvar *window-application-alist* nil 
  "Association list from windows to applications.")


(defclass multi-application (application)
  ((application-name
    :accessor application-name)
   (about-application-action
    :accessor about-application-action)

    (saved-menus
    :documentation "Menus that were active when the application 
was last suspended."
    :initform nil
    :accessor saved-menus)

   (visible-windoids 
    :documentation "List of all windoids visible last time app was suspended."
    :initform nil
    :accessor visible-windoids)
   )

  (:documentation
   "Representation of application specific info.")
  )

(defmethod print-object ((object multi-application) stream)
  (format stream "#<~s ~s>"
          (class-name (class-of object)) 
          (application-name object)))
          

;;##########################################
;; Make the mcl application into a multi-application.

(defvar *mcl-application* *application*
  "Remember the one application object that MCL creates.")

(change-class *mcl-application* (find-class 'multi-application))

;; Do what initialize-instance would have done.
(setf (application-name *mcl-application*) "MCL")
(setf (about-application-action *mcl-application*) #'ccl::about-ccl)
(push *mcl-application* *applications*)
;; (set-menubar *default-menubar*)

;;##########################################

(defmethod initialize-instance :after 
  ((new-appl multi-application) &rest rest &key name about-action)
  "Create an application object, making it the current application."
  (declare (ignore rest))
  (setf (application-name new-appl) name)
  (setf (about-application-action new-appl) about-action)
  (format t "~%new application: ~s" new-appl)
  (push new-appl *applications*)
  (application-resume new-appl)
  (format t "~%current application: ~s" *application*)
  new-appl)

(defmethod application-quit ((appl multi-application))
  "Call this to terminate an application.
This closes all the applications windows.
APPL need not eq *application*, but if so, another application is resumed."
  ;; Close all its windows.
  (map-windows #'(lambda (w)
                   (if (eq appl (cdr (assoc w *window-application-alist*)))
                     (window-close w)))
               :include-invisibles t :include-windoids t)
  (setq *applications* (delete appl *applications*))
  (if (eq appl *application*)
    ;; If current application is being quit, resume some other application.
    (application-resume (car *applications*))
    ;; Else update apple menu anyway.
    (set-apple-menu-applications))
  )

(defun quit-current-application ()
  "Utility function to call application-quit on *application*."
  ;;(format t "~%Current application: ~s" *application*)
  (APPLICATION-QUIT *APPLICATION*))


(defmethod front-window-in-application 
           ((appl multi-application)
            &key class include-invisibles include-windoids)
  "Return the front window in the application, if any."
  (let ((f #'(lambda (w)
               (let ((some-appl (cdr (assoc w *window-application-alist*))))
                 (if (or (eq appl some-appl)
                         (and (null some-appl) (eq appl *mcl-application*)))
                   (return-from front-window-in-application w))))))
    (declare (dynamic-extent f))
    (map-windows f :class class :include-invisibles include-invisibles 
                 :include-windoids include-windoids)))


(defmethod select-front-window-in-application ((appl multi-application))
  "Select the front window in the application, if any.
Otherwise, deactivate selected window."
  ;; Should only be used by the current application since window-select
  ;; doesnt ensure that the application is current.
  (let ((w (front-window-in-application appl)))
    (if w
      (window-select w)
      (when ccl::*selected-window*
        (view-deactivate-event-handler ccl::*selected-window*)
        ))))


(defmethod application-select ((appl multi-application))
  ;; Resume the application and select the front window in the application.
  (application-resume appl)
  (select-front-window-in-application appl))


(defmethod application-resume ((appl multi-application))
  "Resume the application.
Set the menubar to the state the menus were in last time the 
application was active."
  ;; Don't select a window because the application might have been
  ;; resumed because some other window in the applicsation was selected.
  (unless (eq *application* appl)
    ;;(format t "~%resume: ~s current: ~s" appl *application*)
    (application-suspend *application*)
    (setf *application* appl)
    (set-menubar (saved-menus appl)))
  (set-apple-menu-applications)
  ;;    (format t "~%menus: ~s" (menubar))
  )

(defmethod application-suspend ((appl multi-application))
  "Suspend the application.
Save the current menubar away for when the application is resumed.
This is only called by application-resume when a different application
is about to be activated."
  ;; *application* remains as it is until changed by activation of another appl.
  ;; Also could hide visible windoids of the application.
  ;; because windoids really mess up this multi-application scheme
  ;; since they repeatedly activate all windoids and the front window.
  ;; Patch 2 to MCL 2.0f fixes this.
  (setf (saved-menus appl) (menubar))
  ;; Deactivate the front window.
  ;; Bad side effect: this window becomes unselectable until something
  ;; else has been selected.  It's even worse if there is only one window.
  ;; Patch 2 to MCL 2.0f fixes these problems.
  (let ((w (front-window-in-application appl)))
    (when w (view-deactivate-event-handler w))))


(defmacro with-application (application &rest body)
  `(let ((current-application *application*))
     (application-resume ,application)
     (unwind-protect
       ,@body
       (application-resume current-application))))


(defun set-apple-menu-applications ()
  ;; This could be a method on the application...
  (LET ((APPLE-MENU *APPLE-MENU*))
    (menu-enable APPLE-MENU)
    (APPLY #'REMOVE-MENU-ITEMS APPLE-MENU (MENU-ITEMS APPLE-MENU))
    (APPLY #'ADD-MENU-ITEMS
           APPLE-MENU
           (MAKE-INSTANCE 'MENU-ITEM 
             :MENU-ITEM-TITLE 
             (format nil "About ~a..." (application-name *application*))
             :MENU-ITEM-ACTION 
             #'(lambda nil (funcall (about-application-action *application*))))

           (mapcar #'(lambda (appl) 
                       (MAKE-INSTANCE 'MENU-ITEM
                         :MENU-ITEM-TITLE
                         (application-name appl)
                         :MENU-ITEM-ACTION
                         #'(LAMBDA NIL (application-select appl))))
                   (remove *application* *applications*)))
    (add-menu-items  
     apple-menu
     (MAKE-INSTANCE 'MENU-ITEM :MENU-ITEM-TITLE "-" :DISABLED T))))

;;;===================
;;; Handle window initialization, close, selection, etc

;; I'd like to use advise instead of defining methods
;; because someone else might override the same method, but 
;; advisingdoesnt work for some methods, and it's pretty messy.

(defmethod initialize-instance :before ((w window) &rest rest)
  (declare (ignore rest))
  (push (cons w *application*) *window-application-alist*)
  )

(defmethod window-close :around ((w window))
  (let* ((window-appl (assoc w *window-application-alist*))
         (appl (window-application w))
         (was-current (eq appl *application*)))
   ;;(format t "~%closing: ~s" w)
   (when window-appl
     (setf *window-application-alist* 
           (delete window-appl *window-application-alist*)))
   (call-next-method)
   ;; Reselect the application, if it was the current one.
   ;; It would be better to avoid the change in the first place.
   (when was-current
     (application-select appl))
   ))


(defmethod window-application ((w window))
  (or (cdr (assoc w *window-application-alist*))
      *mcl-application*))

(advise 
 (:method window-select-event-handler (window))
 (let* ((w (car arglist))
        (appl (window-application w)))
   ;;(format t "~%advise select: ~s appl: ~s" w appl)
   (application-resume appl)
   )
 :name :multi-application
 :when :before)


;; Around advise doesnt get called when a window is closed.
(defmethod view-activate-event-handler :around ((w window))
  ;;(format t "~%before activation: ~s" w)
  (let ((appl (or (cdr (assoc w *window-application-alist*))
                  *mcl-application*))
        (was-active (window-active-p w)))
    (call-next-method)
    (when (and (not was-active) (window-active-p w))
      (application-resume appl)))
  ;;(format t "~%after activation: ~s" w)
  )


'(defmethod view-deactivate-event-handler :around ((w window))
  ;;(format t "~%before deactivation: ~s" w)
  (call-next-method)
  ;;(format t "~%after deactivation: ~s" w)
  )

#| #####################################################################
Instead of the ugly advise calls above, I would like a new defining form
that might be called defadvise.  The spec would *include*
argument names which should be extracted and bound to the advise arglist.

(defmacro defadvise (spec advise-name when &rest body)
  "Advise on spec."
  `(advise
    ,(clean-up spec)
    (progv ,(args-of spec) arglist
      ,@body)
    :name ,advise-name
    :when ,when))

The progv probably doesnt do a general binding job.
Some failsafe checking should be done, and a undefadvise is also needed.
I don't know enough CL to write the clean-up and args-of routines.
But it could be used like:

(defadvise (initialize-instance ((w window) &rest rest))
  :multi-application :before 
  (push (cons w *application*) *window-application-alist*)
  )

##################################################################### |# 

(provide :multi-application)

#|

;;; Example application

(defun about-foo ()
  (MAKE-INSTANCE 'DIALOG
  :WINDOW-TYPE
  :DOCUMENT
  :WINDOW-TITLE
  "About Foo"
  :VIEW-POSITION
  #@(109 101)
  :VIEW-SIZE
  #@(269 115)
  :VIEW-FONT
  '("Chicago" 12 :SRCOR :PLAIN)
  :VIEW-SUBVIEWS
  (LIST (MAKE-DIALOG-ITEM
          'STATIC-TEXT-DIALOG-ITEM
          #@(38 18)
          #@(178 16)
          "This dialog is about Foo"
          'NIL)
        (MAKE-DIALOG-ITEM
          'BUTTON-DIALOG-ITEM
          #@(95 67)
          #@(62 16)
          "OK"
          #'(LAMBDA (ITEM) ITEM (WINDOW-CLOSE (FRONT-WINDOW)))
          :DEFAULT-BUTTON
          T))))

(PROGN
  (setq foo-application
        (make-instance 'multi-application
          :name "Foo" 
          :about-action 'about-foo))

  (SET-MENUBAR (LIST (MAKE-INSTANCE 'MENU
                       :MENU-TITLE
                       "Foo"
                       :MENU-ITEMS
                       (LIST (MAKE-INSTANCE 'MENU-ITEM
                               :MENU-ITEM-TITLE
                               "Quit"
                               :MENU-ITEM-ACTION
                               'quit-current-application))))))


|#