[cells-devel] celtk notebook widget

Andy Chambers achambers.home at googlemail.com
Sun Jun 15 22:05:53 UTC 2008


Hi,

I made a notebook widget for celtk.  It just uses the built-in tile
notebook and introduces a "tab" widget which is just a container for
stuff you can add to a notebook.

On a separate note,  I was having trouble getting the latest versions
of cells and celtk to play nicely together.  I reverted back to cells
from March to work on this stuff since that's when I was last working
on my expander widget.  I'll investigate the problems and try to
provide some more useful input later this week.


;--- n o t e b o o k ----------------------------------------------

(deftk notebook (widget decoration-mixin)
  ()
  (:tk-spec notebook
    -height -padding -width)
  (:default-initargs
      :id (gentemp "NB")
    :packing nil))

(defmethod make-tk-instance ((self notebook))
  (tk-format `(:make-tk ,self) "ttk::notebook ~a" (^path))
  (tk-format `(:pack ,self) "pack ~a -expand yes -fill both" (^path)))

(defobserver .kids ((self notebook))
  (loop for k in (^kids)
      do (trc "ttk::notebook adds" k (type-of k) (md-name k) (path k))
        (tk-format `(:post-make-tk ,self) "~a add ~a -text ~a"
					  (^path)
					  (path k)
					  (text k))))

;--- t a b -----------------------------------------------------------

(deftk tab (frame-stack widget)
  ()
  (:tk-spec tab
    -state -sticky -padding -text -image)
  (:default-initargs
      :id (gentemp "TB")))


(defmacro mk-tab ((&rest inits) &body body)
  `(make-instance 'tab :fm-parent *parent* , at inits
		  :kids (c? (the-kids
			     , at body))))

(defmethod make-tk-instance ((self tab))
  (tk-format `(:make-tk ,self) "frame ~a" (^path)))

;--- example usage ---------------------------------------------------

(defmd nb-test (window)
  (kids (c? (the-kids
	     (mk-notebook
	      :width 100
	      :kids (c? (the-kids
			 (mk-tab (:text "first")
			   (mk-stack ("tab with container")
			     (mk-label :text "hi")))
			 (mk-tab (:text "second")
			   (mk-label :text "a")
			   (mk-label :text "b")))))))))

(defun test-nb ()
  (test-window 'nb-test))

-- 
----
Andy Chambers
Formedix Ltd



More information about the cells-devel mailing list