[climacs-cvs] CVS update: climacs/esa.lisp climacs/syntax.lisp climacs/gui.lisp

[David Lewis]

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 , at default-initargs)
+	(:default-initargs :command-table ',command-table , at default-initargs)
 	, at 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) ()