[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Sat Nov 11 00:08:31 UTC 2006
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)))
- , at default-initargs)
- , at 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)
+ , at defclass-options))))
(defgeneric eval-option (syntax name value)
(:documentation "Evaluate the option `name' with the specified
More information about the Mcclim-cvs
mailing list