doc functions

resources/public/clojure-dbg.html

@@ -32,7 +32,8 @@
 </div>
 <br/>
 <div class="clojure">
-`(let [x# 1] x#)
+    (require '[klipse.lang.clojure.env :as e])
+    (e/doc* map)
 </div>
 <br/>
 <div class="clojure">

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)}

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))

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 {})))))))))))
+

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})