Permalink
Browse files

Merge branch 'master' of git://github.com/jochu/swank-clojure

  • Loading branch information...
technomancy committed Sep 8, 2009
2 parents 34e6921 + 6f92845 commit 6d3c19b851ce84297ec94580b969b695a0030ec5
Showing with 561 additions and 79 deletions.
  1. +29 −78 swank/commands/basic.clj
  2. +89 −0 swank/commands/completion.clj
  3. +428 −0 swank/commands/contrib/swank_fuzzy.clj
  4. +2 −1 swank/swank.clj
  5. +13 −0 swank/util/java.clj
View
@@ -164,7 +164,7 @@
;;;; Documentation
(defn- briefly-describe-symbol-for-emacs [var]
- (let [lines (fn [s] (seq (.split s (System/getProperty "line.separator"))))
+ (let [lines (fn [s] (seq (.split #^String s (System/getProperty "line.separator"))))
[_ symbol-name arglists d1 d2 & __] (lines (describe-to-string var))
macro? (= d1 "Macro")]
(list :designator symbol-name
@@ -238,35 +238,6 @@ that symbols accessible in the current namespace go first."
;;;; Completions
-(defn- vars-with-prefix
- "Filters a coll of vars and returns only those that have a given
- prefix."
- ([#^String prefix vars]
- (filter #(.startsWith #^String % prefix) (map (comp name :name meta) vars))))
-
-(defn- maybe-alias [sym ns]
- (or (resolve-ns sym (maybe-ns ns))
- (maybe-ns ns)))
-
-(defslimefn simple-completions [symbol-string package]
- (try
- (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
- ns (if sym-ns (maybe-alias (symbol sym-ns) package) (maybe-ns package))
- vars (if sym-ns (vals (ns-publics ns)) (filter var? (vals (ns-map ns))))
- matches (seq (sort (vars-with-prefix sym-name vars)))]
- (if sym-ns
- (list (map (partial str sym-ns "/") matches)
- (if matches
- (str sym-ns "/" (reduce largest-common-prefix matches))
- symbol-string))
- (list matches
- (if matches
- (reduce largest-common-prefix matches)
- symbol-string))))
- (catch java.lang.Throwable t
- (list nil symbol-string))))
-
-
(defslimefn list-all-package-names
([] (map (comp str ns-name) (all-ns)))
([nicknames?] (list-all-package-names)))
@@ -289,37 +260,23 @@ that symbols accessible in the current namespace go first."
;;;; meta dot find
-(defn- slime-find-file-in-dir [#^File file #^String dir]
- (let [file-name (. file (getPath))
- child (File. (File. dir) file-name)]
- (or (when (.exists child)
- `(:file ~(.getPath child)))
- (try
- (let [zipfile (ZipFile. dir)]
- (when (.getEntry zipfile file-name)
- `(:zip ~dir ~file-name)))
- (catch Throwable e false)))))
-
-(defn- slime-find-file-in-paths [#^String file paths]
- (let [f (File. file)]
- (if (.isAbsolute f)
- `(:file ~file)
- (first (filter identity (map #(slime-find-file-in-dir f %) paths))))))
-
-(defn- get-path-prop
- "Returns a coll of the paths represented in a system property"
- ([prop]
- (seq (-> (System/getProperty prop)
- (.split File/pathSeparator))))
- ([prop & props]
- (lazy-cat (get-path-prop prop) (mapcat get-path-prop props))))
-
-(defn- slime-search-paths []
- (concat (get-path-prop "user.dir" "java.class.path" "sun.boot.class.path")
- (let [loader (clojure.lang.RT/baseLoader)]
- (when (instance? java.net.URLClassLoader loader)
- (map #(.getPath #^java.net.URL %)
- (.getURLs #^java.net.URLClassLoader (cast java.net.URLClassLoader (clojure.lang.RT/baseLoader))))))))
+(defn- slime-zip-resource [#^java.net.URL resource]
+ (let [jar-connection #^java.net.JarURLConnection (.openConnection resource)]
+ (list :zip (.getFile (.getJarFileURL jar-connection)) (.getEntryName jar-connection))))
+
+(defn- slime-file-resource [#^java.net.URL resource]
+ (list :file (.getFile resource)))
+
+(defn- slime-find-resource [#^String file]
+ (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))]
@@ -328,30 +285,24 @@ that symbols accessible in the current namespace go first."
(.replace \- \_)
(.replace \. \/))))
-(defn source-location-for-frame [frame]
+(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))))
- (str (namespace-to-path
- (symbol ((re-find #"(.*?)\$"
- (.getClassName frame)) 1)))
- File/separator (.getFileName frame)))
- path (slime-find-file-in-paths filename (slime-search-paths))]
+ (.. frame getClassName (replace \. \/)
+ (substring 0 (.lastIndexOf (.getClassName frame) "."))
+ (concat (str File/separator (.getFileName frame))))
+ (str (namespace-to-path
+ (symbol ((re-find #"(.*?)\$"
+ (.getClassName frame)) 1)))
+ File/separator (.getFileName frame)))
+ path (slime-find-file filename)]
`(:location ~path (:line ~line) nil)))
(defslimefn find-definitions-for-emacs [name]
(let [sym-name (read-from-string name)
sym-var (ns-resolve (maybe-ns *current-package*) sym-name)]
(when-let [meta (and sym-var (meta sym-var))]
- (if-let [path (or
- ;; Check first check using full namespace
- (slime-find-file-in-paths (str (namespace-to-path (:ns meta))
- File/separator
- (:file meta)) (slime-search-paths))
- ;; Otherwise check using just the filename
- (slime-find-file-in-paths (:file meta) (slime-search-paths)))]
+ (if-let [path (slime-find-file (:file meta))]
`((~(str "(defn " (:name meta) ")")
(:location
~path
@@ -388,4 +339,4 @@ that symbols accessible in the current namespace go first."
(source-location-for-frame
(nth (.getStackTrace *current-exception*) n)))
-(defslimefn create-repl [target] '("user" user))
+(defslimefn create-repl [target] '("user" "user"))
@@ -0,0 +1,89 @@
+(remove-ns 'swank.commands.completion)
+(ns swank.commands.completion
+ (:use (swank util core commands)
+ (swank.util string clojure java)))
+
+(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 method-name (mapcat instance-methods (vals (ns-imports ns))))))))
+
+(defn potential-static
+ "Returns a list of potential static methods for a given namespace"
+ ([#^Class class]
+ (map method-name (static-methods class))))
+
+(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 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 symbol-ns)))
+ (concat (potential-var ns)
+ (when-not symbol-ns
+ (potential-ns))
+ (potential-classes ns)
+ (potential-dot ns))))
+
+(defn- maybe-alias [sym ns]
+ (or (resolve-ns sym (maybe-ns ns))
+ (maybe-ns ns)))
+
+(defslimefn simple-completions [symbol-string package]
+ (try
+ (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
+ potential (potential-completions (when sym-ns (symbol sym-ns)) (ns-name (maybe-ns package)))
+ 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))))
Oops, something went wrong.

0 comments on commit 6d3c19b

Please sign in to comment.