1 files changed, 123 insertions, 0 deletions
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj
new file mode 100644
index 0000000..232a116
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj
@@ -0,0 +1,123 @@
+(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))
+    "")))