[cells-devel] Celtk: Separating placing from instantiation of widgets

Frank Goenninger frgo at mac.com
Tue Jan 9 18:03:31 UTC 2007


Dear Celtikers: (or how do we call Celtk users ;-)

In the quest of generating a dynamic GUI for my sweet little app I  
encountered the need to separate widget instance creation from making  
them actually appear... Celtk does handle widget appearance as a side  
effekt of creating an instance - at least I understand the Celtk  
mechanism as such.

Now there's a couple of solutions of that I can imagine - each  
requiring a change to deeper Celtk mechanisms like adding a new slot  
"visiblep" to the widget class and then preventing placing, packing,  
and/or gridding when that slot is nil ... Too much low level stuff -  
I wonder if there's another solution ?!

I have:

(defmodel tibrv-console (window)
   ((active-workarea :accessor active-workarea
				   :initform (c-in nil)
				   :initarg :active-workarea)
    (workareas  :accessor workareas
			  :initform (c-in nil)
			  :initarg :workareas))
   (:default-initargs
      :id :tibrv-console
      :title$ (conc$ "*** G&C::TIBCO Rendezvous Console - " *tibrv- 
console-version* " ***")
      :width (c-in 800)
      :height (c-in 605)
      :workareas (c? (the-kids
   				     (make-kid 'msg-workarea)            ;; These two families  
should not
                                      (make-kid 'listener- 
workarea)))    ;; appear upon creation
		 :kids
		  (c? (the-kids
					  (main-menubar)
						(application-view self)
						(header-view self)
						(tool-header-view self)
						))))

(defmodel workarea (tibrv-model ctk::frame)
	((visiblep :accessor visiblep :initform (c- 
in :unplaced) :initarg :visiblep)
	 (title :accessor title
	  	  :initform (c-in nil)
		  :initarg :title)
	 (required-field-color :accessor required-field-color
					      :initform (c-in nil)
					      :initarg :required-field-color))
	(:default-initargs
			:id (gensym "WORKAREA-")
		:required-field-color (c-in "#f0d5da")))

(defobserver visiblep ((self workarea))
    (if (or (not new-value)
    	     (eql new-value :unplaced))
         (hide self)
	(unhide self)))

(defmethod hide (self)
   (when self
      (dolist (kid (kids self))
	(when kid
	    (hide kid)))
        (when (eql (type-of self) 'ctk::widget)
	  (tk-format '(:fini self) "place forget ~a" (path self)))
        (tk-format '(:fini self) "update idletasks")))

(defmethod unhide (self)
    (when (and self (eql (type-of self) 'ctk::widget))
       (tk-format '(:fini self) "place configure ~a -x ~a -y ~a"
									 (^path)
									 (ctk::^parent-x)
									 (ctk::^parent-y))
     (dolist (kid (kids self))
	(when kid
   	   (unhide kid)))
     (tk-format '(:fini self) "update idletasks")))


Hiding and unhiding works OK when called directly for a workarea  
object.. So that part is solved already...

Any ideas really appreciated.

Frank



More information about the cells-devel mailing list