Added controllergen for actions.

project.clj

@@ -4,8 +4,10 @@
   :url "https://www.bitbucket.org/zilti/clojurefx"
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [swiss-arrows "1.0.0"]
+                 [camel-snake-kebab "0.4.0"]
                  [org.controlsfx/controlsfx "8.40.13"]
                  [com.taoensso/timbre "4.7.4" :exclusions [com.taoensso/carmine]]
+                 [net.openhft/compiler "2.3.0"]
                  [clojure-jsr-223 "0.1.0"]]
   ;; :profiles {:uberjar {:aot :all}}      
   :source-paths ["src"]

src/clojurefx/clojurefx.clj

@@ -10,7 +10,7 @@
 
 (timbre/refer-timbre)
 
-(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))
+;; (defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))
 
 ;; ## Scenegraph
 
@@ -25,7 +25,7 @@
     (debug "method-sym:" method-sym)
 
     (when-not (= (count methods) 1) 
-      (throw (new Exception (str "can't take an interface with more then one method:" (pr-str methods)))))
+      (throw (new Exception (str "can't take an interface with more than one method:" (pr-str methods)))))
 
     (debug (pr-str `(proxy [~interface] []
                       (~method-sym ~args ~@code))))
@@ -34,41 +34,46 @@
        (~method-sym ~args
         ~@code))))
 
-(defn branch? [obj]
+(defmacro handle [obj prop fun]
-  (or (and (instance? javafx.scene.Parent obj)
+  (let [argument (->> fun (drop 1) first)
-           (not (instance? org.controlsfx.control.StatusBar obj)))
+        code (drop 2 fun)]
-      (instance? javafx.scene.control.MenuBar obj)
+    `(.setValue (~(symbol (str (name obj) "/" (name prop)))) (fi javafx.event.ActionEvent ~argument ~@code))))
-      (instance? javafx.scene.control.Menu obj)))
 
-(defn make-node [node children]
+;; (defn branch? [obj]
-  nil)
+;;   (or (and (instance? javafx.scene.Parent obj)
+;;            (not (instance? org.controlsfx.control.StatusBar obj)))
+;;       (instance? javafx.scene.control.MenuBar obj)
+;;       (instance? javafx.scene.control.Menu obj)))
 
-(defn down [x]
+;; (defn make-node [node children]
-  (cond
+;;   nil)
-    (instance? javafx.scene.control.Label x) (.getGraphic x)
-    (instance? javafx.scene.control.ProgressIndicator x) (.getContextMenu x)
-    (instance? javafx.scene.control.ScrollPane x) (.getContent x)
-    (instance? javafx.scene.control.MenuBar x) (.getMenus x)
-    (instance? javafx.scene.control.Menu x) (.getItems x)
-    (instance? javafx.scene.Parent x) (.getChildren x)
-    :else nil))
 
-(defn sgzipper [root]
+;; (defn down [x]
-  (zip/zipper branch? down make-node root))
+;;   (cond
+;;     (instance? javafx.scene.control.Label x) (.getGraphic x)
+;;     (instance? javafx.scene.control.ProgressIndicator x) (.getContextMenu x)
+;;     (instance? javafx.scene.control.ScrollPane x) (.getContent x)
+;;     (instance? javafx.scene.control.MenuBar x) (.getMenus x)
+;;     (instance? javafx.scene.control.Menu x) (.getItems x)
+;;     (instance? javafx.scene.Parent x) (.getChildren x)
+;;     :else nil))
 
-(defn by-id [root id] 
+;; (defn sgzipper [root]
-  (try
+;;   (zip/zipper branch? down make-node root))
-    (cond 
+
-      (not (instance? clojure.lang.IFn root)) (do (trace "Raw input confirmed. Starting.")
+;; (defn by-id [root id] 
-                                                  (by-id (sgzipper root) id)) 
+;;   (try
-      (zip/end? root) (do (trace "Search ended without result.")
+;;     (cond 
-                          nil)
+;;       (not (instance? clojure.lang.IFn root)) (do (trace "Raw input confirmed. Starting.")
-      (nil? (zip/node root)) (by-id (zip/next root) id)
+;;                                                   (by-id (sgzipper root) id)) 
-      (= id (.getId (zip/node root))) (do (debug "Found item:" (zip/node root))
+;;       (zip/end? root) (do (trace "Search ended without result.")
-                                          (zip/node root))
+;;                           nil)
-      :else (do (trace "id of" (zip/node root) "does not match, proceeding to" (zip/node (zip/next root)))
+;;       (nil? (zip/node root)) (by-id (zip/next root) id)
-                (by-id (zip/next root) id)))
+;;       (= id (.getId (zip/node root))) (do (debug "Found item:" (zip/node root))
-    (catch Exception e (error e))))
+;;                                           (zip/node root))
+;;       :else (do (trace "id of" (zip/node root) "does not match, proceeding to" (zip/node (zip/next root)))
+;;                 (by-id (zip/next root) id)))
+;;     (catch Exception e (error e))))
 
 ;; ## Data
 
