From 02a2c6aca2a79b60536d163ccab3bc9a18f7f20a Mon Sep 17 00:00:00 2001
From: zilti <zilti>
Date: Tue, 9 Oct 2018 19:27:58 +0000
Subject: [PATCH] Added new function to use functional interfaces without
 knowing the class name.

---
 project.clj                     |  3 +++
 src/clojurefx/clojurefx.clj     | 42 ++++++++++++++++++++++++++++++---
 src/clojurefx/controllergen.clj | 10 ++++----
 src/clojurefx/fxml.clj          |  5 ++--
 test/clojurefx/fxml_test.clj    |  6 ++++-
 5 files changed, 55 insertions(+), 11 deletions(-)

diff --git a/project.clj b/project.clj
index 0be31ea..26a71b4 100644
--- a/project.clj
+++ b/project.clj
@@ -4,6 +4,9 @@
   :url "https://www.bitbucket.org/zilti/clojurefx"
   :signing {:gpg-key "68484437"}
   :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"]
                  [camel-snake-kebab "0.4.0"]
                  [com.taoensso/timbre "4.10.0" :exclusions [com.taoensso/carmine]]
diff --git a/src/clojurefx/clojurefx.clj b/src/clojurefx/clojurefx.clj
index 860fe61..aa4fe2b 100644
--- a/src/clojurefx/clojurefx.clj
+++ b/src/clojurefx/clojurefx.clj
@@ -11,11 +11,11 @@
 
 (timbre/refer-timbre)
 
-;; ## Scenegraph
+;; ## Functional interfaces
 
 (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]
-  (debug "interface:" interface) 
   (let [iface-ref (reflect/type-reflect interface) 
         methods (filter #(instance? clojure.reflect.Method %) (:members iface-ref))
         functional-method (filter (fn [x] (some #(= % :abstract) (:flags x))) methods) 
@@ -32,7 +32,43 @@
        (~method-sym ~args
         ~@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)
         code (drop 2 fun)]
     `(.setValue (~(symbol (str (name obj) "/" (name prop)))) (fi javafx.event.ActionEvent ~argument ~@code))))
diff --git a/src/clojurefx/controllergen.clj b/src/clojurefx/controllergen.clj
index 85ff82e..e834cdc 100644
--- a/src/clojurefx/controllergen.clj
+++ b/src/clojurefx/controllergen.clj
@@ -41,7 +41,7 @@
   (debug (str (str/replace pkg #"\." "/") "/" classname))
 
   (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)
                       (str (str/replace pkg #"\." "/") "/" classname)
                       nil
@@ -101,7 +101,7 @@
                           (get-in entry [:attrs :fx:id])
                           (str "L" (qualify-class import-classes (name (:tag entry))) ";")
                           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)
           .visitEnd)
       (.visitEnd fv)
@@ -115,7 +115,7 @@
                            (subs entry 1)
                            "(Ljavafx/event/Event;)V"
                            nil nil)]
-      (debug "Generating handler" (subs entry 1) "for" entry)
+      (trace "Generating handler" (subs entry 1) "for" entry)
       (-> (.visitAnnotation mv "Ljavafx/fxml/FXML;" true)
           .visitEnd)
       (.visitCode mv)
@@ -135,7 +135,7 @@
 
 (defn gen-initializer [cw [clj-ns clj-fn]]
   {: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)
         init-mv (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)]
     (.visitCode mv)
@@ -168,7 +168,7 @@
         propped-class (gen-props inited-class fxid-elems import-classes)
         initializer-class (gen-initializer propped-class [clj-ns clj-fn])
         handled-class (gen-handlers initializer-class handler-fns clj-ns)]
-    (debug (pr-str handler-fns))
+    (trace (pr-str handler-fns))
     (.visitEnd handled-class)
     (.toByteArray handled-class)))
 
diff --git a/src/clojurefx/fxml.clj b/src/clojurefx/fxml.clj
index eae53da..cd505d9 100644
--- a/src/clojurefx/fxml.clj
+++ b/src/clojurefx/fxml.clj
@@ -10,6 +10,7 @@
 (def generate-controller clojurefx.controllergen/gen-fx-controller-class)
 
 (defn load-fxml-with-controller [filename init-fn]
-  (generate-controller filename init-fn)
-  (load-fxml filename))
+  (let [init-fn (if (string? init-fn) init-fn (str init-fn))]
+    (generate-controller filename init-fn)
+    (load-fxml filename)))
 
diff --git a/test/clojurefx/fxml_test.clj b/test/clojurefx/fxml_test.clj
index 85fbb33..8ef4bc8 100644
--- a/test/clojurefx/fxml_test.clj
+++ b/test/clojurefx/fxml_test.clj
@@ -1,13 +1,17 @@
 (ns clojurefx.fxml-test
   (:require [clojurefx.fxml :as sut]
+            [clojure.core.async :as async :refer [<! >! chan go go-loop]]
             [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.))
 
 (def test1-fxml (io/resource "fxml/exampleWindow.fxml"))
 
 (t/deftest fxml-loading
+  (debug "FXML loading")
   (t/is (instance? javafx.scene.Node (sut/load-fxml test1-fxml))))
 
 (def test2-fxml (io/resource "fxml/exampleControllerWindow.fxml"))