[cells-cvs] CVS Celtk

fgoenninger fgoenninger at common-lisp.net
Sun Mar 23 11:38:16 UTC 2008


Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv4313

Modified Files:
	multichoice.lisp 
Log Message:
Changed: event id handling (see also entry.lisp)

--- /project/cells/cvsroot/Celtk/multichoice.lisp	2007/01/29 22:58:41	1.14
+++ /project/cells/cvsroot/Celtk/multichoice.lisp	2008/03/23 11:38:16	1.15
@@ -66,12 +66,22 @@
     :event-handler (lambda (self xe)
                      (case (tk-event-type (xsv type xe))
                        (:virtualevent
-                        (trc ":virtualevent" (xsv name xe))
-                        (case (read-from-string (string-upcase (xsv name xe)))
-                          (ListboxSelect
-                           (let ((selection (parse-integer (tk-eval "~a curselection" (^path)))))
-                             (setf (selection (tk-selector self))
-                               (value (elt (^kids) selection)))))))))))
+                         (trc nil "LISTBOX :virtualevent" (xsv name xe))
+                         (let ((event-id
+                                 (intern (read-from-string
+                                           (string-upcase (xsv name xe)))
+                                         :keyword)))
+                           (case event-id
+                             (:listboxselect
+                               (let ((selection
+                                       (parse-integer
+                                         (tk-eval "~a curselection" (^path))
+                                         :junk-allowed t)))
+                                 (trc nil "LISTBOX :virtualevent => selection: " selection)
+                                 (when selection
+                                   (setf (selection (tk-selector self))
+                                         (value (elt (^kids) selection))))))))
+                        )))))
 
 (defmodel listbox-item (tk-object)
   ((item-text :initarg :item-text :accessor item-text




More information about the Cells-cvs mailing list