Permalink
Browse files

Finished up tree model event stuff.

  • Loading branch information...
1 parent 8687c59 commit 86b5e1f6edb58a6fb20caa0283d7c70d4f850dcf @daveray committed Dec 5, 2011
Showing with 190 additions and 32 deletions.
  1. +132 −7 src/seesaw/tree.clj
  2. +58 −25 test/seesaw/test/tree.clj
View
@@ -11,15 +11,141 @@
(ns seesaw.tree)
(defprotocol TreeModelEventSource
- (fire-event
- [this event-type source path-to-node]
+ (fire-event*
+ [this event-type event]
"Dispatches a TreeModelEvent to all model listeners. event-type is one of
:tree-nodes-changed, :tree-nodes-inserted, :tree-nodes-removed or
- :tree-structure-changed."))
+ :tree-structure-changed. Note, do not use this function directly.
+ Instead use one of the helper functions in (seesaw.tree)."))
+
+(defn- ensure-array
+ [v] (if v (to-array v)))
+
+(defn node-structure-changed
+ "Fire a node structure changed event on a tree model created with
+ (simple-tree-model). node-path is the sequence of nodes from the model
+ root to the node whose structure changed.
+
+ Call this when the entire structure under a node has changed.
+
+ See:
+ (seesaw.tree/simple-tree-model)
+ "
+ [tree-model node-path]
+ (fire-event* tree-model
+ :tree-structure-changed
+ (javax.swing.event.TreeModelEvent. tree-model
+ (ensure-array node-path)
+ nil
+ nil)))
+
+(defn nodes-removed
+ "Fire a node removed event on a tree model created with
+ (simple-tree-model). parent-path is the path to the parent node,
+ indices is a seq of the indices of the removed nodes and children
+ is a seq of the removed nodes.
+
+ See:
+ (seesaw.tree/simple-tree-model)
+ (seesaw.tree/node-removed)
+ "
+ [tree-model parent-path indices children]
+ (fire-event* tree-model
+ :tree-nodes-removed
+ (javax.swing.event.TreeModelEvent. tree-model
+ (ensure-array parent-path)
+ (into-array Integer/TYPE indices)
+ (ensure-array children))))
+
+(defn node-removed
+ "Fire a node removed event on a tree model created with
+ (simple-tree-model). parent-path is the path to the parent node,
+ index is the index of the removed node and child is the removed node.
+
+ See:
+ (seesaw.tree/nodes-removed)
+ (seesaw.tree/simple-tree-model)
+ "
+ [tree-model parent-path index child]
+ (nodes-removed tree-model parent-path [index] [child]))
+
+(defn- build-insert-or-change-event [tree-model parent-path children]
+ (let [indices (if-let [parent (last parent-path)]
+ (map #(.getIndexOfChild tree-model parent %) children)) ]
+ (javax.swing.event.TreeModelEvent. tree-model
+ (ensure-array parent-path)
+ (if indices (into-array Integer/TYPE indices))
+ (ensure-array children))))
+
+(defn nodes-inserted
+ "Fire a node insertion event. parent-path is the path to the parent of the
+ newly inserted children. children is the newly inserted nodes.
+
+ See:
+ (seesaw.tree/node-inserted)
+ (seesaw.tree/simple-tree-model)
+ "
+ [tree-model parent-path children]
+ (fire-event* tree-model
+ :tree-nodes-inserted
+ (build-insert-or-change-event tree-model parent-path children)))
+
+(defn node-inserted
+ "Fire a node insertion event. parent-path is the path to the parent of the
+ newly inserted child. child is the newly inserted node.
+
+ See:
+ (seesaw.tree/nodes-inserted)
+ (seesaw.tree/simple-tree-model)
+ "
+ [tree-model node-path]
+ (let [parent-path (butlast node-path)
+ node (last node-path)]
+ (nodes-inserted tree-model
+ (or parent-path [node])
+ (if parent-path [node]))))
+
+(defn nodes-changed
+ "Fire a node changed event. parent-path is the path to the parent of the
+ changed children. children is the changed nodes.
+
+ Fire this event if the appearance of a node has changed in any way.
+
+ See:
+ (seesaw.tree/node-changed)
+ (seesaw.tree/simple-tree-model)
+ "
+ [tree-model parent-path children]
+ (fire-event* tree-model
+ :tree-nodes-changed
+ (build-insert-or-change-event tree-model parent-path children)))
+
+(defn node-changed
+ "Fire a node changed event. parent-path is the path to the parent of the
+ changed node. child is the changed node.
+
+ Fire this event if the appearance of a node has changed in any way.
+
+ See:
+ (seesaw.tree/nodes-changed)
+ (seesaw.tree/simple-tree-model)
+ "
+ [tree-model node-path]
+ (let [parent-path (butlast node-path)
+ node (last node-path)]
+ (nodes-changed tree-model
+ (or parent-path [node])
+ (if parent-path [node]))))
(defn simple-tree-model
"Create a simple, read-only TreeModel for use with seesaw.core/tree.
- The arguments are the same as clojure.core/tree-seq."
+ The arguments are the same as clojure.core/tree-seq. Changes to the
+ underlying model can be reported with the various node-xxx event
+ functions in seesaw.tree.
+
+ See:
+ http://docs.oracle.com/javase/6/docs/api/javax/swing/tree/TreeModel.html
+ "
[branch? children root]
(let [listeners (atom [])]
(reify
@@ -37,13 +163,12 @@
(valueForPathChanged [this path newValue])
TreeModelEventSource
- (fire-event [this event-type source path-to-node]
+ (fire-event* [this event-type event]
(let [handler (condp = event-type
:tree-nodes-changed #(.treeNodesChanged %1 %2)
:tree-nodes-inserted #(.treeNodesInserted %1 %2)
:tree-nodes-removed #(.treeNodesRemoved %1 %2)
- :tree-structure-changed #(.treeStructureChanged %1 %2))
- event (javax.swing.event.TreeModelEvent. source (object-array path-to-node))]
+ :tree-structure-changed #(.treeStructureChanged %1 %2))]
(doseq [listener @listeners]
(handler listener event)))))))
View
@@ -44,7 +44,7 @@
(it "should allow a listener to be added"
(let [called (atom nil)]
(.addTreeModelListener m (tree-listener #(reset! called %)))
- (fire-event m :tree-nodes-changed :foo [:bar])
+ (node-changed m [(.getRoot m)])
(expect @called)))
(it "should allow a listener to be removed"
(let [called-a (atom nil)
@@ -54,31 +54,64 @@
(.addTreeModelListener m listener-a)
(.addTreeModelListener m listener-b)
(.removeTreeModelListener m listener-a)
- (fire-event m :tree-nodes-changed :foo [:bar])
+ (node-changed m [(.getRoot m)])
(expect (not @called-a))
(expect @called-b)))))
+(defn- make-test-model []
+ (simple-tree-model #(.isDirectory %) #(.listFiles %) (java.io.File. ".")))
+
(describe fire-event
- (it "fires events of the correct type"
- (let [m (simple-tree-model (constantly true) (constantly nil) :x)
- nodes-changed (atom nil)
- nodes-inserted (atom nil)
- nodes-removed (atom nil)
- structure-changed (atom nil)
- ; dummy args
- event-source :foo
- path-to-node [:bar]]
- (listen m
- :tree-nodes-changed #(reset! nodes-changed %)
- :tree-nodes-inserted #(reset! nodes-inserted %)
- :tree-nodes-removed #(reset! nodes-removed %)
- :tree-structure-changed #(reset! structure-changed %))
- (expect (not (or @nodes-changed @nodes-inserted @nodes-removed @structure-changed)))
- (fire-event m :tree-nodes-changed event-source path-to-node)
- (expect @nodes-changed)
- (fire-event m :tree-nodes-inserted event-source path-to-node)
- (expect @nodes-inserted)
- (fire-event m :tree-nodes-removed event-source path-to-node)
- (expect @nodes-removed)
- (fire-event m :tree-structure-changed event-source path-to-node)
- (expect @structure-changed))))
+ (it "fires nodes-changed events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-nodes-changed #(reset! e %))
+ (nodes-changed m [root] (map #(.getChild m root %) (range 4)))
+ (expect (not (nil? @e)))))
+ (it "fires node-changed events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-nodes-changed #(reset! e %))
+ (node-changed m [root])
+ (expect (not (nil? @e)))))
+ (it "fires nodes-inserted events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-nodes-inserted #(reset! e %))
+ (nodes-inserted m [root] (map #(.getChild m root %) (range 4)))
+ (expect (not (nil? @e)))))
+ (it "fires node-inserted events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-nodes-inserted #(reset! e %))
+ (node-inserted m [root])
+ (expect (not (nil? @e)))))
+
+ (it "fires node-structure-changed events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-structure-changed #(reset! e %))
+ (node-structure-changed m [root])
+ (expect (not (nil? @e)))))
+
+ (it "fires nodes-removed events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-nodes-removed #(reset! e %))
+ (nodes-removed m [root] (range 1 4) (map #(.getChild m root %) (range 1 4)))
+ (expect (not (nil? @e)))))
+
+ (it "fires node-removed events"
+ (let [m (make-test-model)
+ e (atom nil)
+ root (.getRoot m)]
+ (listen m :tree-nodes-removed #(reset! e %))
+ (node-removed m [root] 2 (.getChild m root 2))
+ (expect (not (nil? @e))))))
+

4 comments on commit 86b5e1f

@harto
Contributor
harto commented on 86b5e1f Dec 5, 2011

Looks pretty much the same as what I had, but with tests and documentation :)
I think the only other difference is that I used (int-array ...) instead of (into-array Integer/TYPE ...).

@daveray
Owner

Cool. I'll make that change. Did you actually have this implemented already? We talked about it, but I didn't see any new commits or pull requests from you.

@harto
Contributor
harto replied Dec 5, 2011
@daveray
Owner

Ok. Cool.

Please sign in to comment.