[cells-cvs] CVS cells-gtk

[ktilton]

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

Modified Files:
	menus.lisp textview.lisp 
Log Message:
de-closify the menu used  to implement submenus

--- /project/cells/cvsroot/cells-gtk/menus.lisp	2008/01/31 03:31:12	1.3
+++ /project/cells/cvsroot/cells-gtk/menus.lisp	2008/01/31 06:50:25	1.4
@@ -185,7 +185,6 @@
   :padding 0)
 
 
-
 (def-widget menu-bar (menu-shell)
   () () ())
 
@@ -203,35 +202,24 @@
                        (mk-accel-label :text (label self))))))
    (accel :accessor accel :initarg :accel :initform (c-in nil))
    (owner :initarg :owner :accessor owner :initform (c-in nil))
-   (submenu :initarg :submenu :cell nil :accessor submenu :initform nil) ; gtk-menu-item-get-submenu not doing it. POD
-   (appended? :initarg :appended? :cell nil :accessor appended? :initform nil))
+   (submenu-id :initarg :submenu-id :cell nil :accessor submenu-id :initform nil) ; gtk-menu-item-get-submenu not doing it. POD
+   )
   (right-justified)
   (activate))
 
 (defobserver .kids ((self menu-shell))  
   (when new-value
     (dolist (kid new-value)
-      
-      (if (appended? kid)
-          (break "ducking duplicate append of kid ~a to (~a ~a) already in ~a" kid  (id self) self  (appended? kid))
-        (progn
-          (trc nil "mshell" (id self) self :kid kid :kidid (id kid) :kidpar (fm-parent kid))
-          (gtk-menu-shell-append (id self) (id kid))
-          (setf (appended? kid) (cons (id self) self))))))
+      (gtk-menu-shell-append (id self) (id kid))))
   #+clisp (call-next-method))
 
 (defobserver .kids ((self menu-item))
   (when old-value ; pod never occurs ?
-    (gtk-menu-item-remove-submenu (id self)))
+    (gtk-menu-item-remove-submenu (id self))) ;; almost certainly wrong -- better to Just Break here?
   (when new-value
-    #+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)))))
+    (gtk-menu-item-set-submenu (id self) (setf (submenu-id self) (gtk-menu-new)))
+    (dolist (kid new-value)
+      (gtk-menu-shell-append (submenu-id self) (id kid)))))
 
 (defun accel-key-mods (accel)
   (destructuring-bind (key &rest mods-lst) accel
--- /project/cells/cvsroot/cells-gtk/textview.lisp	2008/01/28 23:59:24	1.1
+++ /project/cells/cvsroot/cells-gtk/textview.lisp	2008/01/31 06:50:25	1.2
@@ -94,8 +94,6 @@
                  item)))
       #'(lambda (popup-menu)
           (loop for old in (old-popups text-view) do 
-               (when-bind (sub (submenu old)) 
-                 (gtk-object-forget (id sub) sub))
                (gtk-object-forget (id old) old))
           (let ((tops (mapcar #'do-padds p-adds)))
             (setf (old-popups text-view) accum)