diff options
Diffstat (limited to 'vim/bundle/slimv/swank-clojure')
38 files changed, 3789 insertions, 0 deletions
diff --git a/vim/bundle/slimv/swank-clojure/COPYING b/vim/bundle/slimv/swank-clojure/COPYING new file mode 100644 index 0000000..fec593a --- /dev/null +++ b/vim/bundle/slimv/swank-clojure/COPYING @@ -0,0 +1,227 @@ +Eclipse Public License - v 1.0 + +THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE +PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF +THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. + +1. DEFINITIONS + +"Contribution" means: + +a) in the case of the initial Contributor, the initial code and +documentation distributed under this Agreement, and + +b) in the case of each subsequent Contributor: + +i) changes to the Program, and + +ii) additions to the Program; + +where such changes and/or additions to the Program originate from and +are distributed by that particular Contributor. A Contribution +'originates' from a Contributor if it was added to the Program by such +Contributor itself or anyone acting on such Contributor's +behalf. Contributions do not include additions to the Program which: +(i) are separate modules of software distributed in conjunction with +the Program under their own license agreement, and (ii) are not +derivative works of the Program. + +"Contributor" means any person or entity that distributes the Program. + +"Licensed Patents" mean patent claims licensable by a Contributor +which are necessarily infringed by the use or sale of its Contribution +alone or when combined with the Program. + +"Program" means the Contributions distributed in accordance with this +Agreement. + +"Recipient" means anyone who receives the Program under this +Agreement, including all Contributors. + +2. GRANT OF RIGHTS + +a) Subject to the terms of this Agreement, each Contributor hereby +grants Recipient a non-exclusive, worldwide, royalty-free copyright +license to reproduce, prepare derivative works of, publicly display, +publicly perform, distribute and sublicense the Contribution of such +Contributor, if any, and such derivative works, in source code and +object code form. + +b) Subject to the terms of this Agreement, each Contributor hereby +grants Recipient a non-exclusive, worldwide, royalty-free patent +license under Licensed Patents to make, use, sell, offer to sell, +import and otherwise transfer the Contribution of such Contributor, if +any, in source code and object code form. This patent license shall +apply to the combination of the Contribution and the Program if, at +the time the Contribution is added by the Contributor, such addition +of the Contribution causes such combination to be covered by the +Licensed Patents. The patent license shall not apply to any other +combinations which include the Contribution. No hardware per se is +licensed hereunder. + +c) Recipient understands that although each Contributor grants the +licenses to its Contributions set forth herein, no assurances are +provided by any Contributor that the Program does not infringe the +patent or other intellectual property rights of any other entity. Each +Contributor disclaims any liability to Recipient for claims brought by +any other entity based on infringement of intellectual property rights +or otherwise. As a condition to exercising the rights and licenses +granted hereunder, each Recipient hereby assumes sole responsibility +to secure any other intellectual property rights needed, if any. For +example, if a third party patent license is required to allow +Recipient to distribute the Program, it is Recipient's responsibility +to acquire that license before distributing the Program. + +d) Each Contributor represents that to its knowledge it has sufficient +copyright rights in its Contribution, if any, to grant the copyright +license set forth in this Agreement. + +3. REQUIREMENTS + +A Contributor may choose to distribute the Program in object code form +under its own license agreement, provided that: + +a) it complies with the terms and conditions of this Agreement; and + +b) its license agreement: + +i) effectively disclaims on behalf of all Contributors all warranties +and conditions, express and implied, including warranties or +conditions of title and non-infringement, and implied warranties or +conditions of merchantability and fitness for a particular purpose; + +ii) effectively excludes on behalf of all Contributors all liability +for damages, including direct, indirect, special, incidental and +consequential damages, such as lost profits; + +iii) states that any provisions which differ from this Agreement are +offered by that Contributor alone and not by any other party; and + +iv) states that source code for the Program is available from such +Contributor, and informs licensees how to obtain it in a reasonable +manner on or through a medium customarily used for software exchange. + +When the Program is made available in source code form: + +a) it must be made available under this Agreement; and + +b) a copy of this Agreement must be included with each copy of the Program. + +Contributors may not remove or alter any copyright notices contained +within the Program. + +Each Contributor must identify itself as the originator of its +Contribution, if any, in a manner that reasonably allows subsequent +Recipients to identify the originator of the Contribution. + +4. COMMERCIAL DISTRIBUTION + +Commercial distributors of software may accept certain +responsibilities with respect to end users, business partners and the +like. While this license is intended to facilitate the commercial use +of the Program, the Contributor who includes the Program in a +commercial product offering should do so in a manner which does not +create potential liability for other Contributors. Therefore, if a +Contributor includes the Program in a commercial product offering, +such Contributor ("Commercial Contributor") hereby agrees to defend +and indemnify every other Contributor ("Indemnified Contributor") +against any losses, damages and costs (collectively "Losses") arising +from claims, lawsuits and other legal actions brought by a third party +against the Indemnified Contributor to the extent caused by the acts +or omissions of such Commercial Contributor in connection with its +distribution of the Program in a commercial product offering. The +obligations in this section do not apply to any claims or Losses +relating to any actual or alleged intellectual property +infringement. In order to qualify, an Indemnified Contributor must: a) +promptly notify the Commercial Contributor in writing of such claim, +and b) allow the Commercial Contributor tocontrol, and cooperate with +the Commercial Contributor in, the defense and any related settlement +negotiations. The Indemnified Contributor may participate in any such +claim at its own expense. + +For example, a Contributor might include the Program in a commercial +product offering, Product X. That Contributor is then a Commercial +Contributor. If that Commercial Contributor then makes performance +claims, or offers warranties related to Product X, those performance +claims and warranties are such Commercial Contributor's responsibility +alone. Under this section, the Commercial Contributor would have to +defend claims against the other Contributors related to those +performance claims and warranties, and if a court requires any other +Contributor to pay any damages as a result, the Commercial Contributor +must pay those damages. + +5. NO WARRANTY + +EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS +PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY +WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY +OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely +responsible for determining the appropriateness of using and +distributing the Program and assumes all risks associated with its +exercise of rights under this Agreement , including but not limited to +the risks and costs of program errors, compliance with applicable +laws, damage to or loss of data, programs or equipment, and +unavailability or interruption of operations. + +6. DISCLAIMER OF LIABILITY + +EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR +ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING +WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR +DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED +HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +7. GENERAL + +If any provision of this Agreement is invalid or unenforceable under +applicable law, it shall not affect the validity or enforceability of +the remainder of the terms of this Agreement, and without further +action by the parties hereto, such provision shall be reformed to the +minimum extent necessary to make such provision valid and enforceable. + +If Recipient institutes patent litigation against any entity +(including a cross-claim or counterclaim in a lawsuit) alleging that +the Program itself (excluding combinations of the Program with other +software or hardware) infringes such Recipient's patent(s), then such +Recipient's rights granted under Section 2(b) shall terminate as of +the date such litigation is filed. + +All Recipient's rights under this Agreement shall terminate if it +fails to comply with any of the material terms or conditions of this +Agreement and does not cure such failure in a reasonable period of +time after becoming aware of such noncompliance. If all Recipient's +rights under this Agreement terminate, Recipient agrees to cease use +and distribution of the Program as soon as reasonably +practicable. However, Recipient's obligations under this Agreement and +any licenses granted by Recipient relating to the Program shall +continue and survive. + +Everyone is permitted to copy and distribute copies of this Agreement, +but in order to avoid inconsistency the Agreement is copyrighted and +may only be modified in the following manner. The Agreement Steward +reserves the right to publish new versions (including revisions) of +this Agreement from time to time. No one other than the Agreement +Steward has the right to modify this Agreement. The Eclipse Foundation +is the initial Agreement Steward. The Eclipse Foundation may assign +the responsibility to serve as the Agreement Steward to a suitable +separate entity. Each new version of the Agreement will be given a +distinguishing version number. The Program (including Contributions) +may always be distributed subject to the version of the Agreement +under which it was received. In addition, after a new version of the +Agreement is published, Contributor may elect to distribute the +Program (including its Contributions) under the new version. Except as +expressly stated in Sections 2(a) and 2(b) above, Recipient receives +no rights or licenses to the intellectual property of any Contributor +under this Agreement, whether expressly, by implication, estoppel or +otherwise. All rights in the Program not expressly granted under this +Agreement are reserved. + +This Agreement is governed by the laws of the State of Washington and +the intellectual property laws of the United States of America. No +party to this Agreement will bring a legal action under this Agreement +more than one year after the cause of action arose. Each party waives +its rights to a jury trial in any resulting litigation. diff --git a/vim/bundle/slimv/swank-clojure/README.md b/vim/bundle/slimv/swank-clojure/README.md new file mode 100644 index 0000000..f2af463 --- /dev/null +++ b/vim/bundle/slimv/swank-clojure/README.md @@ -0,0 +1,152 @@ +# Swank Clojure + +[Swank Clojure](http://github.com/technomancy/swank-clojure) is a +server that allows [SLIME](http://common-lisp.net/project/slime/) (the +Superior Lisp Interaction Mode for Emacs) to connect to Clojure +projects. To use it you must launch a swank server, then connect to it +from within Emacs. + +## Usage + +If you just want a standalone swank server with no third-party +libraries, you can just install swank-clojure using Leiningen. + + $ lein plugin install swank-clojure 1.3.0-SNAPSHOT + $ ~/.lein/bin/swank-clojure + + M-x slime-connect + +If you put ~/.lein/bin on your $PATH it's even more convenient. + +You can also start a swank server from inside your project: + + $ lein swank # you can specify PORT and HOST optionally + +Note that the lein-swank plugin now comes with Swank Clojure; it does +not need to be specified as a separate dependency any more. + +If you're using Maven, add this to your pom.xml under the +\<dependencies\> section: + + <dependency> + <groupId>swank-clojure</groupId> + <artifactId>swank-clojure</artifactId> + <version>1.2.1</version> + </dependency> + +Then you can launch a swank server like so: + + $ mvn -o clojure:swank + +Note that due to a bug in clojure-maven-plugin, you currently cannot +include it as a test-scoped dependency; it must be compile-scoped. You +also cannot change the port from Maven; it's hard-coded to 4005. + +Put this in your Emacs configuration to get syntax highlighting in the +slime repl: + + (add-hook 'slime-repl-mode-hook 'clojure-mode-font-lock-setup) + +## Connecting with SLIME + +Install the "slime-repl" package using package.el. If you are using +Emacs 23, it's best to get [the latest version of package.el from +Emacs +trunk](http://bit.ly/pkg-el). Then +add Marmalade as an archive source: + + (add-to-list 'package-archives + '("marmalade" . "http://marmalade-repo.org/packages/") t) + +Then you can do <kbd>M-x package-list-packages</kbd>. Go down to +slime-repl and mark it with <kbd>i</kbd>. Execute the installation by +pressing <kbd>x</kbd>. + +When you perform the installation, you will see warnings related to +the byte-compilation of the packages. This is **normal**; the packages +will work just fine even if there are problems byte-compiling it upon +installation. + +Then you should be able to connect to the swank server you launched: + + M-x slime-connect + +It will prompt you for your host (usually localhost) and port. It may +also warn you that your SLIME version doesn't match your Swank +version; this should be OK. + +Having old versions of SLIME either manually installed or installed +using a system-wide package manager like apt-get may cause issues. + +## SLIME Commands + +Commonly-used SLIME commands: + +* **C-c TAB**: Autocomplete symbol at point +* **C-x C-e**: Eval the form under the point +* **C-c C-k**: Compile the current buffer +* **C-c C-l**: Load current buffer and force dependent namespaces to reload +* **M-.**: Jump to the definition of a var +* **C-c S-i**: Inspect a value +* **C-c C-m**: Macroexpand the call under the point +* **C-c C-d C-d**: Look up documentation for a var +* **C-c C-z**: Switch from a Clojure buffer to the repl buffer +* **C-c M-p**: Switch the repl namespace to match the current buffer +* **C-c C-w c**: List all callers of a given function + +Pressing "v" on a stack trace a debug buffer will jump to the file and +line referenced by that frame if possible. + +Note that SLIME was designed to work with Common Lisp, which has a +distinction between interpreted code and compiled code. Clojure has no +such distinction, so the load-file functionality is overloaded to add +<code>:reload-all</code> behaviour. + +## Embedding + +You can embed Swank Clojure in your project, start the server from +within your own code, and connect via Emacs to that instance: + + (ns my-app + (:require [swank.swank])) + (swank.swank/start-repl) ;; optionally takes a port argument + +Then use M-x slime-connect to connect from within Emacs. + +You can also start the server directly from the "java" command-line +launcher if you AOT-compile it and specify "swank.swank" as your main +class. + +## Debug Repl + +For now, see [Hugo Duncan's +blog](http://hugoduncan.org/post/2010/swank_clojure_gets_a_break_with_the_local_environment.xhtml) +for an explanation of this excellent feature. Further documentation to come. + +## swank-clojure.el + +Previous versions of Swank Clojure bundled an Elisp library called +swank-clojure.el that provided ways to launch your swank server from +within your Emacs process. It's much more reliable to launch the +server from your build tool, so this has been removed. + +## Community + +The [mailing list](http://groups.google.com/group/swank-clojure) and +clojure channel on Freenode are the best places to bring up +questions/issues. + +Contributions are preferred as either Github pull requests or using +"git format-patch". Please use standard indentation with no tabs, +trailing whitespace, or lines longer than 80 columns. See [this post +on submitting good patches](http://technomancy.us/135) for some +tips. If you've got some time on your hands, reading this [style +guide](http://mumble.net/~campbell/scheme/style.txt) wouldn't hurt +either. + +## License + +Copyright (C) 2008-2011 Jeffrey Chu, Phil Hagelberg, Hugo Duncan, and +contributors + +Licensed under the EPL. (See the file COPYING.) diff --git a/vim/bundle/slimv/swank-clojure/leiningen/swank.clj b/vim/bundle/slimv/swank-clojure/leiningen/swank.clj new file mode 100644 index 0000000..d3875b8 --- /dev/null +++ b/vim/bundle/slimv/swank-clojure/leiningen/swank.clj @@ -0,0 +1,30 @@ +(ns leiningen.swank + "Launch swank server for Emacs to connect." + (:use [leiningen.compile :only [eval-in-project]]) + (:import [java.io File])) + +(defn swank-form [project port host opts] + ;; bootclasspath workaround: http://dev.clojure.org/jira/browse/CLJ-673 + (when (:eval-in-leiningen project) + (require '[clojure walk template stacktrace])) + `(do + (let [is# ~(:repl-init-script project)] + (when (.exists (File. (str is#))) + (load-file is#))) + (require '~'swank.swank) + (require '~'swank.commands.basic) + (@(ns-resolve '~'swank.swank '~'start-repl) + (Integer. ~port) ~@(concat (map read-string opts) + [:host host])) + ;; This exits immediately when using :eval-in-leiningen; must block + (when ~(:eval-in-leiningen project) + (doseq [t# ((ns-resolve '~'swank.commands.basic + '~'get-thread-list))] + (.join t#))))) + +(defn swank + "Launch swank server for Emacs to connect. Optionally takes PORT and HOST." + ([project port host & opts] + (eval-in-project project (swank-form project port host opts))) + ([project port] (swank project port "localhost")) + ([project] (swank project 4005))) diff --git a/vim/bundle/slimv/swank-clojure/project.clj b/vim/bundle/slimv/swank-clojure/project.clj new file mode 100644 index 0000000..f0a1c71 --- /dev/null +++ b/vim/bundle/slimv/swank-clojure/project.clj @@ -0,0 +1,9 @@ +(defproject swank-clojure "1.3.0" + :description "Swank server connecting Clojure to Emacs SLIME" + :url "http://github.com/technomancy/swank-clojure" + :dependencies [[org.clojure/clojure "1.2.0"]] + :dev-dependencies [[lein-multi "1.0.0"]] + :multi-deps {"1.1" [[org.clojure/clojure "1.1.0"] + [org.clojure/clojure-contrib "1.1.0"]] + "1.3" [[org.clojure/clojure "1.3.0-master-SNAPSHOT"]]} + :shell-wrapper {:main swank.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")) |