[cells-gtk-cvs] CVS update: root/cells-gtk/menus.lisp

[Peter Denno]

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp.net:/tmp/cvs-serv7527/cells-gtk

Modified Files:
	menus.lisp 
Log Message:
Stuff to clean up menus that occur as the menu-items supplied by populate-popup signals. Also new owner slot on menu-item.
Date: Sat Feb 26 23:28:08 2005
Author: pdenno

Index: root/cells-gtk/menus.lisp
diff -u root/cells-gtk/menus.lisp:1.8 root/cells-gtk/menus.lisp:1.9
--- root/cells-gtk/menus.lisp:1.8	Wed Feb 16 23:22:01 2005
+++ root/cells-gtk/menus.lisp	Sat Feb 26 23:28:08 2005
@@ -149,7 +149,9 @@
    (label-widget :accessor label-widget :initarg :label-widget :initform nil)
    (accel-label-widget :accessor accel-label-widget :initform (c? (and (label self)
 							   (to-be (mk-accel-label :text (label self))))))
-   (accel :accessor accel :initarg :accel :initform (c-in nil)))
+   (accel :accessor accel :initarg :accel :initform (c-in nil))
+   (owner :initarg :owner :accessor owner :initform (c-in nil))
+   (submenu :cell nil :accessor submenu :initform nil)) ; gtk-menu-item-get-submenu not doing it. POD
   (right-justified)
   (activate))
 
@@ -184,11 +186,11 @@
     (gtk-container-add (id self) (id new-value))))
 
 (def-c-output .kids ((self menu-item))
-  (when old-value
+  (when old-value ; pod never occurs ?
     (gtk-menu-item-remove-submenu (id self)))
   (when new-value
     (gtk-menu-item-set-submenu (id self)
-       (id (make-be 'menu :kids new-value)))))
+       (id (setf (submenu self) (make-be 'menu :kids new-value))))))
 
 (def-widget check-menu-item (menu-item)
   ((init :accessor init :initarg :init :initform nil))