124 lines
4.3 KiB
Clojure
124 lines
4.3 KiB
Clojure
(ns swank.commands.contrib.swank-arglists
|
|
(:use (swank util core commands)))
|
|
|
|
((slime-fn 'swank-require) :swank-c-p-c)
|
|
|
|
;;; pos starts at 1 bc 0 is function name
|
|
(defn position-in-arglist? [arglist pos]
|
|
(or (some #(= '& %) arglist)
|
|
(<= pos (count arglist))))
|
|
|
|
;; (position-in-arglist? '[x y] 2)
|
|
;; => true
|
|
|
|
(defn highlight-position [arglist pos]
|
|
(if (zero? pos)
|
|
arglist
|
|
;; i.e. not rest args
|
|
(let [num-normal-args (count (take-while #(not= % '&) arglist))]
|
|
(if (<= pos num-normal-args)
|
|
(into [] (concat (take (dec pos) arglist)
|
|
'(===>)
|
|
(list (nth arglist (dec pos)))
|
|
'(<===)
|
|
(drop pos arglist)))
|
|
(let [rest-arg? (some #(= % '&) arglist)]
|
|
(if rest-arg?
|
|
(into [] (concat (take-while #(not= % '&) arglist)
|
|
'(===>)
|
|
'(&)
|
|
(list (last arglist))
|
|
'(<===)))))))))
|
|
|
|
;; (highlight-position '[x y] 0)
|
|
;; => [===> x <=== y]
|
|
|
|
(defn highlight-arglists [arglists pos]
|
|
(let [arglists (read-string arglists)]
|
|
(loop [checked []
|
|
current (first arglists)
|
|
remaining (rest arglists)]
|
|
(if (position-in-arglist? current pos)
|
|
(apply list (concat checked
|
|
[(highlight-position current pos)]
|
|
remaining))
|
|
(when (seq remaining)
|
|
(recur (conj checked current)
|
|
(first remaining)
|
|
(rest remaining)))))))
|
|
|
|
;; (highlight-arglists "([x] [x & more])" 1)
|
|
;; => ([===> x <===] [x & more])
|
|
|
|
;;(defmacro dbg[x] `(let [x# ~x] (println '~x "->" x#) x#))
|
|
|
|
(defn defnk-arglists? [arglists]
|
|
(and (not (nil? arglists ))
|
|
(not (vector? (first (read-string arglists))))))
|
|
|
|
(defn fix-defnk-arglists [arglists]
|
|
(str (list (into [] (read-string arglists)))))
|
|
|
|
(defn arglists-for-fname-lookup [fname]
|
|
((slime-fn 'operator-arglist) fname *current-package*))
|
|
|
|
(defn arglists-for-fname [fname]
|
|
(let [arglists (arglists-for-fname-lookup fname)]
|
|
;; defnk's arglists format is (a b) instead of ([a b])
|
|
(if (defnk-arglists? arglists)
|
|
(fix-defnk-arglists arglists)
|
|
arglists)))
|
|
|
|
(defn message-format [cmd arglists pos]
|
|
(str (when cmd (str cmd ": "))
|
|
(when arglists
|
|
(if pos
|
|
(highlight-arglists arglists pos)
|
|
arglists))))
|
|
|
|
(defn handle-apply [raw-specs pos]
|
|
(let [fname (second (first raw-specs))]
|
|
(message-format fname (arglists-for-fname fname) (dec pos))))
|
|
|
|
(defslimefn arglist-for-echo-area [raw-specs & options]
|
|
(let [{:keys [arg-indices
|
|
print-right-margin
|
|
print-lines]} (apply hash-map options)]
|
|
(if-not (and raw-specs
|
|
(seq? raw-specs)
|
|
(seq? (first raw-specs)))
|
|
nil ;; problem?
|
|
(let [pos (first (second options))
|
|
top-level? (= 1 (count raw-specs))
|
|
parent-pos (when-not top-level?
|
|
(second (second options)))
|
|
fname (ffirst raw-specs)
|
|
parent-fname (when-not top-level?
|
|
(first (second raw-specs)))
|
|
arglists (arglists-for-fname fname)
|
|
inside-binding? (and (not top-level?)
|
|
(#{"let" "binding" "doseq" "for" "loop"}
|
|
parent-fname)
|
|
(= 1 parent-pos))]
|
|
;; (dbg raw-specs)
|
|
;; (dbg options)
|
|
(cond
|
|
;; display arglists for function being applied unless on top of apply
|
|
(and (= fname "apply") (not= pos 0)) (handle-apply raw-specs pos)
|
|
;; highlight binding inside binding forms unless >1 level deep
|
|
inside-binding? (message-format parent-fname
|
|
(arglists-for-fname parent-fname)
|
|
1)
|
|
:else (message-format fname arglists pos))))))
|
|
|
|
(defslimefn variable-desc-for-echo-area [variable-name]
|
|
(with-emacs-package
|
|
(or
|
|
(try
|
|
(when-let [sym (read-string variable-name)]
|
|
(when-let [var (resolve sym)]
|
|
(when (.isBound #^clojure.lang.Var var)
|
|
(str variable-name " => " (var-get var)))))
|
|
(catch Exception e nil))
|
|
"")))
|