Added controllergen for actions.
This commit is contained in:
parent
733dad8048
commit
0ad7f1d099
3 changed files with 146 additions and 50 deletions
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
(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)))
|
||||
(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))))
|
||||
|
||||
(defn make-node [node children]
|
||||
nil)
|
||||
;; (defn branch? [obj]
|
||||
;; (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]
|
||||
(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 make-node [node children]
|
||||
;; nil)
|
||||
|
||||
(defn sgzipper [root]
|
||||
(zip/zipper branch? down make-node root))
|
||||
;; (defn down [x]
|
||||
;; (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]
|
||||
(try
|
||||
(cond
|
||||
(not (instance? clojure.lang.IFn root)) (do (trace "Raw input confirmed. Starting.")
|
||||
(by-id (sgzipper root) id))
|
||||
(zip/end? root) (do (trace "Search ended without result.")
|
||||
nil)
|
||||
(nil? (zip/node root)) (by-id (zip/next root) id)
|
||||
(= id (.getId (zip/node root))) (do (debug "Found item:" (zip/node root))
|
||||
(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))))
|
||||
;; (defn sgzipper [root]
|
||||
;; (zip/zipper branch? down make-node root))
|
||||
|
||||
;; (defn by-id [root id]
|
||||
;; (try
|
||||
;; (cond
|
||||
;; (not (instance? clojure.lang.IFn root)) (do (trace "Raw input confirmed. Starting.")
|
||||
;; (by-id (sgzipper root) id))
|
||||
;; (zip/end? root) (do (trace "Search ended without result.")
|
||||
;; nil)
|
||||
;; (nil? (zip/node root)) (by-id (zip/next root) id)
|
||||
;; (= id (.getId (zip/node root))) (do (debug "Found item:" (zip/node root))
|
||||
;; (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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
([ziptree] (get-fxid-elems ziptree []))
|
||||
([ziptree elems]
|
||||
(cond
|
||||
(zip/end? ziptree) (do (debug "End reached, returning.") elems)
|
||||
(contains? (:attrs (zip/node ziptree)) :fx:id) (do (debug "Found a match!\n" (zip/node ziptree))
|
||||
(recur (zip/next ziptree) (conj elems (zip/node ziptree))))
|
||||
:else (do (debug "No match, continuing:" (zip/node ziptree)) (recur (zip/next ziptree) elems)))))
|
||||
;; Compiler
|
||||
|
||||
(defonce cached-compiler (CachedCompiler. nil nil))
|
||||
|
||||
(defn makeclass [pkg classname code]
|
||||
(debug (str "\n" code))
|
||||
(try
|
||||
(.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))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue