Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 164 lines (145 sloc) 8.543 kb
2415fa4 @daveray Natural dnd flavor creation.
authored
1 ; Copyright (c) Dave Ray, 2011. All rights reserved.
2
3 ; The use and distribution terms for this software are covered by the
4 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
5 ; which can be found in the file epl-v10.html at the root of this
6 ; distribution.
7 ; By using this software in any fashion, you are agreeing to be bound by
8 ; the terms of this license.
9 ; You must not remove this notice, or any other, from this software.
10
11 (ns seesaw.test.dnd
12 (:use seesaw.dnd)
13 (:use [seesaw.graphics]
14 [lazytest.describe :only (describe it testing)]
15 [lazytest.expect :only (expect)])
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
16 (:import [java.awt.datatransfer DataFlavor StringSelection
17 UnsupportedFlavorException]
18 [javax.swing TransferHandler]))
2415fa4 @daveray Natural dnd flavor creation.
authored
19
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
20 (describe local-object-flavor
2415fa4 @daveray Natural dnd flavor creation.
authored
21 (it "creates a JVM local flavor for an arbitrary class"
22 (let [c (class [])
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
23 f (local-object-flavor c)]
2415fa4 @daveray Natural dnd flavor creation.
authored
24 (expect (= (format "%s; class=%s" DataFlavor/javaJVMLocalObjectMimeType (.getName c)) (.getMimeType f)))))
25 (it "creates a JVM local flavor for an arbitrary value"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
26 (= (local-object-flavor (class [])) (local-object-flavor []))))
27
28 (describe uri-list-flavor
365f7b8 @daveray Switch from java.net.URL to java.net.URI for uri-list. URI is a bette…
authored
29 (it "implements to-remote to convert list of URIs to uri-list"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
30 (= "http://google.com\r\nhttp://github.com"
31 (to-remote uri-list-flavor
365f7b8 @daveray Switch from java.net.URL to java.net.URI for uri-list. URI is a bette…
authored
32 [(java.net.URI. "http://google.com")
33 (java.net.URI. "http://github.com")])))
34 (it "implements to-local to convert uri-list to list of URIs"
35 (= [(java.net.URI. "http://google.com") (java.net.URI. "http://github.com")]
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
36 (to-local uri-list-flavor "http://google.com\r\nhttp://github.com" ))))
2415fa4 @daveray Natural dnd flavor creation.
authored
37
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
38 (describe default-transferable
39 (testing "resulting transferable"
40 (it "can hold an arbitrary object"
41 (let [o ["hi"]
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
42 t (default-transferable [string-flavor o])]
bfa4df4 @daveray to-flavor -> to-raw-flavor
authored
43 (expect (identical? o (.getTransferData t (to-raw-flavor string-flavor))))))
12d7f11 @daveray Implemented dnd createTransferable and getSourceActions, reworking th…
authored
44 (it "can hold arbitrary objects or functions"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
45 (let [t (default-transferable [string-flavor "hi"
46 (local-object-flavor Integer) (fn [] 99)])]
bfa4df4 @daveray to-flavor -> to-raw-flavor
authored
47 (expect (= "hi" (.getTransferData t (to-raw-flavor string-flavor))))
48 (expect (= 99 (.getTransferData t (to-raw-flavor (local-object-flavor Integer)))))))
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
49 (it "throws UnsupportedFlavorException correctly"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
50 (let [t (default-transferable [string-flavor "hi"])]
bfa4df4 @daveray to-flavor -> to-raw-flavor
authored
51 (try (.getTransferData t (to-raw-flavor file-list-flavor)) false
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
52 (catch UnsupportedFlavorException e true))))
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
53 (it "implements (getTransferDataFlavors)"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
54 (let [t (default-transferable [(local-object-flavor []) []])
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
55 flavors (.getTransferDataFlavors t)]
bfa4df4 @daveray to-flavor -> to-raw-flavor
authored
56 (expect (= (to-raw-flavor (local-object-flavor [])) (aget flavors 0)))))
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
57 (it "implements (isDataFlavorSupported)"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
58 (let [t (default-transferable [(local-object-flavor []) []])]
bfa4df4 @daveray to-flavor -> to-raw-flavor
authored
59 (expect (.isDataFlavorSupported t (to-raw-flavor (local-object-flavor []))))
60 (expect (not (.isDataFlavorSupported t (to-raw-flavor string-flavor))))))))
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
61
62 (defn fake-transfer-support [t]
63 (javax.swing.TransferHandler$TransferSupport. (javax.swing.JLabel.) t))
64
65 (describe default-transfer-handler
1a45725 @davesann modified :import option on default-transfer-handler to allow checking…
davesann authored
66 (testing "(default-transfer-handler)"
67 (it "creates a transfer handler"
68 (instance? javax.swing.TransferHandler (default-transfer-handler)))
69 (it "throws an ex-info if there is a handler-map without an on-drop key"
70 (try
71 (default-transfer-handler :import [string-flavor {}]) false
72 (catch clojure.lang.ExceptionInfo e true))))
90003e1 @daveray Finished importData impl
authored
73
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
74 (testing "(canImport)"
75 (it "returns false if the :import map is missing or empty"
76 (not (.canImport (default-transfer-handler) (fake-transfer-support (StringSelection. "hi")))))
90003e1 @daveray Finished importData impl
authored
77
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
78 (it "only accepts flavors in the keys of the :import map"
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
79 (let [th (default-transfer-handler :import [string-flavor (fn [info])])]
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
80 (expect (.canImport th (fake-transfer-support (StringSelection. "hi"))))
1a45725 @davesann modified :import option on default-transfer-handler to allow checking…
davesann authored
81 (expect (not (.canImport th (fake-transfer-support (default-transferable [])))))))
82
83 (let [transfer-handler (default-transfer-handler
84 :import [string-flavor {:on-drop (fn [info])
85 :can-drop? (fn [info]
86 (= info "should match"))}])]
87 (testing ":can-drop?"
88 (it "returns false if the import handler is a map and :can-drop? returns false"
89 (not (.canImport transfer-handler
90 (fake-transfer-support (StringSelection. "should not match")))))
91
92 (it "returns true if the import handler is a map and :can-drop? returns true"
93 (.canImport transfer-handler
94 (fake-transfer-support (StringSelection. "should match"))))
95
96 (let [transfer-handler (default-transfer-handler
97 :import [string-flavor {:on-drop (fn [info])}])]
98 (it "returns true if the import handler is a map and :can-drop? is not given"
99 (.canImport transfer-handler
100 (fake-transfer-support (StringSelection. "should match"))))))))
90003e1 @daveray Finished importData impl
authored
101
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
102 (testing "(importData)"
103 (it "returns false immediately if (canImport) returns false"
104 (let [called (atom false)
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
105 th (default-transfer-handler :import [string-flavor (fn [info] (reset! called true))])]
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
106 (expect (not (.importData th (fake-transfer-support (default-transferable [])))))
90003e1 @daveray Finished importData impl
authored
107 (expect (not @called))))
108
109 (it "calls the handler for the first matching flavor"
110 (let [called (atom nil)
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
111 th (default-transfer-handler :import [string-flavor (fn [info] (reset! called info) true)])
90003e1 @daveray Finished importData impl
authored
112 support (fake-transfer-support (StringSelection. "Something"))]
113 (expect (.importData th support))
114 (expect (= @called {:data "Something"
115 :drop? false
116 :drop-location nil
117 :target (.getComponent support)
12d7f11 @daveray Implemented dnd createTransferable and getSourceActions, reworking th…
authored
118 :support support})))))
119
120 (testing "(createTransferable)"
121 (it "returns a transferable given :import/:start "
122 (let [c (javax.swing.JTextField. "some text")
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
123 th (default-transfer-handler :export { :start (fn [c] [string-flavor (.getText c)]) })
12d7f11 @daveray Implemented dnd createTransferable and getSourceActions, reworking th…
authored
124 trans (.createTransferable th c)]
bfa4df4 @daveray to-flavor -> to-raw-flavor
authored
125 (expect (= "some text" (.getTransferData trans (to-raw-flavor string-flavor)))))))
12d7f11 @daveray Implemented dnd createTransferable and getSourceActions, reworking th…
authored
126
127 (testing "(getSourceActions)"
128 (it "returns :none if :export is omitted"
129 (let [c (javax.swing.JTextField. "some text")
130 th (default-transfer-handler)
131 actions (.getSourceActions th c)]
132 (expect (= TransferHandler/NONE actions))))
133 (it "returns :none if the provided function returns nil"
134 (let [c (javax.swing.JTextField. "some text")
135 th (default-transfer-handler :export { :actions (fn [c] nil) })
136 actions (.getSourceActions th c)]
137 (expect (= TransferHandler/NONE actions))))
138 (it "returns :move by default"
139 (let [c (javax.swing.JTextField. "some text")
140 th (default-transfer-handler :export {})
141 actions (.getSourceActions th c)]
142 (expect (= TransferHandler/MOVE actions))))
143 (it "returns the result of calling the provided function"
144 (let [c (javax.swing.JTextField. "some text")
145 th (default-transfer-handler :export { :actions (fn [c] :link) })
146 actions (.getSourceActions th c)]
a273b44 @daveray Finished inital basic impl of dnd ops. Still need to integrate into c…
authored
147 (expect (= TransferHandler/LINK actions)))))
148 (testing "(exportDone)"
149 (it "returns false if :export is omitted"
150 (let [th (default-transfer-handler)]
151 (expect (not (.exportDone th nil nil TransferHandler/MOVE)))))
152 (it "returns false if :export/:finish is omitted"
153 (let [th (default-transfer-handler :export {})]
154 (expect (not (.exportDone th nil nil TransferHandler/MOVE)))))
155 (it "calls the :export/:finish function with a map"
156 (let [source (javax.swing.JTextField. "some text")
7ea6359 @daveray Reworked drag and drop flavors completely. Much better.
authored
157 tr (default-transferable [string-flavor "hi" (local-object-flavor Integer) (fn [] 99)])
a273b44 @daveray Finished inital basic impl of dnd ops. Still need to integrate into c…
authored
158 called (atom nil)
159 th (default-transfer-handler :export { :finish (fn [v] (reset! called v) true) })]
160 (.exportDone th source tr TransferHandler/MOVE)
161 (expect (= {:source source :data tr :action :move} @called))))))
162
2acf7a0 @daveray Implemented default transferable. Started transfer-handler impl.
authored
163
Something went wrong with that request. Please try again.