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

Modified Files: input-editor.lisp drei.lisp drei-redisplay.lisp drei-clim.lisp Log Message: Drei redisplay cleanup. Fix some annoying bugs and make the structure of the redisplay functions clearer. Also minor fixup of the Drei-customized expression acceptor and some docstring changes.

--- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/11/10 01:15:58 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/11/17 20:18:56 1.4 @@ -76,7 +76,7 @@ (syntax (buffer (drei-instance obj)))) ;; XXX Really add it here? (stream-add-output-record stream (drei-instance obj)) - (display-drei-area (drei-instance obj))))) + (display-drei (drei-instance obj)))))

(defmethod stream-insertion-pointer ((stream drei-input-editing-mixin)) @@ -202,7 +202,7 @@ (delete-region begin-mark (stream-scan-pointer stream)) (insert-sequence begin-mark new-contents)) (update-syntax (buffer drei) (syntax (buffer drei))) - (display-drei-area drei) + (display-drei drei) (when (or rescan (not equal)) (queue-rescan stream)))))

@@ -387,7 +387,7 @@ (when was-directly-processing (display-message "Aborted")))))) ;; Will also take care of redisplaying minibuffer. - (display-drei (pane-frame (editor-pane drei)) drei) + (display-drei drei) (let ((first-mismatch (mismatch before (stream-input-buffer stream)))) (cond ((null first-mismatch) ;; No change actually took place, even though IP may @@ -493,7 +493,7 @@ ;; Since everything inserted with this method is noise strings, we ;; do not bother to modify the scan pointer or queue rescans. (update-syntax (buffer drei) (syntax (buffer drei))) - (display-drei-area drei))) + (display-drei drei)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -591,12 +591,15 @@ for gesture = (with-input-context ('expression :override nil) (object type) (read-gesture :stream stream) - (expression (performing-drei-operations (drei :with-undo t) + (expression (performing-drei-operations (drei :with-undo t + :redisplay t) (presentation-replace-input stream object type (view drei) :buffer-start (stream-insertion-pointer stream) :allow-other-keys t - :accept-result nil)) + :accept-result nil + :rescan t)) + (rescan-if-necessary stream) nil)) ;; True if `gesture' was freshly read from the user, and not ;; just retrieved from the buffer during a rescan. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/14 07:48:30 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/17 20:18:56 1.6 @@ -535,7 +535,10 @@ :documentation "The kill ring object associated with the Drei instance.") (%previous-command :initform nil - :accessor previous-command) + :accessor previous-command + :documentation "The previous CLIM command +executed by this Drei instance. May be NIL if no command has been +executed.") (%point-cursor :accessor point-cursor :initarg :point-cursor :type cursor @@ -565,7 +568,7 @@ :initarg :minibuffer :type (or minibuffer-pane null) :documentation "The minibuffer pane (or null) -associated with the Drei instance.") +associated with the Drei instance. This may be NIL.") (%command-table :initform (make-instance 'drei-command-table :name 'drei-dispatching-table) :reader command-table @@ -575,8 +578,10 @@ 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.")) + (:documentation "The abstract Drei class that maintains +standard Drei editor state. It should not be directly +instantiated, a subclass implementing specific behavior (a Drei +variant) should be used instead."))

