Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv31967
Modified Files: esa.lisp Log Message: Make C-g (and abort gestures in general) behave properly when they are part of a long gesture chain.
--- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/05/23 14:41:48 1.7 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/27 11:03:21 1.8 @@ -467,19 +467,6 @@ do (process-gesture drei gesture) finally (setf (executingp drei) nil)))
-(defclass macrorecord-processed-gestures-mixin () - () - (:documentation "Subclasses of this class will perform gesture -recording for macro recording when the gesture is being -processed. This is important when gesture reading does not go -through `esa-read-gesture', for example when the command -processor is being in an event-handling context.")) - -(defmethod process-gesture :before ((command-processor macrorecord-processed-gestures-mixin) gesture) - (when (and (recordingp command-processor) - (directly-processing-p command-processor)) - (push gesture (recorded-keys command-processor)))) - (defclass asynchronous-command-processor (command-processor instant-macro-execution-mixin macrorecord-processed-gestures-mixin) @@ -491,8 +478,9 @@
(defmethod process-gesture :before ((command-processor asynchronous-command-processor) gesture) (when (and (find gesture *abort-gestures* - :test #'gesture-matches-gesture-name-p) + :test #'gesture-matches-gesture-name-p) (directly-processing-p command-processor)) + (setf (accumulated-gestures command-processor) nil) (signal 'abort-gesture :event gesture)))
(defclass command-loop-command-processor (command-processor) @@ -632,7 +620,16 @@ (defun substitute-numeric-argument-p (command numargp) (substitute numargp *numeric-argument-p* command :test #'eq))
-(defgeneric process-gestures (command-processor)) +(defgeneric process-gestures (command-processor) + (:documentation "Process the gestures accumulated in +`command-processor', returning T if there are no gestures +accumulated or the accumulated gestures correspond to a +command. In this case, the command will also be executed and the +list of accumulated gestures set to NIL. Will return NIL if the +accumulated gestures do not yet correspond to a command, but +eventually could, if more gestures are provided. Signals +`unbound-gesture-sequence' if the accumulated gestures could +never refer to a command."))
(defmethod process-gestures ((command-processor command-processor)) (multiple-value-bind (prefix-arg prefix-p gestures) @@ -660,7 +657,13 @@ *partial-command-parser* (command-table command-processor) *standard-input* command 0))) - (setf (accumulated-gestures command-processor) nil)) + ;; If we are macrorecording, store whatever the user + ;; did to invoke this command. + (when (recordingp command-processor) + (setf (recorded-keys command-processor) + (append (accumulated-gestures command-processor) + (recorded-keys command-processor)))) + (setf (accumulated-gestures command-processor) nil)) (funcall (command-executor command-processor) command-processor command) nil)) (t t))))))) @@ -686,14 +689,15 @@ (loop for gesture = (read-gesture :stream stream) until (proper-gesture-p gesture) - finally (progn (when (recordingp command-processor) - (push gesture (recorded-keys command-processor))) - (return gesture)))) + finally (return gesture)))
(defun esa-unread-gesture (gesture &key (command-processor *command-processor*) (stream *standard-input*)) (cond ((recordingp command-processor) - (pop (recorded-keys command-processor)) + (cond ((equal (first (recorded-keys command-processor)) gesture) + (pop (recorded-keys command-processor))) + ((equal (first (accumulated-gestures command-processor)) gesture) + (pop (accumulated-gestures command-processor)))) (unread-gesture gesture :stream stream)) ((executingp command-processor) (push gesture (remaining-keys command-processor))) @@ -735,6 +739,14 @@ (funcall (command-executor command-processor) command-processor command)))))
+(defmethod process-gestures-or-command :around ((command-processor command-processor)) + (handler-case (call-next-method) + (abort-gesture (c) + ;; If the user aborts, we want to forget whatever previous + ;; gestures he entered since the last command execution. + (setf (accumulated-gestures command-processor) nil) + (signal c)))) + (defmethod process-gestures-or-command ((command-processor command-processor)) ;; Build up a list of gestures and repeatedly pass them to ;; `process-gestures'. This "clumsy" approach is chosen because we @@ -743,7 +755,8 @@ ;; rescanning of accumulated input data or some yet-unimplemented ;; complex state retaining mechanism (such as continuations). (loop - (setf *current-gesture* (esa-read-gesture :command-processor command-processor)) + (setf *current-gesture* + (esa-read-gesture :command-processor command-processor)) (unless (process-gesture command-processor *current-gesture*) (return))))