[mcclim-cvs] CVS mcclim/Examples

[tmoore]

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

Modified Files:
	dragndrop-translator.lisp 
Log Message:
Missing eval-when

--- /project/mcclim/cvsroot/mcclim/Examples/dragndrop-translator.lisp	2006/03/13 06:13:05	1.1
+++ /project/mcclim/cvsroot/mcclim/Examples/dragndrop-translator.lisp	2006/03/13 11:24:01	1.2
@@ -23,14 +23,15 @@
 (defparameter *colors* (list +black+ +white+ +red+ +green+ +blue+ +magenta+
 			     +cyan+ +yellow+))
 
-(defparameter *color-alist*  `(("black" . ,+black+)
-			       ("white" . ,+white+)
-			       ("red" . ,+red+)
-			       ("green" . ,+green+)
-			       ("blue" . ,+blue+)
-			       ("magenta" . ,+magenta+)
-			       ("cyan" . ,+cyan+)
-			       ("yellow" . ,+yellow+)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defparameter *color-alist*  `(("black" . ,+black+)
+				 ("white" . ,+white+)
+				 ("red" . ,+red+)
+				 ("green" . ,+green+)
+				 ("blue" . ,+blue+)
+				 ("magenta" . ,+magenta+)
+				 ("cyan" . ,+cyan+)
+				 ("yellow" . ,+yellow+))))
 
 (define-presentation-type named-color ()
   :inherit-from `(completion ,*color-alist* :value-key cdr))
@@ -79,7 +80,12 @@
     (setf (color shape) (cdr (nth elt *color-alist*)))))
 
 (define-drag-and-drop-translator com-drop-color
-    (rect command rect drag-test)
+    (rect command rect drag-test
+     :tester ((destination-object event)
+	      (when destination-object
+		(break))
+	      event
+	      t))
     (object destination-object)
   (if (eq object destination-object)
       `(com-set-random-color ,object)