diff --git a/build.boot b/build.boot index ae4b812..bb86975 100644 --- a/build.boot +++ b/build.boot @@ -1,5 +1,5 @@ ;-*- mode: Clojure;-*- -(set-env! :resource-paths #{"src" "java"} +(set-env! :resource-paths #{"src"} :dependencies '[[org.clojure/clojure "1.7.0-alpha4"] [com.taoensso/timbre "3.3.1" :exclusions [com.taoensso/carmine]] [org.clojure/core.typed "0.2.77"] @@ -7,13 +7,16 @@ [boot-deps "0.1.2" :scope "test"] [midje "1.6.3" :scope "test"] - [zilti/boot-midje "0.1.1" :scope "test"] - [zilti/boot-typed "0.1.0" :scope "test"]]) + [adzerk/bootlaces "0.1.9" :scope "test"] + [zilti/boot-midje "0.1.2" :scope "test"] + [zilti/boot-typed "0.1.1" :scope "test"]]) (require '[zilti.boot-midje :refer [midje]] - '[zilti.boot-typed :refer [typed]]) + '[zilti.boot-typed :refer [typed]] + '[adzerk.bootlaces :refer :all]) -(def +version+ "0.0.5-SNAPSHOT") +(def +version+ "0.0.21-SNAPSHOT") +(bootlaces! +version+) (task-options! pom {:project 'clojurefx @@ -21,16 +24,21 @@ :description "A Clojure JavaFX wrapper." :url "https://bitbucket.com/zilti/clojurefx" :scm {:url "https://bitbucket.com/zilti/clojurefx"} - :license {:name "GNU Lesser General Public License 3.0" - :url "http://www.gnu.org/licenses/lgpl-3.0.txt"}} - midje {:test-paths #{"test"} - :autotest true} - typed {:namespaces #{'clojurefx.blargh}} + :license {"name" "GNU Lesser General Public License 3.0" + "url" "http://www.gnu.org/licenses/lgpl-3.0.txt"}} + midje {:test-paths #{"test"}} + typed {:namespaces #{'clojurefx.clojurefx 'clojurefx.protocols 'clojurefx.scripting}} repl {:server true}) (deftask develop [] + (task-options! + midje {:autotest true}) + + (set-env! :resource-paths #{"src" "test"}) + (comp (repl) (midje) (watch) (typed))) + diff --git a/src/clojurefx/clojurefx.clj b/src/clojurefx/clojurefx.clj index fbfc93a..66a95ee 100644 --- a/src/clojurefx/clojurefx.clj +++ b/src/clojurefx/clojurefx.clj @@ -1,9 +1,10 @@ (ns clojurefx.clojurefx - (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile]) + (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send meta with-meta]) (:require [clojure.core.typed :refer :all] [clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]] [taoensso.timbre :as timbre] [clojure.java.io :as io] + [clojure.zip :as zip] [clojurefx.protocols :refer :all] [clojure.java.io :refer :all])) @@ -19,8 +20,8 @@ Simple wrapper for Platform/runLater. You should use run-later. (defmacro run-later [& body] `(run-later* (fn [] ~@body))) -(defn run-now*" -A modification of run-later waiting for the running method to return. You should use run-now. + (defn run-now*" + A modification of run-later waiting for the running method to return. You should use run-now. " [f] (if (javafx.application.Platform/isFxApplicationThread) (apply f []) @@ -29,14 +30,14 @@ A modification of run-later waiting for the running method to return. You should (deliver result (try (f) (catch Throwable e e)))) @result))) -(defmacro run-now " -Runs the code on the FX application thread and waits until the return value is delivered. + (defmacro run-now " + Runs the code on the FX application thread and waits until the return value is delivered. " [& body] `(run-now* (fn [] ~@body))) (tc-ignore (timbre/refer-timbre)) -(import (javafx.scene.control Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar +(import (javafx.scene.control Labeled Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion TitledPane TabPane Tab TableColumnBase Labeled) (javafx.scene Node Scene Parent) @@ -46,12 +47,7 @@ Runs the code on the FX application thread and waits until the return value is d (javafx.css Styleable) (java.util Collection)) -;; TODO This belongs elsewhere. -(tc-ignore - (defn load-fxml [filename] - (.load (javafx.fxml.FXMLLoader.) (-> filename io/resource io/input-stream)))) - -;; TODO Use pred-substitute for tc-assert +;; TODO Use pred-substitute for tc-assert? (defn tc-assert [clazz :- Class value :- Any & [message :- String]] (try (assert (instance? clazz value)) (catch AssertionError e (tc-ignore (error (if message message "") e) @@ -63,9 +59,29 @@ Runs the code on the FX application thread and waits until the return value is d (clojure.core.typed/pred* (quote clazz) 'clojurefx.clojurefx (fn [arg] (boolean (instance? clazz arg))))) +(defn pred-protocol [proto check] + (let [impls (keys (proto :impls)) + check (type check)] + (reduce #(or %1 (isa? check %2)) false impls))) + +;;## Shadows + +(extend-protocol FXMeta + clojure.lang.IObj + (meta [this] (clojure.core/meta this)) + (with-meta [this metadata] (clojure.core/with-meta this metadata)) + Node + (meta [this] (.getUserData ^Node this)) + (with-meta [this metadata] (.setUserData ^Node this metadata) this) + MenuItem + (meta [this] (.getUserData ^MenuItem this)) + (with-meta [this metadata] (.setUserData ^MenuItem this metadata) this)) + +;;## Standard + (tc-ignore (extend-protocol FXValue - Label + Labeled (get-value [this] (.getText ^Label this)) (set-value! [this value] (tc-assert String value) (.setText ^Label this ^String value) this) TextField @@ -152,15 +168,6 @@ Runs the code on the FX application thread and waits until the return value is d (get-graphic [this] (.getGraphic ^Menu this)) (set-graphic! [this graphic] (.setGraphic ^Menu this ^Node graphic)))) -(tc-ignore - (extend-protocol clojure.lang.IObj - Node - (meta [this] (.getUserData ^Node this)) - (withMeta [this metadata] (.setUserData ^Node this metadata) this) - MenuItem - (meta [this] (.getUserData ^MenuItem this)) - (withMeta [this metadata] (.setUserData ^MenuItem this metadata) this))) - (extend-protocol FXStyleSetter Node (set-style! [this style] (.setStyle ^Node this ^String style) this) @@ -177,6 +184,8 @@ Runs the code on the FX application thread and waits until the return value is d (get-styleable-parent [this] (.getStyleableParent ^Styleable this)) (get-type-selector [this] (.getTypeSelector ^Styleable this))) +;;## Special Types + (extend-type Stage FXStage (get-title [this] (.getTitle ^Stage this)) @@ -188,3 +197,31 @@ Runs the code on the FX application thread and waits until the return value is d FXScene (get-root [this] (.getRoot ^Scene this)) (set-root! [this root] (.setRoot ^Scene this ^Parent root) this)) + +;;## IdMapper +(defn fxzipper [root] + (zip/zipper (fn branch? [node] + (or (pred-protocol FXParent node) (pred-protocol FXContainer node))) + (fn children [node] + (if (pred-protocol FXParent node) + (into [] (get-subnodes node)) + [(get-content node)])) + (fn make-node [node children] + (if (pred-protocol FXParent node) + (set-subnodes! node children) + (set-content! node children))) + root)) + +(defn get-node-by-id [graph id] + (loop [zipper (fxzipper graph)] + (cond (zip/end? zipper) nil + (= (get-id (zip/node zipper)) (name id)) (zip/node zipper) + :else (recur (zip/next zipper))))) + +(defn get-id-map [graph] + (loop [zipper (fxzipper graph) + ids {}] + (if (zip/end? zipper) + ids + (recur (zip/next zipper) + (assoc ids (keyword (get-id (zip/node zipper))) (zip/node zipper)))))) diff --git a/src/clojurefx/factory.clj b/src/clojurefx/factory.clj index f6c775a..4495338 100644 --- a/src/clojurefx/factory.clj +++ b/src/clojurefx/factory.clj @@ -1,11 +1,12 @@ (ns clojurefx.factory - (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile]) + (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile meta with-meta]) (:require [clojure.core.typed :refer :all] - [clojure.core.typed.unsafe :refer [ignore-with-unckecked-cast]] + [clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]] [taoensso.timbre :as timbre] [clojure.java.io :as io] - [clojurefx.clojurefx :refer :all] - [clojurefx.protocols :refer :all])) + [clojurefx.clojurefx :as fx] + [clojurefx.protocols :refer :all]) + (:import (javafx.scene Scene Node Parent))) (tc-ignore (timbre/refer-timbre)) @@ -22,14 +23,23 @@ (def setter second) (def translation-map - (atom {:text (with-meta [#'get-value #'set-value!] {:argument String :parent FXValue}) + (atom {;;; FXValue + :text (with-meta [#'get-value #'set-value!] {:argument String :parent FXValue}) :value (with-meta [#'get-value #'set-value!] {:argument Object :parent FXValue}) + ;;; FXId :id (with-meta [#'get-id #'set-id!] {:argument String :parent FXId}) + ;;; FXGraphic :graphic (with-meta [#'get-graphic #'set-graphic!] {:argument Node :parent FXGraphic}) + ;;; FXContainer :content (with-meta [#'get-content #'set-content!] {:argument Node :parent FXContainer}) + ;;; FXParent :children (with-meta [#'get-subnodes #'set-subnodes!] {:argument java.util.List :parent FXParent}) + ;;; FXStyleSetter / FXStyleable + :style (with-meta [#'get-style #'set-style!] {:argument String :parent FXStyleable}) + ;;; FXStage :title (with-meta [#'get-title #'set-title!] {:argument String :parent FXStage}) :scene (with-meta [#'get-scene #'set-scene!] {:argument Scene :parent FXStage}) + ;;; FXScene :root (with-meta [#'get-root #'set-root!] {:argument Parent :parent FXScene})})) (def mandatory-constructor-args diff --git a/src/clojurefx/protocols.clj b/src/clojurefx/protocols.clj index dc2c973..b638219 100644 --- a/src/clojurefx/protocols.clj +++ b/src/clojurefx/protocols.clj @@ -1,7 +1,16 @@ (ns clojurefx.protocols - (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send]) + (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send meta with-meta]) (:require [clojure.core.typed :refer :all])) +;;## Shadows + +(defprotocol [[A :variance :covariant]] + FXMeta + (meta [this :- A] :- (Map Any Any)) + (with-meta [this :- A metadata :- (Map Any Any)] :- A)) + +;;## Standard + (declare-protocols FXValue FXId FXParent) (defprotocol [[A :variance :covariant] [B :variance :covariant]] @@ -54,6 +63,8 @@ (defalias FXStyled (U FXStyleable FXStyleSetter)) +;;## Special Types + (defprotocol [[A :variance :covariant :< javafx.stage.Stage] [B :variance :covariant :< javafx.scene.Scene]] FXStage diff --git a/test/clojurefx/clojurefx_test.clj b/test/clojurefx/clojurefx_test.clj index e0d17ec..687afe5 100644 --- a/test/clojurefx/clojurefx_test.clj +++ b/test/clojurefx/clojurefx_test.clj @@ -1,13 +1,34 @@ (ns clojurefx.clojurefx-test - (:refer-clojure :exclude [compile]) + (:refer-clojure :exclude [compile meta with-meta]) + (:require [clojurefx.factory :as factory] + [clojurefx.protocols :refer :all]) (:use midje.sweet clojurefx.clojurefx)) -(def example-hierarchy - [:VBox {:id "VBox" - :children [:Label {:text "Hi JavaFX!"} - :Label {:text "Hi Clojure!"}]}]) +(import (javafx.scene.layout VBox) + (javafx.scene.control ScrollPane Button Label)) -(fact "This compiles." - (resolv-o-matic :Label) => javafx.scene.control.Label - (type (compile example-hierarchy)) => javafx.scene.layout.VBox) +;;## Element testing + +;;## IdMapper +(def example-graph + (factory/compile + [VBox {:id "topBox" + :children [Button {:id "button" + :text "Close"} + ScrollPane {:content [Label {:id "label" + :text "This rocks."}]}]}])) + +(facts "Id mapper" + (fact "Getting a top-level entry" + (type (get-node-by-id example-graph "topBox")) => javafx.scene.layout.VBox) + (fact "Getting an entry in an FXParent" + (type (get-node-by-id example-graph "button")) => javafx.scene.control.Button) + (fact "Getting an entry in an FXParent and an FXContainer" + (type (get-node-by-id example-graph "label")) => javafx.scene.control.Label) + (fact "Fetching the whole id map." + (map? (get-id-map example-graph)) => true) + (fact "Fetching label text from id-map." + (-> (get-id-map example-graph) + :label + get-value) => "This rocks.")) diff --git a/test/clojurefx/factory_test.clj b/test/clojurefx/factory_test.clj new file mode 100644 index 0000000..94c0b28 --- /dev/null +++ b/test/clojurefx/factory_test.clj @@ -0,0 +1,31 @@ +(ns clojurefx.factory-test + (:refer-clojure :exclude [compile meta with-meta]) + (:require [clojurefx.protocols :refer :all]) + (:use midje.sweet + clojurefx.factory) + (:import (javafx.scene.control Button Label ScrollPane) + (javafx.scene.layout VBox))) + +(def fxml-node (atom nil)) + +(facts "FXML loading" + (fact "Load the fxml file" + (type (reset! fxml-node (load-fxml "resources/test.fxml"))) => javafx.scene.layout.VBox) + (fact "Get VBox id" + (.getId @fxml-node) => "topBox")) + +(def example-graph + [VBox {:id "topBox" + :children [Button {:id "button" + :text "Close"} + ScrollPane {:content [Label {:id "label" + :text "This rocks."}]}]}]) + +(def scene-graph (atom nil)) + +(facts "Vector compilation" + (fact "Simple element" + (type (compile [Label {:text "Hello ClojureFX"}])) => javafx.scene.control.Label) + (fact "Nested structure" + (type (reset! scene-graph (compile example-graph))) => javafx.scene.layout.VBox + (get-id @scene-graph) => "topBox")) diff --git a/test/resources/test.fxml b/test/resources/test.fxml new file mode 100644 index 0000000..81750ce --- /dev/null +++ b/test/resources/test.fxml @@ -0,0 +1,15 @@ + + + + + + + + + + +