[climacs-cvs] CVS update: climacs/esa.lisp climacs/syntax.lisp climacs/gui.lisp - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

14 Nov 2005

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv31363
Modified Files:
    esa.lisp syntax.lisp gui.lisp 
Log Message:
Added command-table slot to syntax objects. Define-syntax now passes command-table
to new syntaxes. com-extended-command uses find-applicable-command-table.
Date: Mon Nov 14 17:30:14 2005
Author: dlewis
Index: climacs/esa.lisp
diff -u climacs/esa.lisp:1.24 climacs/esa.lisp:1.25

--- climacs/esa.lisp:1.24	Sun Nov 13 00:09:35 2005
+++ climacs/esa.lisp	Mon Nov 14 17:30:13 2005
@@ -379,8 +379,7 @@
     ()
   (let ((item (handler-case
           (accept
-		`(command :command-table
-			  ,(command-table (car (windows *application-frame*))))
+		`(command :command-table ,(find-applicable-command-table *application-frame*))
    	:prompt "Extended Command")
           (error () (progn (beep)
    			(display-message "No such command")
Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.60 climacs/syntax.lisp:1.61
--- climacs/syntax.lisp:1.60	Sun Nov 13 00:09:34 2005
+++ climacs/syntax.lisp	Mon Nov 14 17:30:13 2005
@@ -23,7 +23,8 @@
 (in-package :climacs-syntax)
(defclass syntax (name-mixin)
-  ((buffer :initarg :buffer :reader buffer)))
+  ((buffer :initarg :buffer :reader buffer)
+   (command-table :initarg :command-table)))
(define-condition no-such-operation (simple-error)
   ()
@@ -204,7 +205,7 @@
         :pathname-types ',pathname-types)
        *syntaxes*)
       (defclass ,class-name ,superclasses ,slots
-	(:default-initargs ,@default-initargs)
+	(:default-initargs :command-table ',command-table ,@default-initargs)
    ,@defclass-options))))
#+nil
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.197 climacs/gui.lisp:1.198
--- climacs/gui.lisp:1.197	Sun Nov 13 10:24:45 2005
+++ climacs/gui.lisp	Mon Nov 14 17:30:13 2005
@@ -267,7 +267,8 @@
       (and syntax
       (slot-exists-p syntax 'command-table)
       (slot-boundp syntax 'command-table)
-	   (slot-value syntax 'command-table)))
+	   (slot-value syntax 'command-table)
+	   (find-command-table (slot-value syntax 'command-table))))
    (find-command-table 'global-climacs-table)))
(define-command (com-full-redisplay :name t :command-table base-table) ()

    