Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv30176/ESA
Modified Files: dead-keys.lisp esa.lisp packages.lisp Log Message: Actually fix dead keys.
Turns out I got confused in my own maze of command processors.
Still needs a proper design decision about what to do wrt. abort gestures (C-g).
--- /project/mcclim/cvsroot/mcclim/ESA/dead-keys.lisp 2008/04/29 16:27:42 1.1 +++ /project/mcclim/cvsroot/mcclim/ESA/dead-keys.lisp 2008/04/29 20:52:04 1.2 @@ -113,18 +113,26 @@ (define-dead-key-combination (code-char 251) (:dead-circumflex #\u)) (define-dead-key-combination (code-char 94) (:dead-circumflex #\space))
-(defmacro handling-dead-keys ((gesture) &body body) +(defmacro handling-dead-keys ((gesture &optional restart) &body body) "Accumulate dead keys and subsequent characters. `Gesture' should be a symbol bound to either a gesture or an input event. When it has been determined that a sequence of `gesture's either does or doesn't result in a full gesture, `body' will be -evaluated with `gesture' bound to that gesture." +evaluated with `gesture' bound to that gesture. If `restart' is +true, start over with a new accumulation. If an `abort-gesture' +condition is signalled in `body', the accumulation will be +cleared." (with-gensyms (state-sym) `(retaining-value (,state-sym *dead-key-table*) + (when ,restart + (setf ,state-sym *dead-key-table*)) (flet ((invoke-body (,gesture) (setf ,state-sym *dead-key-table*) - ,@body)) - (if (typep gesture '(or keyboard-event character)) + (handler-case (progn ,@body) + (abort-gesture (c) + (setf ,state-sym *dead-key-table*) + (signal c))))) + (if (typep ,gesture '(or keyboard-event character)) (let ((value (gethash (if (characterp ,gesture) ,gesture (keyboard-event-key-name ,gesture)) --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/29 16:27:42 1.20 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/29 20:52:05 1.21 @@ -550,7 +550,7 @@ (end-command-loop (overriding-handler command-processor))) (setf (overriding-handler (super-command-processor command-processor)) nil))
-(defmethod process-gesture ((command-processor command-loop-command-processor) gesture) +(defmethod process-gesture :around ((command-processor command-loop-command-processor) gesture) (handling-dead-keys (gesture) (cond ((find gesture *abort-gestures* :test #'gesture-matches-gesture-name-p) @@ -562,10 +562,7 @@ (end-command-loop command-processor) (signal c)))) (t - (setf (accumulated-gestures command-processor) - (nconc (accumulated-gestures command-processor) - (list gesture))) - (process-gestures command-processor) + (call-next-method) (when (funcall (end-condition command-processor)) (funcall (end-function command-processor)) (end-command-loop command-processor)))))) @@ -777,11 +774,12 @@ ;; well, something that either requires this kind of repeated ;; 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)) - (unless (process-gesture command-processor *current-gesture*) - (return)))) + (loop for gesture = (esa-read-gesture :command-processor command-processor) + for first = t then nil + do (handling-dead-keys (gesture first) + (let ((*current-gesture* gesture)) + (unless (process-gesture command-processor *current-gesture*) + (return))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/04/29 16:27:42 1.18 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/04/29 20:52:05 1.19 @@ -89,6 +89,7 @@ #:find-applicable-command-table #:esa-command-parser #:esa-partial-command-parser + #:handling-dead-keys
#:gesture-matches-gesture-name-p #:meta-digit #:proper-gesture-p