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 ,@default-initargs) - ,@defclass-options)))) + ,@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)