[mcclim-cvs] CVS mcclim

[thenriksen]

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

Modified Files:
	dead-keys.lisp package.lisp 
Log Message:
Wrap up the last dead-key stuff for Drei gadgets.


--- /project/mcclim/cvsroot/mcclim/dead-keys.lisp	2008/04/30 21:27:48	1.1
+++ /project/mcclim/cvsroot/mcclim/dead-keys.lisp	2008/05/01 06:48:23	1.2
@@ -113,3 +113,35 @@
 (define-dead-key-combination (code-char 251) (:dead-circumflex #\u))
 (define-dead-key-combination (code-char 94) (:dead-circumflex #\space))
 (define-dead-key-combination (code-char 94) (:dead-circumflex :dead-circumflex))
+
+(defmacro merging-dead-keys ((gesture state) &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. `State' must be a
+place, initially NIL, that will contain the state of dead-key
+handling, enabling asynchronous use of the macro."
+  `(flet ((invoke-body (,gesture)
+            (setf ,state *dead-key-table*)
+            , at body))
+     (when (null ,state)
+       (setf ,state *dead-key-table*))
+     (if (typep ,gesture '(or keyboard-event character))
+         (let ((value (gethash (if (characterp ,gesture)
+                                   ,gesture
+                                   (keyboard-event-key-name ,gesture))
+                               ,state)))
+           (etypecase value
+             (null
+              (cond ((eq ,state *dead-key-table*)
+                     (invoke-body ,gesture))
+                    ((or (and (typep ,gesture 'keyboard-event)
+                              (keyboard-event-character ,gesture))
+                         (characterp ,gesture))
+                     (setf ,state *dead-key-table*))))
+             (character
+              (invoke-body value))
+             (hash-table
+              (setf ,state value))))
+         (invoke-body ,gesture))))
--- /project/mcclim/cvsroot/mcclim/package.lisp	2008/04/14 16:46:38	1.68
+++ /project/mcclim/cvsroot/mcclim/package.lisp	2008/05/01 06:48:23	1.69
@@ -1945,6 +1945,7 @@
    #:frame-display-pointer-documentation-string
    #:list-pane-items
    #:output-record-baseline
+   #:merging-dead-keys
    
    #:draw-output-border-over
    #:draw-output-border-under