This commit is contained in:
Michiel Borkent 2021-05-24 13:38:30 +02:00
parent 1a6ce3312c
commit dd58d814d5

View file

@ -1,24 +1,27 @@
(ns sci.script-tag (ns sci.script-tag
(:refer-clojure :exclude [defn]) (:refer-clojure :exclude [defn time])
(:require [clojure.core :as c] (:require [clojure.core :as c]
[clojure.string :as str] [clojure.string :as str]
[goog.object :as gobject] [goog.object :as gobject]
[goog.string] [goog.string]
[sci.core :as sci])) [sci.core :as sci]))
(c/defmacro defn [fn-name & args] (c/defmacro time
(let [ns-sym (gensym "ns")] "Evaluates expr and prints the time it took. Returns the value of expr."
`(let [~ns-sym (ns-name *ns*)] [expr]
(clojure.core/defn ~fn-name ~@args) `(let [start# (cljs.core/system-time)
~(when (:export (meta fn-name)) ret# ~expr]
`(sci.script-tag/-export ~fn-name (str ~ns-sym "." '~fn-name)))))) (prn (cljs.core/str "Elapsed time: "
(.toFixed (- (system-time) start#) 6)
" msecs"))
ret#))
(c/defn -export [f k] (c/defn export [k f]
(let [k (munge k) (let [k (munge k)
parts (str/split k #"\.")] parts (str/split k #"\.")]
(loop [parts parts (loop [parts parts
prev js/window] prev js/window]
(let [fpart (first parts)] (when-first [fpart parts]
(cond (= "user" fpart) (cond (= "user" fpart)
(recur (rest parts) prev) (recur (rest parts) prev)
(= 1 (count parts)) (= 1 (count parts))
@ -29,17 +32,19 @@
(let [obj #js {}] (let [obj #js {}]
(gobject/set prev fpart obj) (gobject/set prev fpart obj)
(recur (rest parts) (recur (rest parts)
obj)))))) obj))))))))
(gobject/set js/window k f)))
(def stns (sci/create-ns 'sci.script-tag nil)) (def stns (sci/create-ns 'sci.script-tag nil))
(def cljns (sci/create-ns 'clojure.core nil))
(def namespaces (def namespaces
{'sci.script-tag {'sci.script-tag
{'defn (sci/copy-var defn stns) {'export (sci/copy-var export stns)}
'-export (sci/copy-var -export stns)} 'clojure.core
'clojure.core {'println (sci/copy-var println stns) {'println (sci/copy-var println cljns)
'prn (sci/copy-var prn stns)}}) 'prn (sci/copy-var prn cljns)
'system-time (sci/copy-var system-time cljns)
'time (sci/copy-var time cljns)}})
(def ctx (atom (sci/init {:namespaces namespaces (def ctx (atom (sci/init {:namespaces namespaces
:classes {'js js/window :classes {'js js/window
@ -54,8 +59,12 @@
plug-in-name ;; unused for now plug-in-name ;; unused for now
(swap! ctx sci/merge-opts sci-opts)) (swap! ctx sci/merge-opts sci-opts))
(def built-in (-> (eval-string "(map ns-name (all-ns))")
set
(disj 'user)))
(c/defn- load-contents [script-tags] (c/defn- load-contents [script-tags]
(when-first [tag script-tags] (if-let [tag (first script-tags)]
(if-let [text (not-empty (gobject/get tag "textContent"))] (if-let [text (not-empty (gobject/get tag "textContent"))]
(do (eval-string text) (do (eval-string text)
(load-contents (rest script-tags))) (load-contents (rest script-tags)))
@ -67,7 +76,17 @@
(let [response (gobject/get this "response")] (let [response (gobject/get this "response")]
(eval-string response)) (eval-string response))
(load-contents (rest script-tags)))))] (load-contents (rest script-tags)))))]
(.send req))))) (.send req)))
(eval-string (str/replace"
(run! (fn [ns]
(let [nsn (ns-name ns)]
(when-not (contains? '%s nsn)
(run! (fn [var]
(let [m (meta var)]
(when (:export m)
(sci.script-tag/export (str nsn \".\" (:name m)) @var))))
(vals (ns-publics ns))))))
(all-ns))" "%s" built-in))))
(js/document.addEventListener (js/document.addEventListener
"DOMContentLoaded" "DOMContentLoaded"