Added ASM
This commit is contained in:
parent
ae3a80b947
commit
c981584128
2 changed files with 102 additions and 63 deletions
|
|
@ -9,6 +9,7 @@
|
||||||
[org.controlsfx/controlsfx "8.40.13"]
|
[org.controlsfx/controlsfx "8.40.13"]
|
||||||
[com.taoensso/timbre "4.7.4" :exclusions [com.taoensso/carmine]]
|
[com.taoensso/timbre "4.7.4" :exclusions [com.taoensso/carmine]]
|
||||||
[net.openhft/compiler "2.3.0"]
|
[net.openhft/compiler "2.3.0"]
|
||||||
|
[org.ow2.asm/asm "6.0_BETA"]
|
||||||
[clojure-jsr-223 "0.1.0"]]
|
[clojure-jsr-223 "0.1.0"]]
|
||||||
:profiles {:test {:source-paths ["test"]
|
:profiles {:test {:source-paths ["test"]
|
||||||
:resource-paths ["test-resources"]}
|
:resource-paths ["test-resources"]}
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,9 @@
|
||||||
(ns clojurefx.controllergen
|
(ns clojurefx.controllergen
|
||||||
(import (net.openhft.compiler CachedCompiler CompilerUtils))
|
(:gen-class :name Controllergen
|
||||||
|
:implements [org.objectweb.asm.Opcodes]
|
||||||
|
:prefix "")
|
||||||
|
;; (:import (net.openhft.compiler CachedCompiler CompilerUtils))
|
||||||
|
(:import org.objectweb.asm.ClassWriter)
|
||||||
(:use swiss.arrows)
|
(:use swiss.arrows)
|
||||||
(:require [clojure.xml :as xml]
|
(:require [clojure.xml :as xml]
|
||||||
[clojure.zip :as zip]
|
[clojure.zip :as zip]
|
||||||
|
|
@ -13,31 +17,65 @@
|
||||||
|
|
||||||
;; Compiler
|
;; Compiler
|
||||||
|
|
||||||
(defonce cached-compiler (CachedCompiler. nil nil))
|
;; (defonce cached-compiler (CachedCompiler. nil nil))
|
||||||
|
|
||||||
(defn makeclass [pkg classname code]
|
;; (defn makeclass [pkg classname code]
|
||||||
(debug (str "\n" code))
|
;; (debug (str "\n" code))
|
||||||
(try
|
;; (try
|
||||||
(.loadFromJava cached-compiler (str/join "." [pkg classname]) code)
|
;; (.loadFromJava cached-compiler (str/join "." [pkg classname]) code)
|
||||||
(catch java.lang.ClassNotFoundException e (error e))))
|
;; (catch java.lang.ClassNotFoundException e (error e))))
|
||||||
|
|
||||||
;; Parser
|
;; ;; Parser
|
||||||
|
|
||||||
(def stockimports "import clojure.java.api.Clojure;\nimport clojure.lang.IFn;\nimport java.net.URL;\nimport java.util.ResourceBundle;\nimport javafx.event.ActionEvent;\nimport javafx.fxml.FXML;\n")
|
(def imports (list clojure.java.api.Clojure clojure.lang.IFn java.net.URL java.util.ResourceBundle javafx.event.ActionEvent javafx.fxml.FXML))
|
||||||
|
|
||||||
(def stockprops " @FXML
|
(defn build-imports [filename]
|
||||||
private ResourceBundle resources;
|
(->> slurp filename
|
||||||
|
str/split-lines
|
||||||
|
(filter #(str/starts-with? % "<?import"))
|
||||||
|
(map #(str/replace % #"<\?" ""))
|
||||||
|
(map #(str/replace % #"\?>" ""))
|
||||||
|
(map #(Class/forName %))
|
||||||
|
(reduce conj imports)))
|
||||||
|
|
||||||
@FXML
|
(defn qualify-class [imports class-str]
|
||||||
private URL location;\n\n")
|
(first (filter #(= class-str (last (str/split (pr-str %) #"\."))))))
|
||||||
|
|
||||||
(defn get-imports [filename]
|
(defn init-class [pkg classname]
|
||||||
(->> (slurp filename)
|
(let [cw (new org.objectweb.asm.ClassWriter 0)]
|
||||||
(str/split-lines)
|
(.. cw (visit V1_8
|
||||||
(filter #(str/starts-with? % "<?import"))
|
(+ ACC_PUBLIC)
|
||||||
(map #(str/replace % #"<\?" ""))
|
(str pkg "/" classname)
|
||||||
(map #(str/replace % #"\?>" ";"))
|
nil
|
||||||
(str/join "\n")))
|
"java/lang/Object"
|
||||||
|
nil)
|
||||||
|
(visitField ACC_PRIVATE
|
||||||
|
"resources"
|
||||||
|
(pr-str (qualify-class "ResourceBundle"))
|
||||||
|
null
|
||||||
|
null)
|
||||||
|
(visitField ACC_PRIVATE
|
||||||
|
"location"
|
||||||
|
(pr-str (qualify-class "URL"))
|
||||||
|
null
|
||||||
|
null))
|
||||||
|
cw))
|
||||||
|
|
||||||
|
;; (def stockimports "import clojure.java.api.Clojure;\nimport clojure.lang.IFn;\nimport java.net.URL;\nimport java.util.ResourceBundle;\nimport javafx.event.ActionEvent;\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]
|
(defn zip-tree-seq [node]
|
||||||
(tree-seq (complement string?)
|
(tree-seq (complement string?)
|
||||||
|
|
@ -66,51 +104,51 @@
|
||||||
:attrs
|
:attrs
|
||||||
:fx:controller))
|
:fx:controller))
|
||||||
|
|
||||||
(defn gen-props [coll]
|
;; (defn gen-props [coll]
|
||||||
(let [props-str
|
;; (let [props-str
|
||||||
(->> (flatten coll)
|
;; (->> (flatten coll)
|
||||||
(map #(format " @FXML\n public %s %s;\n\n"
|
;; (map #(format " @FXML\n public %s %s;\n\n"
|
||||||
(name (:tag %)) (get-in % [:attrs :fx:id])))
|
;; (name (:tag %)) (get-in % [:attrs :fx:id])))
|
||||||
(str/join ""))]
|
;; (str/join ""))]
|
||||||
(debug (type props-str))
|
;; (debug (type props-str))
|
||||||
props-str))
|
;; props-str))
|
||||||
|
|
||||||
(defn gen-handlers [coll clj-ns]
|
;; (defn gen-handlers [coll clj-ns]
|
||||||
(->> (flatten coll)
|
;; (->> (flatten coll)
|
||||||
(map #(format " @FXML\n void %s(ActionEvent event) {\n Clojure.var(\"%s\", \"%s\").invoke(this, event);\n }\n\n"
|
;; (map #(format " @FXML\n void %s(ActionEvent event) {\n Clojure.var(\"%s\", \"%s\").invoke(this, event);\n }\n\n"
|
||||||
(subs % 1) clj-ns (csk/->kebab-case (subs % 1))))
|
;; (subs % 1) clj-ns (csk/->kebab-case (subs % 1))))
|
||||||
(str/join "")))
|
;; (str/join "")))
|
||||||
|
|
||||||
(defn gen-initializer [cns cfn]
|
;; (defn gen-initializer [cns cfn]
|
||||||
(format " @FXML
|
;; (format " @FXML
|
||||||
void initialize() {
|
;; void initialize() {
|
||||||
Clojure.var(\"%s\", \"%s\").invoke(this);
|
;; Clojure.var(\"%s\", \"%s\").invoke(this);
|
||||||
}" cns cfn))
|
;; }" cns cfn))
|
||||||
|
|
||||||
(defn gen-fx-controller [fxmlzip fxmlpath [clj-ns clj-fn]]
|
;; (defn gen-fx-controller [fxmlzip fxmlpath [clj-ns clj-fn]]
|
||||||
(let [clazz (get-controller-class fxmlzip)
|
;; (let [clazz (get-controller-class fxmlzip)
|
||||||
[pkg classname] (reverse (map str/reverse (str/split (str/reverse clazz) #"\." 2)))
|
;; [pkg classname] (reverse (map str/reverse (str/split (str/reverse clazz) #"\." 2)))
|
||||||
fxid-elems (get-fxid-elems fxmlzip)
|
;; fxid-elems (get-fxid-elems fxmlzip)
|
||||||
handler-fns (get-handler-fns fxmlzip)]
|
;; handler-fns (get-handler-fns fxmlzip)]
|
||||||
(debug "fxid-elems:" (pr-str fxid-elems))
|
;; (debug "fxid-elems:" (pr-str fxid-elems))
|
||||||
(debug "handler-fns:" (pr-str handler-fns))
|
;; (debug "handler-fns:" (pr-str handler-fns))
|
||||||
(str (format "package %s;\n\n" pkg)
|
;; (str (format "package %s;\n\n" pkg)
|
||||||
stockimports
|
;; stockimports
|
||||||
(get-imports fxmlpath)
|
;; (get-imports fxmlpath)
|
||||||
(format "\n\npublic class %s {\n\n" classname)
|
;; (format "\n\npublic class %s {\n\n" classname)
|
||||||
(gen-props fxid-elems)
|
;; (gen-props fxid-elems)
|
||||||
(gen-handlers handler-fns clj-ns)
|
;; (gen-handlers handler-fns clj-ns)
|
||||||
(gen-initializer clj-ns clj-fn)
|
;; (gen-initializer clj-ns clj-fn)
|
||||||
"\n}")))
|
;; "\n}")))
|
||||||
|
|
||||||
;; Plumber
|
;; ;; Plumber
|
||||||
|
|
||||||
(defn gen-fx-controller-class [fxmlpath clj-fn]
|
;; (defn gen-fx-controller-class [fxmlpath clj-fn]
|
||||||
(let [clj-fn (if (symbol? clj-fn)
|
;; (let [clj-fn (if (symbol? clj-fn)
|
||||||
(str (namespace clj-fn) "/" (name clj-fn))
|
;; (str (namespace clj-fn) "/" (name clj-fn))
|
||||||
clj-fn)
|
;; clj-fn)
|
||||||
fxmlzip (zip-tree-seq (xml/parse (io/input-stream fxmlpath)))
|
;; fxmlzip (zip-tree-seq (xml/parse (io/input-stream fxmlpath)))
|
||||||
clazz (get-controller-class fxmlzip)
|
;; clazz (get-controller-class fxmlzip)
|
||||||
[pkg classname] (reverse (map str/reverse (str/split (str/reverse clazz) #"\." 2)))
|
;; [pkg classname] (reverse (map str/reverse (str/split (str/reverse clazz) #"\." 2)))
|
||||||
cljvec (str/split clj-fn #"/")]
|
;; cljvec (str/split clj-fn #"/")]
|
||||||
(makeclass pkg classname (gen-fx-controller fxmlzip fxmlpath cljvec))))
|
;; (makeclass pkg classname (gen-fx-controller fxmlzip fxmlpath cljvec))))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue