[cells-cvs] CVS Celtk

[fgoenninger]

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)