From c012f55efda29f09179e921cf148d79deb57616e Mon Sep 17 00:00:00 2001
From: Nick Shipp <nick@shipp.ninja>
Date: Sun, 7 May 2017 09:04:01 -0400
Subject: Much maturering of vim configs

---
 .../slimv/swank-clojure/swank/commands/basic.clj   | 601 +++++++++++++++++++++
 .../swank-clojure/swank/commands/completion.clj    | 103 ++++
 .../slimv/swank-clojure/swank/commands/contrib.clj |   9 +
 .../swank/commands/contrib/swank_arglists.clj      | 123 +++++
 .../swank/commands/contrib/swank_c_p_c.clj         |  21 +
 .../commands/contrib/swank_c_p_c/internal.clj      |  59 ++
 .../swank/commands/contrib/swank_fuzzy.clj         | 428 +++++++++++++++
 .../slimv/swank-clojure/swank/commands/indent.clj  | 100 ++++
 .../swank-clojure/swank/commands/inspector.clj     | 323 +++++++++++
 .../slimv/swank-clojure/swank/commands/xref.clj    |  51 ++
 10 files changed, 1818 insertions(+)
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/basic.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/completion.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_arglists.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/indent.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj
 create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands/xref.clj

(limited to 'vim/bundle/slimv/swank-clojure/swank/commands')

diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/basic.clj b/vim/bundle/slimv/swank-clojure/swank/commands/basic.clj
new file mode 100644
index 0000000..a397280
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/basic.clj
@@ -0,0 +1,601 @@
+(ns swank.commands.basic
+  (:refer-clojure :exclude [load-file print-doc])
+  (:use (swank util commands core)
+        (swank.util.concurrent thread)
+        (swank.util string clojure)
+        (swank.clj-contrib pprint macroexpand))
+  (:require (swank.util [sys :as sys])
+            (swank.commands [xref :as xref]))
+  (:import (java.io StringReader File)
+           (java.util.zip ZipFile)
+           (clojure.lang LineNumberingPushbackReader)))
+
+;;;; Connection
+
+(defslimefn connection-info []
+  `(:pid ~(sys/get-pid)
+         :style :spawn
+         :lisp-implementation (:type "Clojure"
+                                     :name "clojure"
+                                     :version ~(clojure-version))
+         :package (:name ~(name (ns-name *ns*))
+                         :prompt ~(name (ns-name *ns*)))
+         :version ~(deref protocol-version)))
+
+(defslimefn quit-lisp []
+  (System/exit 0))
+
+(defslimefn toggle-debug-on-swank-error []
+  (alter-var-root #'swank.core/debug-swank-clojure not))
+
+;;;; Evaluation
+
+(defn- eval-region
+  "Evaluate string, return the results of the last form as a list and
+   a secondary value the last form."
+  ([string]
+     (eval-region string "NO_SOURCE_FILE" 1))
+  ([string file line]
+     (with-open [rdr (proxy [LineNumberingPushbackReader]
+                         ((StringReader. string))
+                       (getLineNumber [] line))]
+       (binding [*file* file]
+         (loop [form (read rdr false rdr), value nil, last-form nil]
+           (if (= form rdr)
+             [value last-form]
+             (recur (read rdr false rdr)
+                    (eval (with-env-locals form))
+                    form)))))))
+
+(defn- compile-region
+  "Compile region."
+  ([string file line]
+     (with-open [rdr1 (proxy [LineNumberingPushbackReader]
+                          ((StringReader. string)))
+                 rdr (proxy [LineNumberingPushbackReader] (rdr1)
+                       (getLineNumber [] (+ line (.getLineNumber rdr1) -1)))]
+       (clojure.lang.Compiler/load rdr file (.getName (File. file))))))
+
+
+(defslimefn interactive-eval-region [string]
+  (with-emacs-package
+    (pr-str (first (eval-region string)))))
+
+(defslimefn interactive-eval [string]
+  (with-emacs-package
+    (pr-str (first (eval-region string)))))
+
+(defslimefn listener-eval [form]
+  (with-emacs-package
+    (with-package-tracking
+      (let [[value last-form] (eval-region form)]
+        (when (and last-form (not (one-of? last-form '*1 '*2 '*3 '*e)))
+          (set! *3 *2)
+          (set! *2 *1)
+          (set! *1 value))
+        (send-repl-results-to-emacs value)))))
+
+(defslimefn eval-and-grab-output [string]
+  (with-emacs-package
+    (let [retval (promise)]
+      (list (with-out-str
+              (deliver retval (pr-str (first (eval-region string)))))
+            @retval))))
+
+(defslimefn pprint-eval [string]
+  (with-emacs-package
+    (pretty-pr-code (first (eval-region string)))))
+
+;;;; Macro expansion
+
+(defn- apply-macro-expander [expander string]
+  (pretty-pr-code (expander (read-string string))))
+
+(defslimefn swank-macroexpand-1 [string]
+  (apply-macro-expander macroexpand-1 string))
+
+(defslimefn swank-macroexpand [string]
+  (apply-macro-expander macroexpand string))
+
+;; not implemented yet, needs walker
+(defslimefn swank-macroexpand-all [string]
+  (apply-macro-expander macroexpand-all string))
+
+;;;; Compiler / Execution
+
+(def compiler-exception-location-re #"Exception:.*\(([^:]+):([0-9]+)\)")
+(defn- guess-compiler-exception-location [#^Throwable t]
+  (when (instance? clojure.lang.Compiler$CompilerException t)
+    (let [[match file line] (re-find compiler-exception-location-re (str t))]
+      (when (and file line)
+        `(:location (:file ~file) (:line ~(Integer/parseInt line)) nil)))))
+
+;; TODO: Make more and better guesses
+(defn- exception-location [#^Throwable t]
+  (or (guess-compiler-exception-location t)
+      '(:error "No error location available")))
+
+;; plist of message, severity, location, references, short-message
+(defn- exception-to-message [#^Throwable t]
+  `(:message ~(.toString t)
+             :severity :error
+             :location ~(exception-location t)
+             :references nil
+             :short-message ~(.toString t)))
+
+(defn- compile-file-for-emacs*
+  "Compiles a file for emacs. Because clojure doesn't compile, this is
+   simple an alias for load file w/ timing and messages. This function
+   is to reply with the following:
+     (:swank-compilation-unit notes results durations)"
+  ([file-name]
+     (let [start (System/nanoTime)]
+       (try
+         (let [ret (clojure.core/load-file file-name)
+               delta (- (System/nanoTime) start)]
+           `(:compilation-result nil ~(pr-str ret) ~(/ delta 1000000000.0)))
+         (catch Throwable t
+           (let [delta (- (System/nanoTime) start)
+                 causes (exception-causes t)
+                 num (count causes)]
+             (.printStackTrace t) ;; prints to *inferior-lisp*
+             `(:compilation-result
+               ~(map exception-to-message causes) ;; notes
+               nil ;; results
+               ~(/ delta 1000000000.0) ;; durations
+               )))))))
+
+(defslimefn compile-file-for-emacs
+  ([file-name load? & compile-options]
+     (when load?
+       (compile-file-for-emacs* file-name))))
+
+(defslimefn load-file [file-name]
+  (let [libs-ref @(resolve 'clojure.core/*loaded-libs*)
+        libs @libs-ref]
+    (try
+      (dosync (ref-set libs-ref #{}))
+      (pr-str (clojure.core/load-file file-name))
+         (finally
+          (dosync (alter libs-ref into libs))))))
+
+(defn- line-at-position [file position]
+  (try
+    (with-open [f (java.io.LineNumberReader. (java.io.FileReader. file))]
+      (.skip f position)
+      (.getLineNumber f))
+    (catch Exception e 1)))
+
+(defslimefn compile-string-for-emacs [string buffer position directory debug]
+  (let [start (System/nanoTime)
+        line (line-at-position directory position)
+        ret (with-emacs-package
+              (when-not (= (name (ns-name *ns*)) *current-package*)
+                (throw (clojure.lang.Compiler$CompilerException.
+                        directory line
+                        (Exception. (str "No such namespace: "
+                                         *current-package*)))))
+              (compile-region string directory line))
+        delta (- (System/nanoTime) start)]
+    `(:compilation-result nil ~(pr-str ret) ~(/ delta 1000000000.0))))
+
+;;;; Describe
+
+(defn- maybe-resolve-sym [symbol-name]
+  (try
+    (ns-resolve (maybe-ns *current-package*) (symbol symbol-name))
+    (catch ClassNotFoundException e nil)))
+
+(defn- maybe-resolve-ns [sym-name]
+  (let [sym (symbol sym-name)]
+    (or ((ns-aliases (maybe-ns *current-package*)) sym)
+        (find-ns sym))))
+
+(defn- print-doc* [m]
+  (println "-------------------------")
+  (println (str (when-let [ns (:ns m)] (str (ns-name ns) "/")) (:name m)))
+  (cond
+   (:forms m) (doseq [f (:forms m)]
+                (print "  ")
+                (prn f))
+   (:arglists m) (prn (:arglists m)))
+  (if (:special-form m)
+    (do
+      (println "Special Form")
+      (println " " (:doc m))
+      (if (contains? m :url)
+        (when (:url m)
+          (println (str "\n  Please see http://clojure.org/" (:url m))))
+        (println (str "\n  Please see http://clojure.org/special_forms#"
+                      (:name m)))))
+    (do
+      (when (:macro m)
+        (println "Macro"))
+      (println " " (:doc m)))))
+
+(def print-doc (let [print-doc (resolve 'clojure.core/print-doc)]
+                 (if (or (nil? print-doc) (-> print-doc meta :private))
+                   (comp print-doc* meta)
+                   print-doc)))
+
+(defn- describe-to-string [var]
+  (with-out-str
+    (print-doc var)))
+
+(defn- describe-symbol* [symbol-name]
+  (with-emacs-package
+    (if-let [v (maybe-resolve-sym symbol-name)]
+      (if-not (class? v)
+        (describe-to-string v)))))
+
+(defslimefn describe-symbol [symbol-name]
+  (describe-symbol* symbol-name))
+
+(defslimefn describe-function [symbol-name]
+  (describe-symbol* symbol-name))
+
+;; Only one namespace... so no kinds
+(defslimefn describe-definition-for-emacs [name kind]
+  (describe-symbol* name))
+
+;; Only one namespace... so only describe symbol
+(defslimefn documentation-symbol
+  ([symbol-name default] (documentation-symbol symbol-name))
+  ([symbol-name] (describe-symbol* symbol-name)))
+
+;;;; Documentation
+
+(defn- briefly-describe-symbol-for-emacs [var]
+  (let [lines (fn [s] (.split #^String s (System/getProperty "line.separator")))
+        [_ symbol-name arglists d1 d2 & __] (lines (describe-to-string var))
+        macro? (= d1 "Macro")]
+    (list :designator symbol-name
+          (cond
+           macro? :macro
+           (:arglists (meta var)) :function
+           :else :variable)
+          (apply str (concat arglists (if macro? d2 d1))))))
+
+(defn- make-apropos-matcher [pattern case-sensitive?]
+  (let [pattern (java.util.regex.Pattern/quote pattern)
+        pat (re-pattern (if case-sensitive?
+                          pattern
+                          (format "(?i:%s)" pattern)))]
+    (fn [var] (re-find pat (pr-str var)))))
+
+(defn- apropos-symbols [string external-only? case-sensitive? package]
+  (let [packages (or (when package [package]) (all-ns))
+        matcher (make-apropos-matcher string case-sensitive?)
+        lister (if external-only? ns-publics ns-interns)]
+    (filter matcher
+            (apply concat (map (comp (partial map second) lister)
+                               packages)))))
+
+(defn- present-symbol-before
+  "Comparator such that x belongs before y in a printed summary of symbols.
+Sorted alphabetically by namespace name and then symbol name, except
+that symbols accessible in the current namespace go first."
+  [x y]
+  (let [accessible?
+        (fn [var] (= (maybe-resolve-sym (:name (meta var)))
+                     var))
+        ax (accessible? x) ay (accessible? y)]
+    (cond
+     (and ax ay) (compare (:name (meta x)) (:name (meta y)))
+     ax -1
+     ay 1
+     :else (let [nx (str (:ns (meta x))) ny (str (:ns (meta y)))]
+             (if (= nx ny)
+               (compare (:name (meta x)) (:name (meta y)))
+               (compare nx ny))))))
+
+(defslimefn apropos-list-for-emacs
+  ([name]
+     (apropos-list-for-emacs name nil))
+  ([name external-only?]
+     (apropos-list-for-emacs name external-only? nil))
+  ([name external-only? case-sensitive?]
+     (apropos-list-for-emacs name external-only? case-sensitive? nil))
+  ([name external-only? case-sensitive? package]
+     (let [package (when package
+                     (maybe-ns package))]
+       (map briefly-describe-symbol-for-emacs
+            (sort present-symbol-before
+                  (apropos-symbols name external-only? case-sensitive?
+                                   package))))))
+
+;;;; Operator messages
+(defslimefn operator-arglist [name package]
+  (try
+    (let [f (read-string name)]
+      (cond
+       (keyword? f) "([map])"
+       (symbol? f) (let [var (ns-resolve (maybe-ns package) f)]
+                     (if-let [args (and var (:arglists (meta var)))]
+                       (pr-str args)
+                       nil))
+       :else nil))
+    (catch Throwable t nil)))
+
+;;;; Package Commands
+
+(defslimefn list-all-package-names
+  ([] (map (comp str ns-name) (all-ns)))
+  ([nicknames?] (list-all-package-names)))
+
+(defslimefn set-package [name]
+  (let [ns (maybe-ns name)]
+    (in-ns (ns-name ns))
+    (list (str (ns-name ns))
+          (str (ns-name ns)))))
+
+;;;; Tracing
+
+(defonce traced-fn-map {})
+
+(def #^{:dynamic true} *trace-level* 0)
+
+(defn- indent [num]
+  (dotimes [x (+ 1 num)]
+    (print "  ")))
+
+(defn- trace-fn-call [sym f args]
+  (let [fname (symbol (str (.name (.ns sym)) "/" (.sym sym)))]
+    (indent *trace-level*)
+    (println (str *trace-level* ":")
+             (apply str (take 240 (pr-str (when fname (cons fname args)) ))))
+    (let [result (binding [*trace-level* (+ *trace-level* 1)] (apply f args))]
+      (indent *trace-level*)
+      (println (str *trace-level* ": " fname " returned " (apply str (take 240 (pr-str result)))))
+      result)))
+
+(defslimefn swank-toggle-trace [fname]
+  (when-let [sym (maybe-resolve-sym fname)]
+    (if-let [f# (get traced-fn-map sym)]
+      (do
+        (alter-var-root #'traced-fn-map dissoc sym)
+        (alter-var-root sym (constantly f#))
+        (str " untraced."))
+      (let [f# @sym]
+        (alter-var-root #'traced-fn-map assoc sym f#)
+        (alter-var-root sym
+                        (constantly
+                         (fn [& args]
+                           (trace-fn-call sym f# args))))
+        (str " traced.")))))
+
+(defslimefn untrace-all []
+  (doseq [sym (keys traced-fn-map)]
+    (swank-toggle-trace (.sym sym))))
+
+;;;; Source Locations
+(comment
+  "Sets the default directory (java's user.dir). Note, however, that
+   this will not change the search path of load-file. ")
+(defslimefn set-default-directory
+  ([directory & ignore]
+     (System/setProperty "user.dir" directory)
+     directory))
+
+
+;;;; meta dot find
+
+(defn- clean-windows-path [#^String path]
+  ;; Decode file URI encoding and remove an opening slash from
+  ;; /c:/program%20files/... in jar file URLs and file resources.
+  (or (and (.startsWith (System/getProperty "os.name") "Windows")
+           (second (re-matches #"^/([a-zA-Z]:/.*)$" path)))
+      path))
+
+(defn- slime-zip-resource [#^java.net.URL resource]
+  (let [jar-connection #^java.net.JarURLConnection (.openConnection resource)
+        jar-file (.getPath (.toURI (.getJarFileURL jar-connection)))]
+    (list :zip (clean-windows-path jar-file) (.getEntryName jar-connection))))
+
+(defn- slime-file-resource [#^java.net.URL resource]
+  (list :file (clean-windows-path (.getFile resource))))
+
+(defn- slime-find-resource [#^String file]
+  (if-let [resource (.getResource (clojure.lang.RT/baseLoader) file)]
+    (if (= (.getProtocol resource) "jar")
+      (slime-zip-resource resource)
+      (slime-file-resource resource))))
+
+(defn- slime-find-file [#^String file]
+  (if (.isAbsolute (File. file))
+    (list :file file)
+    (slime-find-resource file)))
+
+(defn- namespace-to-path [ns]
+  (let [#^String ns-str (name (ns-name ns))
+        last-dot-index (.lastIndexOf ns-str ".")]
+    (if (pos? last-dot-index)
+      (-> (.substring ns-str 0 last-dot-index)
+          (.replace \- \_)
+          (.replace \. \/)))))
+
+(defn- classname-to-path [class-name]
+  (namespace-to-path
+   (symbol (.replace class-name \_ \-))))
+
+
+(defn- location-in-file [path line]
+  `(:location ~path (:line ~line) nil))
+
+(defn- location-label [name type]
+  (if type
+    (str "(" type " " name ")")
+    (str name)))
+
+(defn- location [name type path line]
+  `((~(location-label name type)
+     ~(if path
+        (location-in-file path line)
+        (list :error (format "%s - definition not found." name))))))
+
+(defn- location-not-found [name type]
+  (location name type nil nil))
+
+(defn source-location-for-frame [#^StackTraceElement frame]
+  (let [line     (.getLineNumber frame)
+        filename (if (.. frame getFileName (endsWith ".java"))
+                   (.. frame getClassName (replace \. \/)
+                       (substring 0 (.lastIndexOf (.getClassName frame) "."))
+                       (concat (str File/separator (.getFileName frame))))
+                   (let [ns-path (classname-to-path
+                                  ((re-find #"(.*?)\$"
+                                            (.getClassName frame)) 1))]
+                     (if ns-path
+                       (str ns-path File/separator (.getFileName frame))
+                       (.getFileName frame))))
+        path     (slime-find-file filename)]
+    (location-in-file path line)))
+
+(defn- namespace-to-filename [ns]
+  (str (-> (str ns)
+           (.replaceAll "\\." File/separator)
+           (.replace \- \_ ))
+       ".clj"))
+
+(defn- source-location-for-meta [meta xref-type-name]
+  (location (:name meta)
+            xref-type-name
+            (slime-find-file (:file meta))
+            (:line meta)))
+
+(defn- find-ns-definition [sym-name]
+  (if-let [ns (maybe-resolve-ns sym-name)]
+    (when-let [path (slime-find-file (namespace-to-filename ns))]
+      (location ns nil path 1))))
+
+(defn- find-var-definition [sym-name]
+  (if-let [meta (meta (maybe-resolve-sym sym-name))]
+    (source-location-for-meta meta "defn")))
+
+(defslimefn find-definitions-for-emacs [name]
+  (let [sym-name (read-string name)]
+    (or (find-var-definition sym-name)
+        (find-ns-definition sym-name)
+        (location name nil nil nil))))
+
+(defn who-specializes [class]
+  (letfn [(xref-lisp [sym] ; see find-definitions-for-emacs
+                     (if-let [meta (meta sym)]
+                       (source-location-for-meta meta "method")
+                       (location-not-found (.getName sym) "method")))]
+    (let [methods (try (. class getMethods)
+                       (catch java.lang.IllegalArgumentException e nil)
+                       (catch java.lang.NullPointerException e nil))]
+      (map xref-lisp methods))))
+
+(defn who-calls [name]
+  (letfn [(xref-lisp [sym-var]        ; see find-definitions-for-emacs
+                     (when-let [meta (meta sym-var)]
+                       (source-location-for-meta meta nil)))]
+    (let [callers (xref/all-vars-who-call name) ]
+      (map first (map xref-lisp callers)))))
+
+(defslimefn xref [type name]
+  (let [sexp (maybe-resolve-sym name)]
+       (condp = type
+              :specializes (who-specializes sexp)
+              :calls   (who-calls (symbol name))
+              :callers nil
+              :not-implemented)))
+
+(defslimefn throw-to-toplevel []
+  (throw debug-quit-exception))
+
+(defn invoke-restart [restart]
+  ((nth restart 2)))
+
+(defslimefn invoke-nth-restart-for-emacs [level n]
+  ((invoke-restart (*sldb-restarts* (nth (keys *sldb-restarts*) n)))))
+
+(defslimefn throw-to-toplevel []
+  (if-let [restart (*sldb-restarts* :quit)]
+    (invoke-restart restart)))
+
+(defslimefn sldb-continue []
+  (if-let [restart (*sldb-restarts* :continue)]
+    (invoke-restart restart)))
+
+(defslimefn sldb-abort []
+  (if-let [restart (*sldb-restarts* :abort)]
+    (invoke-restart restart)))
+
+
+(defslimefn backtrace [start end]
+  (build-backtrace start end))
+
+(defslimefn buffer-first-change [file-name] nil)
+
+(defn locals-for-emacs [m]
+  (sort-by second
+           (map #(list :name (name (first %)) :id 0
+                       :value (pr-str (second %))) m)))
+
+(defslimefn frame-catch-tags-for-emacs [n] nil)
+(defslimefn frame-locals-for-emacs [n]
+  (if (and (zero? n) (seq *current-env*))
+    (locals-for-emacs *current-env*)))
+
+(defslimefn frame-locals-and-catch-tags [n]
+  (list (frame-locals-for-emacs n)
+        (frame-catch-tags-for-emacs n)))
+
+(defslimefn debugger-info-for-emacs [start end]
+  (build-debugger-info-for-emacs start end))
+
+(defslimefn eval-string-in-frame [expr n]
+  (if (and (zero? n) *current-env*)
+    (with-bindings *current-env*
+      (eval expr))))
+
+(defslimefn frame-source-location [n]
+  (source-location-for-frame
+   (nth (.getStackTrace *current-exception*) n)))
+
+;; Older versions of slime use this instead of the above.
+(defslimefn frame-source-location-for-emacs [n]
+  (source-location-for-frame
+   (nth (.getStackTrace *current-exception*) n)))
+
+(defslimefn create-repl [target] '("user" "user"))
+
+;;; Threads
+
+(def #^{:private true} thread-list (atom []))
+
+(defn- get-root-group [#^java.lang.ThreadGroup tg]
+  (if-let [parent (.getParent tg)]
+    (recur parent)
+    tg))
+
+(defn- get-thread-list []
+  (let [rg (get-root-group (.getThreadGroup (Thread/currentThread)))
+        arr (make-array Thread (.activeCount rg))]
+    (.enumerate rg arr true)
+    (seq arr)))
+
+(defn- extract-info [#^Thread t]
+  (map str [(.getId t) (.getName t) (.getPriority t) (.getState t)]))
+
+(defslimefn list-threads
+  "Return a list (LABELS (ID NAME STATUS ATTRS ...) ...).
+LABELS is a list of attribute names and the remaining lists are the
+corresponding attribute values per thread."
+  []
+  (reset! thread-list (get-thread-list))
+  (let [labels '(id name priority state)]
+    (cons labels (map extract-info @thread-list))))
+
+;;; TODO: Find a better way, as Thread.stop is deprecated
+(defslimefn kill-nth-thread [index]
+  (when index
+    (when-let [thread (nth @thread-list index nil)]
+      (println "Thread: " thread)
+      (.stop thread))))
+
+(defslimefn quit-thread-browser []
+  (reset! thread-list []))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/completion.clj b/vim/bundle/slimv/swank-clojure/swank/commands/completion.clj
new file mode 100644
index 0000000..4fc2b20
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/completion.clj
@@ -0,0 +1,103 @@
+(ns swank.commands.completion
+  (:use (swank util core commands)
+        (swank.util string clojure java class-browse)))
+
+(defn potential-ns
+  "Returns a list of potential namespace completions for a given
+   namespace"
+  ([] (potential-ns *ns*))
+  ([ns]
+     (for [ns-sym (concat (keys (ns-aliases (ns-name ns)))
+                          (map ns-name (all-ns)))]
+       (name ns-sym))))
+
+(defn potential-var-public
+  "Returns a list of potential public var name completions for a
+   given namespace"
+  ([] (potential-var-public *ns*))
+  ([ns]
+     (for [var-sym (keys (ns-publics ns))]
+       (name var-sym))))
+
+(defn potential-var
+  "Returns a list of all potential var name completions for a given
+   namespace"
+  ([] (potential-var *ns*))
+  ([ns]
+     (for [[key v] (ns-map ns)
+           :when (var? v)]
+       (name key))))
+
+(defn potential-classes
+  "Returns a list of potential class name completions for a given
+   namespace"
+  ([] (potential-classes *ns*))
+  ([ns]
+     (for [class-sym (keys (ns-imports ns))]
+       (name class-sym))))
+
+(defn potential-dot
+  "Returns a list of potential dot method name completions for a given
+   namespace"
+  ([] (potential-dot *ns*))
+  ([ns]
+     (map #(str "." %) (set (map member-name (mapcat instance-methods (vals (ns-imports ns))))))))
+
+(defn potential-static
+  "Returns a list of potential static members for a given namespace"
+  ([#^Class class]
+     (concat (map member-name (static-methods class))
+	     (map member-name (static-fields class)))))
+
+
+(defn potential-classes-on-path
+  "Returns a list of Java class and Clojure package names found on the current
+  classpath. To minimize noise, list is nil unless a '.' is present in the search
+  string, and nested classes are only shown if a '$' is present."
+  ([symbol-string]
+	 (when (.contains symbol-string ".")
+	   (if (.contains symbol-string "$")
+		 @nested-classes
+		 @top-level-classes))))
+
+(defn resolve-class
+  "Attempts to resolve a symbol into a java Class. Returns nil on
+   failure."
+  ([sym]
+     (try
+      (let [res (resolve sym)]
+        (when (class? res)
+          res))
+      (catch Throwable t
+        nil))))
+
+
+(defn- maybe-alias [sym ns]
+  (or (resolve-ns sym (maybe-ns ns))
+      (maybe-ns ns)))
+
+(defn potential-completions [symbol-ns ns]
+  (if symbol-ns
+    (map #(str symbol-ns "/" %)
+         (if-let [class (resolve-class symbol-ns)]
+           (potential-static class)
+           (potential-var-public (maybe-alias symbol-ns ns))))
+    (concat (potential-var ns)
+            (when-not symbol-ns
+              (potential-ns))
+            (potential-classes ns)
+            (potential-dot ns))))
+
+
+(defslimefn simple-completions [symbol-string package]
+  (try
+   (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+		 potential         (concat (potential-completions (when sym-ns (symbol sym-ns)) (ns-name (maybe-ns package)))
+								   (potential-classes-on-path symbol-string))
+         matches           (seq (sort (filter #(.startsWith #^String % symbol-string) potential)))]
+     (list matches
+           (if matches
+             (reduce largest-common-prefix matches)
+             symbol-string)))
+   (catch java.lang.Throwable t
+     (list nil symbol-string))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj
new file mode 100644
index 0000000..6c0ed07
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib.clj
@@ -0,0 +1,9 @@
+(ns swank.commands.contrib
+  (:use (swank util core commands)))
+
+(defslimefn swank-require [keys]
+  (binding [*ns* (find-ns 'swank.commands.contrib)]
+    (doseq [k (if (seq? keys) keys (list keys))]
+      (try
+       (require (symbol (str "swank.commands.contrib." (name k))))
+       (catch java.io.FileNotFoundException fne nil)))))
\ No newline at end of file
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))
+    "")))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj
new file mode 100644
index 0000000..40ca3fd
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c.clj
@@ -0,0 +1,21 @@
+(ns swank.commands.contrib.swank-c-p-c
+  (:use (swank util core commands)
+        (swank.commands completion)
+        (swank.util string clojure)
+        (swank.commands.contrib.swank-c-p-c internal)))
+
+(defslimefn completions [symbol-string package]
+  (try
+   (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+         potential         (concat
+			    (potential-completions
+			     (when sym-ns (symbol sym-ns))
+			     (ns-name (maybe-ns package)))
+			    (potential-classes-on-path symbol-string))
+         matches           (seq (sort (filter #(split-compound-prefix-match? symbol-string %) potential)))]
+     (list matches
+           (if matches
+             (reduce largest-common-prefix matches)
+             symbol-string)))
+   (catch java.lang.Throwable t
+     (list nil symbol-string))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj
new file mode 100644
index 0000000..89701dd
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_c_p_c/internal.clj
@@ -0,0 +1,59 @@
+(ns swank.commands.contrib.swank-c-p-c.internal
+  (:use (swank util core commands)
+        (swank.commands completion)
+        (swank.util string clojure)))
+
+(defn compound-prefix-match?
+  "Takes a `prefix' and a `target' string and returns whether `prefix'
+  is a compound-prefix of `target'.
+
+  Viewing each of `prefix' and `target' as a series of substrings
+  split by `split', if each substring of `prefix' is a prefix of the
+  corresponding substring in `target' then we call `prefix' a
+  compound-prefix of `target'."
+  ([split #^String prefix #^String target]
+     (let [prefixes (split prefix)
+           targets  (split target)]
+       (when (<= (count prefixes) (count targets))
+         (every? true? (map #(.startsWith #^String %1 %2) targets prefixes))))))
+
+(defn unacronym
+  "Interposes delimiter between each character of string."
+  ([delimiter #^String string]
+     (apply str (interpose delimiter string)))
+  {:tag String})
+
+(defn delimited-compound-prefix-match?
+  "Uses a delimiter as the `split' for a compound prefix match check.
+  See also: `compound-prefix-match?'"
+  ([delimiter prefix target]
+     (compound-prefix-match? #(.split #^String % (str "[" (java.util.regex.Pattern/quote delimiter) "]") -1)
+                             prefix
+                             target)))
+
+
+(defn delimited-compound-prefix-match-acronym?
+  ([delimiter prefix target]
+     (or (delimited-compound-prefix-match? delimiter prefix target)
+         (delimited-compound-prefix-match? delimiter (unacronym (first delimiter) prefix) target))))
+
+(defn camel-compound-prefix-match?
+  "Uses camel case as a delimiter for a compound prefix match check.
+
+   See also: `compound-prefix-match?'"
+  ([#^String prefix #^String target]
+     (compound-prefix-match? #(re-seq #"(?:^.|[A-Z])[^A-Z]*" %)
+                             prefix
+                             target)))
+
+(defn split-compound-prefix-match? [#^String symbol-string #^String potential]
+  (if (.startsWith symbol-string ".")
+    (and (.startsWith potential ".")
+         (camel-compound-prefix-match? symbol-string potential))
+    (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+          [pot-ns pot-name] (symbol-name-parts potential)]
+      (and (or (= sym-ns pot-ns)
+               (and sym-ns pot-ns
+                    (delimited-compound-prefix-match-acronym? "." sym-ns pot-ns)))
+           (or (delimited-compound-prefix-match-acronym? "-." sym-name pot-name)
+               (camel-compound-prefix-match? sym-name pot-name))))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj
new file mode 100644
index 0000000..5aebb55
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/contrib/swank_fuzzy.clj
@@ -0,0 +1,428 @@
+;;; swank_fuzzy.clj --- fuzzy symbol completion, Clojure implementation.
+
+;; Original CL implementation authors (from swank-fuzzy.lisp) below,
+;; Authors: Brian Downing <bdowning@lavos.net>
+;;          Tobias C. Rittweiler <tcr@freebits.de>
+;;          and others
+
+;; This progam is based on the swank-fuzzy.lisp.
+;; Thanks the CL implementation authors for that useful software.
+
+(ns swank.commands.contrib.swank-fuzzy
+  (:use (swank util core commands))
+  (:use (swank.util clojure)))
+
+(def #^{:dynamic true} *fuzzy-recursion-soft-limit* 30)
+(defn- compute-most-completions [short full]
+  (let [collect-chunk (fn [[pcur [[pa va] ys]] [pb vb]]
+                        (let [xs (if (= (dec pb) pcur)
+                                   [[pa (str va vb)]]
+                                   [[pb vb] [pa va]])]
+                          [pb (if ys (conj xs ys) xs)]))
+        step (fn step [short full pos chunk seed limit?]
+               (cond
+                 (and (empty? full) (not (empty? short)))
+                 nil
+                 (or (empty? short) limit?)
+                 (if chunk
+                   (conj seed
+                         (second (reduce collect-chunk
+                                         [(ffirst chunk) [(first chunk)]]
+                                         (rest chunk))))
+                   seed)
+                 (= (first short) (first full))
+                 (let [seed2
+                       (step short (rest full) (inc pos) chunk seed
+                             (< *fuzzy-recursion-soft-limit* (count seed)))]
+                   (recur (rest short) (rest full) (inc pos)
+                          (conj chunk [pos (str (first short))])
+                          (if (and seed2 (not (empty? seed2)))
+                            seed2
+                            seed)
+                          false))
+                 :else
+                 (recur short (rest full) (inc pos) chunk seed false)))]
+    (map reverse (step short full 0 [] () false))))
+
+(def fuzzy-completion-symbol-prefixes "*+-%&?<")
+(def fuzzy-completion-word-separators "-/.")
+(def fuzzy-completion-symbol-suffixes "*+->?!")
+(defn- score-completion [completion short full]
+  (let [find1
+        (fn [c s]
+          (re-find (re-pattern (java.util.regex.Pattern/quote (str c))) s))
+        at-beginning? zero?
+        after-prefix?
+        (fn [pos]
+          (and (= pos 1)
+               (find1 (nth full 0) fuzzy-completion-symbol-prefixes)))
+        word-separator?
+        (fn [pos]
+          (find1 (nth full pos) fuzzy-completion-word-separators))
+        after-word-separator?
+        (fn [pos]
+          (find1 (nth full (dec pos)) fuzzy-completion-word-separators))
+        at-end?
+        (fn [pos]
+          (= pos (dec (count full))))
+        before-suffix?
+        (fn [pos]
+          (and (= pos (- (count full) 2))
+               (find1 (nth full (dec (count full)))
+                      fuzzy-completion-symbol-suffixes)))]
+    (letfn [(score-or-percentage-of-previous
+             [base-score pos chunk-pos]
+             (if (zero? chunk-pos)
+               base-score
+               (max base-score
+                    (+ (* (score-char (dec pos) (dec chunk-pos)) 0.85)
+                       (Math/pow 1.2 chunk-pos)))))
+            (score-char
+             [pos chunk-pos]
+             (score-or-percentage-of-previous
+              (cond (at-beginning? pos)         10
+                    (after-prefix? pos)         10
+                    (word-separator? pos)       1
+                    (after-word-separator? pos) 8
+                    (at-end? pos)               6
+                    (before-suffix? pos)        6
+                    :else                       1)
+              pos chunk-pos))
+            (score-chunk
+             [chunk]
+             (let [chunk-len (count (second chunk))]
+               (apply +
+                      (map score-char
+                           (take chunk-len (iterate inc (first chunk)))
+                           (reverse (take chunk-len
+                                          (iterate dec (dec chunk-len))))))))]
+      (let [chunk-scores (map score-chunk completion)
+            length-score (/ 10.0 (inc (- (count full) (count short))))]
+        [(+ (apply + chunk-scores) length-score)
+         (list (map list chunk-scores completion) length-score)]))))
+
+(defn- compute-highest-scoring-completion [short full]
+  (let [scored-results
+        (map (fn [result]
+               [(first (score-completion result short full))
+                result])
+             (compute-most-completions short full))
+        winner (first (sort (fn [[av _] [bv _]] (> av bv))
+                            scored-results))]
+    [(second winner) (first winner)]))
+
+(defn- call-with-timeout [time-limit-in-msec proc]
+  "Create a thunk that returns true if given time-limit-in-msec has been
+  elapsed and calls proc with the thunk as an argument. Returns a 3 elements
+  vec: A proc result, given time-limit-in-msec has been elapsed or not,
+  elapsed time in millisecond."
+  (let [timed-out (atom false)
+        start! (fn []
+                 (future (do
+                           (Thread/sleep time-limit-in-msec)
+                           (swap! timed-out (constantly true)))))
+        timed-out? (fn [] @timed-out)
+        started-at (System/nanoTime)]
+    (start!)
+    [(proc timed-out?)
+     @timed-out
+     (/ (double (- (System/nanoTime) started-at)) 1000000.0)]))
+
+(defmacro with-timeout
+  "Create a thunk that returns true if given time-limit-in-msec has been
+  elapsed and bind it to timed-out?. Then execute body."
+  #^{:private true}
+  [[timed-out? time-limit-in-msec] & body]
+  `(call-with-timeout ~time-limit-in-msec (fn [~timed-out?] ~@body)))
+
+(defstruct fuzzy-matching
+  :var :ns :symbol :ns-name :score :ns-chunks :var-chunks)
+
+(defn- fuzzy-extract-matching-info [matching string]
+  (let [[user-ns-name _] (symbol-name-parts string)]
+    (cond
+      (:var matching)
+      [(str (:symbol matching))
+       (cond (nil? user-ns-name) nil
+             :else (:ns-name matching))]
+      :else
+      [""
+       (str (:symbol matching))])))
+
+(defn- fuzzy-find-matching-vars
+  [string ns var-filter external-only?]
+  (let [compute (partial compute-highest-scoring-completion string)
+        ns-maps (cond
+                  external-only? ns-publics
+                  (= ns *ns*)    ns-map
+                  :else          ns-interns)]
+    (map (fn [[match-result score var sym]]
+           (if (var? var)
+             (struct fuzzy-matching
+                     var nil (or (:name (meta var))
+                                 (symbol (pr-str var)))
+                     nil
+                     score nil match-result)
+             (struct fuzzy-matching
+                     nil nil sym
+                     nil
+                     score nil match-result)))
+         (filter (fn [[match-result & _]]
+                   (or (= string "")
+                       (not-empty match-result)))
+                 (map (fn [[k v]]
+                        (if (= string "")
+                          (conj [nil 0.0] v k)
+                          (conj (compute (.toLowerCase (str k))) v k)))
+                      (filter var-filter (seq (ns-maps ns))))))))
+(defn- fuzzy-find-matching-nss
+  [string]
+  (let [compute (partial compute-highest-scoring-completion string)]
+    (map (fn [[match-result score ns ns-sym]]
+           (struct fuzzy-matching nil ns ns-sym (str ns-sym)
+                   score match-result nil))
+         (filter (fn [[match-result & _]] (not-empty match-result))
+                 (map (fn [[ns-sym ns]]
+                        (conj (compute (str ns-sym)) ns ns-sym))
+                      (concat
+                       (map (fn [ns] [(symbol (str ns)) ns]) (all-ns))
+                       (ns-aliases *ns*)))))))
+
+(defn- fuzzy-generate-matchings
+  [string default-ns timed-out?]
+  (let [take* (partial take-while (fn [_] (not (timed-out?))))
+        [parsed-ns-name parsed-symbol-name] (symbol-name-parts string)
+        find-vars
+        (fn find-vars
+          ([designator ns]
+             (find-vars designator ns identity))
+          ([designator ns var-filter]
+             (find-vars designator ns var-filter nil))
+          ([designator ns var-filter external-only?]
+             (take* (fuzzy-find-matching-vars designator
+                                              ns
+                                              var-filter
+                                              external-only?))))
+        find-nss (comp take* fuzzy-find-matching-nss)
+        make-duplicate-var-filter
+        (fn [fuzzy-ns-matchings]
+          (let [nss (set (map :ns-name fuzzy-ns-matchings))]
+            (comp not nss str :ns meta second)))
+        matching-greater
+        (fn [a b]
+          (cond
+            (> (:score a) (:score b)) -1
+            (< (:score a) (:score b)) 1
+            :else (compare (:symbol a) (:symbol b))))
+        fix-up
+        (fn [matchings parent-package-matching]
+          (map (fn [m]
+                 (assoc m
+                   :ns-name (:ns-name parent-package-matching)
+                   :ns-chunks (:ns-chunks parent-package-matching)
+                   :score (if (= parsed-ns-name "")
+                            (/ (:score parent-package-matching) 100)
+                            (+ (:score parent-package-matching)
+                               (:score m)))))
+               matchings))]
+    (sort matching-greater
+          (cond
+            (nil? parsed-ns-name)
+            (concat
+             (find-vars parsed-symbol-name (maybe-ns default-ns))
+             (find-nss parsed-symbol-name))
+            ;; (apply concat
+            ;;        (let [ns *ns*]
+            ;;          (pcalls #(binding [*ns* ns]
+            ;;                     (find-vars parsed-symbol-name
+            ;;                                (maybe-ns default-ns)))
+            ;;                  #(binding [*ns* ns]
+            ;;                     (find-nss parsed-symbol-name)))))
+            (= "" parsed-ns-name)
+            (find-vars parsed-symbol-name (maybe-ns default-ns))
+            :else
+            (let [found-nss (find-nss parsed-ns-name)
+                  find-vars1 (fn [ns-matching]
+                               (fix-up
+                                (find-vars parsed-symbol-name
+                                           (:ns ns-matching)
+                                           (make-duplicate-var-filter
+                                            (filter (partial = ns-matching)
+                                                    found-nss))
+                                           true)
+                                ns-matching))]
+              (concat
+               (apply concat
+                      (map find-vars1 (sort matching-greater found-nss)))
+               found-nss))))))
+
+(defn- fuzzy-format-matching [string matching]
+  (let [[symbol package] (fuzzy-extract-matching-info matching string)
+        result (str package (when package "/") symbol)]
+    [result (.indexOf #^String result #^String symbol)]))
+
+(defn- classify-matching [m]
+  (let [make-var-meta (fn [m]
+                        (fn [key]
+                          (when-let [var (:var m)]
+                            (when-let [var-meta (meta var)]
+                              (get var-meta key)))))
+        vm (make-var-meta m)]
+    (set
+     (filter
+      identity
+      [(when-not (or (vm :macro) (vm :arglists))
+         :boundp)
+       (when (vm :arglists) :fboundp)
+       ;; (:typespec)
+       ;; (:class)
+       (when (vm :macro)    :macro)
+       (when (special-symbol? (:symbol m)) :special-operator)
+       (when (:ns-name m)   :package)
+       (when (= clojure.lang.MultiFn (vm :tag))
+         :generic-function)]))))
+(defn- classification->string [flags]
+  (format (apply str (replicate 8 "%s"))
+          (if (or (:boundp flags)
+                  (:constant flags)) "b" "-")
+          (if (:fboundp flags) "f" "-")
+          (if (:generic-function flags) "g" "-")
+          (if (:class flags) "c" "-")
+          (if (:typespec flags) "t" "-")
+          (if (:macro flags) "m" "-")
+          (if (:special-operator flags) "s" "-")
+          (if (:package flags) "p" "-")))
+
+(defn- fuzzy-convert-matching-for-emacs [string matching]
+  (let [[name added-length] (fuzzy-format-matching string matching)]
+    [name
+     (format "%.2f" (:score matching))
+     (concat (:ns-chunks matching)
+             (map (fn [[offset string]] [(+ added-length offset) string])
+                  (:var-chunks matching)))
+     (classification->string (classify-matching matching))
+     ]))
+
+(defn- fuzzy-completion-set
+  [string default-ns limit time-limit-in-msec]
+  (let [[matchings interrupted? _]
+        (with-timeout [timed-out? time-limit-in-msec]
+          (vec (fuzzy-generate-matchings string default-ns timed-out?)))
+        subvec1 (if (and limit
+                         (> limit 0)
+                         (< limit (count matchings)))
+                  (fn [v] (subvec v 0 limit))
+                  identity)]
+    [(subvec1 (vec (map (partial fuzzy-convert-matching-for-emacs string)
+                        matchings)))
+     interrupted?]))
+
+(defslimefn fuzzy-completions
+  [string default-package-name
+   _limit limit _time-limit-in-msec time-limit-in-msec]
+  (let [[xs x] (fuzzy-completion-set string default-package-name
+                                     limit time-limit-in-msec)]
+    (list
+     (map (fn [[symbol score chunks class]]
+            (list symbol score (map (partial apply list) chunks) class))
+          xs)
+     (when x 't))))
+
+(defslimefn fuzzy-completion-selected [_ _] nil)
+
+(comment
+  (do
+    (use '[clojure.test])
+
+    (is (= '(([0 "m"] [9 "v"] [15 "b"]))
+           (compute-most-completions "mvb" "multiple-value-bind")))
+    (is (= '(([0 "zz"]) ([0 "z"] [2 "z"]) ([1 "zz"]))
+           (compute-most-completions "zz" "zzz")))
+    (is (= 103
+           (binding [*fuzzy-recursion-soft-limit* 2]
+             (count
+              (compute-most-completions "ZZZZZZ" "ZZZZZZZZZZZZZZZZZZZZZZZ")))))
+
+    (are [x p s] (= x (score-completion [[p s]] s "*multiple-value+"))
+         '[10.625 (((10 [0 "*"])) 0.625)] 0  "*"  ;; at-beginning
+         '[10.625 (((10 [1 "m"])) 0.625)] 1  "m"  ;; after-prefix
+         '[1.625 (((1 [9 "-"])) 0.625)]   9  "-"  ;; word-sep
+         '[8.625 (((8 [10 "v"])) 0.625)]  10 "v"  ;; after-word-sep
+         '[6.625 (((6 [15 "+"])) 0.625)]  15 "+"  ;; at-end
+         '[6.625 (((6 [14 "e"])) 0.625)]  14 "e"  ;; before-suffix
+         '[1.625 (((1 [2 "u"])) 0.625)]   2  "u"  ;; other
+         )
+    (is (= (+ 10 ;; m's score
+              (+ (* 10 0.85) (Math/pow 1.2 1))) ;; u's score
+           (let [[_ x]
+                 (score-completion [[1 "mu"]] "mu" "*multiple-value+")]
+             ((comp first ffirst) x)))
+        "`m''s score + `u''s score (percentage of previous which is 'm''s)")
+
+    (is (= '[([0 "zz"]) 24.7]
+           (compute-highest-scoring-completion "zz" "zzz")))
+
+    (are [to? ret to proc] (= [ret to?]
+                              (let [[x y _] (call-with-timeout to proc)]
+                                [x y]))
+         false "r" 10 (fn [_] "r")
+         true  nil 1 (fn [_] (Thread/sleep 10) nil))
+
+    (are [symbol package input] (= [symbol package]
+                                   (fuzzy-extract-matching-info
+                                    (struct fuzzy-matching
+                                            true nil
+                                            "symbol" "ns-name"
+                                            nil nil nil)
+                                    input))
+         "symbol" "ns-name" "p/*"
+         "symbol" nil "*")
+    (is (= ["" "ns-name"]
+           (fuzzy-extract-matching-info
+            (struct fuzzy-matching
+                    nil nil
+                    "ns-name" ""
+                    nil nil nil)
+            "")))
+
+    (defmacro try! #^{:private true}
+      [& body]
+      `(do
+         ~@(map (fn [x] `(try ~x (catch Throwable ~'_ nil)))
+                body)))
+
+    (try
+     (def testing-testing0 't)
+     (def #^{:private true} testing-testing1 't)
+     (are [x external-only?] (= x
+                                (vec
+                                 (sort
+                                  (map (comp str :symbol)
+                                       (fuzzy-find-matching-vars
+                                        "testing" *ns*
+                                        (fn [[k v]]
+                                          (and (= ((comp :ns meta) v) *ns*)
+                                               (re-find #"^testing-"
+                                                        (str k))))
+                                        external-only?)))))
+          ["testing-testing0" "testing-testing1"] nil
+          ["testing-testing0"] true)
+     (finally
+      (try!
+        (ns-unmap *ns* 'testing-testing0)
+        (ns-unmap *ns* 'testing-testing1))))
+
+    (try
+     (create-ns 'testing-testing0)
+     (create-ns 'testing-testing1)
+     (is (= '["testing-testing0" "testing-testing1"]
+            (vec
+             (sort
+              (map (comp str :symbol)
+                   (fuzzy-find-matching-nss "testing-"))))))
+     (finally
+      (try!
+        (remove-ns 'testing-testing0)
+        (remove-ns 'testing-testing1))))
+    )
+  )
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/indent.clj b/vim/bundle/slimv/swank-clojure/swank/commands/indent.clj
new file mode 100644
index 0000000..bafa9a8
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/indent.clj
@@ -0,0 +1,100 @@
+(ns swank.commands.indent
+  (:use (swank util core)
+        (swank.core hooks connection)
+        (swank.util hooks)))
+
+(defn- need-full-indentation-update?
+  "Return true if the indentation cache should be updated for all
+   namespaces. 
+
+   This is a heuristic so as to avoid scanning all symbols from all
+   namespaces. Instead, we only check whether the set of namespaces in
+   the cache match the set of currently defined namespaces."
+  ([connection]
+     (not= (hash (all-ns))
+           (hash @(connection :indent-cache-pkg)))))
+
+(defn- find-args-body-position
+  "Given an arglist, return the number of arguments before 
+     [... & body]
+   If no & body is found, nil will be returned"
+  ([args]
+     (when (coll? args)
+       (when-let [amp-position (position '#{&} args)]
+         (when-let [body-position (position '#{body clauses} args)]
+           (when (= (inc amp-position) body-position)
+             amp-position))))))
+
+(defn- find-arglists-body-position
+  "Find the smallest body position from an arglist"
+  ([arglists]
+     (let [positions (remove nil? (map find-args-body-position arglists))]
+       (when-not (empty? positions)
+         (apply min positions)))))
+
+(defn- find-var-body-position
+  "Returns a var's :indent override or the smallest body position of a
+   var's arglists"
+  ([var]
+     (let [var-meta (meta var)]
+       (or (:indent var-meta)
+           (find-arglists-body-position (:arglists var-meta))))))
+
+(defn- var-indent-representation
+  "Returns the slime indentation representation (name . position) for
+   a given var. If there is no indentation representation, nil is
+   returned."
+  ([var]
+     (when-let [body-position (find-var-body-position var)]
+       (when (or (= body-position 'defun)
+                 (not (neg? body-position)))
+         (list (name (:name (meta var)))
+               '.
+               body-position)))))
+
+(defn- get-cache-update-for-var
+  "Checks whether a given var needs to be updated in a cache. If it
+   needs updating, return [var-name var-indentation-representation].
+   Otherwise return nil"
+  ([find-in-cache var]
+     (when-let [indent (var-indent-representation var)]
+       (let [name (:name (meta var))]
+         (when-not (= (find-in-cache name) indent)
+           [name indent])))))
+
+(defn- get-cache-updates-in-namespace
+  "Finds all cache updates needed within a namespace"
+  ([find-in-cache ns]
+     (remove nil? (map (partial get-cache-update-for-var find-in-cache) (vals (ns-interns ns))))))
+
+(defn- update-indentation-delta
+  "Update the cache and return the changes in a (symbol '. indent) list.
+   If FORCE is true then check all symbols, otherwise only check
+   symbols belonging to the buffer package"
+  ([cache-ref load-all-ns?]
+     (let [find-in-cache @cache-ref]
+       (let [namespaces (if load-all-ns? (all-ns) [(maybe-ns *current-package*)])
+             updates (mapcat (partial get-cache-updates-in-namespace find-in-cache) namespaces)]
+         (when (seq updates)
+           (dosync (alter cache-ref into updates))
+           (map second updates))))))
+
+(defn- perform-indentation-update
+  "Update the indentation cache in connection and update emacs.
+   If force is true, then start again without considering the old cache."
+  ([conn force]
+     (let [cache (conn :indent-cache)]
+       (let [delta (update-indentation-delta cache force)]
+         (dosync
+          (ref-set (conn :indent-cache-pkg) (hash (all-ns)))
+          (when (seq delta)
+            (send-to-emacs `(:indentation-update ~delta))))))))
+
+(defn- sync-indentation-to-emacs
+  "Send any indentation updates to Emacs via emacs-connection"
+  ([]
+     (perform-indentation-update
+      *current-connection*
+      (need-full-indentation-update? *current-connection*))))
+
+(add-hook pre-reply-hook #'sync-indentation-to-emacs)
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj b/vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj
new file mode 100644
index 0000000..f8d490c
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/inspector.clj
@@ -0,0 +1,323 @@
+(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)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands/xref.clj b/vim/bundle/slimv/swank-clojure/swank/commands/xref.clj
new file mode 100644
index 0000000..16af826
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands/xref.clj
@@ -0,0 +1,51 @@
+(ns swank.commands.xref
+  (:use clojure.walk swank.util)
+  (:import (clojure.lang RT)
+           (java.io LineNumberReader InputStreamReader PushbackReader)))
+
+;; Yoinked and modified from clojure.contrib.repl-utils.
+;; Now takes a var instead of a sym in the current ns
+(defn- get-source-from-var
+  "Returns a string of the source code for the given symbol, if it can
+find it. This requires that the symbol resolve to a Var defined in
+a namespace for which the .clj is in the classpath. Returns nil if
+it can't find the source.
+Example: (get-source-from-var 'filter)"
+  [v] (when-let [filepath (:file (meta v))]
+        (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)]
+          (with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
+            (dotimes [_ (dec (:line (meta v)))] (.readLine rdr))
+            (let [text (StringBuilder.)
+                  pbr (proxy [PushbackReader] [rdr]
+                        (read [] (let [i (proxy-super read)]
+                                   (.append text (char i))
+                                   i)))]
+              (read (PushbackReader. pbr))
+              (str text))))))
+
+(defn- recursive-contains? [coll obj]
+  "True if coll contains obj. Obj can't be a seq"
+  (not (empty? (filter #(= obj %) (flatten coll)))))
+
+(defn- does-var-call-fn [var fn]
+  "Checks if a var calls a function named 'fn"
+  (if-let [source (get-source-from-var var)]
+    (let [node (read-string source)]
+     (if (recursive-contains? node fn)
+       var
+       false))))
+
+(defn- does-ns-refer-to-var? [ns var]
+  (ns-resolve ns var))
+
+(defn all-vars-who-call [sym]
+  (filter
+   ifn?
+   (filter
+    #(identity %)
+    (map #(does-var-call-fn % sym)
+         (flatten
+          (map vals
+               (map ns-interns
+                    (filter #(does-ns-refer-to-var? % sym)
+                            (all-ns)))))))))
-- 
cgit v1.2.3-54-g00ecf