[cells-cvs] CVS Celtk

[ktilton]

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

Modified Files:
	entry.lisp ltktest-ci.lisp timer.lisp tk-object.lisp togl.lisp 
Log Message:


--- /project/cells/cvsroot/Celtk/entry.lisp	2006/06/03 12:04:37	1.14
+++ /project/cells/cvsroot/Celtk/entry.lisp	2006/09/03 13:39:56	1.15
@@ -16,7 +16,7 @@
 
 |#
 
-;;; $Header: /project/cells/cvsroot/Celtk/entry.lisp,v 1.14 2006/06/03 12:04:37 ktilton Exp $
+;;; $Header: /project/cells/cvsroot/Celtk/entry.lisp,v 1.15 2006/09/03 13:39:56 ktilton Exp $
 
 (in-package :Celtk)
 
@@ -40,10 +40,10 @@
     :xscrollcommand (c-in nil)
     :textvariable (c? (intern (^path)))
     :event-handler (lambda (self xe)
-                     (TRC nil "widget-event-handler" self (xsv type xe) )
+                     (TRC nil "ENTRY event-handler" self (xsv type xe) (tk-event-type (xsv type xe)))
                      (case (tk-event-type (xsv type xe))
                        (:virtualevent
-                        (trc nil "v/e" (xsv name xe))
+                        (trc nil "ENTRY virtual event" (xsv name xe))
                         (case (read-from-string (string-upcase (xsv name xe)))
                           (trace
                            (TRC nil "entry e/h trace" self (when (plusp (xsv user-data xe))
--- /project/cells/cvsroot/Celtk/ltktest-ci.lisp	2006/06/07 22:13:41	1.8
+++ /project/cells/cvsroot/Celtk/ltktest-ci.lisp	2006/09/03 13:39:56	1.9
@@ -99,7 +99,7 @@
   ; to defer things until The Right Time. Which brings us back to Tk. Inspect the source of
   ; tk-user-queue-handler and search the Celtk source for "with-integrity (:client" to see how Celtk
   ; manages to talk to Tk in the order Tk likes. And hack the function tk-format-now to have
-  ; Celtk dump the TCL/Tk code being sent to wish during initialization, and notice how un-random it looks. You can
+  ; Celtk dump the code it has evaluated by TCL/Tk during initialization, and notice how un-random it looks. You can
   ; then comment out the above specification of a Tk-savvy handler to see (a) the order that would have happened
   ; before Cells3 and (b) the demo collapse in a broken heap. 
   ;
@@ -393,7 +393,6 @@
                              for y = (+ (* 50 (cos angle-2)) 200 (* 150 (cos w)))
                              nconcing (list x y))))))
 
-
 (defun (setf moire-spin) (repeat self)
   (setf (repeat (car (timers self))) repeat)) ;; just hiding the implementation
 
@@ -453,3 +452,6 @@
 (defun mk-entry-numeric (&rest iargs)
   (apply 'make-instance 'entry-numeric :fm-parent *parent* iargs))
   
+(defun ctk::ltktest-ci ()
+  (cells-reset 'tk-user-queue-handler)
+  (ctk:test-window 'ltktest-cells-inside))
\ No newline at end of file
--- /project/cells/cvsroot/Celtk/timer.lisp	2006/07/24 05:04:01	1.10
+++ /project/cells/cvsroot/Celtk/timer.lisp	2006/09/03 13:39:56	1.11
@@ -74,10 +74,13 @@
    
    (on-command :reader on-command
      :initform (lambda (self)
-                 (when (eq (^state) :on)
+                 (unless (md-dead self)
+                   (trc nil "timer on-command dispatched!!!!!" self)
+                   (when (eq (^state) :on)
                      (assert (^action))
                      (funcall (^action) self)
-                     (setf (^executed) t))))
+                     (setf (^executed) t)))))
+
    (after-factory :reader after-factory
      :initform (c? (bwhen (rpt (when (eq (^state) :on)
                                (^repeat)))
@@ -92,7 +95,6 @@
 
 (defobserver state ((self timer))
   (unless (eq new-value :on)
-    (trc "bingo!!!!!!!!!!!!!!!!!!!!! state takes out timer" self)
     (cancel-timer self)))
 
 (defun set-timer (self time)
--- /project/cells/cvsroot/Celtk/tk-object.lisp	2006/07/06 22:10:40	1.8
+++ /project/cells/cvsroot/Celtk/tk-object.lisp	2006/09/03 13:39:56	1.9
@@ -34,6 +34,11 @@
    (user-errors :initarg :user-errors :accessor user-errors :initform nil))
   (:documentation "Root class for widgets and (canvas) items"))
 
+(defmethod not-to-be :before ((self tk-object))
+  (loop for timer in (^timers) do
+        (setf (state timer) :off)
+        (not-to-be timer)))
+
 (defmethod md-awaken :before ((self tk-object))
   (make-tk-instance self))
 
--- /project/cells/cvsroot/Celtk/togl.lisp	2006/08/28 21:44:40	1.18
+++ /project/cells/cvsroot/Celtk/togl.lisp	2006/09/03 13:39:56	1.19
@@ -185,8 +185,8 @@
 
 (def-togl-callback create ()
   (trc "!!!!!!!!!!!!!!!!!! about to install togl-ptr!!!!!!!!!!!!!!!!!!" togl-ptr )
-  #+cl-ftgl (setf cl-ftgl::*ftgl-ogl* togl-ptr) ;; help debug failure to use lazy cells/classes to defer FTGL till Ogl ready
-  (ogl::kt-opengl-reset)
+  ;;#+cl-ftgl (setf cl-ftgl::*ftgl-ogl* togl-ptr) ;; help debug failure to use lazy cells/classes to defer FTGL till Ogl ready
+  ;;(ogl::kt-opengl-reset)
   (setf (togl-ptr self) togl-ptr)
   (setf (gethash (pointer-address togl-ptr) (tkwins *tkw*)) self))