@@ -119,13 +124,6 @@
         check (type check)]
     (reduce #(or %1 (isa? check %2)) false impls)))
 
-;; ## FXMLLoader
-
-(defn load-fxml [filename]
-  (let [loader (new javafx.fxml.FXMLLoader)]
-    (.setLocation loader (io/resource ""))
-    (.load loader (-> filename io/resource io/input-stream))))
-
 ;; ## Constructors
 
 (defn find-constructor [clazz cargs]

src/clojurefx/controllergen.clj

@@ -1,16 +1,112 @@
 (ns clojurefx.controllergen
+  (import (net.openhft.compiler CachedCompiler CompilerUtils))
+  (:use swiss.arrows)
   (:require [clojure.xml :as xml]
             [clojure.zip :as zip]
-            [taoensso.timbre :as timbre]))
+            [clojure.string :as str]
+            [taoensso.timbre :as timbre]
+            [camel-snake-kebab.core :as csk]))
 (timbre/refer-timbre)
 
-(def xmlzip (zip/xml-zip (xml/parse "/Users/danielziltener/projects/lizenztool/resources/fxml/mainwindow.fxml")))
+(def xmlzip (zip/xml-zip (xml/parse "/home/zilti/projects/lizenztool/resources/fxml/mainwindow.fxml")))
 
-(defn get-fxid-elems
+;; Compiler
-  ([ziptree] (get-fxid-elems ziptree []))
+
-  ([ziptree elems]
+(defonce cached-compiler (CachedCompiler. nil nil))
-   (cond
+
-     (zip/end? ziptree) (do (debug "End reached, returning.") elems)
+(defn makeclass [pkg classname code]
-     (contains? (:attrs (zip/node ziptree)) :fx:id) (do (debug "Found a match!\n" (zip/node ziptree))
+  (debug (str "\n" code))
-                                               (recur (zip/next ziptree) (conj elems (zip/node ziptree))))
+  (try
-     :else (do (debug "No match, continuing:" (zip/node ziptree)) (recur (zip/next ziptree) elems)))))
+    (.loadFromJava cached-compiler (str/join "." [pkg classname]) code)
+    (catch java.lang.ClassNotFoundException e (error e))))
+
+;; Parser
+
+(def stockimports "import clojure.java.api.Clojure;\nimport clojure.lang.IFn;\nimport java.net.URL;\nimport java.util.ResourceBundle;\nimport javafx.fxml.FXML;\n")
+
+(def stockprops "    @FXML
+    private ResourceBundle resources;
+
+    @FXML
+    private URL location;\n\n")
+
+(defn get-imports [filename]
+  (->>  (slurp filename)
+        (str/split-lines)
+        (filter #(str/starts-with? % "<?import"))
+        (map #(str/replace % #"<\?" ""))
+        (map #(str/replace % #"\?>" ";"))
+        (str/join "\n")))
+
+(defn zip-tree-seq [node]
+  (tree-seq (complement string?)
+            :content
+            node))
+
+(defn get-handler-props [{:keys [attrs]}]
+  (->> attrs
+       (filter #(str/starts-with? (name (key %)) "on"))
+       (map val)))
+
+(defn get-handler-fns [ziptree]
+  (->> ziptree
+       (map get-handler-props)
+       (remove empty?)
+       flatten))
+
+(defn get-fxid-elems [ziptree]
+  (->> ziptree
+       (filter #(contains? (:attrs %) :fx:id))))
+
+(defn get-controller-class [fxmlzip]
+  (->> fxmlzip
+       (filter #(contains? (:attrs %) :fx:controller))
+       first
+       :attrs
+       :fx:controller))
+
+(defn gen-props [coll]
+  (let [props-str
+        (->> (flatten coll) 
+             (map #(format "    @FXML\n    public %s %s;\n\n"
+                           (name (:tag %)) (get-in % [:attrs :fx:id])))
+             (str/join ""))]
+    (debug (type props-str))
+    props-str))
+
+(defn gen-handlers [coll clj-ns]
+  (->> (flatten coll) 
+       (map #(format "    @FXML\n    void %s(Object event) {\n        Clojure.var(\"%s\", \"%s\").invoke(event);\n    }\n\n"
+                     (subs % 1) clj-ns (csk/->kebab-case (subs % 1))))
+       (str/join "")))
+
+(defn gen-initializer [cns cfn]
+  (format "    @FXML
+    void initialize() {
+        Clojure.var(\"%s\", \"%s\").invoke(this);
+    }" cns cfn))
+
+(defn gen-fx-controller [fxmlzip fxmlpath [clj-ns clj-fn]]
+  (let [clazz (get-controller-class fxmlzip)
+        [pkg classname] (reverse (map str/reverse (str/split (str/reverse clazz) #"\." 2)))
+        fxid-elems (get-fxid-elems fxmlzip)
+        handler-fns (get-handler-fns fxmlzip)]
+    (debug "fxid-elems:" (pr-str fxid-elems))
+    (debug "handler-fns:" (pr-str handler-fns))
+    (str (format "package %s;\n\n" pkg)
+         stockimports
+         (get-imports fxmlpath)
+         (format "\n\npublic class %s {\n\n" classname)
+         (gen-props fxid-elems)
+         (gen-handlers handler-fns clj-ns)
+         (gen-initializer clj-ns clj-fn)
+         "\n}")))
+
+;; Plumber
+
+(defn gen-fx-controller-class [fxmlpath clj-fn]
+  (let [fxmlzip (zip-tree-seq (xml/parse fxmlpath))
+        clazz (get-controller-class fxmlzip)
+        [pkg classname] (reverse (map str/reverse (str/split (str/reverse clazz) #"\." 2)))
+        cljvec (str/split clj-fn #"/")] 
+    (makeclass pkg classname (gen-fx-controller fxmlzip fxmlpath cljvec))))