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@labri.fr) +;;; (c) copyright 2006-2007 by +;;; Troels Henriksen (athas@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)) ,@bindings) ;; for presentation-to-command-translators,