[mcclim-cvs] CVS mcclim

[thenriksen]

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

Modified Files:
	input-editing.lisp 
Log Message:
Added support for CLIM 2.2-style `with-activation-gestures' and
`with-delimiter-gestures'.


--- /project/mcclim/cvsroot/mcclim/input-editing.lisp	2006/12/12 22:32:40	1.54
+++ /project/mcclim/cvsroot/mcclim/input-editing.lisp	2006/12/12 22:36:32	1.55
@@ -63,12 +63,14 @@
 	(t existing-delimiter-gestures)))
 
 (defmacro with-activation-gestures ((gestures &key override) &body body)
-  ;; XXX Guess this implies that gestures need to be defined at compile time.
-  ;; Sigh.
-  (let ((gesture-form (if (and (symbolp gestures)
-			       (gethash gestures *gesture-names*))
-			  `(list ',gestures)
-			  gestures))
+  ;; XXX Guess this implies that gestures need to be defined at
+  ;; compile time.  Sigh.  We permit both CLIM 2.0-style gesture names
+  ;; and CLIM 2.2 style characters.
+  (let ((gesture-form (cond ((or (and (symbolp gestures)
+                                      (gethash gestures *gesture-names*))
+                                 (characterp gestures))
+                             `(list ',gestures))
+                            (t gestures)))
 	(gestures (gensym))
 	(override-var (gensym)))
     `(let* ((,gestures ,gesture-form)	;Preserve evaluation order of arguments
@@ -81,15 +83,17 @@
        , at body)))
 
 (defmacro with-delimiter-gestures ((gestures &key override) &body body)
-  ;; XXX Guess this implies that gestures need to be defined at compile time.
-  ;; Sigh.
-  (let ((gesture-form (if (and (symbolp gestures)
-			       (gethash gestures *gesture-names*))
-			  `(list ',gestures)
-			  gestures))
+  ;; XXX Guess this implies that gestures need to be defined at
+  ;; compile time.  Sigh.  We permit both CLIM 2.0-style gesture names
+  ;; and CLIM 2.2 style characters.
+  (let ((gesture-form (cond ((or (and (symbolp gestures)
+                                      (gethash gestures *gesture-names*))
+                                 (characterp gestures))
+                             `(list ',gestures))
+                            (t gestures)))
 	(gestures (gensym))
 	(override-var (gensym)))
-    `(let* ((,gestures ,gesture-form)	;Preserve evaluation order of arguments
+    `(let* ((,gestures ,gesture-form) ;Preserve evaluation order of arguments
 	    (,override-var ,override)
 	    (*delimiter-gestures* (make-delimiter-gestures
 				   (if ,override-var