Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv13115 Modified Files: syntax.lisp packages.lisp misc-commands.lisp gui.lisp esa.lisp Log Message: Introduce find-applicable-command-table, specialised on frame class. Remove some :around kludgery from (setf syntax) and (setf buffer). At the moment f-a-c-t for climacs just asks the syntax which command-table to use, but this could be extended to views etc. Date: Sun Nov 13 00:09:36 2005 Author: dmurray Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.59 climacs/syntax.lisp:1.60 --- climacs/syntax.lisp:1.59 Mon Oct 31 14:42:31 2005 +++ climacs/syntax.lisp Sun Nov 13 00:09:34 2005 @@ -205,19 +205,7 @@ *syntaxes*) (defclass ,class-name ,superclasses ,slots (:default-initargs ,@default-initargs) - ,@defclass-options) - ,@(when command-table - ;; FIXME: double colons? Looks ugly to me. More - ;; importantly, we can't use EXTENDED-PANE as a specializer - ;; here, because that hasn't been defined yet. - `((defmethod climacs-gui::note-pane-syntax-changed - (pane (syntax ,class-name)) - (setf (command-table pane) ',command-table))))))) - -;;; FIXME: see comment in DEFINE-SYNTAX -(defgeneric climacs-gui::note-pane-syntax-changed (pane syntax) - (:method (pane syntax) - (setf (command-table pane) 'climacs-gui::global-climacs-table))) + ,@defclass-options)))) #+nil (defmacro define-syntax (class-name (name superclasses) &body body) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.82 climacs/packages.lisp:1.83 --- climacs/packages.lisp:1.82 Tue Sep 13 21:23:59 2005 +++ climacs/packages.lisp Sun Nov 13 00:09:34 2005 @@ -195,7 +195,8 @@ #:esa-top-level #:simple-command-loop #:global-esa-table #:keyboard-macro-table #:help-table - #:set-key)) + #:set-key + #:find-applicable-command-table)) (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax Index: climacs/misc-commands.lisp diff -u climacs/misc-commands.lisp:1.1 climacs/misc-commands.lisp:1.2 --- climacs/misc-commands.lisp:1.1 Sat Nov 12 10:38:32 2005 +++ climacs/misc-commands.lisp Sun Nov 13 00:09:34 2005 @@ -734,22 +734,6 @@ (defmethod set-syntax ((buffer climacs-buffer) (syntax syntax)) (setf (syntax buffer) syntax)) -;;; FIXME: This :around method is probably not going to remain here -;;; for ever; it is a symptom of level mixing, I think. See also the -;;; similar method on (SETF BUFFER). -- CSR, 2005-10-31. -(defmethod (setf syntax) :around (syntax (buffer climacs-buffer)) - (call-next-method) - ;; FIXME: we need this because some clients (e.g. the tablature - ;; editor) use climacs buffers without a gui, for off-line (e.g. Web - ;; backend) processing. The problem here is that (setf syntax) - ;; /should/ have no GUI effects whatsoever. So maybe the right - ;; answer would instead be to find the active pane's buffer in the - ;; top-level loop? That might need to be pushed into ESA. - (when clim:*application-frame* - (let ((pane (current-window))) - (assert (eq (buffer pane) buffer)) - (note-pane-syntax-changed pane syntax)))) - ;;FIXME - what should this specialise on? (defmethod set-syntax ((buffer climacs-buffer) syntax) (set-syntax buffer (make-instance syntax :buffer buffer))) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.195 climacs/gui.lisp:1.196 --- climacs/gui.lisp:1.195 Sat Nov 12 10:34:34 2005 +++ climacs/gui.lisp Sun Nov 13 00:09:34 2005 @@ -250,6 +250,14 @@ do (when (modified-p buffer) (setf (needs-saving buffer) t)))) +(defmethod find-applicable-command-table ((frame climacs)) + (or + (let ((syntax (syntax (buffer (current-window))))) + (and (slot-exists-p syntax 'command-table) + (slot-boundp syntax 'command-table) + (slot-value syntax 'command-table))) + (find-command-table 'global-climacs-table))) + (define-command (com-full-redisplay :name t :command-table base-table) () (full-redisplay (current-window))) @@ -359,11 +367,11 @@ (when default (switch-to-buffer default)))) -;;; FIXME: see the comment by (SETF SYNTAX) :AROUND. -- CSR, -;;; 2005-10-31. -(defmethod (setf buffer) :around (buffer (pane extended-pane)) - (call-next-method) - (note-pane-syntax-changed pane (syntax buffer))) +;; ;;; FIXME: see the comment by (SETF SYNTAX) :AROUND. -- CSR, +;; ;;; 2005-10-31. +;; (defmethod (setf buffer) :around (buffer (pane extended-pane)) +;; (call-next-method) +;; (note-pane-syntax-changed pane (syntax buffer))) (define-command (com-switch-to-buffer :name t :command-table pane-table) () (let* ((default (second (buffers *application-frame*))) Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.23 climacs/esa.lisp:1.24 --- climacs/esa.lisp:1.23 Thu Nov 3 15:58:52 2005 +++ climacs/esa.lisp Sun Nov 13 00:09:35 2005 @@ -215,7 +215,7 @@ ('menu-item) (object) (with-input-context - (`(command :command-table ,(command-table (car (windows frame))))) + (`(command :command-table ,command-table)) (object) (let ((gestures '())) (multiple-value-bind (numarg numargp) @@ -263,6 +263,11 @@ (car command) command))) +(defgeneric find-applicable-command-table (frame)) + +(defmethod find-applicable-command-table ((frame esa-frame-mixin)) + (command-table (car (windows frame)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Top level @@ -281,12 +286,12 @@ do (restart-case (progn (handler-case - (progn + (let ((command-table (find-applicable-command-table frame))) ;; for presentation-to-command-translators, ;; which are searched for in ;; (frame-command-table *application-frame*) - (setf (frame-command-table frame) (command-table (car (windows frame)))) - (process-gestures-or-command frame (command-table (car (windows frame))))) + (setf (frame-command-table frame) command-table) + (process-gestures-or-command frame command-table)) (abort-gesture () (display-message "Quit"))) (redisplay-frame-panes frame)) (return-to-esa () nil))))))