Added new function to use functional interfaces without knowing the class name.
This commit is contained in:
parent
99bacba0a1
commit
02a2c6aca2
5 changed files with 55 additions and 11 deletions
|
@ -4,6 +4,9 @@
|
||||||
:url "https://www.bitbucket.org/zilti/clojurefx"
|
:url "https://www.bitbucket.org/zilti/clojurefx"
|
||||||
:signing {:gpg-key "68484437"}
|
:signing {:gpg-key "68484437"}
|
||||||
:dependencies [[org.clojure/clojure "1.9.0"]
|
:dependencies [[org.clojure/clojure "1.9.0"]
|
||||||
|
[org.clojure/core.async "0.4.474" :scope "test"]
|
||||||
|
[org.openjfx/javafx-fxml "11-ea+25"]
|
||||||
|
[org.openjfx/javafx-swing "11-ea+25"]
|
||||||
[swiss-arrows "1.0.0"]
|
[swiss-arrows "1.0.0"]
|
||||||
[camel-snake-kebab "0.4.0"]
|
[camel-snake-kebab "0.4.0"]
|
||||||
[com.taoensso/timbre "4.10.0" :exclusions [com.taoensso/carmine]]
|
[com.taoensso/timbre "4.10.0" :exclusions [com.taoensso/carmine]]
|
||||||
|
|
|
@ -11,11 +11,11 @@
|
||||||
|
|
||||||
(timbre/refer-timbre)
|
(timbre/refer-timbre)
|
||||||
|
|
||||||
;; ## Scenegraph
|
;; ## Functional interfaces
|
||||||
|
|
||||||
(defmacro fi
|
(defmacro fi
|
||||||
|
"This macro is used to make use of functional interfaces. The class name of the functional interface has to be given."
|
||||||
[interface args & code]
|
[interface args & code]
|
||||||
(debug "interface:" interface)
|
|
||||||
(let [iface-ref (reflect/type-reflect interface)
|
(let [iface-ref (reflect/type-reflect interface)
|
||||||
methods (filter #(instance? clojure.reflect.Method %) (:members iface-ref))
|
methods (filter #(instance? clojure.reflect.Method %) (:members iface-ref))
|
||||||
functional-method (filter (fn [x] (some #(= % :abstract) (:flags x))) methods)
|
functional-method (filter (fn [x] (some #(= % :abstract) (:flags x))) methods)
|
||||||
|
@ -32,7 +32,43 @@
|
||||||
(~method-sym ~args
|
(~method-sym ~args
|
||||||
~@code))))
|
~@code))))
|
||||||
|
|
||||||
(defmacro handle [obj prop fun]
|
(defn- map2
|
||||||
|
"Like map, but takes two elements at a time."
|
||||||
|
([fun a b] (list (fun a b)))
|
||||||
|
([fun [a b & coll]]
|
||||||
|
(cons (fun a b) (map2 fun coll))))
|
||||||
|
|
||||||
|
(defn typematcher
|
||||||
|
[arg-types methods]
|
||||||
|
(let [method (first methods)]
|
||||||
|
(cond (or (nil? method) (empty? method)) nil
|
||||||
|
|
||||||
|
(and (= (count arg-types) (count (:parameter-types method)))
|
||||||
|
(every? #(isa? (first %) (second %)) (interleave arg-types (:parameter-types method))))
|
||||||
|
method
|
||||||
|
|
||||||
|
:else
|
||||||
|
(recur arg-types (rest methods)))))
|
||||||
|
|
||||||
|
(defmacro connect
|
||||||
|
"This macro is used to make use of functional interfaces. The args list has to be provided with the arg types, like in Java: [Type name1 Type name2]."
|
||||||
|
[instance args & code]
|
||||||
|
(let [class-ref (reflect/type-reflect (class instance))
|
||||||
|
ifaces (flatten (map reflect/type-reflect (into #{} (:bases class-ref))))
|
||||||
|
methods (filter #(instance? clojure.reflect.Method %) (:members ifaces))
|
||||||
|
functional-methods (filter (fn [x] (some #(= % :abstract) (:flags x))) methods)
|
||||||
|
arg-types (map2 (fn [a _] a) args)
|
||||||
|
method (typematcher arg-types functional-methods)]
|
||||||
|
(debug "method-sym:" (:name method))
|
||||||
|
|
||||||
|
`(proxy [~(:declaring-class method)] []
|
||||||
|
(~(:name method) ~(map2 (fn [_ b] b) args)
|
||||||
|
~@code))
|
||||||
|
))
|
||||||
|
|
||||||
|
(defmacro handle
|
||||||
|
""
|
||||||
|
[obj prop fun]
|
||||||
(let [argument (->> fun (drop 1) first)
|
(let [argument (->> fun (drop 1) first)
|
||||||
code (drop 2 fun)]
|
code (drop 2 fun)]
|
||||||
`(.setValue (~(symbol (str (name obj) "/" (name prop)))) (fi javafx.event.ActionEvent ~argument ~@code))))
|
`(.setValue (~(symbol (str (name obj) "/" (name prop)))) (fi javafx.event.ActionEvent ~argument ~@code))))
|
||||||
|
|
|
@ -41,7 +41,7 @@
|
||||||
(debug (str (str/replace pkg #"\." "/") "/" classname))
|
(debug (str (str/replace pkg #"\." "/") "/" classname))
|
||||||
|
|
||||||
(let [cw (new org.objectweb.asm.ClassWriter 0)
|
(let [cw (new org.objectweb.asm.ClassWriter 0)
|
||||||
clazz (.visit cw Opcodes/V1_8
|
clazz (.visit cw Opcodes/V1_7
|
||||||
(+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
|
(+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
|
||||||
(str (str/replace pkg #"\." "/") "/" classname)
|
(str (str/replace pkg #"\." "/") "/" classname)
|
||||||
nil
|
nil
|
||||||
|
@ -101,7 +101,7 @@
|
||||||
(get-in entry [:attrs :fx:id])
|
(get-in entry [:attrs :fx:id])
|
||||||
(str "L" (qualify-class import-classes (name (:tag entry))) ";")
|
(str "L" (qualify-class import-classes (name (:tag entry))) ";")
|
||||||
nil nil)]
|
nil nil)]
|
||||||
(debug "Generating" (get-in entry [:attrs :fx:id]) "with type" (qualify-class import-classes (name (:tag entry))))
|
(trace "Generating" (get-in entry [:attrs :fx:id]) "with type" (qualify-class import-classes (name (:tag entry))))
|
||||||
(-> (.visitAnnotation fv "Ljavafx/fxml/FXML;" true)
|
(-> (.visitAnnotation fv "Ljavafx/fxml/FXML;" true)
|
||||||
.visitEnd)
|
.visitEnd)
|
||||||
(.visitEnd fv)
|
(.visitEnd fv)
|
||||||
|
@ -115,7 +115,7 @@
|
||||||
(subs entry 1)
|
(subs entry 1)
|
||||||
"(Ljavafx/event/Event;)V"
|
"(Ljavafx/event/Event;)V"
|
||||||
nil nil)]
|
nil nil)]
|
||||||
(debug "Generating handler" (subs entry 1) "for" entry)
|
(trace "Generating handler" (subs entry 1) "for" entry)
|
||||||
(-> (.visitAnnotation mv "Ljavafx/fxml/FXML;" true)
|
(-> (.visitAnnotation mv "Ljavafx/fxml/FXML;" true)
|
||||||
.visitEnd)
|
.visitEnd)
|
||||||
(.visitCode mv)
|
(.visitCode mv)
|
||||||
|
@ -135,7 +135,7 @@
|
||||||
|
|
||||||
(defn gen-initializer [cw [clj-ns clj-fn]]
|
(defn gen-initializer [cw [clj-ns clj-fn]]
|
||||||
{:post [(s/valid? (partial instance? org.objectweb.asm.ClassWriter) %)]}
|
{:post [(s/valid? (partial instance? org.objectweb.asm.ClassWriter) %)]}
|
||||||
(debug clj-ns clj-fn)
|
(trace clj-ns clj-fn)
|
||||||
(let [mv (.visitMethod cw Opcodes/ACC_PUBLIC "initialize" "()V" nil nil)
|
(let [mv (.visitMethod cw Opcodes/ACC_PUBLIC "initialize" "()V" nil nil)
|
||||||
init-mv (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)]
|
init-mv (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)]
|
||||||
(.visitCode mv)
|
(.visitCode mv)
|
||||||
|
@ -168,7 +168,7 @@
|
||||||
propped-class (gen-props inited-class fxid-elems import-classes)
|
propped-class (gen-props inited-class fxid-elems import-classes)
|
||||||
initializer-class (gen-initializer propped-class [clj-ns clj-fn])
|
initializer-class (gen-initializer propped-class [clj-ns clj-fn])
|
||||||
handled-class (gen-handlers initializer-class handler-fns clj-ns)]
|
handled-class (gen-handlers initializer-class handler-fns clj-ns)]
|
||||||
(debug (pr-str handler-fns))
|
(trace (pr-str handler-fns))
|
||||||
(.visitEnd handled-class)
|
(.visitEnd handled-class)
|
||||||
(.toByteArray handled-class)))
|
(.toByteArray handled-class)))
|
||||||
|
|
||||||
|
|
|
@ -10,6 +10,7 @@
|
||||||
(def generate-controller clojurefx.controllergen/gen-fx-controller-class)
|
(def generate-controller clojurefx.controllergen/gen-fx-controller-class)
|
||||||
|
|
||||||
(defn load-fxml-with-controller [filename init-fn]
|
(defn load-fxml-with-controller [filename init-fn]
|
||||||
(generate-controller filename init-fn)
|
(let [init-fn (if (string? init-fn) init-fn (str init-fn))]
|
||||||
(load-fxml filename))
|
(generate-controller filename init-fn)
|
||||||
|
(load-fxml filename)))
|
||||||
|
|
||||||
|
|
|
@ -1,13 +1,17 @@
|
||||||
(ns clojurefx.fxml-test
|
(ns clojurefx.fxml-test
|
||||||
(:require [clojurefx.fxml :as sut]
|
(:require [clojurefx.fxml :as sut]
|
||||||
|
[clojure.core.async :as async :refer [<! >! chan go go-loop]]
|
||||||
[clojure.test :as t]
|
[clojure.test :as t]
|
||||||
[clojure.java.io :as io]))
|
[clojure.java.io :as io]
|
||||||
|
[taoensso.timbre :as timbre]))
|
||||||
|
(timbre/refer-timbre)
|
||||||
|
|
||||||
(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))
|
(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))
|
||||||
|
|
||||||
(def test1-fxml (io/resource "fxml/exampleWindow.fxml"))
|
(def test1-fxml (io/resource "fxml/exampleWindow.fxml"))
|
||||||
|
|
||||||
(t/deftest fxml-loading
|
(t/deftest fxml-loading
|
||||||
|
(debug "FXML loading")
|
||||||
(t/is (instance? javafx.scene.Node (sut/load-fxml test1-fxml))))
|
(t/is (instance? javafx.scene.Node (sut/load-fxml test1-fxml))))
|
||||||
|
|
||||||
(def test2-fxml (io/resource "fxml/exampleControllerWindow.fxml"))
|
(def test2-fxml (io/resource "fxml/exampleControllerWindow.fxml"))
|
||||||
|
|
Loading…
Reference in a new issue