[climacs-cvs] CVS update: climacs/syntax.lisp climacs/packages.lisp climacs/misc-commands.lisp climacs/gui.lisp climacs/esa.lisp
Dave Murray
dmurray at common-lisp.net
Sat Nov 12 23:09:39 UTC 2005
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 , at default-initargs)
- , at 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)))
+ , at 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))))))
More information about the Climacs-cvs
mailing list