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))