aboutsummaryrefslogtreecommitdiffhomepage
path: root/gui/menus.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'gui/menus.lisp')
-rw-r--r--gui/menus.lisp27
1 files changed, 19 insertions, 8 deletions
diff --git a/gui/menus.lisp b/gui/menus.lisp
index 0e51aba..77ce56f 100644
--- a/gui/menus.lisp
+++ b/gui/menus.lisp
@@ -22,13 +22,8 @@
(focus
(when (slot-boundp menu 'focus)
(unless (eq new-value (slot-value menu 'focus))
- (fire-blur-event-on (slot-value menu 'focus)))))))
-
-(defmethod (setf closer-mop:slot-value-using-class ) :after
- (new-value class (menu menu) slot)
- (case (closer-mop:slot-definition-name slot)
- (focus
- (fire-focus-event-on new-value))))
+ (fire-blur-event-on (slot-value menu 'focus))
+ (fire-focus-event-on new-value))))))
(macrolet
((def-menu-accessors (&rest accessor-names)
@@ -56,20 +51,30 @@
(dolist (o (menu-items menu))
(drop-unit o)))
+(defconstant +menu-mouseover-tag+ "menu-mouseover-tag")
+
(defgeneric add-menu-item (menu item))
(defmethod add-menu-item ((menu menu) item)
(setf (unit-region item) (unit-region menu)
(focusablep item) nil) ; so that event handling here doesn't steal menu focus
+ (add-handler
+ item
+ (on-mousemotion ()
+ :tag +menu-mouseover-tag+
+ (setf (menu-focus menu) item)))
(setf (menu-items menu)
(nconc (menu-items menu) (list item)))
(when (unit-in-scene-p menu)
(add-unit item)))
-(defun remove-menu-item (menu item)
+(defgeneric remove-menu-item (menu item))
+
+(defmethod remove-menu-item ((menu menu) item)
(when (member item (menu-items menu))
(setf (unit-region item) *application*)
(setf (menu-items menu)
(delete item (menu-items menu)))
+ (remove-handler item :mousemotion :tag +menu-mouseover-tag+)
(drop-unit item)))
(defmethod render ((menu menu))
@@ -105,6 +110,12 @@
(y item) (- (+ (y vs) (height vs) (vert-scroll vs))
(vscroller-items-height vs))))
+(defun refresh-vscroller (vs)
+ (setf (vert-scroll vs) (vert-scroll vs)))
+
+(defmethod remove-menu-item :after ((vs vscroller) item)
+ (refresh-vscroller vs))
+
(defmethod initialize-instance :after ((vscroller vscroller) &key)
(add-handler vscroller #'vscroller-scroll))