--- a/src/indyvon/core.clj	Tue Jul 06 06:05:28 2010 +0400
+++ b/src/indyvon/core.clj	Wed Jul 07 03:10:22 2010 +0400
@@ -20,9 +20,14 @@
 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
 
 (defprotocol EventDispatcher
-  (listen! [this component])
-  (register [this context handlers])
-  (commit [this]))
+  (listen! [this component]
+           "Listen for events on the specified AWT Component.")
+  (register [this context handle handlers]
+            "Returns new context associated with the specified event
+            handlers (an event-id -> handler-fn map). Handle is used
+            to match the contexts between commits.")
+  (commit [this]
+          "Apply the registered handlers for event processing."))
 
 (defprotocol Anchored
   "Provide anchor point for Layers. Used by viewport."
@@ -53,11 +58,11 @@
 (defn default-theme []
   (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
   
-(defrecord LayerContext [layer parent x y width height update-fn
-  dispatcher font-context theme target])
+(defrecord LayerContext [x y width height update-fn font-context
+                         theme target dispatcher node])
 
 (defn default-context []
-  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil))
+  (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil nil))
 
 (defn update [context]
   ((:update-fn context)))
@@ -102,18 +107,22 @@
          (finally
           (.dispose graphics))))))
 
-(defn listen* [context & handlers]
-  (register (:dispatcher context) context (apply array-map handlers)))
+(defmacro handlers [handle bindings & specs]
+  "bindings => binding-form context
+   specs => (:event-id name & handler-body)* form
 
-;; (listen context
-;;   (:mouse-entered e (println e))
-;;   (:mouse-exited e (println e)))
-(defmacro listen [context & specs]
-  `(register (:dispatcher ~context) ~context
-             ~(reduce #(assoc %1
-                         (first %2)
-                         `(fn [~(second %2)] ~@(nnext %2)))
-                      {} specs)))
+  Execute form with the specified event handlers."
+  (let [[binding context] bindings
+        context (or context binding)]
+    `(let [context# ~context
+           ~binding
+           (register (:dispatcher context#) context# handle
+                     ~(reduce (fn [m spec]
+                                (assoc m (first spec)
+                                       `(fn [~(second spec)]
+                                          ~@(nnext spec)))) {}
+                                          (butlast specs)))]
+       ~(last specs))))
 
 ;;
 ;; EventDispatcher implementation
@@ -128,33 +137,17 @@
       java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
       java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
 
-(defrecord DispatcherNode [layer x y width height handlers children])
-
-(defrecord DispatcherRootNode [children])
+(defrecord DispatcherNode [handle handlers parent x y width height])
 
-(defn- make-node [c handlers]
-  (DispatcherNode. (:layer c) (:x c) (:y c) (:width c) (:height c)
-                   handlers nil))
-
-(defn- add-child [node child]
-  (assoc node :children (cons child (:children node))))
+(defn- make-node [c handle handlers]
+  (DispatcherNode. handle handlers (:node c)
+                   (:x c) (:y c) (:width c) (:height c)))
 
-(defn- registered-parent
-  "Returns first context parent registered for event processing."
-  [tree context]
-  (let [parent (:parent context)]
-    (cond
-     (nil? parent) nil
-     (contains? tree parent) parent
-     :default (recur tree parent))))
+(defn- assoc-cons [m key val]
+  (assoc m key (cons val (get m key))))
 
-(defn- add-context
-  [tree context handlers]
-  (let [parent (registered-parent tree context)
-        node (make-node context handlers)]
-    (assoc tree
-      parent (add-child (tree parent) node)
-      context node)))
+(defn- add-node [tree node]
+  (assoc-cons tree (:parent node) node))
 
 (defn- inside?
   ([x y node]
@@ -168,10 +161,12 @@
 
 (defn- under-cursor
   "Returns a sequence of child nodes under cursor."
-  [x y node]
-  (some #(if (inside? x y %)
-           (conj (under-cursor x y %) %))
-        (:children node)))
+  ([x y tree]
+     (under-cursor x y tree nil))
+  ([x y tree node]
+     (some #(if (inside? x y %)
+              (conj (under-cursor x y %) %))
+           (get tree node))))
 
 (defn- remove-all [coll1 coll2 pred]
   (filter #(not (some (partial pred %) coll2)) coll1))
@@ -199,8 +194,8 @@
   [hovered tree event]
   (let [x (.getX event)
         y (.getY event)
-        hovered2 (under-cursor x y (get tree nil))
-        pred #(= (:layer %1) (:layer %2))
+        hovered2 (under-cursor x y tree)
+        pred #(= (:handle %1) (:handle %2))
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
         moved (remove-all hovered2 entered pred)]
@@ -228,9 +223,8 @@
    (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
 
 (defn make-event-dispatcher []
-  (let [tree-i {nil (DispatcherRootNode. nil)} ; initial
-        tree-r (ref tree-i)                    ; register
-        tree (ref tree-i)                      ; dispatch
+  (let [tree-r (ref {})   ; register
+        tree (ref {})     ; dispatch
         hovered (ref '())
         picked (ref '())]
     (reify
@@ -239,11 +233,13 @@
         (doto component
           (.addMouseListener this)
           (.addMouseMotionListener this)))
-     (register [this context handlers]
-        (dosync (alter tree-r add-context context handlers)))
+     (register [this context handle handlers]
+        (let [node (make-node context handle handlers)]
+          (dosync (alter tree-r add-node node))
+          (assoc context :node node)))
      (commit [this]
         (dosync (ref-set tree @tree-r)
-                (ref-set tree-r tree-i)))
+                (ref-set tree-r {})))
      MouseListener
      (mouseEntered [this event]
         (dispatch-mouse-motion hovered @tree event))