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

[Christophe Rhodes]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv14852

Modified Files:
	gui.lisp slidemacs-gui.lisp syntax.lisp 
Log Message:
Fix slidemacs-gui syntax, in a slightly hacky way (but less hacky than 
CSR climacs-devel 2005-10-30).

New function CLIMACS-GUI::NOTE-PANE-SYNTAX-CHANGED, used by (SETF 
BUFFER) and (SETF SYNTAX), and with methods automatically defined with 
the :COMMAND-TABLE option to DEFINE-SYNTAX.

Don't let slidemacs-gui put stuff in the global command table.

Date: Mon Oct 31 14:42:32 2005
Author: crhodes

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.192 climacs/gui.lisp:1.193
--- climacs/gui.lisp:1.192	Wed Oct 19 22:56:59 2005
+++ climacs/gui.lisp	Mon Oct 31 14:42:31 2005
@@ -1173,6 +1173,12 @@
     (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)))
+
 (define-command (com-switch-to-buffer :name t :command-table pane-table) ()
   (let* ((default (second (buffers *application-frame*)))
 	 (buffer (if default
@@ -1416,7 +1422,16 @@
 (defmethod set-syntax ((buffer climacs-buffer) (syntax syntax))
   (setf (syntax buffer) syntax))
 
-;;FIXME - what should this specialise on?
+;;; 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)
+  (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/slidemacs-gui.lisp
diff -u climacs/slidemacs-gui.lisp:1.20 climacs/slidemacs-gui.lisp:1.21
--- climacs/slidemacs-gui.lisp:1.20	Tue Oct 11 23:20:52 2005
+++ climacs/slidemacs-gui.lisp	Mon Oct 31 14:42:31 2005
@@ -28,14 +28,17 @@
   ((lexer :reader lexer)
    (valid-parse :initform 1) (parser))
   (:name "Slidemacs-GUI")
-  (:pathname-types))
+  (:pathname-types)
+  (:command-table slidemacs-table))
 
 (defvar *slidemacs-display* nil)
 
 (defvar *current-slideset*)
 (defvar *did-display-a-slide*)
 
-(make-command-table 'slidemacs-table :errorp nil)
+(make-command-table 'slidemacs-table 
+                    :errorp nil
+                    :inherit-from '(climacs-gui::global-climacs-table))
 
 (defun slidemacs-entity-string (entity)
   (coerce (buffer-sequence (buffer entity)
@@ -307,7 +310,7 @@
       (display-text-with-wrap-for-pane object stream))))
 
 (define-command (com-browse-to-url :name "Browse To URL"
-                                   :command-table global-command-table
+                                   :command-table slidemacs-table
                                    :menu t
                                    :provide-output-destination-keyword t)
     ((url 'slidemacs-url :prompt "url"))
@@ -315,7 +318,7 @@
   (sb-ext:run-program "/usr/bin/open" (list url)))
 
 (define-presentation-to-command-translator browse-url-translator
-    (slidemacs-url com-browse-to-url global-command-table
+    (slidemacs-url com-browse-to-url slidemacs-table
                    :gesture :select
                    :documentation "Browse To URL"
                    :pointer-documentation "Browse To URL")


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.58 climacs/syntax.lisp:1.59
--- climacs/syntax.lisp:1.58	Tue Sep 13 21:23:59 2005
+++ climacs/syntax.lisp	Mon Oct 31 14:42:31 2005
@@ -167,6 +167,7 @@
   (let ((defclass-options nil)
 	(default-initargs nil)
 	(name nil)
+        (command-table nil)
 	(pathname-types nil))
     (dolist (option options)
       (case (car option)
@@ -180,6 +181,11 @@
 	     (error "More than one ~S option provided to ~S"
 		    ':pathname-types 'define-syntax)
 	     (setf pathname-types (cdr option))))
+        ((:command-table)
+         (if command-table
+             (error "More than one ~S option provided to ~S"
+                    ':command-table 'define-syntax)
+             (setf command-table (cadr option))))
 	((:default-initargs)
 	 (if default-initargs
 	     (error "More than one ~S option provided to ~S"
@@ -199,7 +205,19 @@
        *syntaxes*)
       (defclass ,class-name ,superclasses ,slots
 	(:default-initargs , at default-initargs)
-	, at defclass-options))))
+	, 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)))
 
 #+nil
 (defmacro define-syntax (class-name (name superclasses) &body body)