(defmethod (setf active) :after (new-val (drei drei)) (mapcar #'(lambda (cursor) @@ -616,7 +621,7 @@ bot (clone-mark (high-mark buffer) :right))))

;; Main redisplay entry point. -(defgeneric display-drei (frame drei) +(defgeneric display-drei (drei) (:documentation "Display the given Drei instance."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -626,7 +631,9 @@ (defmacro handling-drei-conditions (&body body) "Evaluate `body' while handling Drei user notification signals. The handling consists of displaying their meaning to the -user in the minibuffer." +user in the minibuffer. This is the macro that ensures conditions +such as `motion-before-end' does not land the user in the +debugger." `(handler-case (progn ,@body) (offset-before-beginning () (beep) (display-message "Beginning of buffer")) @@ -673,7 +680,9 @@ from `drei-instance'. The keyword arguments can be used to provide forms that will be used to obtain values for the respective special variables, instead of finding their value in -`drei-instance'." +`drei-instance'. This macro binds all of the usual Drei special +variables, but also some CLIM special variables needed for +ESA-style command parsing." (once-only (drei-instance) `(let* ((*current-buffer* ,(or current-buffer `(buffer ,drei-instance))) (*current-window* ,(or current-window drei-instance)) @@ -697,15 +706,17 @@ &key with-undo (update-syntax t) (redisplay t)) (with-accessors ((buffer buffer)) drei (with-undo ((when with-undo (list buffer))) - (funcall continuation) - (when update-syntax - (update-syntax buffer (syntax buffer)) - (when (modified-p buffer) - (clear-modify buffer))) - (when redisplay - (display-drei *application-frame* drei)) - (unless with-undo - (clear-undo-history (buffer drei)))))) + (funcall continuation)) + (when (or update-syntax redisplay) + (update-syntax buffer (syntax buffer))) + (unless with-undo + (clear-undo-history (buffer drei))) + (when redisplay + (etypecase drei + (pane + (redisplay-frame-pane *application-frame* drei)) + (t + (display-drei drei))))))

(defmacro performing-drei-operations ((drei &rest args &key with-undo (update-syntax t) @@ -718,7 +729,8 @@ redisplayed, the syntax updated, etc. Exactly what is done can be controlled via the keyword arguments. Note that if `with-undo' is false, the *entire* undo history will be cleared after `body' has -been evaluated." +been evaluated. This macro expands into a call to +`invoke-performing-drei-operations'." (declare (ignore with-undo update-syntax redisplay)) `(invoke-performing-drei-operations ,drei (lambda () ,@body) @@ -772,7 +784,8 @@ can be done to arbitrary streams from within `body'. Or, at least, make sure the Drei instance will not be a problem. When Drei calls a command, it will be wrapped in this macro, so it -should be safe to use `accept' within Drei commands." +should be safe to use `accept' within Drei commands. This macro +expands into a call to `invoke-accepting-from-user'." `(invoke-accepting-from-user ,drei #'(lambda () ,@body)))

;;; Plain `execute-frame-command' is not good enough for us. Our @@ -780,29 +793,19 @@ ;;; that it is also responsible for updating the syntax of the buffer ;;; in the pane. (defgeneric execute-drei-command (drei-instance command) - (:documentation "Execute a CLIM command for a given Drei -instance. Methods defined on this generic function should set up -things like handling some Drei conditions, setting up undo, -etc.")) - -(defun execute-drei-command-for-frame (frame drei-instance command) - "Execute `command' using `execute-frame-command' on -`frame'. This function will handle Drei conditions and display -them on the minibuffer, as well as recording whatever changes -`command' makes to the buffer in the undo tree, and update the -syntax to reflect the changes." - (with-accessors ((buffer buffer)) drei-instance - (handling-drei-conditions - ;; Must be a list of buffers, so wrap in call to `list'. - (with-undo ((list buffer)) - (accepting-from-user (drei-instance) - (execute-frame-command frame command))) - (setf (previous-command drei-instance) command) - (update-syntax buffer (syntax buffer)) - (when (modified-p buffer) - (clear-modify buffer))))) + (:documentation "Execute `command' for `drei'. This is the +standard function for executing Drei commands - it will take care +of reporting to the user if a condition is signalled, updating +the syntax, setting the `previous-command' of `drei' and +recording the operations performed by `command' for undo."))

(defmethod execute-drei-command ((drei drei) command) - (let ((*standard-input* (or *minibuffer* *standard-input*))) - (execute-drei-command-for-frame (pane-frame (editor-pane drei)) - drei command))) + (with-accessors ((buffer buffer)) drei + (let ((*standard-input* (or *minibuffer* *standard-input*))) + (performing-drei-operations (drei :redisplay nil + :update-syntax t + :with-undo t) + (handling-drei-conditions + (accepting-from-user (drei) + (apply (command-name command) (command-arguments command))) + (setf (previous-command drei) command)))))) --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2006/11/09 00:52:01 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2006/11/17 20:18:56 1.4 @@ -394,27 +394,14 @@ (round (- cursor-x))) 0)))))))

-(defun display-drei-gadget (drei &key force-p (display-minibuffer t)) - "Redisplay the given Drei pane. If `display-minibuffer' is -non-NIL (the default), also redisplay the minibuffer associated -with the Drei instance. Use this from the event handlers so -`*standard-output*' is properly bound." - (let ((*standard-output* drei)) - (redisplay-frame-pane (pane-frame drei) drei :force-p force-p)) - (when display-minibuffer - (with-accessors ((minibuffer minibuffer)) drei - (let* ((minibuffer (or minibuffer *minibuffer*)) - (*standard-output* minibuffer)) - (redisplay-frame-pane (pane-frame minibuffer) minibuffer))))) - (defmethod handle-repaint :before ((pane drei-pane) region) (declare (ignore region)) (redisplay-frame-pane (pane-frame pane) pane))

