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

swank/commands/basic.clj

@@ -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"))

swank/commands/completion.clj

@@ -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))))