[cells-cvs] CVS Celtk
ktilton
ktilton at common-lisp.net
Sun Mar 26 14:07:15 UTC 2006
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
More information about the Cells-cvs
mailing list