Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv14804
Modified Files: Celtk.lisp ltktest-cells-inside.lisp Log Message: popup menu now sets canvas background color
--- /project/cells/cvsroot/Celtk/Celtk.lisp 2006/03/26 03:40:59 1.10 +++ /project/cells/cvsroot/Celtk/Celtk.lisp 2006/03/26 14:07:15 1.11 @@ -39,7 +39,7 @@ #:frame-stack #:mk-frame-stack #:path #:^path #:mk-menu-entry-radiobutton #:mk-menu-entry-checkbutton #:mk-menu-radio-group #:mk-menu-entry-separator - #:mk-menu-entry-command #:tk-callback #:mk-menu #:^menus #:mk-menu-entry-cascade #:mk-menubar + #:mk-menu-entry-command #:tk-callback #:menu #:mk-menu #:^menus #:mk-menu-entry-cascade #:mk-menubar #:^entry-values #:tk-eval-list #:mk-scale #:mk-popup-menubutton #:polygon #:mk-polygon #:oval #:mk-oval #:line #:mk-line #:arc #:mk-arc #:text-item #:mk-text-item #:rectangle #:mk-rectangle #:bitmap #:mk-bitmap #:canvas #:mk-canvas #:mk-frame-row @@ -47,7 +47,8 @@ #:mk-scroller #:mk-menu-entry-cascade-ex #:with-ltk #:tk-format #:send-wish #:value #:.tkw #:tk-user-queue-handler #:user-errors #:^user-errors - #:timer #:timers #:repeat #:executions #:state #:timer-reset #:make-timer-steps)) + #:timer #:timers #:repeat #:executions #:state #:timer-reset #:make-timer-steps + #:^widget-menu #:widget-menu))
(defpackage :celtk-user (:use :common-lisp :utils-kt :cells :celtk)) @@ -149,13 +150,21 @@ (gridding :reader gridding :initarg :gridding :initform nil) (enabled :reader enabled :initarg :enabled :initform t) (bindings :reader bindings :initarg :bindings :initform nil) - (menus :reader menus :initarg :menus :initform nil) + (menus :reader menus :initarg :menus :initform nil + :documentation "An assoc of an arbitrary key and the associated CLOS menu instances (not their tk ids)") (image-files :reader image-files :initarg :image-files :initform nil) (selector :reader selector :initarg :selector :initform (c? (upper self selector)))) (:default-initargs :id (gentemp "W")))
+(defun widget-menu (self key) + (or (find key (^menus) :key 'md-name) + (break "The only menus I see are~{ ~a,~} not requested ~a" (mapcar 'md-name (^menus)) key))) + +(defmacro ^widget-menu (key) + `(widget-menu self ,key)) + (defmethod make-tk-instance ((self widget)) (setf (gethash (^path) (dictionary .tkw)) self) (when (tk-class self) --- /project/cells/cvsroot/Celtk/ltktest-cells-inside.lisp 2006/03/26 03:40:59 1.10 +++ /project/cells/cvsroot/Celtk/ltktest-cells-inside.lisp 2006/03/26 14:07:15 1.11 @@ -38,7 +38,13 @@ How is programming with Celtk different from LTk?
Contrast the code below with the excellent ltktest "classic" in ltk.lisp to -see how Celtk programming is different. +see how Celtk programming is different. I won't say better, because some people prefer an +imperative approach where they can have all the bricks laid out in front of them +and lay them out carefully one by one to get exactly what they want without thinking +very hard. The declarative approach makes one think a little harder but in the end +do less work. The trade-off becomes a big win for the declarative model as the +interface gets either bigger or more dynamic, such as widgets that come and go as the +user specifies different things in other widgets.
Second topic:
@@ -103,9 +109,13 @@ ; (tk-test-class 'ltktest-cells-inside))
-; That is all the imperative code there is to Celtk application development, aside from widget commands. Tk handles some -; of the driving imperative logic, and Celtk internals handle the rest. The application works via rules reacting to change, -; computing new state for the application model, which operates on the outside world via observers (on-change callbacks) triggered +; That is all the imperative code there is to Celtk application development, aside from widget commands, and those +; invariably (?) consist of a single setf. So where does the rest of the state change necessary to keep a GUI +; interface self-consistent get taken care of? + +; Tk handles some of the driving imperative logic -- they call the company ActiveState for a reason -- and Celtk internals +; handle the rest. The application works via Cells rules reacting to change by computing new state for the application model, +; which operates on the outside world via observers (on-change callbacks) triggered ; automatically by the Cells engine. See DEFOBSERVER.
(defmodel ltktest-cells-inside (window) @@ -295,6 +305,18 @@ () (:default-initargs :id :test-canvas + :background (c? (or (selection (fm! :bkg (^menus))) + 'SystemButtonFace)) + ; + ; we are taking the demo a little further to make it a little more real world than just + ; printing to standard output. A point to make here is the decoupling of the menu from + ; its application role, namely allowing the user to specify the background color of + ; the spinning lines. The pop-up is now a radio-group menu that does not know how the + ; choice it is maintaining will be used. It simply takes care of its business of allowing + ; the user to choose exactly one color. Changes get propagated automatically by the Cells + ; engine to any slot whose rule happens to read the radio-group selection slot. And that + ; is all they have to do, read the value. No need to code "subscribe" or "notify" code. + ; :scroll-region '(0 0 500 400) :gridding "-row 0 -column 0 -sticky news" ; @@ -309,7 +331,7 @@ ; :xscrollcommand (c-in nil) ;; see canvas class for the Tk limitation behind this nonsense :yscrollcommand (c-in nil) ;; in brief, Tk lacks the concept of "late binding" on widget names - + :bindings (c? (list (list "<1>" (lambda (event) ; ; Stolen from the original. It means "when the left button is @@ -322,21 +344,33 @@ ; an observer on the bindings slot passes the needed bindings to Tk ; via the client queue. ; - (pop-up (car (^menus)) ;; (^menus) -> (menus self) + (pop-up (^widget-menu :bkg-pop) ;; (^menus) -> (menus self) (event-root-x event) (event-root-y event)))))) + :menus (c? (the-kids ; - ; here is a limitation with the declarative paradigm: pop-up menus are free to float about - ; unpacked in any parent. One just needs to remember the name of the menu widget to - ; pass it to the pop-up function. So imperative code like ltktest "classic" can just make the menus - ; saving their name in a closed-over local variable and then refer to them in a callback to pop them up. - ; - ; in the declarative paradigm we need a slot (defined for any widget or item class) in which - ; to build and store such menus. As with bindings, the nice thing again is that we find everything relative - ; to this widget specified in one place. + ; we could just build the menu in the rule above for bindings and then close over the variable + ; bearing the menu's Tk name in the binding callback in the call to pop-up, but I try to decompose + ; these things in the event that the bindings become dynamic over time (meaning the rule to generate + ; the binding list will run repeatedly) we are not forever regenerating the same pop-up menu. + ; premature optimization? well, it also makes the code clearer, and should the list of menus become + ; variable over time allows us to GC (via Tk "destroy") menus, so this is not so much about + ; optimization as it is about the Good Things that happen to well-organized code. ; + (mk-menu + :id :bkg-pop + :kids (c? (the-kids + (mk-menu-radio-group + :id :bkg + :selection (c-in nil) + :kids (c? (the-kids + (mk-menu-entry-radiobutton :label "Crimson Tide" :value "red") + (mk-menu-entry-radiobutton :label "Oak Tree Ribbon" :value "yellow") + (mk-menu-entry-radiobutton :label "Sky" :value "blue"))))))) + (mk-menu + :id :options :kids (c? (the-kids (mapcar (lambda (spec) (destructuring-bind (lbl . out$) spec