/[mcclim]/mcclim/menu.lisp
ViewVC logotype

Diff of /mcclim/menu.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by cvs, Fri Dec 8 14:42:43 2000 UTC revision 1.4 by cvs, Mon Dec 11 09:08:56 2000 UTC
# Line 88  Line 88 
88    ((command :initform nil :initarg :command)))    ((command :initform nil :initarg :command)))
89    
90  (defmethod arm-branch ((button menu-button-leaf-pane))  (defmethod arm-branch ((button menu-button-leaf-pane))
91    (unless (slot-value button 'destroyed)    (with-slots (client) button
92      (with-slots (client) button      (arm-menu client)
93        (arm-menu client)      (mapc #'destroy-substructure (menu-children client))
94        (mapc #'destroy-substructure (menu-children client))      (arm-menu button)))
       (arm-menu button))))  
95    
96  (defmethod destroy-substructure ((button menu-button-leaf-pane))  (defmethod destroy-substructure ((button menu-button-leaf-pane))
97    (with-slots (armed destroyed) button    (with-slots (armed) button
98        (setf armed nil)))        (setf armed nil)))
99    
100  (defmethod handle-event ((pane menu-button-leaf-pane) (event pointer-button-release-event))  (defmethod handle-event ((pane menu-button-leaf-pane) (event pointer-button-release-event))
# Line 106  Line 105 
105        (destroy-substructure (menu-root pane)))))        (destroy-substructure (menu-root pane)))))
106    
107  (defmethod handle-event ((pane menu-button-leaf-pane) (event pointer-exit-event))  (defmethod handle-event ((pane menu-button-leaf-pane) (event pointer-exit-event))
108    (unless (slot-value pane 'destroyed)    (disarm-menu pane))
     (disarm-menu pane)))  
109    
110  (defmethod handle-event ((pane menu-button-leaf-pane) (event pointer-ungrab-event))  (defmethod handle-event ((pane menu-button-leaf-pane) (event pointer-ungrab-event))
111    (destroy-substructure (menu-root pane)))    (destroy-substructure (menu-root pane)))
# Line 156  Line 154 
154    (with-slots (frame-manager submenu-frame) sub-menu    (with-slots (frame-manager submenu-frame) sub-menu
155      (when submenu-frame      (when submenu-frame
156        (mapc #'destroy-substructure (menu-children sub-menu))        (mapc #'destroy-substructure (menu-children sub-menu))
       (mapc #'(lambda (child)  
                 (setf (slot-value child 'destroyed) t))  
             (menu-children sub-menu))  
157        (disown-frame frame-manager submenu-frame)        (disown-frame frame-manager submenu-frame)
158        (setf submenu-frame nil))))        (setf submenu-frame nil))))
159    
160  (defmethod arm-branch ((sub-menu menu-button-submenu-pane))  (defmethod arm-branch ((sub-menu menu-button-submenu-pane))
161    (unless (slot-value sub-menu 'destroyed)    (with-slots (client frame-manager submenu-frame) sub-menu
162      (with-slots (client frame-manager submenu-frame) sub-menu      (arm-menu client)
163        (arm-menu client)      (if submenu-frame
164        (if submenu-frame          (progn (mapc #'destroy-substructure (menu-children sub-menu))
165            (progn (mapc #'destroy-substructure (menu-children sub-menu))                 (mapc #'disarm-menu (menu-children sub-menu)))
166                   (mapc #'disarm-menu (menu-children sub-menu)))          (progn
167            (progn            (mapc #'destroy-substructure (menu-children client))
168              (mapc #'destroy-substructure (menu-children client))            (create-substructure sub-menu sub-menu)))
169              (create-substructure sub-menu sub-menu)))      (arm-menu sub-menu)))
       (arm-menu sub-menu))))  
170    
171  (defmethod handle-event ((pane menu-button-submenu-pane) (event pointer-button-release-event))  (defmethod handle-event ((pane menu-button-submenu-pane) (event pointer-button-release-event))
172    (destroy-substructure (menu-root pane)))    (destroy-substructure (menu-root pane)))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5