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
---
.../swank/clj_contrib/macroexpand.clj | 17 +
.../swank-clojure/swank/clj_contrib/pprint.clj | 34 ++
vim/bundle/slimv/swank-clojure/swank/commands.clj | 14 +
.../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 ++
vim/bundle/slimv/swank-clojure/swank/core.clj | 388 +++++++++++++
.../slimv/swank-clojure/swank/core/connection.clj | 68 +++
.../slimv/swank-clojure/swank/core/hooks.clj | 4 +
.../slimv/swank-clojure/swank/core/protocol.clj | 50 ++
.../slimv/swank-clojure/swank/core/server.clj | 102 ++++
.../slimv/swank-clojure/swank/core/threadmap.clj | 29 +
vim/bundle/slimv/swank-clojure/swank/dev.clj | 6 +
vim/bundle/slimv/swank-clojure/swank/loader.clj | 101 ++++
vim/bundle/slimv/swank-clojure/swank/rpc.clj | 159 ++++++
vim/bundle/slimv/swank-clojure/swank/swank.clj | 92 ++++
vim/bundle/slimv/swank-clojure/swank/util.clj | 72 +++
.../swank-clojure/swank/util/class_browse.clj | 149 +++++
.../slimv/swank-clojure/swank/util/clojure.clj | 33 ++
.../swank-clojure/swank/util/concurrent/mbox.clj | 31 ++
.../swank-clojure/swank/util/concurrent/thread.clj | 50 ++
.../slimv/swank-clojure/swank/util/hooks.clj | 12 +
vim/bundle/slimv/swank-clojure/swank/util/io.clj | 40 ++
vim/bundle/slimv/swank-clojure/swank/util/java.clj | 16 +
.../slimv/swank-clojure/swank/util/net/sockets.clj | 57 ++
.../slimv/swank-clojure/swank/util/string.clj | 16 +
vim/bundle/slimv/swank-clojure/swank/util/sys.clj | 13 +
34 files changed, 3371 insertions(+)
create mode 100644 vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/commands.clj
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
create mode 100644 vim/bundle/slimv/swank-clojure/swank/core.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/core/connection.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/core/server.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/dev.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/loader.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/rpc.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/swank.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/clojure.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/hooks.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/io.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/java.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/string.clj
create mode 100644 vim/bundle/slimv/swank-clojure/swank/util/sys.clj
(limited to 'vim/bundle/slimv/swank-clojure/swank')
diff --git a/vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj
new file mode 100644
index 0000000..8cb052b
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/macroexpand.clj
@@ -0,0 +1,17 @@
+(ns swank.clj-contrib.macroexpand)
+
+(def
+ #^{:private true}
+ walk-enabled?
+ (.getResource (clojure.lang.RT/baseLoader) "clojure/contrib/macro_utils.clj"))
+
+(when walk-enabled?
+ (require 'clojure.contrib.macro-utils))
+
+(defmacro macroexpand-all* [form]
+ (if walk-enabled?
+ `(clojure.contrib.macro-utils/mexpand-all ~form)
+ `(macroexpand ~form)))
+
+(defn macroexpand-all [form]
+ (macroexpand-all* form))
\ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj
new file mode 100644
index 0000000..b10df5f
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/clj_contrib/pprint.clj
@@ -0,0 +1,34 @@
+(ns swank.clj-contrib.pprint)
+
+(def #^{:private true} pprint-enabled?
+ (try ;; 1.2+
+ (.getResource (clojure.lang.RT/baseLoader) "clojure/pprint")
+ (require '[clojure.pprint :as pp])
+ (defmacro #^{:private true} pretty-pr-code*
+ ([code]
+ (if pprint-enabled?
+ `(binding [pp/*print-suppress-namespaces* true]
+ (pp/with-pprint-dispatch pp/code-dispatch
+ (pp/write ~code :pretty true :stream nil)))
+ `(pr-str ~code))))
+ true
+ (catch Exception e
+ (try ;; 1.0, 1.1
+ (.loadClass (clojure.lang.RT/baseLoader)
+ "clojure.contrib.pprint.PrettyWriter")
+ (require '[clojure.contrib.pprint :as pp])
+ (defmacro #^{:private true} pretty-pr-code*
+ ([code]
+ (if pprint-enabled?
+ `(binding [pp/*print-suppress-namespaces* true]
+ (pp/with-pprint-dispatch pp/*code-dispatch*
+ (pp/write ~code :pretty true :stream nil)))
+ `(pr-str ~code))))
+ true
+ ;; if you just don't have contrib, be silent.
+ (catch ClassNotFoundException _)
+ (catch Exception e
+ (println e))))))
+
+(defn pretty-pr-code [code]
+ (pretty-pr-code* code))
diff --git a/vim/bundle/slimv/swank-clojure/swank/commands.clj b/vim/bundle/slimv/swank-clojure/swank/commands.clj
new file mode 100644
index 0000000..1ad8bdc
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/commands.clj
@@ -0,0 +1,14 @@
+(ns swank.commands)
+
+(defonce slime-fn-map {})
+
+(defmacro defslimefn
+ ([fname & body]
+ `(alter-var-root #'slime-fn-map
+ assoc
+ (symbol "swank" ~(name fname))
+ (defn ~fname ~@body)))
+ {:indent 'defun})
+
+(defn slime-fn [sym]
+ (slime-fn-map (symbol "swank" (name sym))))
\ No newline at end of file
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)))))))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core.clj b/vim/bundle/slimv/swank-clojure/swank/core.clj
new file mode 100644
index 0000000..892b6a8
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core.clj
@@ -0,0 +1,388 @@
+(ns swank.core
+ (:use (swank util commands)
+ (swank.util hooks)
+ (swank.util.concurrent thread)
+ (swank.core connection hooks threadmap))
+ (:require (swank.util.concurrent [mbox :as mb])))
+
+;; Protocol version
+(defonce protocol-version (atom "20100404"))
+
+;; Emacs packages
+(def #^{:dynamic true} *current-package*)
+
+;; current emacs eval id
+(def #^{:dynamic true} *pending-continuations* '())
+
+(def sldb-stepping-p nil)
+(def sldb-initial-frames 10)
+(def #^{:dynamic true} #^{:doc "The current level of recursive debugging."}
+ *sldb-level* 0)
+(def #^{:dynamic true} #^{:doc "The current restarts."}
+ *sldb-restarts* 0)
+
+(def #^{:doc "Include swank-clojure thread in stack trace for debugger."}
+ debug-swank-clojure false)
+
+(defonce active-threads (ref ()))
+
+(defn maybe-ns [package]
+ (cond
+ (symbol? package) (or (find-ns package) (maybe-ns 'user))
+ (string? package) (maybe-ns (symbol package))
+ (keyword? package) (maybe-ns (name package))
+ (instance? clojure.lang.Namespace package) package
+ :else (maybe-ns 'user)))
+
+(defmacro with-emacs-package [& body]
+ `(binding [*ns* (maybe-ns *current-package*)]
+ ~@body))
+
+(defmacro with-package-tracking [& body]
+ `(let [last-ns# *ns*]
+ (try
+ ~@body
+ (finally
+ (when-not (= last-ns# *ns*)
+ (send-to-emacs `(:new-package ~(str (ns-name *ns*))
+ ~(str (ns-name *ns*)))))))))
+
+(defmacro dothread-swank [& body]
+ `(dothread-keeping-clj [*current-connection*]
+ ~@body))
+
+;; Exceptions for debugging
+(defonce debug-quit-exception (Exception. "Debug quit"))
+(defonce debug-continue-exception (Exception. "Debug continue"))
+(defonce debug-abort-exception (Exception. "Debug abort"))
+
+(def #^{:dynamic true} #^Throwable *current-exception* nil)
+
+;; Local environment
+(def #^{:dynamic true} *current-env* nil)
+
+(let [&env :unavailable]
+ (defmacro local-bindings
+ "Produces a map of the names of local bindings to their values."
+ []
+ (if-not (= &env :unavailable)
+ (let [symbols (keys &env)]
+ (zipmap (map (fn [sym] `(quote ~sym)) symbols) symbols)))))
+
+;; Handle Evaluation
+(defn send-to-emacs
+ "Sends a message (msg) to emacs."
+ ([msg]
+ (mb/send @(*current-connection* :control-thread) msg)))
+
+(defn send-repl-results-to-emacs [val]
+ (send-to-emacs `(:write-string ~(str (pr-str val) "\n") :repl-result)))
+
+(defn with-env-locals
+ "Evals a form with given locals. The locals should be a map of symbols to
+values."
+ [form]
+ (if (seq *current-env*)
+ `(let ~(vec (mapcat #(list % `(*current-env* '~%)) (keys *current-env*)))
+ ~form)
+ form))
+
+(defn eval-in-emacs-package [form]
+ (with-emacs-package
+ (eval form)))
+
+
+(defn eval-from-control
+ "Blocks for a mbox message from the control thread and executes it
+ when received. The mbox message is expected to be a slime-fn."
+ ([] (let [form (mb/receive (current-thread))]
+ (apply (ns-resolve *ns* (first form)) (rest form)))))
+
+(defn eval-loop
+ "A loop which continuosly reads actions from the control thread and
+ evaluates them (will block if no mbox message is available)."
+ ([] (continuously (eval-from-control))))
+
+(defn exception-causes [#^Throwable t]
+ (lazy-seq
+ (cons t (when-let [cause (.getCause t)]
+ (exception-causes cause)))))
+
+(defn- debug-quit-exception? [t]
+ (some #(identical? debug-quit-exception %) (exception-causes t)))
+
+(defn- debug-continue-exception? [t]
+ (some #(identical? debug-continue-exception %) (exception-causes t)))
+
+(defn- debug-abort-exception? [t]
+ (some #(identical? debug-abort-exception %) (exception-causes t)))
+
+(defn exception-stacktrace [t]
+ (map #(list %1 %2 '(:restartable nil))
+ (iterate inc 0)
+ (map str (.getStackTrace t))))
+
+(defn debugger-condition-for-emacs []
+ (list (or (.getMessage *current-exception*) "No message.")
+ (str " [Thrown " (class *current-exception*) "]")
+ nil))
+
+(defn make-restart [kw name description f]
+ [kw [name description f]])
+
+(defn add-restart-if [condition restarts kw name description f]
+ (if condition
+ (conj restarts (make-restart kw name description f))
+ restarts))
+
+(declare sldb-debug)
+(defn cause-restart-for [thrown depth]
+ (make-restart
+ (keyword (str "cause" depth))
+ (str "CAUSE" depth)
+ (str "Invoke debugger on cause "
+ (apply str (take depth (repeat " ")))
+ (.getMessage thrown)
+ " [Thrown " (class thrown) "]")
+ (partial sldb-debug nil thrown *pending-continuations*)))
+
+(defn add-cause-restarts [restarts thrown]
+ (loop [restarts restarts
+ cause (.getCause thrown)
+ level 1]
+ (if cause
+ (recur
+ (conj restarts (cause-restart-for cause level))
+ (.getCause cause)
+ (inc level))
+ restarts)))
+
+(defn calculate-restarts [thrown]
+ (let [restarts [(make-restart :quit "QUIT" "Quit to the SLIME top level"
+ (fn [] (throw debug-quit-exception)))]
+ restarts (add-restart-if
+ (pos? *sldb-level*)
+ restarts
+ :abort "ABORT" (str "ABORT to SLIME level " (dec *sldb-level*))
+ (fn [] (throw debug-abort-exception)))
+ restarts (add-restart-if
+ (and (.getMessage thrown)
+ (.contains (.getMessage thrown) "BREAK"))
+ restarts
+ :continue "CONTINUE" (str "Continue from breakpoint")
+ (fn [] (throw debug-continue-exception)))
+ restarts (add-cause-restarts restarts thrown)]
+ (into (array-map) restarts)))
+
+(defn format-restarts-for-emacs []
+ (doall (map #(list (first (second %)) (second (second %))) *sldb-restarts*)))
+
+(defn build-backtrace [start end]
+ (doall (take (- end start) (drop start (exception-stacktrace *current-exception*)))))
+
+(defn build-debugger-info-for-emacs [start end]
+ (list (debugger-condition-for-emacs)
+ (format-restarts-for-emacs)
+ (build-backtrace start end)
+ *pending-continuations*))
+
+(defn sldb-loop
+ "A loop that is intented to take over an eval thread when a debug is
+ encountered (an continue to perform the same thing). It will
+ continue until a *debug-quit* exception is encountered."
+ [level]
+ (try
+ (send-to-emacs
+ (list* :debug (current-thread) level
+ (build-debugger-info-for-emacs 0 sldb-initial-frames)))
+ ([] (continuously
+ (do
+ (send-to-emacs `(:debug-activate ~(current-thread) ~level nil))
+ (eval-from-control))))
+ (catch Throwable t
+ (send-to-emacs
+ `(:debug-return ~(current-thread) ~*sldb-level* ~sldb-stepping-p))
+ (if-not (debug-continue-exception? t)
+ (throw t)))))
+
+(defn invoke-debugger
+ [locals #^Throwable thrown id]
+ (binding [*current-env* locals
+ *current-exception* thrown
+ *sldb-restarts* (calculate-restarts thrown)
+ *sldb-level* (inc *sldb-level*)]
+ (sldb-loop *sldb-level*)))
+
+(defn sldb-debug [locals thrown id]
+ (try
+ (invoke-debugger nil thrown id)
+ (catch Throwable t
+ (when (and (pos? *sldb-level*)
+ (not (debug-abort-exception? t)))
+ (throw t)))))
+
+(defmacro break
+ []
+ `(invoke-debugger (local-bindings) (Exception. "BREAK:") *pending-continuations*))
+
+(defn doall-seq [coll]
+ (if (seq? coll)
+ (doall coll)
+ coll))
+
+(defn eval-for-emacs [form buffer-package id]
+ (try
+ (binding [*current-package* buffer-package
+ *pending-continuations* (cons id *pending-continuations*)]
+ (if-let [f (slime-fn (first form))]
+ (let [form (cons f (rest form))
+ result (doall-seq (eval-in-emacs-package form))]
+ (run-hook pre-reply-hook)
+ (send-to-emacs `(:return ~(thread-name (current-thread))
+ (:ok ~result) ~id)))
+ ;; swank function not defined, abort
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))))
+ (catch Throwable t
+ ;; Thread/interrupted clears this thread's interrupted status; if
+ ;; Thread.stop was called on us it may be set and will cause an
+ ;; InterruptedException in one of the send-to-emacs calls below
+ (Thread/interrupted)
+
+ ;; (.printStackTrace t #^java.io.PrintWriter *err*)
+
+ (cond
+ (debug-quit-exception? t)
+ (do
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))
+ (if-not (zero? *sldb-level*)
+ (throw t)))
+
+ (debug-abort-exception? t)
+ (do
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))
+ (if-not (zero? *sldb-level*)
+ (throw debug-abort-exception)))
+
+ (debug-continue-exception? t)
+ (do
+ (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id))
+ (throw t))
+
+ :else
+ (do
+ (set! *e t)
+ (try
+ (sldb-debug
+ nil
+ (if debug-swank-clojure t (or (.getCause t) t))
+ id)
+ ;; reply with abort
+ (finally (send-to-emacs `(:return ~(thread-name (current-thread)) (:abort) ~id)))))))))
+
+(defn- add-active-thread [thread]
+ (dosync
+ (commute active-threads conj thread)))
+
+(defn- remove-active-thread [thread]
+ (dosync
+ (commute active-threads (fn [threads] (remove #(= % thread) threads)))))
+
+(defn spawn-worker-thread
+ "Spawn an thread that blocks for a single command from the control
+ thread, executes it, then terminates."
+ ([conn]
+ (dothread-swank
+ (try
+ (add-active-thread (current-thread))
+ (thread-set-name "Swank Worker Thread")
+ (eval-from-control)
+ (finally
+ (remove-active-thread (current-thread)))))))
+
+(defn spawn-repl-thread
+ "Spawn an thread that sets itself as the current
+ connection's :repl-thread and then enters an eval-loop"
+ ([conn]
+ (dothread-swank
+ (thread-set-name "Swank REPL Thread")
+ (with-connection conn
+ (eval-loop)))))
+
+(defn find-or-spawn-repl-thread
+ "Returns the current connection's repl-thread or create a new one if
+ the existing one does not exist."
+ ([conn]
+ ;; TODO - check if an existing repl-agent is still active & doesn't have errors
+ (dosync
+ (or (when-let [conn-repl-thread @(conn :repl-thread)]
+ (when (.isAlive #^Thread conn-repl-thread)
+ conn-repl-thread))
+ (ref-set (conn :repl-thread)
+ (spawn-repl-thread conn))))))
+
+(defn thread-for-evaluation
+ "Given an id and connection, find or create the appropiate agent."
+ ([id conn]
+ (cond
+ (= id true) (spawn-worker-thread conn)
+ (= id :repl-thread) (find-or-spawn-repl-thread conn)
+ :else (find-thread id))))
+
+;; Handle control
+(defn read-loop
+ "A loop that reads from the socket (will block when no message
+ available) and dispatches the message to the control thread."
+ ([conn control]
+ (with-connection conn
+ (continuously (mb/send control (read-from-connection conn))))))
+
+(defn dispatch-event
+ "Dispatches/executes an event in the control thread's mailbox queue."
+ ([ev conn]
+ (let [[action & args] ev]
+ (cond
+ (= action :emacs-rex)
+ (let [[form-string package thread id] args
+ thread (thread-for-evaluation thread conn)]
+ (mb/send thread `(eval-for-emacs ~form-string ~package ~id)))
+
+ (= action :return)
+ (let [[thread & ret] args]
+ (binding [*print-level* nil, *print-length* nil]
+ (write-to-connection conn `(:return ~@ret))))
+
+ (one-of? action
+ :presentation-start :presentation-end
+ :new-package :new-features :ed :percent-apply
+ :indentation-update
+ :eval-no-wait :background-message :inspect)
+ (binding [*print-level* nil, *print-length* nil]
+ (write-to-connection conn ev))
+
+ (= action :write-string)
+ (write-to-connection conn ev)
+
+ (one-of? action
+ :debug :debug-condition :debug-activate :debug-return)
+ (let [[thread & args] args]
+ (write-to-connection conn `(~action ~(thread-map-id thread) ~@args)))
+
+ (= action :emacs-interrupt)
+ (let [[thread & args] args]
+ (dosync
+ (cond
+ (and (true? thread) (seq @active-threads))
+ (.stop #^Thread (first @active-threads))
+ (= thread :repl-thread) (.stop #^Thread @(conn :repl-thread)))))
+ :else
+ nil))))
+
+;; Main loop definitions
+(defn control-loop
+ "A loop that reads from the mbox queue and runs dispatch-event on
+ it (will block if no mbox control message is available). This is
+ intended to only be run on the control thread."
+ ([conn]
+ (binding [*1 nil, *2 nil, *3 nil, *e nil]
+ (with-connection conn
+ (continuously (dispatch-event (mb/receive (current-thread)) conn))))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/connection.clj b/vim/bundle/slimv/swank-clojure/swank/core/connection.clj
new file mode 100644
index 0000000..1b78bc6
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/connection.clj
@@ -0,0 +1,68 @@
+(ns swank.core.connection
+ (:use (swank util)
+ (swank.util sys)
+ (swank.core protocol))
+ (:import (java.net ServerSocket Socket InetAddress)
+ (java.io InputStreamReader OutputStreamWriter)))
+
+(def #^{:dynamic true} *current-connection*)
+(def default-encoding "iso-8859-1")
+
+(defmacro with-connection [conn & body]
+ `(binding [*current-connection* ~conn] ~@body))
+
+(def encoding-map
+ {"latin-1" "iso-8859-1"
+ "latin-1-unix" "iso-8859-1"
+ "iso-latin-1-unix" "iso-8859-1"
+ "iso-8859-1" "iso-8859-1"
+ "iso-8859-1-unix" "iso-8859-1"
+
+ "utf-8" "utf-8"
+ "utf-8-unix" "utf-8"
+
+ "euc-jp" "euc-jp"
+ "euc-jp-unix" "euc-jp"
+
+ "us-ascii" "us-ascii"
+ "us-ascii-unix" "us-ascii"})
+
+(defn make-connection ;; rename to make-swank-connection
+ "Given a `socket', creates a swank connection. Accepts an optional
+ argument `encoding' to define the encoding of the connection. If
+ encoding is nil, then the default encoding will be used.
+
+ See also: `default-encoding', `start-server-socket!'"
+ ([#^Socket socket] (make-connection socket default-encoding))
+ ([#^Socket socket encoding]
+ (let [#^String
+ encoding (or (encoding-map encoding encoding) default-encoding)]
+ {:socket socket
+ :reader (InputStreamReader. (.getInputStream socket) encoding)
+ :writer (OutputStreamWriter. (.getOutputStream socket) encoding)
+ :writer-redir (ref nil)
+
+ :indent-cache (ref {})
+ :indent-cache-pkg (ref nil)
+
+ :control-thread (ref nil)
+ :read-thread (ref nil)
+ :repl-thread (ref nil)})))
+
+(defn read-from-connection
+ "Reads a single message from a swank-connection.
+
+ See also: `write-to-connection', `read-swank-message',
+ `make-swank-connection'"
+ ([] (read-from-connection *current-connection*))
+ ([conn]
+ (read-swank-message (conn :reader))))
+
+(defn write-to-connection
+ "Writes a single message to a swank-connection.
+
+ See also: `read-from-connection', `write-swank-message',
+ `make-swank-connection'"
+ ([msg] (write-to-connection *current-connection* msg))
+ ([conn msg]
+ (write-swank-message (conn :writer) msg)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj b/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
new file mode 100644
index 0000000..93b5963
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
@@ -0,0 +1,4 @@
+(ns swank.core.hooks
+ (:use (swank.util hooks)))
+
+(defhook pre-reply-hook)
\ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj b/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
new file mode 100644
index 0000000..409d189
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
@@ -0,0 +1,50 @@
+(ns swank.core.protocol
+ (:use (swank util)
+ (swank.util io))
+ (:require swank.rpc))
+
+;; Read forms
+(def #^{:private true}
+ namespace-re #"(^\(:emacs-rex \([a-zA-Z][a-zA-Z0-9]+):")
+
+(defn- fix-namespace
+ "Changes the namespace of a function call from pkg:fn to ns/fn. If
+ no pkg exists, then nothing is done."
+ ([text] (.replaceAll (re-matcher namespace-re text) "$1/")))
+
+(defn write-swank-message
+ "Given a `writer' (java.io.Writer) and a `message' (typically an
+ sexp), encode the message according to the swank protocol and
+ write the message into the writer."
+ ([#^java.io.Writer writer message]
+ (swank.rpc/encode-message writer message))
+ {:tag String})
+
+(def read-fail-exception (Exception. "Error reading swank message"))
+
+(defn read-swank-message
+ "Given a `reader' (java.io.Reader), read the message as a clojure
+ form (typically a sexp). This method will block until a message is
+ completely transfered.
+
+ Note: This function will do some amount of Common Lisp -> clojure
+ conversions. This is due to the fact that several slime functions
+ like to treat everything it's talking to as a common lisp
+ implementation.
+ - If an :emacs-rex form is received and the first form contains a
+ common lisp package designation, this will convert it to use a
+ clojure designation.
+ - t will be converted to true
+
+ See also `write-swank-message'."
+ ([#^java.io.Reader reader]
+ (let [len (Integer/parseInt (read-chars reader 6 read-fail-exception) 16)
+ msg (read-chars reader len read-fail-exception)
+ form (try
+ (read-string (fix-namespace msg))
+ (catch Exception ex
+ (.println System/err (format "unreadable message: %s" msg))
+ (throw ex)))]
+ (if (seq? form)
+ (deep-replace {'t true} form)
+ form))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/server.clj b/vim/bundle/slimv/swank-clojure/swank/core/server.clj
new file mode 100644
index 0000000..1c9f70a
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/server.clj
@@ -0,0 +1,102 @@
+(ns swank.core.server
+ (:use (swank util core)
+ (swank.util sys io)
+ (swank.util.concurrent thread)
+ (swank.util.net sockets)
+ (swank.core connection protocol))
+ (:import (java.io File FileReader BufferedReader InputStreamReader OutputStreamWriter)
+ (java.net Socket)))
+
+;; The swank.core.server is the layer above swank.util.net.sockets
+;; - Manages the socket server
+;; - Accepts and authenticates incoming connections
+;; - Creates swank.core.connections
+;; - Spins up new threads
+
+(defonce connections (ref []))
+
+(def slime-secret-path (str (user-home-path) File/separator ".slime-secret"))
+
+(defn- slime-secret
+ "Returns the first line from the slime-secret file, path found in
+ slime-secret-path (default: .slime-secret in the user's home
+ directory).
+
+ See also: `accept-authenticated-connection'"
+ ([] (failing-gracefully
+ (let [slime-secret-file (File. (str (user-home-path) File/separator ".slime-secret"))]
+ (when (and (.isFile slime-secret-file) (.canRead slime-secret-file))
+ (with-open [secret (BufferedReader. (FileReader. slime-secret-file))]
+ (.readLine secret)))))))
+
+(defn- accept-authenticated-connection ;; rename to authenticate-socket, takes in a connection
+ "Accepts and returns new connection if it is from an authenticated
+ machine. Otherwise, return nil.
+
+ Authentication depends on the contents of a slime-secret file on
+ both the server (swank) and the client (emacs slime). If no
+ slime-secret file is provided on the server side, all connections
+ are accepted.
+
+ See also: `slime-secret'"
+ ([#^Socket socket opts]
+ (returning [conn (make-connection socket (get opts :encoding default-encoding))]
+ (if-let [secret (slime-secret)]
+ (when-not (= (read-from-connection conn) secret)
+ (close-socket! socket))
+ conn))))
+
+(defn- make-output-redirection
+ ([conn]
+ (call-on-flush-stream
+ #(with-connection conn
+ (send-to-emacs `(:write-string ~%)))))
+ {:tag java.io.StringWriter})
+
+(defn- socket-serve [connection-serve socket opts]
+ (with-connection (accept-authenticated-connection socket opts)
+ (let [out-redir (java.io.PrintWriter. (make-output-redirection
+ *current-connection*))]
+ (binding [*out* out-redir
+ *err* out-redir]
+ (dosync (ref-set (*current-connection* :writer-redir) *out*))
+ (dosync (alter connections conj *current-connection*))
+ (connection-serve *current-connection*)))))
+
+;; Setup frontent
+(defn start-swank-socket-server!
+ "Starts and returns the socket server as a swank host. Takes an
+ optional set of options as a map:
+
+ :announce - an fn that will be called and provided with the
+ listening port of the newly established server. Default: none."
+ ([server connection-serve] (start-swank-socket-server! connection-serve {}))
+ ([server connection-serve options]
+ (start-server-socket! server connection-serve)
+ (when-let [announce (options :announce)]
+ (announce (.getLocalPort server)))
+ server))
+
+(defn setup-server
+ "The port it started on will be called as an argument to (announce-fn
+ port). A connection will then be created and (connection-serve conn)
+ will then be called."
+ [port announce-fn connection-serve opts]
+ (start-swank-socket-server!
+ (make-server-socket {:port port
+ :host (opts :host "localhost")
+ :backlog (opts :backlog 0)})
+ #(socket-serve connection-serve % opts)
+ {:announce announce-fn}))
+
+;; Announcement functions
+(defn simple-announce [port]
+ (println "Connection opened on local port " port))
+
+(defn announce-port-to-file
+ "Writes the given port number into a file."
+ ([#^String file port]
+ (with-open [out (new java.io.FileWriter file)]
+ (doto out
+ (.write (str port "\n"))
+ (.flush)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj b/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
new file mode 100644
index 0000000..246a3d2
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
@@ -0,0 +1,29 @@
+(ns swank.core.threadmap
+ (:use (swank util)
+ (swank.util.concurrent thread)))
+
+(defonce thread-map-next-id (ref 1))
+(defonce thread-map (ref {}))
+
+(defn- thread-map-clean []
+ (doseq [[id t] @thread-map]
+ (when (or (nil? t)
+ (not (thread-alive? t)))
+ (dosync
+ (alter thread-map dissoc id)))))
+
+(defn- get-thread-id [thread]
+ (if-let [entry (find-first #(= (val %) thread) @thread-map)]
+ (key entry)
+ (let [next-id @thread-map-next-id]
+ (alter thread-map assoc next-id thread)
+ (alter thread-map-next-id inc)
+ next-id)))
+
+(defn thread-map-id [thread]
+ (returning [id (dosync (get-thread-id thread))]
+ (thread-map-clean)))
+
+(defn find-thread [id]
+ (@thread-map id))
+
diff --git a/vim/bundle/slimv/swank-clojure/swank/dev.clj b/vim/bundle/slimv/swank-clojure/swank/dev.clj
new file mode 100644
index 0000000..3d702ee
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/dev.clj
@@ -0,0 +1,6 @@
+(ns swank.dev
+ (:use (swank util)))
+
+(defmacro with-swank-io [& body]
+ `(binding [*out* @(:writer-redir (first @swank.core.server/connections))]
+ ~@body))
diff --git a/vim/bundle/slimv/swank-clojure/swank/loader.clj b/vim/bundle/slimv/swank-clojure/swank/loader.clj
new file mode 100644
index 0000000..27466f6
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/loader.clj
@@ -0,0 +1,101 @@
+(ns swank.loader
+ (:require [swank.util.sys :as sys]
+ [swank.util.clojure :as clj])
+ (:import [java.io File]))
+
+(defonce #^File *swank-source-path*
+ (if-let [resource (.getResource (clojure.lang.RT/baseLoader)
+ #^String *file*)]
+ (.getParentFile (File. (.getFile resource)))))
+
+(defonce #^File *swank-compile-path*
+ (File. (str (sys/user-home-path)
+ File/separator
+ ".slime"
+ File/separator
+ "cljclass")))
+
+(defn file-directory? [#^File f]
+ (.isDirectory f))
+
+(defn file-last-modified [#^File f]
+ (.lastModified f))
+
+(defn all-files-in-directory [#^File f]
+ (let [list-files (.listFiles f)
+ files (remove file-directory? list-files)
+ directories (filter file-directory? list-files)]
+ (concat files (mapcat all-files-in-directory directories))))
+
+(defn clj-file? [#^File f]
+ (.endsWith (str f) ".clj"))
+
+(defn swank-source-files [#^File path]
+ (filter clj-file? (all-files-in-directory path)))
+
+(defn relative-path-name [#^File parent #^File file]
+ (let [file-name (str file)
+ parent-name (str parent)]
+ (when (.startsWith file-name parent-name)
+ (.substring file-name (inc (.length parent-name))))))
+
+(defn file-name-to-swank-package-sym [#^String file-name]
+ (assert (clj-file? file-name))
+ (symbol
+ (str "swank."
+ (clj/unmunge
+ (.replaceAll (.substring file-name 0 (- (.length file-name) 4))
+ File/separator
+ ".")))))
+
+(defn swank-packages []
+ (map #(file-name-to-swank-package-sym (relative-path-name *swank-source-path* %))
+ (swank-source-files *swank-source-path*)))
+
+(defn swank-version
+ "A likely bad way of calculating a version number for swank clojure"
+ ([]
+ (str (reduce + (map file-last-modified (swank-source-files *swank-source-path*)))
+ "+" (clojure-version))))
+
+(defn delete-file-recursive [& paths]
+ (when-not (empty? paths)
+ (let [f #^File (first paths)]
+ (if (and f (.exists f))
+ (if (.isDirectory f)
+ (if-let [files (seq (.listFiles f))]
+ (recur (concat files paths))
+ (do
+ (.delete f)
+ (recur (rest paths))))
+ (do
+ (.delete f)
+ (recur (rest paths))))
+ (recur (rest paths))))))
+
+(defn clean-up []
+ (let [current-path (File. *swank-compile-path* (str (swank-version)))]
+ (doseq [compiled-path (.listFiles *swank-compile-path*)
+ :when (not= current-path compiled-path)]
+ (delete-file-recursive compiled-path))))
+
+(defn swank-ns? [ns]
+ (.startsWith (name (ns-name ns)) "swank."))
+
+(defn all-swank-ns []
+ (filter swank-ns? (all-ns)))
+
+(defn compile-swank [#^String path]
+ (binding [*compile-path* path]
+ (doseq [sym (swank-packages)]
+ (println "Compiling" (name sym))
+ (compile sym))))
+
+(defn init []
+ (let [path (File. *swank-compile-path* (str (swank-version)))
+ path-already-exists? (.exists path)]
+ (when-not path-already-exists?
+ (.mkdirs path))
+ (add-classpath (-> path .toURI .toURL))
+ (when-not path-already-exists?
+ (compile-swank (str path)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/rpc.clj b/vim/bundle/slimv/swank-clojure/swank/rpc.clj
new file mode 100644
index 0000000..5f40a57
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/rpc.clj
@@ -0,0 +1,159 @@
+;;; This code has been placed in the Public Domain. All warranties are disclaimed.
+(ns #^{:doc "Pass remote calls and responses between lisp systems using the swank-rpc protocol."
+ :author "Terje Norderhaug <terje@in-progress.com>"}
+ swank.rpc
+ (:use (swank util)
+ (swank.util io))
+ (:import (java.io Writer Reader PushbackReader StringReader)))
+
+;; ERROR HANDLING
+
+(def swank-protocol-error (Exception. "Swank protocol error."))
+
+;; LOGGING
+
+(def log-events false)
+
+(def log-output nil)
+
+(defn log-event [format-string & args]
+ (when log-events
+ (.write (or log-output *out*) (apply format format-string args))
+ (.flush (or log-output *out*))
+ nil))
+
+;; INPUT
+
+(defn- read-form
+ "Read a form that conforms to the swank rpc protocol"
+ ([#^Reader rdr]
+ (let [c (.read rdr)]
+ (condp = (char c)
+ \" (let [sb (StringBuilder.)]
+ (loop []
+ (let [c (.read rdr)]
+ (if (= c -1)
+ (throw (java.io.EOFException. "Incomplete reading of quoted string."))
+ (condp = (char c)
+ \" (str sb)
+ \\ (do (.append sb (char (.read rdr)))
+ (recur))
+ (do (.append sb (char c))
+ (recur)))))))
+ \( (loop [result []]
+ (let [form (read-form rdr)]
+ (let [c (.read rdr)]
+ (if (= c -1)
+ (throw (java.io.EOFException. "Incomplete reading of list."))
+ (condp = (char c)
+ \) (sequence (conj result form))
+ \space (recur (conj result form)))))))
+ \' (list 'quote (read-form rdr))
+ (let [sb (StringBuilder.)]
+ (loop [c c]
+ (if (not= c -1)
+ (condp = (char c)
+ \\ (do (.append sb (char (.read rdr)))
+ (recur (.read rdr)))
+ \space (.unread rdr c)
+ \) (.unread rdr c)
+ (do (.append sb (char c))
+ (recur (.read rdr))))))
+ (let [str (str sb)]
+ (cond
+ (. Character isDigit c) (Integer/parseInt str)
+ (= "nil" str) nil
+ (= "t" str) true
+ :else (symbol str))))))))
+
+(defn- read-packet
+ ([#^Reader reader]
+ (let [len (Integer/parseInt (read-chars reader 6 swank-protocol-error) 16)]
+ (read-chars reader len swank-protocol-error))))
+
+(defn decode-message
+ "Read an rpc message encoded using the swank rpc protocol."
+ ([#^Reader rdr]
+ (let [packet (read-packet rdr)]
+ (log-event "READ: %s\n" packet)
+ (try
+ (with-open [rdr (PushbackReader. (StringReader. packet))]
+ (read-form rdr))
+ (catch Exception e
+ (list :reader-error packet e))))))
+
+; (with-open [rdr (StringReader. "00001f(swank:a 123 (%b% (t nil) \"c\"))")] (decode-message rdr))
+
+
+;; OUTPUT
+
+(defmulti print-object (fn [x writer] (type x)))
+
+(defmethod print-object :default [o, #^Writer w]
+ (print-method o w))
+
+(defmethod print-object Boolean [o, #^Writer w]
+ (.write w (if o "t" "nil")))
+
+(defmethod print-object String [#^String s, #^Writer w]
+ (let [char-escape-string {\" "\\\""
+ \\ "\\\\"}]
+ (do (.append w \")
+ (dotimes [n (count s)]
+ (let [c (.charAt s n)
+ e (char-escape-string c)]
+ (if e (.write w e) (.append w c))))
+ (.append w \"))
+ nil))
+
+(defmethod print-object clojure.lang.ISeq [o, #^Writer w]
+ (.write w "(")
+ (print-object (first o) w)
+ (doseq [item (rest o)]
+ (.write w " ")
+ (print-object item w))
+ (.write w ")"))
+
+(defn- write-form
+ ([#^Writer writer message]
+ (print-object message writer)))
+
+(defn- write-packet
+ ([#^Writer writer str]
+ (let [len (.length str)]
+ (doto writer
+ (.write (format "%06x" len))
+ (.write str)
+ (.flush)))))
+
+(defn encode-message
+ "Write an rpc message encoded using the swank rpc protocol."
+ ([#^Writer writer message]
+ (let [str (with-out-str
+ (write-form *out* message)) ]
+ (log-event "WRITE: %s\n" str)
+ (write-packet writer str))))
+
+; (with-out-str (encode-message *out* "hello"))
+; (with-out-str (encode-message *out* '(a 123 (swank:b (true false) "c"))))
+
+
+;; DISPATCH
+
+(defonce rpc-fn-map {})
+
+(defn register-dispatch
+ ([name fn]
+ (register-dispatch name fn #'rpc-fn-map))
+ ([name fn fn-map]
+ (alter-var-root fn-map assoc name fn)))
+
+(defn dispatch-message
+ ([message fn-map]
+ (let [operation (first message)
+ operands (rest message)
+ fn (fn-map operation)]
+ (assert fn)
+ (apply fn operands)))
+ ([message]
+ (dispatch-message message rpc-fn-map)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/swank.clj b/vim/bundle/slimv/swank-clojure/swank/swank.clj
new file mode 100644
index 0000000..d14e5c0
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/swank.clj
@@ -0,0 +1,92 @@
+;;;; swank-clojure.clj --- Swank server for Clojure
+;;;
+;;; Copyright (C) 2008 Jeffrey Chu
+;;;
+;;; This file is licensed under the terms of the GNU General Public
+;;; License as distributed with Emacs (press C-h C-c to view it).
+;;;
+;;; See README file for more information about installation
+;;;
+
+(ns swank.swank
+ (:use [swank.core]
+ [swank.core connection server]
+ [swank.util.concurrent thread]
+ [swank.util.net sockets]
+ [clojure.main :only [repl]])
+ (:require [swank.commands]
+ [swank.commands basic indent completion
+ contrib inspector])
+ (:import [java.lang System]
+ [java.io File])
+ (:gen-class))
+
+(defn ignore-protocol-version [version]
+ (reset! protocol-version version))
+
+(defn- connection-serve [conn]
+ (let [control
+ (dothread-swank
+ (thread-set-name "Swank Control Thread")
+ (try
+ (control-loop conn)
+ (catch Exception e
+ ;; fail silently
+ nil))
+ (close-socket! (conn :socket)))
+ read
+ (dothread-swank
+ (thread-set-name "Read Loop Thread")
+ (try
+ (read-loop conn control)
+ (catch Exception e
+ ;; This could be put somewhere better
+ (.println System/err "exception in read loop")
+ (.printStackTrace e)
+ (.interrupt control)
+ (dosync (alter connections (partial remove #{conn}))))))]
+ (dosync
+ (ref-set (conn :control-thread) control)
+ (ref-set (conn :read-thread) read))))
+
+(defn start-server
+ "Start the server and write the listen port number to
+ PORT-FILE. This is the entry point for Emacs."
+ [port-file & opts]
+ (let [opts (apply hash-map opts)]
+ (setup-server (get opts :port 0)
+ (fn announce-port [port]
+ (announce-port-to-file port-file port)
+ (simple-announce port))
+ connection-serve
+ opts)))
+
+(def #^{:private true} encodings-map
+ {"UTF-8" "utf-8-unix"
+ })
+
+(defn- get-system-encoding []
+ (when-let [enc-name (.name (java.nio.charset.Charset/defaultCharset))]
+ (encodings-map enc-name)))
+
+(defn start-repl
+ "Start the server wrapped in a repl. Use this to embed swank in your code."
+ ([port & opts]
+ (let [stop (atom false)
+ opts (merge {:port (Integer. port)
+ :encoding (or (System/getProperty "swank.encoding")
+ (get-system-encoding)
+ "iso-latin-1-unix")}
+ (apply hash-map opts))]
+ (repl :read (fn [rprompt rexit]
+ (if @stop rexit
+ (do (reset! stop true)
+ `(start-server (-> "java.io.tmpdir"
+ (System/getProperty)
+ (File. "slime-port.txt")
+ (.getCanonicalPath))
+ ~@(apply concat opts)))))
+ :need-prompt (constantly false))))
+ ([] (start-repl 4005)))
+
+(def -main start-repl)
diff --git a/vim/bundle/slimv/swank-clojure/swank/util.clj b/vim/bundle/slimv/swank-clojure/swank/util.clj
new file mode 100644
index 0000000..756e6f0
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util.clj
@@ -0,0 +1,72 @@
+(ns swank.util
+ (:import (java.io StringReader)
+ (clojure.lang LineNumberingPushbackReader)))
+
+(defmacro one-of?
+ "Short circuiting value comparison."
+ ([val & possible]
+ (let [v (gensym)]
+ `(let [~v ~val]
+ (or ~@(map (fn [p] `(= ~v ~p)) possible))))))
+
+(defn find-first
+ "Returns the first entry in a coll matches a given predicate."
+ ([coll] (find-first identity coll))
+ ([pred coll]
+ (first (filter pred coll))))
+
+(defn position
+ "Finds the first position of an item that matches a given predicate
+ within col. Returns nil if not found. Optionally provide a start
+ offset to search from."
+ ([pred coll] (position pred coll 0))
+ ([pred coll start]
+ (loop [coll (drop start coll), i start]
+ (when (seq coll)
+ (if (pred (first coll))
+ i
+ (recur (rest coll) (inc i))))))
+ {:tag Integer})
+
+(when-not (ns-resolve 'clojure.core 'group-by)
+ ;; TODO: not sure why eval is necessary here; breaks without it.
+ (eval '(defn group-by
+ "Categorizes elements within a coll into a map based on a function."
+ ([f coll]
+ (reduce
+ (fn [ret x]
+ (let [k (f x)]
+ (assoc ret k (conj (get ret k []) x))))
+ {})))))
+
+(when-not (ns-resolve 'clojure.core 'flatten)
+ (eval '(defn flatten [x]
+ (filter (complement sequential?)
+ (rest (tree-seq sequential? seq x))))))
+
+(defmacro returning [[var ret] & body]
+ `(let [~var ~ret]
+ ~@body
+ ~var))
+
+
+(defn deep-replace [smap coll]
+ (map #(if (or (seq? %) (vector? %))
+ (deep-replace smap %)
+ %)
+ (replace smap coll)))
+
+(defmacro keep-bindings [bindings f]
+ (let [bind-vars (take (count bindings) (repeatedly gensym))]
+ `(let [~@(interleave bind-vars bindings)]
+ (fn [& args#]
+ (binding [~@(interleave bindings bind-vars)]
+ (apply ~f args#))))))
+
+(defmacro continuously [& body]
+ `(loop [] ~@body (recur)))
+
+(defmacro failing-gracefully [& body]
+ `(try
+ ~@body
+ (catch Throwable _# nil)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj b/vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj
new file mode 100644
index 0000000..94f325b
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/class_browse.clj
@@ -0,0 +1,149 @@
+;;; class-browse.clj -- Java classpath and Clojure namespace browsing
+
+;; by Jeff Valk
+;; created 2009-10-14
+
+;; Scans the classpath for all class files, and provides functions for
+;; categorizing them.
+
+;; See the following for JVM classpath and wildcard expansion rules:
+;; http://java.sun.com/javase/6/docs/technotes/tools/findingclasses.html
+;; http://java.sun.com/javase/6/docs/technotes/tools/solaris/classpath.html
+
+(ns swank.util.class-browse
+ "Provides Java classpath and (compiled) Clojure namespace browsing.
+ Scans the classpath for all class files, and provides functions for
+ categorizing them. Classes are resolved on the start-up classpath only.
+ Calls to 'add-classpath', etc are not considered.
+
+ Class information is built as a list of maps of the following keys:
+ :name Java class or Clojure namespace name
+ :loc Classpath entry (directory or jar) on which the class is located
+ :file Path of the class file, relative to :loc"
+ (:import [java.io File FilenameFilter]
+ [java.util StringTokenizer]
+ [java.util.jar JarFile JarEntry]
+ [java.util.regex Pattern]))
+
+;;; Class file naming, categorization
+
+(defn jar-file? [#^String n] (.endsWith n ".jar"))
+(defn class-file? [#^String n] (.endsWith n ".class"))
+(defn clojure-ns-file? [#^String n] (.endsWith n "__init.class"))
+(defn clojure-fn-file? [#^String n] (re-find #"\$.*__\d+\.class" n))
+(defn top-level-class-file? [#^String n] (re-find #"^[^\$]+\.class" n))
+(defn nested-class-file? [#^String n]
+ ;; ^ excludes anonymous classes
+ (re-find #"^[^\$]+(\$[^\d]\w*)+\.class" n))
+
+(def clojure-ns? (comp clojure-ns-file? :file))
+(def clojure-fn? (comp clojure-fn-file? :file))
+(def top-level-class? (comp top-level-class-file? :file))
+(def nested-class? (comp nested-class-file? :file))
+
+(defn class-or-ns-name
+ "Returns the Java class or Clojure namespace name for a class relative path."
+ [#^String n]
+ (.replace
+ (if (clojure-ns-file? n)
+ (-> n (.replace "__init.class" "") (.replace "_" "-"))
+ (.replace n ".class" ""))
+ File/separator "."))
+
+;;; Path scanning
+
+(defmulti path-class-files
+ "Returns a list of classes found on the specified path location
+ (jar or directory), each comprised of a map with the following keys:
+ :name Java class or Clojure namespace name
+ :loc Classpath entry (directory or jar) on which the class is located
+ :file Path of the class file, relative to :loc"
+ (fn [#^ File f _]
+ (cond (.isDirectory f) :dir
+ (jar-file? (.getName f)) :jar
+ (class-file? (.getName f)) :class)))
+
+(defmethod path-class-files :default
+ [& _] [])
+
+(defmethod path-class-files :jar
+ ;; Build class info for all jar entry class files.
+ [#^File f #^File loc]
+ (let [lp (.getPath loc)]
+ (try
+ (map (fn [fp] {:loc lp :file fp :name (class-or-ns-name fp)})
+ (filter class-file?
+ (map #(.getName #^JarEntry %)
+ (enumeration-seq (.entries (JarFile. f))))))
+ (catch Exception e [])))) ; fail gracefully if jar is unreadable
+
+(defmethod path-class-files :dir
+ ;; Dispatch directories and files (excluding jars) recursively.
+ [#^File d #^File loc]
+ (let [fs (.listFiles d (proxy [FilenameFilter] []
+ (accept [d n] (not (jar-file? n)))))]
+ (reduce concat (for [f fs] (path-class-files f loc)))))
+
+(defmethod path-class-files :class
+ ;; Build class info using file path relative to parent classpath entry
+ ;; location. Make sure it decends; a class can't be on classpath directly.
+ [#^File f #^File loc]
+ (let [fp (.getPath f), lp (.getPath loc)
+ m (re-matcher (re-pattern (Pattern/quote
+ (str "^" lp File/separator))) fp)]
+ (if (not (.find m)) ; must be descendent of loc
+ []
+ (let [fpr (.substring fp (.end m))]
+ [{:loc lp :file fpr :name (class-or-ns-name fpr)}]))))
+
+;;; Classpath expansion
+
+(def java-version
+ (Float/parseFloat (.substring (System/getProperty "java.version") 0 3)))
+
+(defn expand-wildcard
+ "Expands a wildcard path entry to its matching .jar files (JDK 1.6+).
+ If not expanding, returns the path entry as a single-element vector."
+ [#^String path]
+ (let [f (File. path)]
+ (if (and (= (.getName f) "*") (>= java-version 1.6))
+ (-> f .getParentFile
+ (.list (proxy [FilenameFilter] []
+ (accept [d n] (jar-file? n)))))
+ [f])))
+
+(defn scan-paths
+ "Takes one or more classpath strings, scans each classpath entry location, and
+ returns a list of all class file paths found, each relative to its parent
+ directory or jar on the classpath."
+ ([cp]
+ (if cp
+ (let [entries (enumeration-seq
+ (StringTokenizer. cp File/pathSeparator))
+ locs (mapcat expand-wildcard entries)]
+ (reduce concat (for [loc locs] (path-class-files loc loc))))
+ ()))
+ ([cp & more]
+ (reduce #(concat %1 (scan-paths %2)) (scan-paths cp) more)))
+
+;;; Class browsing
+
+(def available-classes
+ (filter (complement clojure-fn?) ; omit compiled clojure fns
+ (scan-paths (System/getProperty "sun.boot.class.path")
+ (System/getProperty "java.ext.dirs")
+ (System/getProperty "java.class.path"))))
+
+;; Force lazy seqs before any user calls, and in background threads; there's
+;; no sense holding up SLIME init. (It's usually quick, but a monstrous
+;; classpath could concievably take a while.)
+
+(def top-level-classes
+ (future (doall (map (comp class-or-ns-name :name)
+ (filter top-level-class?
+ available-classes)))))
+
+(def nested-classes
+ (future (doall (map (comp class-or-ns-name :name)
+ (filter nested-class?
+ available-classes)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/clojure.clj b/vim/bundle/slimv/swank-clojure/swank/util/clojure.clj
new file mode 100644
index 0000000..9d04875
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/clojure.clj
@@ -0,0 +1,33 @@
+(ns swank.util.clojure)
+
+(defn unmunge
+ "Converts a javafied name to a clojure symbol name"
+ ([#^String name]
+ (reduce (fn [#^String s [to from]]
+ (.replaceAll s from (str to)))
+ name
+ clojure.lang.Compiler/CHAR_MAP)))
+
+(defn ns-path
+ "Returns the path form of a given namespace"
+ ([#^clojure.lang.Namespace ns]
+ (let [#^String ns-str (name (ns-name ns))]
+ (-> ns-str
+ (.substring 0 (.lastIndexOf ns-str "."))
+ (.replace \- \_)
+ (.replace \. \/)))))
+
+(defn symbol-name-parts
+ "Parses a symbol name into a namespace and a name. If name doesn't
+ contain a namespace, the default-ns is used (nil if none provided)."
+ ([symbol]
+ (symbol-name-parts symbol nil))
+ ([#^String symbol default-ns]
+ (let [ns-pos (.indexOf symbol (int \/))]
+ (if (= ns-pos -1) ;; namespace found?
+ [default-ns symbol]
+ [(.substring symbol 0 ns-pos) (.substring symbol (inc ns-pos))]))))
+
+(defn resolve-ns [sym ns]
+ (or (find-ns sym)
+ (get (ns-aliases ns) sym)))
\ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj
new file mode 100644
index 0000000..8c30d74
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/mbox.clj
@@ -0,0 +1,31 @@
+(ns swank.util.concurrent.mbox
+ (:refer-clojure :exclude [send get]))
+
+;; Holds references to the mailboxes (message queues)
+(defonce mailboxes (ref {}))
+
+(defn get
+ "Returns the mailbox for a given id. Creates one if one does not
+ already exist."
+ ([id]
+ (dosync
+ (when-not (@mailboxes id)
+ (alter mailboxes assoc
+ id (java.util.concurrent.LinkedBlockingQueue.))))
+ (@mailboxes id))
+ {:tag java.util.concurrent.LinkedBlockingQueue})
+
+(defn send
+ "Sends a message to a given id."
+ ([id message]
+ (let [mbox (get id)]
+ (.put mbox message))))
+
+(defn receive
+ "Blocking recieve for messages for the given id."
+ ([id]
+ (let [mb (get id)]
+ (.take mb))))
+
+(defn clean []
+ )
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj
new file mode 100644
index 0000000..fa77a22
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/concurrent/thread.clj
@@ -0,0 +1,50 @@
+(ns swank.util.concurrent.thread
+ (:use (swank util)))
+
+(defn- gen-name []
+ (name (gensym "Thread-")))
+
+(defn start-thread
+ "Starts a thread that run the given function f"
+ ([#^Runnable f]
+ (doto (Thread. f)
+ (.start))))
+
+(defmacro dothread [& body]
+ `(start-thread (fn [] ~@body)))
+
+(defmacro dothread-keeping [bindings & body]
+ `(start-thread (keep-bindings ~bindings (fn [] ~@body))))
+
+(defmacro dothread-keeping-clj [more-bindings & body]
+ (let [clj-star-syms (filter #(or (= (name %) "*e")
+ (= (name %) "*1")
+ (= (name %) "*2")
+ (= (name %) "*3")
+ (and (.startsWith #^String (name %) "*")
+ (.endsWith #^String (name %) "*")
+ (> (count (name %)) 1)))
+ (keys (ns-publics (find-ns 'clojure.core))))]
+ `(dothread-keeping [~@clj-star-syms ~@more-bindings]
+ ~@body)))
+
+(defn current-thread []
+ (Thread/currentThread))
+
+(defn thread-set-name
+ ([name] (thread-set-name (current-thread) name))
+ ([#^Thread thread name]
+ (.setName thread name)))
+
+(defn thread-name
+ ([] (thread-name (current-thread)))
+ ([#^Thread thread]
+ (.getName thread)))
+
+(defn thread-id
+ ([] (thread-id (current-thread)))
+ ([#^Thread thread]
+ (.getId thread)))
+
+(defn thread-alive? [#^Thread t]
+ (.isAlive t))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/hooks.clj b/vim/bundle/slimv/swank-clojure/swank/util/hooks.clj
new file mode 100644
index 0000000..dd7af50
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/hooks.clj
@@ -0,0 +1,12 @@
+(ns swank.util.hooks)
+
+(defmacro defhook [name & hooks]
+ `(defonce ~name (ref (list ~@hooks))))
+
+;;;; Hooks
+(defn add-hook [place function]
+ (dosync (alter place conj function)))
+
+(defn run-hook [functions & arguments]
+ (doseq [f @functions]
+ (apply f arguments)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/io.clj b/vim/bundle/slimv/swank-clojure/swank/util/io.clj
new file mode 100644
index 0000000..6247eec
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/io.clj
@@ -0,0 +1,40 @@
+(ns swank.util.io
+ (:use [swank util]
+ [swank.util.concurrent thread])
+ (:import [java.io StringWriter Reader PrintWriter]))
+
+(defn read-chars
+ ([rdr n] (read-chars rdr n false))
+ ([#^Reader rdr n throw-exception]
+ (let [cbuf (make-array Character/TYPE n)]
+ (loop [i 0]
+ (let [size (.read rdr cbuf i (- n i))]
+ (cond
+ (neg? size) (if throw-exception
+ (throw throw-exception)
+ (String. cbuf 0 i))
+ (= (+ i size) n) (String. cbuf)
+ :else (recur (+ i size))))))))
+
+(defn call-on-flush-stream
+ "Creates a stream that will call a given function when flushed."
+ ([flushf]
+ (let [closed? (atom false)
+ #^PrintWriter stream
+ (PrintWriter.
+ (proxy [StringWriter] []
+ (close [] (reset! closed? true))
+ (flush []
+ (let [#^StringWriter me this
+ len (.. me getBuffer length)]
+ (when (> len 0)
+ (flushf (.. me getBuffer (substring 0 len)))
+ (.. me getBuffer (delete 0 len)))))))]
+ (dothread
+ (thread-set-name "Call-on-write Stream")
+ (continuously
+ (Thread/sleep 200)
+ (when-not @closed?
+ (.flush stream))))
+ stream))
+ {:tag PrintWriter})
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/java.clj b/vim/bundle/slimv/swank-clojure/swank/util/java.clj
new file mode 100644
index 0000000..4cc802f
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/java.clj
@@ -0,0 +1,16 @@
+(ns swank.util.java)
+
+(defn member-name [#^java.lang.reflect.Member member]
+ (.getName member))
+
+(defn member-static? [#^java.lang.reflect.Member member]
+ (java.lang.reflect.Modifier/isStatic (.getModifiers member)))
+
+(defn static-methods [#^Class class]
+ (filter member-static? (.getMethods class)))
+
+(defn static-fields [#^Class class]
+ (filter member-static? (.getDeclaredFields class)))
+
+(defn instance-methods [#^Class class]
+ (remove member-static? (.getMethods class)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj b/vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj
new file mode 100644
index 0000000..1c45ff1
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/net/sockets.clj
@@ -0,0 +1,57 @@
+(ns swank.util.net.sockets
+ (:use (swank util)
+ (swank.util.concurrent thread))
+ (:import (java.net ServerSocket Socket SocketException InetAddress)))
+
+(defn make-server-socket
+ "Create a java.net.ServerSocket. A map of `options':
+
+ :port - The port which this ServerSocket will listen on. It must
+ be a number between 0-65535. If 0 or not provided, the server
+ will be created on any free port.
+
+ :host - The address the server will bind to, can be used on multi
+ homed hosts. This can be an InetAddress or a hostname string. If
+ not provided or nil, it will listen on all addresses.
+
+ :backlog - The maximum queue length of incoming connection
+ indications (ie. connection requests). If the queue is full, new
+ indications will be refused. If set to less than or equal to 0,
+ the default value will be used."
+ ([] (ServerSocket.))
+ ([options] (ServerSocket. (options :port 0)
+ (options :backlog 0)
+ (when-let [host (options :host)]
+ (if (instance? InetAddress host)
+ host
+ (InetAddress/getByName host))))))
+
+(defn start-server-socket!
+ "Given a `server-socket' (java.net.ServerSocket), call
+ `handle-socket' for each new connection and provide current
+ socket.
+
+ This will return immediately with the Thread that is blocking for
+ new connections. Use Thread.join() if you need to wait for the
+ server to close."
+ ([server-socket handle-socket]
+ (dothread-keeping-clj nil
+ (thread-set-name (str "Socket Server [" (thread-id) "]"))
+ (with-open [#^ServerSocket server server-socket]
+ (while (not (.isClosed server))
+ (handle-socket (.accept server)))))))
+
+(defn close-socket!
+ "Cleanly shutdown and close a java.net.Socket. This will not affect
+ an already running instance of SocketServer."
+ ([#^Socket socket]
+ (doto socket
+ (.shutdownInput)
+ (.shutdownOutput)
+ (.close))))
+
+(defn close-server-socket!
+ "Shutdown a java.net.SocketServer. Existing connections will
+ persist."
+ ([#^ServerSocket server]
+ (.close server)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/string.clj b/vim/bundle/slimv/swank-clojure/swank/util/string.clj
new file mode 100644
index 0000000..3250a61
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/string.clj
@@ -0,0 +1,16 @@
+(ns swank.util.string)
+
+(defn largest-common-prefix
+ "Returns the largest common prefix of two strings."
+ ([#^String a, #^String b]
+ (apply str (take-while (comp not nil?) (map #(when (= %1 %2) %1) a b))))
+ {:tag String})
+
+(defn char-position
+ "Finds the position of a character within a string, optionally
+ provide a starting index. Returns nil if none is found."
+ ([c str] (char-position c str 0))
+ ([#^Character c #^String str #^Integer start]
+ (let [idx (.indexOf str (int c) start)]
+ (when (not= -1 idx)
+ idx))))
\ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/util/sys.clj b/vim/bundle/slimv/swank-clojure/swank/util/sys.clj
new file mode 100644
index 0000000..f76c319
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/util/sys.clj
@@ -0,0 +1,13 @@
+(ns swank.util.sys)
+
+(defn get-pid
+ "Returns the PID of the JVM. This is largely a hack and may or may
+ not be accurate depending on the JVM in which clojure is running
+ off of."
+ ([]
+ (or (first (.. java.lang.management.ManagementFactory (getRuntimeMXBean) (getName) (split "@")))
+ (System/getProperty "pid")))
+ {:tag String})
+
+(defn user-home-path []
+ (System/getProperty "user.home"))
--
cgit v1.2.3-70-g09d2