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)