From 0ad7f1d09927b5320b35f015ee4d4a583001f8bc Mon Sep 17 00:00:00 2001 From: "dziltener@lyrion.ch" Date: Tue, 1 Aug 2017 16:04:33 +0000 Subject: [PATCH] Added controllergen for actions. --- project.clj | 2 + src/clojurefx/clojurefx.clj | 78 +++++++++++---------- src/clojurefx/controllergen.clj | 116 +++++++++++++++++++++++++++++--- 3 files changed, 146 insertions(+), 50 deletions(-) diff --git a/project.clj b/project.clj index 23e3f2d..7a8b9fb 100644 --- a/project.clj +++ b/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"] diff --git a/src/clojurefx/clojurefx.clj b/src/clojurefx/clojurefx.clj index 86ff6ab..c3c235a 100644 --- a/src/clojurefx/clojurefx.clj +++ b/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] - (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] diff --git a/src/clojurefx/controllergen.clj b/src/clojurefx/controllergen.clj index 40525be..f2093cc 100644 --- a/src/clojurefx/controllergen.clj +++ b/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 - ([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? % "" ";")) + (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))))