zilti/clojurefx
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added testing, fixed factory/compiler and IdMapper bugs

Browse source
This commit is contained in:
Daniel Ziltener 2015-01-17 06:10:45 +00:00
parent 8b77afd142
commit 5cea89227c
7 changed files with 179 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
build.boot
View file

@ -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)))

81
src/clojurefx/clojurefx.clj
View file

@ -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))))))

20
src/clojurefx/factory.clj
View file

@ -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

13
src/clojurefx/protocols.clj
View file

@ -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

37
test/clojurefx/clojurefx_test.clj
View file

@ -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."))

31
test/clojurefx/factory_test.clj Normal file
View file

@ -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"))

15
test/resources/test.fxml Normal file
View file

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<?import java.net.*?>
<?import javafx.geometry.*?>
<?import javafx.scene.control.*?>
<?import javafx.scene.layout.*?>
<?import javafx.scene.text.*?>
<?language clojure?>
<VBox xmlns:fx="http://javafx.com/fxml" alignment="center" fx:id="topBox">
<Button fx:id="button" text="Close"/>
<ScrollPane>
<Label fx:id="label" text="This rocks."/>
</ScrollPane>
</VBox>