diff options
author | Colin Okay <okay@toyful.space> | 2022-07-23 16:44:17 -0500 |
---|---|---|
committer | Colin Okay <okay@toyful.space> | 2022-07-23 16:44:17 -0500 |
commit | 228eebe0a022fac2159c53f504fae8628268b9b9 (patch) | |
tree | 34dbd48f80f8833597adb96ba9073b05354cd286 /gui/menus.lisp | |
parent | 8f36ccc37a52557e6b41515e510033a61998ef73 (diff) |
[remove] spurious refs to display tree events; [tweak] menu focus
I may add these display tree events back in
Diffstat (limited to 'gui/menus.lisp')
-rw-r--r-- | gui/menus.lisp | 27 |
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)) |