[mcclim-cvs] CVS mcclim/ESA

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/ESA
In directory clnet:/tmp/cvs-serv7043/ESA

Modified Files:
	packages.lisp esa.lisp 
Log Message:
Change the use of global variables in Drei to functions that query a
single global variable (*drei-instance*).

At the same time, change a few things in ESA to make Dreis use of it
less hacky.


--- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp	2007/08/13 21:56:04	1.3
+++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp	2007/11/19 20:28:42	1.4
@@ -45,8 +45,9 @@
 
 (defpackage :esa
   (:use :clim-lisp :clim :esa-utils)
-  (:export #:buffers #:frame-current-buffer #:current-buffer #:*current-buffer*
-           #:windows #:frame-current-window #:current-window #:*current-window*
+  (:export #:*esa-instance*
+           #:buffers #:esa-current-buffer #:current-buffer
+           #:windows #:esa-current-window #:current-window
            #:*previous-command*
            #:*minibuffer* #:minibuffer #:minibuffer-pane #:display-message
            #:with-minibuffer-stream
--- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp	2007/09/30 22:03:54	1.10
+++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp	2007/11/19 20:28:43	1.11
@@ -2,6 +2,8 @@
 
 ;;;  (c) copyright 2005 by
 ;;;           Robert Strandh (strandh at labri.fr)
+;;;  (c) copyright 2006-2007 by
+;;;           Troels Henriksen (athas at sigkill.dk)
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Library General Public
@@ -26,41 +28,38 @@
 ;;; 
 ;;; Querying ESAs.
 
-(defgeneric buffers (application-frame)
-  (:documentation "Return a list of all the buffers of the application."))
+(defvar *esa-instance* nil
+  "This symbol should be bound to an ESA instance, though any
+object will do, provided the proper methods are defined. It will
+be used as the argument to the various \"query\" functions
+defined by ESA. For the vast majority of ESAs, `*esa-instance*'
+will probably have the same value as `*application-frame*'.")
 
-(defgeneric frame-current-buffer (application-frame)
-  (:documentation "Return the current buffer of APPLICATION-FRAME.")
-  (:method ((frame application-frame))
-    nil))
+(defgeneric buffers (esa)
+  (:documentation "Return a list of all the buffers of the application."))
 
-(defvar *current-buffer* nil
-  "When a command is being executed, the current buffer.")
+(defgeneric esa-current-buffer (esa)
+  (:documentation "Return the current buffer of APPLICATION-FRAME."))
 
 (defun current-buffer ()
-  "Return the current buffer of `*application-frame*'."
-  (frame-current-buffer *application-frame*))
+  "Return the currently active buffer of the running ESA."
+  (esa-current-buffer *esa-instance*))
 
-(defgeneric windows (application-frame)
-  (:documentation "Return a list of all the windows of the application.")
-  (:method ((application-frame application-frame))
+(defgeneric windows (esa)
+  (:documentation "Return a list of all the windows of the ESA.")
+  (:method ((esa application-frame))
     '()))
 
-(defgeneric frame-current-window (application-frame)
-  (:documentation "Return the current window of APPLICATION-FRAME.")
-  (:method ((frame application-frame))
-    (first (windows frame))))
-
-(defvar *current-window* nil
-  "When a command is being executed, the current window.")
+(defgeneric esa-current-window (esa)
+  (:documentation "Return the current window of ESA."))
 
 (defun current-window ()
-  "Return the current window of `*application-frame*'."  
-  (frame-current-window *application-frame*))
+  "Return the currently active window of the running ESA instance."
+  (esa-current-window *esa-instance*))
 
 (defvar *previous-command* nil
   "When a command is being executed, the command previously
-executed by the current frame.")
+executed by the application.")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
@@ -766,6 +765,12 @@
 (defclass esa-frame-mixin (command-processor)
   ((windows :accessor windows)))
 
+(defmethod esa-current-buffer ((esa esa-frame-mixin))
+  (first (buffers esa)))
+
+(defmethod esa-current-window ((esa esa-frame-mixin))
+  (first (windows esa)))
+
 (defmethod command-table ((frame esa-frame-mixin))
   (find-applicable-command-table frame))
 
@@ -795,7 +800,7 @@
   ;; FIXME: I'm not sure that we want to do this for commands sent
   ;; from other threads; we almost certainly don't want to do it twice
   ;; in such cases...
-  (setf (previous-command (frame-current-window frame)) command))
+  (setf (previous-command (esa-current-window frame)) command))
 
 (defmethod execute-frame-command :around ((frame esa-frame-mixin) command)
   (call-next-method)
@@ -850,16 +855,15 @@
                     (*partial-command-parser* ,partial-command-parser)
                     (*extended-command-prompt* ,prompt)
                     (*pointer-documentation-output*
-                     (frame-pointer-documentation-output ,frame)))
+                     (frame-pointer-documentation-output ,frame))
+                    (*esa-instance* ,frame))
                 (unless (eq (frame-state ,frame) :enabled)
                   (enable-frame ,frame))
                 (redisplay-frame-panes ,frame :force-p t)
                 (loop
                    do (restart-case
                           (handler-case
-                              (let* ((*current-window* (frame-current-window ,frame))
-                                     (*current-buffer* (frame-current-buffer ,frame))
-                                     (*command-processor* ,frame)
+                              (let* ((*command-processor* ,frame)
                                      (command-table (find-applicable-command-table ,frame))
                                      , at bindings)
                                 ;; for presentation-to-command-translators,