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))