diff --git a/resources/public/clojure-dbg.html b/resources/public/clojure-dbg.html index 5576d600..26e7ba4f 100644 --- a/resources/public/clojure-dbg.html +++ b/resources/public/clojure-dbg.html @@ -32,7 +32,8 @@
-`(let [x# 1] x#) + (require '[klipse.lang.clojure.env :as e]) + (e/doc* map)

diff --git a/src/klipse/lang/clojure.cljs b/src/klipse/lang/clojure.cljs index 10425c83..56102efb 100644 --- a/src/klipse/lang/clojure.cljs +++ b/src/klipse/lang/clojure.cljs @@ -2,8 +2,10 @@ (:require-macros [gadjett.core :as gadjett :refer [dbg]] [purnam.core :refer [!]] + [klipse.lang.clojure.env :refer [doc]] [cljs.core.async.macros :refer [go go-loop]]) (:require + [klipse.lang.clojure.env :refer [current-ns st]] klipse.lang.clojure.bundled-namespaces gadjett.core-fn cljsjs.codemirror.mode.clojure @@ -26,9 +28,7 @@ (js* "window.cljs.user = {}") -(defonce ^:private current-ns (atom 'cljs.user)) -(def create-state-eval (memoize cljs/empty-state)) (def create-state-compile (memoize cljs/empty-state)) (defn display [value {:keys [print-length beautify-strings]}] @@ -101,14 +101,14 @@ *ns* (create-ns @current-ns) compiler/emits (partial my-emits max-eval-duration)] ; we have to set `env/*compiler*` because `binding` and core.async don't play well together (https://www.reddit.com/r/Clojure/comments/4wrjw5/withredefs_doesnt_play_well_with_coreasync/) and the code of `eval-str` uses `binding` of `env/*compiler*`. - (cljs/eval-str (create-state-eval) + (cljs/eval-str (st) s "my.klipse" {:eval my-eval :ns @current-ns :def-emits-var true :verbose verbose - :*compiler* (set! env/*compiler* (create-state-eval)) + :*compiler* (set! env/*compiler* (st)) :context :expr :static-fns static-fns :load (partial io/load-ns external-libs)} diff --git a/src/klipse/lang/clojure/env.clj b/src/klipse/lang/clojure/env.clj new file mode 100644 index 00000000..b54daea6 --- /dev/null +++ b/src/klipse/lang/clojure/env.clj @@ -0,0 +1,6 @@ +(ns klipse.lang.clojure.env) + +(defmacro doc + "Prints documentation for a var or special form given its name" + [name] + `(klipse.lang.clojure.env/doc* '~name)) diff --git a/src/klipse/lang/clojure/env.cljs b/src/klipse/lang/clojure/env.cljs new file mode 100644 index 00000000..a17cf604 --- /dev/null +++ b/src/klipse/lang/clojure/env.cljs @@ -0,0 +1,120 @@ +(ns klipse.lang.clojure.env + (:require-macros + [cljs.env.macros :as env]) + (:require [cljs.analyzer :as ana] + [cljs.repl :refer [print-doc]] + [clojure.string :as string] + [cljs.js :as cljs])) + +(def st (memoize cljs/empty-state)) +(defonce ^:private current-ns (atom 'cljs.user)) + +(defn- drop-macros-suffix + [ns-name] + (if (string/ends-with? ns-name "$macros") + (apply str (drop-last 7 ns-name)) + ns-name)) + +(defn- add-macros-suffix + [sym] + (symbol (str (name sym) "$macros"))) + +(defn- all-ns + "Returns a sequence of all namespaces." + [] + (keys (::ana/namespaces @(st)))) + +(defn- all-macros-ns [] + (->> (all-ns) + (filter #(string/ends-with? (str %) "$macros")))) + +(defn- get-namespace + "Gets the AST for a given namespace." + [ns] + {:pre [(symbol? ns)]} + (get-in @(st) [::ana/namespaces ns])) + +(defn- resolve-var + "Given an analysis environment resolve a var. Analogous to + clojure.core/resolve" + [env sym] + {:pre [(map? env) (symbol? sym)]} + (try + (ana/resolve-var env sym + (ana/confirm-var-exists-throw)) + (catch :default _ + (ana/resolve-macro-var env sym)))) + +(defn- get-macro-var + [env sym macros-ns] + {:pre [(symbol? macros-ns)]} + (when-let [macro-var (env/with-compiler-env (st) + (resolve-var env (symbol macros-ns (name sym))))] + (assoc macro-var :ns macros-ns))) + +(defn- get-var + [env sym] + (binding [ana/*cljs-warning-handlers* nil] + (let [var (or (env/with-compiler-env (st) (resolve-var env sym)) + (some #(get-macro-var env sym %) (all-macros-ns)))] + (when var + (-> (cond-> var + (not (:ns var)) + (assoc :ns (symbol (namespace (:name var)))) + (= (namespace (:name var)) (str (:ns var))) + (update :name #(symbol (name %)))) + (update :ns (comp symbol drop-macros-suffix str))))))) + +(defn- get-aenv [] + (assoc (ana/empty-env) + :ns (get-namespace @current-ns) + :context :expr)) + +(defn- undo-reader-conditional-spacing + "Undoes the effect that wrapping a reader conditional around + a defn has on a docstring." + [s] + ;; We look for five spaces (or six, in case that the docstring + ;; is not aligned under the first quote) after the first newline + ;; (or two, in case the doctring has an unpadded blank line + ;; after the first), and then replace all five (or six) spaces + ;; after newlines with two. + (when-not (nil? s) + (if (re-find #"[^\n]*\n\n?\s{5,6}\S.*" s) + (string/replace-all s #"\n ?" "\n ") + s))) + +(defn- doc* [name] + (if-let [special-name ('{& fn catch try finally try} name)] + (doc* special-name) + (cond + ;(special-doc-map name) + ;(cljs.repl/print-doc (special-doc-map name)) + + ;(repl-special-doc-map name) + ;(cljs.repl/print-doc (repl-special-doc name)) + + ;(get-namespace name) + ;(cljs.repl/print-doc (select-keys (get-namespace name) [:name :doc])) + + (get-var (get-aenv) name) + (symbol (with-out-str (print-doc (let [aenv (get-aenv) + var (get-var aenv name) + m (-> (select-keys var + [:ns :name :doc :forms :arglists :macro :url]) + (update-in [:doc] undo-reader-conditional-spacing) + (merge + {:forms (-> var :meta :forms second) + :arglists (-> var :meta :arglists second)}))] + (cond-> (update-in m [:name] clojure.core/name) + (:protocol-symbol var) + (assoc :protocol true + :methods + (->> (get-in var [:protocol-info :methods]) + (map (fn [[fname sigs]] + [fname {:doc (:doc + (get-var aenv + (symbol (str (:ns var)) (str fname)))) + :arglists (seq sigs)}])) + (into {}))))))))))) + diff --git a/src/klipse/lang/clojure/io.cljs b/src/klipse/lang/clojure/io.cljs index d113d7d4..9e309b2b 100644 --- a/src/klipse/lang/clojure/io.cljs +++ b/src/klipse/lang/clojure/io.cljs @@ -57,6 +57,7 @@ (def skip-ns-macros #{'cljs.core 'cljs.pprint 'cljs.env.macros + 'klipse.lang.clojure.env 'cljs.analyzer.macros 'cljs.js 'cljs.compiler.macros})