Commits

Anonymous committed 4ae5616

Cells can now depend on normal java object properties.

Comments (0)

Files changed (1)

src/net/ksojat/neman/cells.clj

 ;; remove this notice, or any other, from this software.
 
 (ns net.ksojat.neman.cells
-  (:use clojure.set))
+  (:import (clojure.lang IRef)))
 
 ;;
 ;; Cell class
   :constructors {[clojure.lang.IPersistentMap] []})
 
 (defn -Cell-init [init]
-  [[] (ref (merge {:value nil :parents {}} init))])
+  [[] (ref (merge {:value nil :parents {} :triggers []} init))])
 
 (defn -get [this]
   (get @(.state this) :value))
 (defn -getValidator [this]
   (.. this state getValidator))
 
+(defn -addWatch [this watcher action send-off]
+  (.. this state (addWatch watcher action send-off)))
+
+(defn -removeWatch [this watcher]
+  (.. this state (removeWatch watcher)))
+
+(defn -notifyWatches [this]
+  (.. this state notifyWatches))
+
 ;;
-;; Listeners
+;; Property Listeners
+;;
 
 (defmulti add-listener
   (fn [object property callback] [(class object) property]))
 (import '(javax.swing JTextField)
         '(java.awt.event ActionListener ActionEvent))
 
-(defmethod add-listener [JTextField :Text] [object _ callback]
+(defmethod add-listener [JTextField :text] [object _ callback]
   (let [listener (proxy [ActionListener] []
                    (actionPerformed [#^ActionEvent e]
-                     (callback (.getText object))))]
+                     (callback)))]
     (.addActionListener object listener)
     listener))
 
   (.removeActionListener object listener))
 
 ;;
-;; Cell macros
+;;
 ;;
 
+(defn add-parent-watcher [parent update-fn]
+  (if (vector? parent)
+    (let [[object property] parent]
+      (add-listener object property update-fn))
+    (let [watcher (agent nil)]
+      (add-watcher parent :send watcher (fn [& _] (update-fn)))
+      watcher)))
+
+(defn remove-parent-watcher [parent watcher]
+  (if (instance? IRef parent)
+    (remove-watcher  parent watcher)
+    (remove-listener parent watcher)))
+
+(defn parent-value [parent]
+  (if (vector? parent)
+    (let [[object property] parent]
+      (property (bean object)))
+    (deref parent)))
+
 (defmacro alter-cell [cell parents bindings expr]
-  `(let [cell#  ~cell
-         old-p# (:parents @(.state cell#))
-         new-p# (into {} (map (fn [p#] [p# (agent nil)]) ~parents))
-         f#     (fn []
-                  (let ~(vec (interleave bindings (map #(do `(deref ~%)) parents)))
-                  ~expr))]
-     ; Update cell state
-     (dosync
-       (alter (.state cell#) assoc :value (f#) :parents new-p#))
+  `(let [cell# ~cell
+         f# (fn []
+              (let
+                ~(vec (interleave bindings (map #(do `(parent-value ~%)) parents)))
+                ~expr))
+         update# (fn []
+                   (let [ov# (deref cell#), nv# (f#)]
+                     (when (not= ov# nv#)
+                       (dosync (alter (.state cell#) assoc :value nv#))
+                       (doseq [t# (:triggers @(.state cell#))] (t# ov# nv#)))))]
+     ; Remove watchers from old parents
+     (doseq [[r# w#] (:parents @(.state cell#))]
+       (remove-parent-watcher r# w#))
 
-     ; Remove watchers from old parents
-     (doseq [[r# w#] old-p#] (remove-watcher r# w#))
+     ; Add watchers to new parents.
+     (let [new-w# (map (fn [p#] (add-parent-watcher p# update#)) ~parents)
+           new-p# (apply hash-map (interleave ~parents new-w#))]
+       (doall new-w#)
+       (dosync
+         (alter (.state cell#) assoc :parents new-p#))
+       (doall new-p#))
 
-     ; Add watchers to new parents
-     (doseq [[r# w#] new-p#]
-       (add-watcher r# :send w#
-         (fn [& _#]
-           (let [ov# (deref cell#), nv# (f#)]
-             (when (not= ov# nv#)
-               (dosync (alter (.state cell#) assoc :value nv#)))))))
-
+     (update#)
      cell#))
 
 (defmacro cell [parents bindings expr]
   `(alter-cell (net.ksojat.neman.cells.Cell. {}) ~parents ~bindings ~expr))
+
+(defn add-trigger [cell trigger-fn]
+  (dosync
+    (alter (.state cell) update-in [:triggers] conj trigger-fn))
+  trigger-fn)
+
+(comment
+  (def a (ref 1))
+  (def b (ref 2))
+
+  (def x (cell [a b] [v1 v2] (+ v1 v2)))
+  (println @a) (println @b) (println @x)
+  ; 1
+  ; 2
+  ; 3
+
+  (dosync (ref-set a 100))
+  (println @a) (println @x)
+  ; 100
+  ; 102
+
+  (alter-cell x [b] [v] (inc b))
+  (println @x)
+  ; 3
+
+  ;
+  ; Depending on object property
+  ;
+  (def tw (javax.swing.JTextField.))
+  (def fw (javax.swing.JFrame.))
+  (doto fw
+    (.add tw) .pack .show)
+
+  ; Cell is updated when text property of JTextField widget is changed.
+  (def c1 (cell [[tw :text]] [t] (str "Text is: " t)))
+  (add-trigger c1
+    (fn [old-v new-v]
+      (println old-v)
+      (println new-v)))
+)