[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Fri Nov 17 20:18:56 UTC 2006
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 , at 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 ()
, at 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 () , at 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
More information about the Mcclim-cvs
mailing list