[remove] spurious refs to display tree events; [tweak] menu focus

I may add these display tree events back in

6 files changed, 41 insertions, 29 deletions

diff --git a/examples/13-menus.lisp b/examples/13-menus.lisp
index d1c5668..2c797f3 100644
--- a/examples/13-menus.lisp
+++ b/examples/13-menus.lisp
@@ -9,11 +9,23 @@
 (defclass menus-demo (ww::application) ())
 
 (defclass numbered-image (ww::image)
-  ((n :initarg :num :reader num)))
+  ((n :initarg :num :reader num)
+   (menu :initarg :menu :accessor item-menu)))
+
+(defmethod ww::add-menu-item :after ((menu ww::menu) (item numbered-image))
+  (setf (item-menu item) menu))
 
 (ww:defhandler item-clicked
     (ww::on-mousedown (img)
-      (format t "~a was clicked~%" (num img))))
+      (ww::remove-menu-item (item-menu img) img)))
+
+(ww::defhandler indicate-focus
+    (ww::on-focus (img)
+      (format t "~a got focus~%" (num img))))
+
+(ww::defhandler indicate-blur
+    (ww::on-blur (img)
+      (format t "~a lost focus~%" (num img))))
 
 (defmethod ww::boot ((app menus-demo))
   (let ((vscroller
@@ -27,7 +39,9 @@
                                    :num i
                                    :texture (ww:get-asset "Fezghoul.png"))
           do 
-             (ww::add-handler img #'item-clicked)
+             (ww:add-handler img #'item-clicked)
+             (ww:add-handler img #'indicate-blur)
+             (ww:add-handler img #'indicate-focus)
              (ww::add-menu-item vscroller img))
     (ww:add-unit vscroller)
     (ww:refocus-on vscroller)))
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))
 
diff --git a/src/application.lisp b/src/application.lisp
index 4073a15..5b6e9ad 100644
--- a/src/application.lisp
+++ b/src/application.lisp
@@ -71,22 +71,20 @@
     (focus
      (when (slot-boundp app 'focus) 
        (unless (eq new-value (slot-value app 'focus)) 
-         (fire-blur-event-on (slot-value app 'focus)))))))
+         (fire-blur-event-on (slot-value app 'focus))
+         (fire-focus-event-on new-value))))))
 
 (defmethod (setf closer-mop:slot-value-using-class) :after
     (new-value class (app application) slot)
   (case (closer-mop:slot-definition-name slot)
     ((scale width height)
      (set-projection app))
-    (focus
-     (fire-focus-event-on new-value))
     (fps
      (setf (slot-value app 'frame-wait) (/ 1.0 new-value)))))
 
 (defparameter +listener-table-slot-names+
   '(keydown-table keyup-table mousedown-table  mouseup-table  mousemotion-table
-    focus-table blur-table perframe-table after-added-table before-added-table
-    before-dropped-table))
+    focus-table blur-table perframe-table))
 
 (defmethod cleanup ((app application))
   (loop for asset being the hash-value of (application-assets app)
diff --git a/src/events/event-handler.lisp b/src/events/event-handler.lisp
index a88f63d..e9a26cd 100644
--- a/src/events/event-handler.lisp
+++ b/src/events/event-handler.lisp
@@ -262,6 +262,7 @@ can be redefined using this form to support interactive development."
 "
   `(make-instance
     'event-handler
+    :tag ,(get-tag-from-handler-body body)
     :event-type 'wheelwork::mousewheel
     :handler-function (lambda
                           (,(intern (symbol-name target))
@@ -273,7 +274,7 @@ can be redefined using this form to support interactive development."
                                             ,(intern (symbol-name horiz))
                                             ,(intern (symbol-name vert))
                                             ,(intern (symbol-name dir))))
-                        ,@body)))
+                        ,@(get-body-from-handler-body body))))
 
 (defmacro on-blur
     ((&optional (target 'target)) &body body)
diff --git a/src/events/listener.lisp b/src/events/listener.lisp
index 366465a..e66afe2 100644
--- a/src/events/listener.lisp
+++ b/src/events/listener.lisp
@@ -12,9 +12,6 @@
     focus
     blur
     perframe
-    after-added
-    before-added
-    before-dropped
     :r :with :type (or null event-handler) :std nil)
    (keydown-table
     keyup-table
@@ -25,9 +22,6 @@
     focus-table
     blur-table
     perframe-table
-    after-added-table
-    before-added-table
-    before-dropped-table
     :static
     :std (make-hash-table :synchronized t)
     :doc "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if
diff --git a/src/package.lisp b/src/package.lisp
index 7a07726..22cb797 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -47,9 +47,6 @@
    ;; Event Handler API
    #:add-handler
    #:defhandler
-   #:on-after-added
-   #:on-before-added
-   #:on-before-dropped
    #:on-blur
    #:on-focus
    #:on-keydown
@@ -62,9 +59,6 @@
 
    ;; Event Names, useful for dropping whole classes of events from a
    ;; unit
-   #:after-added
-   #:before-added
-   #:before-dropped
    #:blur
    #:focus
    #:keydown