Added new function to use functional interfaces without knowing the class name.

This commit is contained in:
zilti 2018-10-09 19:27:58 +00:00
parent 99bacba0a1
commit 02a2c6aca2
5 changed files with 55 additions and 11 deletions

View file

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

View file

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

View file

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

View file

@ -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]
(let [init-fn (if (string? init-fn) init-fn (str init-fn))]
(generate-controller filename init-fn) (generate-controller filename init-fn)
(load-fxml filename)) (load-fxml filename)))

View file

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