-(defun display-drei-pane (drei-pane current-p) +(defun display-drei-pane (frame drei-pane) "Display `pane'. If `pane' has focus, `current-p' should be non-NIL." - (declare (ignore current-p)) + (declare (ignore frame)) (with-accessors ((buffer buffer) (top top) (bot bot) (point-cursor point-cursor)) drei-pane (if (full-redisplay-p drei-pane) --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2006/11/14 07:48:30 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2006/11/17 20:18:56 1.7 @@ -150,7 +150,7 @@ :end-of-line-action :scroll :background *background-color* :foreground *foreground-color* - :display-function 'display-drei + :display-function 'display-drei-pane :default-view +drei-textual-view+ :width 900 :active nil) @@ -158,6 +158,9 @@ permits (and requires) the host application to control the command loop completely."))

+(defmethod display-drei ((drei drei-pane)) + (redisplay-frame-pane (pane-frame drei) drei)) + (defmethod editor-pane ((drei drei-pane)) ;; The whole point of the `drei-pane' class is that it's its own ;; display surface. @@ -241,12 +244,12 @@ (defmethod armed-callback :after ((gadget drei-gadget-pane) client id) (declare (ignore client id)) (setf (active gadget) t) - (display-drei-gadget gadget :display-minibuffer nil)) + (display-drei gadget))

(defmethod disarmed-callback :after ((gadget drei-gadget-pane) client id) (declare (ignore client id)) (setf (active gadget) nil) - (display-drei-gadget gadget :display-minibuffer nil)) + (display-drei gadget))

(defun handle-new-gesture (drei gesture) (let ((*command-processor* drei) @@ -259,8 +262,24 @@ (unbound-gesture-sequence (c) (display-message "~A is unbound" (gesture-name (gestures c)))) (abort-gesture () - (display-message "Aborted"))) - (redisplay-frame-pane (pane-frame drei) drei)))) + (display-message "Aborted")))))) + +(defmethod execute-drei-command :around ((drei drei-gadget-pane) command) + (with-accessors ((buffer buffer)) drei + (let* ((*minibuffer* (or *minibuffer* + (unless (eq drei *standard-input*) + *standard-input*)))) + (call-next-method)) + (redisplay-frame-pane (pane-frame drei) drei) + (when (modified-p buffer) + (clear-modify buffer)))) + +(defmethod execute-drei-command :after ((drei drei-gadget-pane) command) + (with-accessors ((buffer buffer)) drei + (when (syntax buffer) + (update-syntax buffer (syntax buffer))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))))

;;; This is the method that functions as the entry point for all Drei ;;; gadget logic. @@ -280,14 +299,7 @@ (unwind-protect (progn (deactivate-gadget drei) (funcall continuation)) (activate-gadget drei) - ;; XXX: Work around McCLIM brokenness: - #+(or mcclim building-mcclim) (climi::arm-gadget drei t))) - -(defmethod execute-drei-command ((drei drei-gadget-pane) command) - (let* ((*minibuffer* (or *minibuffer* - (unless (eq drei *standard-input*) - *standard-input*)))) - (execute-drei-command-for-frame (pane-frame drei) drei command))) + (setf (active drei) t)))

(defmethod additional-command-tables append ((drei drei-gadget-pane) (table drei-command-table)) @@ -314,6 +326,9 @@ &key) (tree-recompute-extent area))

+(defmethod display-drei ((drei drei-area)) + (display-drei-area drei)) + ;; For areas, we need to switch to ESA abort gestures after we have ;; left the CLIM gesture reading machinery, but before we start doing ;; ESA gesture processing. @@ -343,18 +358,11 @@ (:documentation "A constellation of a Drei gadget instance and a minibuffer."))

-(defmethod display-drei (frame (drei drei-pane)) - (declare (ignore frame)) - (display-drei-pane drei (active drei))) - -(defmethod display-drei :after (frame (drei drei)) +(defmethod display-drei :after ((drei drei)) (with-accessors ((minibuffer minibuffer)) drei (when (and minibuffer (not (eq minibuffer (editor-pane drei)))) (redisplay-frame-pane (pane-frame minibuffer) minibuffer))))

-(defmethod display-drei (frame (drei drei-area)) - (display-drei-area drei)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Programmer interface stuff