Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv12052/Drei

Modified Files: drei-clim.lisp drei.lisp fundamental-syntax.lisp lisp-syntax.lisp packages.lisp syntax.lisp Log Message: Make syntax-specific command-table handling slightly more sophisticated (hooray for complexity). This is needed to support users with advanced needs, such as Climacs.

--- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2006/11/10 18:39:45 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2006/11/11 00:08:30 1.5 @@ -32,74 +32,6 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Drei command tables. - -;;; Commenting. -(make-command-table 'comment-table :errorp nil) -;;; Deleting. -(make-command-table 'deletion-table :errorp nil) -;;; Editing - making changes to a buffer. -(make-command-table 'editing-table :errorp nil) -;;; Filling. -(make-command-table 'fill-table :errorp nil) -;;; Dealing with charcase. -(make-command-table 'case-table :errorp nil) -;;; Indentation. -(make-command-table 'indent-table :errorp nil) -;;; Marking things. -(make-command-table 'marking-table :errorp nil) -;;; Moving around. -(make-command-table 'movement-table :errorp nil) -;;; Searching. -(make-command-table 'search-table :errorp nil) -;;; Information about buffer contents. -(make-command-table 'info-table :errorp nil) -;;; Self-insertion. -(make-command-table 'self-insert-table :errorp nil) - -;;; Command table for concrete editor stuff. -(define-syntax-command-table editor-table - :errorp nil - :inherit-from '(comment-table - deletion-table - editing-table - case-table - fill-table - indent-table - marking-table - movement-table - search-table - info-table - self-insert-table - keyboard-macro-table)) - -;; Command table for commands that are only available when Drei is a -;; pane. -(make-command-table 'exclusive-pane-table :errorp nil) - -;; Command table for input-editor-only commands. -(make-command-table 'exclusive-input-editor-table :errorp nil) - -(define-command (com-extended-command :command-table exclusive-pane-table) - () - "Prompt for a command name and arguments, then run it." - (let ((item (handler-case - (accept - `(command :command-table ,(command-table *current-window*)) - ;; this gets erased immediately anyway - :prompt "" :prompt-mode :raw) - ((or command-not-accessible command-not-present) () - (beep) - (display-message "No such command") - (return-from com-extended-command nil))))) - (execute-drei-command *current-window* item))) - -(set-key 'com-extended-command - 'exclusive-pane-table - '((#\x :meta))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ;;; The Drei gadget and pane. ;;; ;;; An application can use Drei in two different ways - by using @@ -254,9 +186,6 @@ (setf space-width (text-size medium " " :text-style style) tab-width (* 8 space-width))))))

-(defmethod additional-command-tables append ((drei drei-pane) (table command-table)) - `(exclusive-pane-table)) - ;;; The fun is that in the gadget version of Drei, we do not control ;;; the application command loop, and in fact, need to operate ;;; completely independently of it - we can only act when the our port @@ -361,6 +290,10 @@ (accepting-from-user (drei) (execute-drei-command-for-frame (pane-frame drei) drei command))))

+(defmethod additional-command-tables append ((drei drei-gadget-pane) + (table drei-command-table)) + `(exclusive-gadget-table)) + (defclass drei-area (drei standard-sequence-output-record command-processor instant-macro-execution-mixin) @@ -392,7 +325,7 @@ (defmethod (setf active) :after (new-val (drei drei-area)) (replay drei (editor-pane drei)))

-(defmethod additional-command-tables append ((drei drei-area) (table command-table)) +(defmethod additional-command-tables append ((drei drei-area) (table drei-command-table)) `(exclusive-input-editor-table))

(defclass drei-minibuffer-pane (minibuffer-pane) @@ -426,14 +359,6 @@ (defmethod display-drei (frame (instance drei-area)) (display-drei-area instance))

-(defgeneric command-table (drei) - (:documentation "Return the command table object used by the - Drei instance `drei'.")) - -(defmethod command-table ((drei drei)) - (find-command-table (or (command-table (syntax (buffer drei))) - 'editor-table))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Programmer interface stuff --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/10 18:37:56 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/11 00:08:30 1.4 @@ -405,6 +405,96 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Drei command tables. + +;;; Commenting. +(make-command-table 'comment-table :errorp nil) +;;; Deleting. +(make-command-table 'deletion-table :errorp nil) +;;; Editing - making changes to a buffer. +(make-command-table 'editing-table :errorp nil) +;;; Filling. +(make-command-table 'fill-table :errorp nil) +;;; Dealing with charcase. +(make-command-table 'case-table :errorp nil) +;;; Indentation. +(make-command-table 'indent-table :errorp nil) +;;; Marking things. +(make-command-table 'marking-table :errorp nil) +;;; Moving around. +(make-command-table 'movement-table :errorp nil) +;;; Searching. +(make-command-table 'search-table :errorp nil) +;;; Information about buffer contents. +(make-command-table 'info-table :errorp nil) +;;; Self-insertion. +(make-command-table 'self-insert-table :errorp nil) + +;;; Command table for concrete editor stuff. +(define-syntax-command-table editor-table + :errorp nil + :inherit-from '(comment-table + deletion-table + editing-table + case-table + fill-table + indent-table + marking-table + movement-table + search-table + info-table + self-insert-table + keyboard-macro-table)) + +;; Command table for commands that are only available when Drei is a +;; gadget. There is no pane-exclusive table because the Drei pane is +;; not meant to be used as-is, but is meant to be subclassed, so we do +;; not want to force users to work around too much default behavior. +(make-command-table 'exclusive-gadget-table :errorp nil) + +;; Command table for input-editor-only commands. +(make-command-table 'exclusive-input-editor-table :errorp nil) + +(define-command (com-drei-extended-command :command-table exclusive-gadget-table) + () + "Prompt for a command name and arguments, then run it." + (let ((item (handler-case + (accept + `(command :command-table ,(command-table *current-window*)) + ;; this gets erased immediately anyway + :prompt "" :prompt-mode :raw) + ((or command-not-accessible command-not-present) () + (beep) + (display-message "No such command") + (return-from com-drei-extended-command nil))))) + (execute-drei-command *current-window* item))) + +(set-key 'com-drei-extended-command + 'exclusive-gadget-table + '((#\x :meta))) + +(defclass drei-command-table (standard-command-table) + () + (:documentation "This class is used to provide the kind of +indirection we need to support syntax-specific command tables in +Drei. Commands should *NOT* be added to it.")) + +(defmethod additional-command-tables append ((frame application-frame) + (command-table syntax-command-table)) + "This method allows users of Drei to extend syntaxes with new, +app-specific commands, as long as they inherit from a Drei class +and specialise a method for it." + (additional-command-tables *current-window* command-table)) + +(defmethod command-table-inherit-from ((table drei-command-table)) + (let ((syntax-table (command-table *current-syntax*))) + (list* syntax-table + (when (use-editor-commands-p syntax-table) + 'editor-table) + (additional-command-tables *current-window* table)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; The basic Drei class.

(defclass drei () @@ -475,7 +565,15 @@ :initarg :minibuffer :type (or minibuffer-pane null) :documentation "The minibuffer pane (or null) -associated with the Drei instance.")) +associated with the Drei instance.") + (%command-table :initform (make-instance 'drei-command-table + :name 'drei-dispatching-table) + :reader command-table + :initarg :command-table + :type standard-command-table + :documentation "The command table used for +looking up commands for the Drei instance. Has a sensible +default, don't override it unless you know what you are doing.")) (:default-initargs :active t :editable-p t) (:documentation "An abstract Drei class that should not be directly instantiated.")) @@ -687,13 +785,6 @@ (execute-drei-command-for-frame (pane-frame (editor-pane drei)) drei command)))

-(defmethod additional-command-tables append ((frame application-frame) - (command-table command-table)) - "This method allows users of Drei to extend syntaxes with new, -app-specific commands, as long as they inherit from a Drei class -and specialise a method for it." - (additional-command-tables *current-window* command-table)) - (defgeneric invoke-accepting-from-user (drei continuation) (:documentation "Set up `drei' and the environment so that calls to `accept' will behave properly. Then call --- /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2006/11/08 17:52:55 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2006/11/11 00:08:30 1.3 @@ -24,12 +24,19 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Every syntax must have a command table. + +(define-syntax-command-table fundamental-table + :errorp nil) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; The syntax object and misc stuff.

(define-syntax fundamental-syntax (syntax) ((lines :initform (make-instance 'standard-flexichain)) (scan :accessor scan)) - (:command-table editor-table) + (:command-table fundamental-table) (:name "Fundamental"))

(defmethod initialize-instance :after ((syntax fundamental-syntax) &rest args) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/09 00:53:21 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/11 00:08:30 1.4 @@ -43,8 +43,7 @@ ;;; The command table.

(define-syntax-command-table lisp-table - :errorp nil - :inherit-from '(editor-table)) + :errorp nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/11/11 00:08:30 1.2 @@ -132,7 +132,7 @@ (defpackage :drei-syntax (:use :clim-lisp :clim :drei-buffer :drei-base :flexichain :esa-utils) (:export #:syntax #:syntaxp #:define-syntax #:*default-syntax* #:cursor-positions - #:syntax-command-table #:additional-command-tables #:define-syntax-command-table + #:syntax-command-table #:use-editor-commands-p #:additional-command-tables #:define-syntax-command-table #:eval-option #:define-option-for-syntax #:current-attributes-for-syntax --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2006/11/11 00:08:30 1.2 @@ -25,7 +25,7 @@ (defclass syntax (name-mixin) ((buffer :initarg :buffer :reader buffer) (command-table :initarg :command-table - :initform nil + :initform (error "A command table has not been provided for this syntax") :reader command-table) (%cursor-positions :accessor cursor-positions :initform nil))) @@ -74,6 +74,17 @@ available when Lisp syntax is used in Climacs (or another editor), but not anywhere else."))

+(defgeneric use-editor-commands-p (command-table) + (:documentation "If `command-table' is supposed to include +standard editor commands (for inserting objects, moving cursor, +etc), this function will return T (the default). If you want your +syntax to use standard editor commands, you should *not* inherit +from `editor-table' - the command tables containing the editor +commands will be added automatically, as long as this function +returns T.") + (:method ((command-table syntax-command-table)) + t)) + (defgeneric additional-command-tables (editor command-table) (:method-combination append) (:documentation "Get a list of additional command tables that @@ -240,20 +251,23 @@ ;; collide with user-defined syntax initargs. Use ;; DREI-SYNTAX::%NAME instead. (setf default-initargs (list* :name name default-initargs)) - (once-only (command-table) - `(progn - (push (make-syntax-description - :name ,name :class-name ',class-name - :pathname-types ',pathname-types) - *syntaxes*) - (defclass ,class-name ,superclasses ,slots - (:default-initargs :command-table (when (find-command-table ,command-table) - (if (find-class ,command-table nil) - (make-instance ,command-table :name ,command-table) - ;; It must be just a command table. - (find-command-table ,command-table))) - ,@default-initargs) - ,@defclass-options))))) + `(progn + (push (make-syntax-description + :name ,name :class-name ',class-name + :pathname-types ',pathname-types) + *syntaxes*) + (defclass ,class-name ,superclasses ,slots + ,(append '(:default-initargs) + (when command-table + (list :command-table + (once-only (command-table) + `(when (find-command-table ,command-table) + (if (find-class ,command-table nil) + (make-instance ,command-table :name ,command-table) + ;; It must be just a command table. + (find-command-table ,command-table)))))) + default-initargs) + ,@defclass-options))))

(defgeneric eval-option (syntax name value) (:documentation "Evaluate the option `name' with the specified