Update of /project/cells/cvsroot/Celtk In directory cl-net:/tmp/cvs-serv4382

Modified Files: Celtk.lisp Log Message: Changed: Added :grouped to the list of valid tk queue codes. Changed: More debug output for tk-format.

--- /project/cells/cvsroot/Celtk/Celtk.lisp 2008/06/16 12:35:55 1.43 +++ /project/cells/cvsroot/Celtk/Celtk.lisp 2009/08/14 16:05:20 1.44 @@ -16,7 +16,7 @@

|#

-;;; $Header: /project/cells/cvsroot/Celtk/Celtk.lisp,v 1.43 2008/06/16 12:35:55 ktilton Exp $ +;;; $Header: /project/cells/cvsroot/Celtk/Celtk.lisp,v 1.44 2009/08/14 16:05:20 fgoenninger Exp $

;(pushnew :tile *features*) ;; frgo, 2007-09-21: Need to do this only when tile actually loaded

@@ -75,7 +75,7 @@ (defparameter +tk-client-task-priority+ '(:delete :forget :destroy :pre-make-tk :make-tk :make-tk-menubutton :post-make-tk - :variable :bind :selection :trace :configure :grid :pack :fini)) + :variable :bind :selection :trace :configure :grid :pack :fini :grouped))

(defun tk-user-queue-sort (task1 task2) "Intended for use as user queue sorter, to make Tk happy by giving it stuff in the order it needs to work properly." @@ -136,11 +136,11 @@ (unless (find *tkw* *windows-destroyed*) (let* ((*print-circle* nil) (tk$ (apply 'format nil fmt$ fmt-args))) - (let ((yes ) ; '("menubar" "cd")) + (let ((yes '("key" "wm")) ; '("menubar" "cd")) (no '())) (declare (ignorable yes no)) (when (find-if (lambda (s) (search s tk$)) yes) - (format t "~&tk> ~a~%" tk$))) + (format t "~&tk-format-now> ~a~%" tk$))) (assert *tki*) (setf *tk-last* tk$) (tcl-eval-ex *tki* tk$)))) @@ -148,7 +148,7 @@ (defun tk-format (defer-info fmt$ &rest fmt-args) "Format then send to wish (via user queue)" (assert (or (eq defer-info :grouped) - (consp defer-info)) () "need defer-info to sort command ~a. Specify :grouped if caller is managing user-queue" + (consp defer-info)) () "Need defer-info to sort command ~a. Specify :grouped if caller is managing user-queue" (apply 'format nil fmt$ fmt-args))

(when (eq defer-info :grouped)