zilti/clojurefx
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Finished ASM implementation

Browse source
This commit is contained in:
Daniel Ziltener 2017-11-15 15:03:25 +00:00
parent 168b1bce92
commit 061518faec
2 changed files with 85 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
project.clj
View file

@ -1,4 +1,4 @@
(defproject clojurefx/clojurefx "0.3.1-SNAPSHOT" (defproject clojurefx/clojurefx "0.3.9-SNAPSHOT"
:description "A Clojure wrapper for JavaFX." :description "A Clojure wrapper for JavaFX."
:license "Like Clojure." :license "Like Clojure."
:url "https://www.bitbucket.org/zilti/clojurefx" :url "https://www.bitbucket.org/zilti/clojurefx"
@ -9,8 +9,8 @@
[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"] [org.ow2.asm/asm "6.0"]
[org.ow2.asm/asm-util "6.0_BETA"] [org.ow2.asm/asm-util "6.0"]
[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"]}

169
src/clojurefx/controllergen.clj
View file

@ -2,7 +2,8 @@
;; (:gen-class :name Controllergen ;; (:gen-class :name Controllergen
;; :implements [org.objectweb.asm.Opcodes]) ;; :implements [org.objectweb.asm.Opcodes])
;; (:import (net.openhft.compiler CachedCompiler CompilerUtils)) ;; (:import (net.openhft.compiler CachedCompiler CompilerUtils))
(:import (org.objectweb.asm ClassWriter Opcodes)) (:import (org.objectweb.asm ClassWriter Opcodes)
clojurefx.FXClassLoader)
(: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,18 +14,6 @@
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
(timbre/refer-timbre) (timbre/refer-timbre)
;; (def xmlzip (zip/xml-zip (xml/parse "/home/zilti/projects/lizenztool/resources/fxml/mainwindow.fxml")))
;; 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 ;; ;; Parser
(def imports (list clojure.java.api.Clojure clojure.lang.IFn java.net.URL java.util.ResourceBundle javafx.event.ActionEvent javafx.fxml.FXML)) (def imports (list clojure.java.api.Clojure clojure.lang.IFn java.net.URL java.util.ResourceBundle javafx.event.ActionEvent javafx.fxml.FXML))
@ -39,9 +28,18 @@
(reduce conj imports))) (reduce conj imports)))
(defn qualify-class [imports class-str] (defn qualify-class [imports class-str]
(first (filter #(= class-str (last (str/split (pr-str %) #"\."))) imports))) (debug imports)
(let [classname (first (filter #(= class-str (last (str/split (pr-str %) #"\."))) imports))
classfull (str/replace classname #"\." "/")
classreal (str/split classfull #"\s")]
(-> (filter #(= class-str (last (str/split (pr-str %) #"\."))) imports)
first
(str/replace #"\." "/")
(str/split #"\s")
last)))
(defn init-class [pkg classname import-classes] (defn init-class [pkg classname import-classes]
{:post [(s/valid? (partial instance? org.objectweb.asm.ClassWriter) %)]}
(debug (str (str/replace pkg #"\." "/") "/" classname)) (debug (str (str/replace pkg #"\." "/") "/" classname))
(let [cw (new org.objectweb.asm.ClassWriter 0) (let [cw (new org.objectweb.asm.ClassWriter 0)
@ -52,13 +50,13 @@
"java/lang/Object" "java/lang/Object"
nil) nil)
resources_fv (.visitField cw Opcodes/ACC_PRIVATE resources_fv (.visitField cw Opcodes/ACC_PRIVATE
"resources" "resources"
(pr-str (qualify-class import-classes "ResourceBundle")) (str "L" (qualify-class import-classes "ResourceBundle") ";")
nil nil
nil) nil)
url_fv (.visitField cw Opcodes/ACC_PRIVATE url_fv (.visitField cw Opcodes/ACC_PRIVATE
"location" "location"
(pr-str (qualify-class import-classes "URL")) (str "L" (qualify-class import-classes "URL") ";")
nil nil
nil)] nil)]
(-> (.visitAnnotation resources_fv "Ljavafx/fxml/FXML;" true) (-> (.visitAnnotation resources_fv "Ljavafx/fxml/FXML;" true)
@ -99,100 +97,97 @@
:fx:controller)) :fx:controller))
(defn gen-props [cw [entry & coll] import-classes] (defn gen-props [cw [entry & coll] import-classes]
(if-not (empty? coll) {:post [(s/valid? (partial instance? org.objectweb.asm.ClassWriter) %)]}
(if-not (nil? entry)
(let [fv (.visitField cw Opcodes/ACC_PUBLIC (let [fv (.visitField cw Opcodes/ACC_PUBLIC
(get-in entry [:attrs :fx:id]) (get-in entry [:attrs :fx:id])
(pr-str (qualify-class import-classes (name (:tag entry)))) (str "L" (qualify-class import-classes (name (:tag entry))) ";")
nil nil)] nil nil)]
(-> (.visitAnnotation fv "Ljava/fxml/FXML;" true) (debug "Generating" (get-in entry [:attrs :fx:id]) "with type" (qualify-class import-classes (name (:tag entry))))
(-> (.visitAnnotation fv "Ljavafx/fxml/FXML;" true)
.visitEnd) .visitEnd)
(.visitEnd fv) (.visitEnd fv)
(recur cw coll import-classes)) (gen-props cw coll import-classes))
cw)) cw))
(defn gen-handlers [cw [entry & coll] clj-ns] (defn gen-handlers [cw [entry & coll] clj-ns]
(if-not (empty? coll) {:post [(s/valid? (partial instance? org.objectweb.asm.ClassWriter) %)]}
(if-not (nil? entry)
(let [mv (.visitMethod cw 0 (let [mv (.visitMethod cw 0
(subs entry 1) (subs entry 1)
"(Ljavafx/event/ActionEvent;)V" "(Ljavafx/event/ActionEvent;)V"
nil nil)] nil nil)]
(-> (.visitAnnotation mv "Ljava/fxml/FXML;" true) (debug "Generating handler" (subs entry 1) "for" entry)
(-> (.visitAnnotation mv "Ljavafx/fxml/FXML;" true)
.visitEnd) .visitEnd)
(.. mv (.visitCode mv)
visitCode (.visitLdcInsn mv clj-ns)
(visitLdcInsn clj-ns) (.visitLdcInsn mv (csk/->kebab-case (subs entry 1)))
(visitLdcInsn (csk/->kebab-case (subs entry 1))) (.visitMethodInsn mv Opcodes/INVOKESTATIC "clojure/java/api/Clojure" "var" "(Ljava/lang/Object;Ljava/lang/Object;)Lclojure/lang/IFn;" false)
(visitMethodInsn Opcodes/INVOKESTATIC "clojure/java/api/Clojure" "var" "(Ljava/lang/Object;Ljava/lang/Object;)Lclojure/lang/IFn;" false) (.visitVarInsn mv Opcodes/ALOAD 0)
(visitVarInsn Opcodes/ALOAD 0) (.visitVarInsn mv Opcodes/ALOAD 1)
(visitVarInsn Opcodes/ALOAD 1) (.visitMethodInsn mv Opcodes/INVOKEINTERFACE "clojure/lang/IFn" "invoke" "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;" true)
(visitMethodInsn Opcodes/INVOKEINTERFACE "clojure/lang/IFn" "invoke" "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;" true) (.visitInsn mv Opcodes/POP)
(visitInsn Opcodes/POP) (.visitInsn mv Opcodes/RETURN)
(visitInsn Opcodes/RETURN) (.visitMaxs mv 3 2)
(visitMaxs 3 2) (.visitEnd mv)
visitEnd)
(recur cw coll clj-ns)) (gen-handlers cw coll clj-ns))
cw)) cw))
;; (defn gen-handlers [coll clj-ns] (defn gen-initializer [cw [clj-ns clj-fn]]
;; (->> (flatten coll) {:post [(s/valid? (partial instance? org.objectweb.asm.ClassWriter) %)]}
;; (map #(format " @FXML\n void %s(ActionEvent event) {\n Clojure.var(\"%s\", \"%s\").invoke(this, event);\n }\n\n" (debug clj-ns clj-fn)
;; (subs % 1) clj-ns (csk/->kebab-case (subs % 1)))) (let [mv (.visitMethod cw Opcodes/ACC_PUBLIC "initialize" "()V" nil nil)
;; (str/join ""))) init-mv (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)]
(.visitCode mv)
(-> (.visitAnnotation mv "Ljavafx/fxml/FXML;" true)
.visitEnd)
(.visitLdcInsn mv clj-ns)
(.visitLdcInsn mv clj-fn)
(.visitMethodInsn mv Opcodes/INVOKESTATIC "clojure/java/api/Clojure" "var" "(Ljava/lang/Object;Ljava/lang/Object;)Lclojure/lang/IFn;" false)
(.visitVarInsn mv Opcodes/ALOAD 0)
(.visitMethodInsn mv Opcodes/INVOKEINTERFACE "clojure/lang/IFn" "invoke" "(Ljava/lang/Object;)Ljava/lang/Object;" true)
(.visitInsn mv Opcodes/POP)
(.visitInsn mv Opcodes/RETURN)
(.visitMaxs mv 2 1)
(.visitEnd mv)
;; (defn gen-initializer [cns cfn] (.visitCode init-mv)
;; (format " @FXML (.visitVarInsn init-mv Opcodes/ALOAD 0)
;; void initialize() { (.visitMethodInsn init-mv Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V" false)
;; Clojure.var(\"%s\", \"%s\").invoke(this); (.visitInsn init-mv Opcodes/RETURN)
;; }" cns cfn)) (.visitMaxs init-mv 1 1)
(.visitEnd init-mv)
cw))
;; (defn gen-fx-controller [fxmlzip fxmlpath [clj-ns clj-fn]] (defn gen-fx-controller [fxmlzip fxmlpath [clj-ns clj-fn] [pkg classname]]
;; (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}")))
(defn gen-fx-controller #^Byte [fxmlzip fxmlpath [clj-ns clj-fn] [pkg classname]]
(let [fxid-elems (get-fxid-elems fxmlzip) (let [fxid-elems (get-fxid-elems fxmlzip)
handler-fns (get-handler-fns fxmlzip) handler-fns (get-handler-fns fxmlzip)
import-classes (build-imports fxmlpath)] import-classes (build-imports fxmlpath)
(-> (init-class pkg classname import-classes) inited-class (init-class pkg classname import-classes)
(gen-props fxid-elems import-classes) propped-class (gen-props inited-class fxid-elems import-classes)
(gen-handlers handler-fns clj-ns) initializer-class (gen-initializer propped-class [clj-ns clj-fn])
.toByteArray))) handled-class (gen-handlers initializer-class handler-fns clj-ns)]
(debug (pr-str handler-fns))
(.visitEnd handled-class)
(with-open [out (io/output-stream (io/file "/home/zilti/Test.class"))]
(.write out (.toByteArray handled-class)))
(.toByteArray handled-class)))
;; ;; 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)
;; (str (namespace clj-fn) "/" (name clj-fn))
;; clj-fn)
;; fxmlzip (zip-tree-seq (xml/parse (io/input-stream 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))))
(defn gen-fx-controller-class [fxmlpath clj-fn]
(let [clj-fn ^String (if (symbol? clj-fn) (let [clj-fn ^String (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 #"/")]
controllerclass #^Byte (gen-fx-controller fxmlzip fxmlpath cljvec [pkg classname]) (try
classloader (.getContextClassLoader (Thread/currentThread))] (Class/forName (str pkg "." classname))
(debug "Controllerclass array size is" (count controllerclass) "Byte") (catch Exception e
(debug "Controllerclass of class" (str pkg "." classname) "has an array size of" (count controllerclass) "Byte") (FXClassLoader/loadClass (str pkg "." classname)
(debug (type controllerclass)) (gen-fx-controller fxmlzip fxmlpath cljvec [pkg classname]))))))
(.defineClass classloader (str pkg "." classname) controllerclass 0 (count controllerclass))))