[mcclim-cvs] CVS mcclim/ESA

[thenriksen]

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*)
-                , at body))
-         (if (typep gesture '(or keyboard-event character))
+                (handler-case (progn , at 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