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

Modified Files: Celtk.lisp run.lisp tk-interp.lisp Log Message: use tk_getnummainwindows to figure out when to stop looping on tcl_dooneevent

--- /project/cells/cvsroot/Celtk/Celtk.lisp 2006/05/03 08:46:56 1.15 +++ /project/cells/cvsroot/Celtk/Celtk.lisp 2006/05/03 20:02:36 1.16 @@ -124,7 +124,7 @@ ; ; --- debug stuff --- ; - (let ((yes '("pop" "menu" "mnu")) + (let ((yes '("bind" "pop" "menu" "mnu")) (no '("tk-events")))

(declare (ignorable yes no)) --- /project/cells/cvsroot/Celtk/run.lisp 2006/05/03 17:18:29 1.4 +++ /project/cells/cvsroot/Celtk/run.lisp 2006/05/03 20:02:36 1.5 @@ -72,7 +72,8 @@

(defun tcl-do-one-event-loop () (loop with start-time = (get-internal-real-time) - while (> 10 (floor (- (get-internal-real-time) start-time) internal-time-units-per-second)) + while (and (plusp (tk-get-num-main-windows)) + (> 10 (floor (- (get-internal-real-time) start-time) internal-time-units-per-second))) do (bif (events (prog1 (tk-eval-list "set tk-events") @@ -80,6 +81,7 @@ (progn #+shhh (loop for e in events do (trc "event preview" e)) + (trc "main windows count =" (tk-get-num-main-windows)) (loop for e in events do (setf start-time (get-internal-real-time)) (tk-process-event e))) --- /project/cells/cvsroot/Celtk/tk-interp.lisp 2006/05/03 08:20:49 1.2 +++ /project/cells/cvsroot/Celtk/tk-interp.lisp 2006/05/03 20:02:36 1.3 @@ -165,6 +165,8 @@

(defcfun ("Tcl_GetStringResult" tcl-get-string-result) :string (interp :pointer)) + + (defcfun ("Tk_GetNumMainWindows" tk-get-num-main-windows) :int)

(defun Tcl_Eval (interp script) (with-foreign-string (script-cstr script) @@ -388,11 +390,11 @@ (trc "tk-eval result:" (tk-eval "tk scaling")) (trc "tk-eval-list result:" (tk-eval-list "font families"))))

-(defun exec-main () - (main "\0devtools\frgotk\psu-rc-gui.tcl")) - -#+test -(exec-main) +;;;(defun exec-main () +;;; (main "\0devtools\frgotk\psu-rc-gui.tcl")) +;;; +;;;#+test +;;;(exec-main)

;;; Togl stuff