1
0
Fork 0
mirror of synced 2024-06-15 13:31:10 -04:00
ultimate-vim/sources_non_forked/slimv/swank-clojure/swank/commands/inspector.clj
2022-06-05 18:14:25 +08:00

324 lines
9.3 KiB
Clojure

(ns swank.commands.inspector
(:use (swank util core commands)
(swank.core connection)))
;;;; Inspector for basic clojure data structures
;; This a mess, I'll clean up this code after I figure out exactly
;; what I need for debugging support.
(def inspectee (ref nil))
(def inspectee-content (ref nil))
(def inspectee-parts (ref nil))
(def inspectee-actions (ref nil))
(def inspector-stack (ref nil))
(def inspector-history (ref nil))
(defn reset-inspector []
(dosync
(ref-set inspectee nil)
(ref-set inspectee-content nil)
(ref-set inspectee-parts [])
(ref-set inspectee-actions [])
(ref-set inspector-stack nil)
(ref-set inspector-history [])))
(defn inspectee-title [obj]
(cond
(instance? clojure.lang.LazySeq obj) (str "clojure.lang.LazySeq@...")
:else (str obj)))
(defn print-part-to-string [value]
(let [s (inspectee-title value)
pos (position #{value} @inspector-history)]
(if pos
(str "#" pos "=" s)
s)))
(defn assign-index [o dest]
(dosync
(let [index (count @dest)]
(alter dest conj o)
index)))
(defn value-part [obj s]
(list :value (or s (print-part-to-string obj))
(assign-index obj inspectee-parts)))
(defn action-part [label lambda refresh?]
(list :action label
(assign-index (list lambda refresh?)
inspectee-actions)))
(defn label-value-line
([label value] (label-value-line label value true))
([label value newline?]
(list* (str label) ": " (list :value value)
(if newline? '((:newline)) nil))))
(defmacro label-value-line* [& label-values]
`(concat ~@(map (fn [[label value]]
`(label-value-line ~label ~value))
label-values)))
;; Inspection
;; This is the simple version that only knows about clojure stuff.
;; Many of these will probably be redefined by swank-clojure-debug
(defmulti emacs-inspect
(fn known-types [obj]
(cond
(map? obj) :map
(vector? obj) :vector
(var? obj) :var
(string? obj) :string
(seq? obj) :seq
(instance? Class obj) :class
(instance? clojure.lang.Namespace obj) :namespace
(instance? clojure.lang.ARef obj) :aref
(.isArray (class obj)) :array)))
(defn inspect-meta-information [obj]
(when (> (count (meta obj)) 0)
(concat
'("Meta Information: " (:newline))
(mapcat (fn [[key val]]
`(" " (:value ~key) " = " (:value ~val) (:newline)))
(meta obj)))))
(defmethod emacs-inspect :map [obj]
(concat
(label-value-line*
("Class" (class obj))
("Count" (count obj)))
'("Contents: " (:newline))
(inspect-meta-information obj)
(mapcat (fn [[key val]]
`(" " (:value ~key) " = " (:value ~val)
(:newline)))
obj)))
(defmethod emacs-inspect :vector [obj]
(concat
(label-value-line*
("Class" (class obj))
("Count" (count obj)))
'("Contents: " (:newline))
(inspect-meta-information obj)
(mapcat (fn [i val]
`(~(str " " i ". ") (:value ~val) (:newline)))
(iterate inc 0)
obj)))
(defmethod emacs-inspect :array [obj]
(concat
(label-value-line*
("Class" (class obj))
("Count" (alength obj))
("Component Type" (.getComponentType (class obj))))
'("Contents: " (:newline))
(mapcat (fn [i val]
`(~(str " " i ". ") (:value ~val) (:newline)))
(iterate inc 0)
obj)))
(defmethod emacs-inspect :var [#^clojure.lang.Var obj]
(concat
(label-value-line*
("Class" (class obj)))
(inspect-meta-information obj)
(when (.isBound obj)
`("Value: " (:value ~(var-get obj))))))
(defmethod emacs-inspect :string [obj]
(concat
(label-value-line*
("Class" (class obj)))
(inspect-meta-information obj)
(list (str "Value: " (pr-str obj)))))
(defmethod emacs-inspect :seq [obj]
(concat
(label-value-line*
("Class" (class obj)))
'("Contents: " (:newline))
(inspect-meta-information obj)
(mapcat (fn [i val]
`(~(str " " i ". ") (:value ~val) (:newline)))
(iterate inc 0)
obj)))
(defmethod emacs-inspect :default [obj]
(let [fields (. (class obj) getDeclaredFields)
names (map (memfn getName) fields)
get (fn [f]
(try (.setAccessible f true)
(catch java.lang.SecurityException e))
(try (.get f obj)
(catch java.lang.IllegalAccessException e
"Access denied.")))
vals (map get fields)]
(concat
`("Type: " (:value ~(class obj)) (:newline)
"Value: " (:value ~obj) (:newline)
"---" (:newline)
"Fields: " (:newline))
(mapcat
(fn [name val]
`(~(str " " name ": ") (:value ~val) (:newline))) names vals))))
(defmethod emacs-inspect :class [#^Class obj]
(let [meths (. obj getMethods)
fields (. obj getFields)]
(concat
`("Type: " (:value ~(class obj)) (:newline)
"---" (:newline)
"Fields: " (:newline))
(mapcat (fn [f]
`(" " (:value ~f) (:newline))) fields)
'("---" (:newline)
"Methods: " (:newline))
(mapcat (fn [m]
`(" " (:value ~m) (:newline))) meths))))
(defmethod emacs-inspect :aref [#^clojure.lang.ARef obj]
`("Type: " (:value ~(class obj)) (:newline)
"Value: " (:value ~(deref obj)) (:newline)))
(defn ns-refers-by-ns [#^clojure.lang.Namespace ns]
(group-by (fn [#^clojure.lang.Var v] (. v ns))
(map val (ns-refers ns))))
(defmethod emacs-inspect :namespace [#^clojure.lang.Namespace obj]
(concat
(label-value-line*
("Class" (class obj))
("Count" (count (ns-map obj))))
'("---" (:newline)
"Refer from: " (:newline))
(mapcat (fn [[ns refers]]
`(" "(:value ~ns) " = " (:value ~refers) (:newline)))
(ns-refers-by-ns obj))
(label-value-line*
("Imports" (ns-imports obj))
("Interns" (ns-interns obj)))))
(defn inspector-content [specs]
(letfn [(spec-seq [seq]
(let [[f & args] seq]
(cond
(= f :newline) (str \newline)
(= f :value)
(let [[obj & [str]] args]
(value-part obj str))
(= f :action)
(let [[label lambda & options] args
{:keys [refresh?]} (apply hash-map options)]
(action-part label lambda refresh?)))))
(spec-value [val]
(cond
(string? val) val
(seq? val) (spec-seq val)))]
(map spec-value specs)))
;; Works for infinite sequences, but it lies about length. Luckily, emacs doesn't
;; care.
(defn content-range [lst start end]
(let [amount-wanted (- end start)
shifted (drop start lst)
taken (take amount-wanted shifted)
amount-taken (count taken)]
(if (< amount-taken amount-wanted)
(list taken (+ amount-taken start) start end)
;; There's always more until we know there isn't
(list taken (+ end 500) start end))))
(defn inspect-object [o]
(dosync
(ref-set inspectee o)
(alter inspector-stack conj o)
(when-not (filter #(identical? o %) @inspector-history)
(alter inspector-history conj o))
(ref-set inspectee-content (inspector-content (emacs-inspect o)))
(list :title (inspectee-title o)
:id (assign-index o inspectee-parts)
:content (content-range @inspectee-content 0 500))))
(defslimefn init-inspector [string]
(with-emacs-package
(reset-inspector)
(inspect-object (eval (read-string string)))))
(defn inspect-in-emacs [what]
(letfn [(send-it []
(with-emacs-package
(reset-inspector)
(send-to-emacs `(:inspect ~(inspect-object what)))))]
(cond
*current-connection* (send-it)
(comment (first @connections))
;; TODO: take a second look at this, will probably need garbage collection on connections
(comment
(binding [*current-connection* (first @connections)]
(send-it))))))
(defslimefn inspect-frame-var [frame index]
(if (and (zero? frame) *current-env*)
(let [locals *current-env*
object (locals (nth (keys locals) index))]
(with-emacs-package
(reset-inspector)
(inspect-object object)))))
(defslimefn inspector-nth-part [index]
(get @inspectee-parts index))
(defslimefn inspect-nth-part [index]
(with-emacs-package
(inspect-object ((slime-fn 'inspector-nth-part) index))))
(defslimefn inspector-range [from to]
(content-range @inspectee-content from to))
(defn ref-pop [ref]
(let [[f & r] @ref]
(ref-set ref r)
f))
(defslimefn inspector-call-nth-action [index & args]
(let [[fn refresh?] (get @inspectee-actions index)]
(apply fn args)
(if refresh?
(inspect-object (dosync (ref-pop inspector-stack)))
nil)))
(defslimefn inspector-pop []
(with-emacs-package
(cond
(rest @inspector-stack)
(inspect-object
(dosync
(ref-pop inspector-stack)
(ref-pop inspector-stack)))
:else nil)))
(defslimefn inspector-next []
(with-emacs-package
(let [pos (position #{@inspectee} @inspector-history)]
(cond
(= (inc pos) (count @inspector-history)) nil
:else (inspect-object (get @inspector-history (inc pos)))))))
(defslimefn inspector-reinspect []
(inspect-object @inspectee))
(defslimefn quit-inspector []
(reset-inspector)
nil)
(defslimefn describe-inspectee []
(with-emacs-package
(str @inspectee)))