[cells-cvs] CVS cells-gtk

[ktilton]

Update of /project/cells/cvsroot/cells-gtk
In directory clnet:/tmp/cvs-serv20829

Modified Files:
	gtk-app.lisp menus.lisp 
Log Message:


--- /project/cells/cvsroot/cells-gtk/gtk-app.lisp	2008/01/30 21:13:44	1.2
+++ /project/cells/cvsroot/cells-gtk/gtk-app.lisp	2008/01/31 03:31:12	1.3
@@ -62,7 +62,6 @@
 
 (defvar *gtk-initialized* nil)
 
-
 (defun start-app (app-name &key debug)
   (let ((*gtk-debug* debug))
     (when (not *gtk-initialized*)
@@ -93,8 +92,6 @@
           (setf (visible app) t)
           (when *gtk-debug* (trc nil "STARTING GTK-MAIN") (force-output))
           (unwind-protect
-              (gtk-main)
-            #+chill
               (loop 
                 (restart-case
                     (handler-bind 
@@ -116,13 +113,10 @@
                   (give-up-cleanly () (return-from start-app))
                   (report-error-and-give-up (c) (error c))))
             ;; clean-up forms (takes down application).
-            (trcx not-to-be-app 42)
+            
             (not-to-be app) ; while (> (gtk-main-level) 0) do (gtk-main-quit) NG. Why?
-            (trcx gtk-main-quits 42)
             (loop for i from 0 to 30 do (gtk-main-quit))
-            (trcx mopping-events 42)
             (loop while (gtk-events-pending) do
-                  (trcx gtk-main-iter-do 42)
                   (gtk-main-iteration-do nil)))))))
 
 ;;; Restarts
--- /project/cells/cvsroot/cells-gtk/menus.lisp	2008/01/30 21:13:44	1.2
+++ /project/cells/cvsroot/cells-gtk/menus.lisp	2008/01/31 03:31:12	1.3
@@ -224,13 +224,14 @@
   (when old-value ; pod never occurs ?
     (gtk-menu-item-remove-submenu (id self)))
   (when new-value
-    (with-integrity (:change 'set-sub-menu-actually)
-      (unless (submenu self)
-        (let ((subid (id (setf (submenu self) 
-                           (make-instance 'menu
-                             :md-name (gensym "SUBMENU-MENU")
-                             :kids new-value))))) ;; <=== was mak
-          (gtk-menu-item-set-submenu (id self) subid))))))
+    #+chill (when (eq (md-name self) 'test-gtk::SUBMENU-MENUITEM)
+              (break "NN obs kids enqueues submenu ~a" self cells::*data-pulse-id*))
+    (with-integrity (:awaken 'set-sub-menu-actually)
+      (let ((subid (id (setf (submenu self) 
+                         (make-instance 'menu
+                           :md-name (gensym "SUBMENU-MENU")
+                           :kids new-value))))) ;; <=== was mak
+        (gtk-menu-item-set-submenu (id self) subid)))))
 
 (defun accel-key-mods (accel)
   (destructuring-bind (key &rest mods-lst) accel