Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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

  • Loading branch information...
commit 6d3c19b851ce84297ec94580b969b695a0030ec5 2 parents 34e6921 + 6f92845
Phil Hagelberg technomancy authored
107 swank/commands/basic.clj
@@ -164,7 +164,7 @@
164 164 ;;;; Documentation
165 165
166 166 (defn- briefly-describe-symbol-for-emacs [var]
167   - (let [lines (fn [s] (seq (.split s (System/getProperty "line.separator"))))
  167 + (let [lines (fn [s] (seq (.split #^String s (System/getProperty "line.separator"))))
168 168 [_ symbol-name arglists d1 d2 & __] (lines (describe-to-string var))
169 169 macro? (= d1 "Macro")]
170 170 (list :designator symbol-name
@@ -238,35 +238,6 @@ that symbols accessible in the current namespace go first."
238 238
239 239 ;;;; Completions
240 240
241   -(defn- vars-with-prefix
242   - "Filters a coll of vars and returns only those that have a given
243   - prefix."
244   - ([#^String prefix vars]
245   - (filter #(.startsWith #^String % prefix) (map (comp name :name meta) vars))))
246   -
247   -(defn- maybe-alias [sym ns]
248   - (or (resolve-ns sym (maybe-ns ns))
249   - (maybe-ns ns)))
250   -
251   -(defslimefn simple-completions [symbol-string package]
252   - (try
253   - (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
254   - ns (if sym-ns (maybe-alias (symbol sym-ns) package) (maybe-ns package))
255   - vars (if sym-ns (vals (ns-publics ns)) (filter var? (vals (ns-map ns))))
256   - matches (seq (sort (vars-with-prefix sym-name vars)))]
257   - (if sym-ns
258   - (list (map (partial str sym-ns "/") matches)
259   - (if matches
260   - (str sym-ns "/" (reduce largest-common-prefix matches))
261   - symbol-string))
262   - (list matches
263   - (if matches
264   - (reduce largest-common-prefix matches)
265   - symbol-string))))
266   - (catch java.lang.Throwable t
267   - (list nil symbol-string))))
268   -
269   -
270 241 (defslimefn list-all-package-names
271 242 ([] (map (comp str ns-name) (all-ns)))
272 243 ([nicknames?] (list-all-package-names)))
@@ -289,37 +260,23 @@ that symbols accessible in the current namespace go first."
289 260
290 261 ;;;; meta dot find
291 262
292   -(defn- slime-find-file-in-dir [#^File file #^String dir]
293   - (let [file-name (. file (getPath))
294   - child (File. (File. dir) file-name)]
295   - (or (when (.exists child)
296   - `(:file ~(.getPath child)))
297   - (try
298   - (let [zipfile (ZipFile. dir)]
299   - (when (.getEntry zipfile file-name)
300   - `(:zip ~dir ~file-name)))
301   - (catch Throwable e false)))))
302   -
303   -(defn- slime-find-file-in-paths [#^String file paths]
304   - (let [f (File. file)]
305   - (if (.isAbsolute f)
306   - `(:file ~file)
307   - (first (filter identity (map #(slime-find-file-in-dir f %) paths))))))
308   -
309   -(defn- get-path-prop
310   - "Returns a coll of the paths represented in a system property"
311   - ([prop]
312   - (seq (-> (System/getProperty prop)
313   - (.split File/pathSeparator))))
314   - ([prop & props]
315   - (lazy-cat (get-path-prop prop) (mapcat get-path-prop props))))
316   -
317   -(defn- slime-search-paths []
318   - (concat (get-path-prop "user.dir" "java.class.path" "sun.boot.class.path")
319   - (let [loader (clojure.lang.RT/baseLoader)]
320   - (when (instance? java.net.URLClassLoader loader)
321   - (map #(.getPath #^java.net.URL %)
322   - (.getURLs #^java.net.URLClassLoader (cast java.net.URLClassLoader (clojure.lang.RT/baseLoader))))))))
  263 +(defn- slime-zip-resource [#^java.net.URL resource]
  264 + (let [jar-connection #^java.net.JarURLConnection (.openConnection resource)]
  265 + (list :zip (.getFile (.getJarFileURL jar-connection)) (.getEntryName jar-connection))))
  266 +
  267 +(defn- slime-file-resource [#^java.net.URL resource]
  268 + (list :file (.getFile resource)))
  269 +
  270 +(defn- slime-find-resource [#^String file]
  271 + (let [resource (.getResource (clojure.lang.RT/baseLoader) file)]
  272 + (if (= (.getProtocol resource) "jar")
  273 + (slime-zip-resource resource)
  274 + (slime-file-resource resource))))
  275 +
  276 +(defn- slime-find-file [#^String file]
  277 + (if (.isAbsolute (File. file))
  278 + (list :file file)
  279 + (slime-find-resource file)))
323 280
324 281 (defn- namespace-to-path [ns]
325 282 (let [#^String ns-str (name (ns-name ns))]
@@ -328,30 +285,24 @@ that symbols accessible in the current namespace go first."
328 285 (.replace \- \_)
329 286 (.replace \. \/))))
330 287
331   -(defn source-location-for-frame [frame]
  288 +(defn source-location-for-frame [#^StackTraceElement frame]
332 289 (let [line (.getLineNumber frame)
333 290 filename (if (.. frame getFileName (endsWith ".java"))
334   - (.. frame getClassName (replace \. \/)
335   - (substring 0 (.lastIndexOf (.getClassName frame) "."))
336   - (concat (str File/separator (.getFileName frame))))
337   - (str (namespace-to-path
338   - (symbol ((re-find #"(.*?)\$"
339   - (.getClassName frame)) 1)))
340   - File/separator (.getFileName frame)))
341   - path (slime-find-file-in-paths filename (slime-search-paths))]
  291 + (.. frame getClassName (replace \. \/)
  292 + (substring 0 (.lastIndexOf (.getClassName frame) "."))
  293 + (concat (str File/separator (.getFileName frame))))
  294 + (str (namespace-to-path
  295 + (symbol ((re-find #"(.*?)\$"
  296 + (.getClassName frame)) 1)))
  297 + File/separator (.getFileName frame)))
  298 + path (slime-find-file filename)]
342 299 `(:location ~path (:line ~line) nil)))
343 300
344 301 (defslimefn find-definitions-for-emacs [name]
345 302 (let [sym-name (read-from-string name)
346 303 sym-var (ns-resolve (maybe-ns *current-package*) sym-name)]
347 304 (when-let [meta (and sym-var (meta sym-var))]
348   - (if-let [path (or
349   - ;; Check first check using full namespace
350   - (slime-find-file-in-paths (str (namespace-to-path (:ns meta))
351   - File/separator
352   - (:file meta)) (slime-search-paths))
353   - ;; Otherwise check using just the filename
354   - (slime-find-file-in-paths (:file meta) (slime-search-paths)))]
  305 + (if-let [path (slime-find-file (:file meta))]
355 306 `((~(str "(defn " (:name meta) ")")
356 307 (:location
357 308 ~path
@@ -388,4 +339,4 @@ that symbols accessible in the current namespace go first."
388 339 (source-location-for-frame
389 340 (nth (.getStackTrace *current-exception*) n)))
390 341
391   -(defslimefn create-repl [target] '("user" user))
  342 +(defslimefn create-repl [target] '("user" "user"))
89 swank/commands/completion.clj
... ... @@ -0,0 +1,89 @@
  1 +(remove-ns 'swank.commands.completion)
  2 +(ns swank.commands.completion
  3 + (:use (swank util core commands)
  4 + (swank.util string clojure java)))
  5 +
  6 +(defn potential-ns
  7 + "Returns a list of potential namespace completions for a given
  8 + namespace"
  9 + ([] (potential-ns *ns*))
  10 + ([ns]
  11 + (for [ns-sym (concat (keys (ns-aliases (ns-name ns)))
  12 + (map ns-name (all-ns)))]
  13 + (name ns-sym))))
  14 +
  15 +(defn potential-var-public
  16 + "Returns a list of potential public var name completions for a
  17 + given namespace"
  18 + ([] (potential-var-public *ns*))
  19 + ([ns]
  20 + (for [var-sym (keys (ns-publics ns))]
  21 + (name var-sym))))
  22 +
  23 +(defn potential-var
  24 + "Returns a list of all potential var name completions for a given
  25 + namespace"
  26 + ([] (potential-var *ns*))
  27 + ([ns]
  28 + (for [[key v] (ns-map ns)
  29 + :when (var? v)]
  30 + (name key))))
  31 +
  32 +(defn potential-classes
  33 + "Returns a list of potential class name completions for a given
  34 + namespace"
  35 + ([] (potential-classes *ns*))
  36 + ([ns]
  37 + (for [class-sym (keys (ns-imports ns))]
  38 + (name class-sym))))
  39 +
  40 +(defn potential-dot
  41 + "Returns a list of potential dot method name completions for a given
  42 + namespace"
  43 + ([] (potential-dot *ns*))
  44 + ([ns]
  45 + (map #(str "." %) (set (map method-name (mapcat instance-methods (vals (ns-imports ns))))))))
  46 +
  47 +(defn potential-static
  48 + "Returns a list of potential static methods for a given namespace"
  49 + ([#^Class class]
  50 + (map method-name (static-methods class))))
  51 +
  52 +(defn resolve-class
  53 + "Attempts to resolve a symbol into a java Class. Returns nil on
  54 + failure."
  55 + ([sym]
  56 + (try
  57 + (let [res (resolve sym)]
  58 + (when (class? res)
  59 + res))
  60 + (catch Throwable t
  61 + nil))))
  62 +
  63 +(defn potential-completions [symbol-ns ns]
  64 + (if symbol-ns
  65 + (map #(str symbol-ns "/" %)
  66 + (if-let [class (resolve-class symbol-ns)]
  67 + (potential-static class)
  68 + (potential-var-public symbol-ns)))
  69 + (concat (potential-var ns)
  70 + (when-not symbol-ns
  71 + (potential-ns))
  72 + (potential-classes ns)
  73 + (potential-dot ns))))
  74 +
  75 +(defn- maybe-alias [sym ns]
  76 + (or (resolve-ns sym (maybe-ns ns))
  77 + (maybe-ns ns)))
  78 +
  79 +(defslimefn simple-completions [symbol-string package]
  80 + (try
  81 + (let [[sym-ns sym-name] (symbol-name-parts symbol-string)
  82 + potential (potential-completions (when sym-ns (symbol sym-ns)) (ns-name (maybe-ns package)))
  83 + matches (seq (sort (filter #(.startsWith #^String % symbol-string) potential)))]
  84 + (list matches
  85 + (if matches
  86 + (reduce largest-common-prefix matches)
  87 + symbol-string)))
  88 + (catch java.lang.Throwable t
  89 + (list nil symbol-string))))
428 swank/commands/contrib/swank_fuzzy.clj
... ... @@ -0,0 +1,428 @@
  1 +;;; swank_fuzzy.clj --- fuzzy symbol completion, Clojure implementation.
  2 +
  3 +;; Original CL implementation authors (from swank-fuzzy.lisp) below,
  4 +;; Authors: Brian Downing <bdowning@lavos.net>
  5 +;; Tobias C. Rittweiler <tcr@freebits.de>
  6 +;; and others
  7 +
  8 +;; This progam is based on the swank-fuzzy.lisp.
  9 +;; Thanks the CL implementation authors for that useful software.
  10 +
  11 +(ns swank.commands.contrib.swank-fuzzy
  12 + (:use (swank util core commands))
  13 + (:use (swank.util clojure)))
  14 +
  15 +(def *fuzzy-recursion-soft-limit* 30)
  16 +(defn- compute-most-completions [short full]
  17 + (let [collect-chunk (fn [[pcur [[pa va] ys]] [pb vb]]
  18 + (let [xs (if (= (dec pb) pcur)
  19 + [[pa (str va vb)]]
  20 + [[pb vb] [pa va]])]
  21 + [pb (if ys (conj xs ys) xs)]))
  22 + step (fn step [short full pos chunk seed limit?]
  23 + (cond
  24 + (and (empty? full) (not (empty? short)))
  25 + nil
  26 + (or (empty? short) limit?)
  27 + (if chunk
  28 + (conj seed
  29 + (second (reduce collect-chunk
  30 + [(ffirst chunk) [(first chunk)]]
  31 + (rest chunk))))
  32 + seed)
  33 + (= (first short) (first full))
  34 + (let [seed2
  35 + (step short (rest full) (inc pos) chunk seed
  36 + (< *fuzzy-recursion-soft-limit* (count seed)))]
  37 + (recur (rest short) (rest full) (inc pos)
  38 + (conj chunk [pos (str (first short))])
  39 + (if (and seed2 (not (empty? seed2)))
  40 + seed2
  41 + seed)
  42 + false))
  43 + :else
  44 + (recur short (rest full) (inc pos) chunk seed false)))]
  45 + (map reverse (step short full 0 [] () false))))
  46 +
  47 +(def *fuzzy-completion-symbol-prefixes* "*+-%&?<")
  48 +(def *fuzzy-completion-word-separators* "-/.")
  49 +(def *fuzzy-completion-symbol-suffixes* "*+->?!")
  50 +(defn- score-completion [completion short full]
  51 + (let [find1
  52 + (fn [c s]
  53 + (re-find (re-pattern (java.util.regex.Pattern/quote (str c))) s))
  54 + at-beginning? zero?
  55 + after-prefix?
  56 + (fn [pos]
  57 + (and (= pos 1)
  58 + (find1 (nth full 0) *fuzzy-completion-symbol-prefixes*)))
  59 + word-separator?
  60 + (fn [pos]
  61 + (find1 (nth full pos) *fuzzy-completion-word-separators*))
  62 + after-word-separator?
  63 + (fn [pos]
  64 + (find1 (nth full (dec pos)) *fuzzy-completion-word-separators*))
  65 + at-end?
  66 + (fn [pos]
  67 + (= pos (dec (count full))))
  68 + before-suffix?
  69 + (fn [pos]
  70 + (and (= pos (- (count full) 2))
  71 + (find1 (nth full (dec (count full)))
  72 + *fuzzy-completion-symbol-suffixes*)))]
  73 + (letfn [(score-or-percentage-of-previous
  74 + [base-score pos chunk-pos]
  75 + (if (zero? chunk-pos)
  76 + base-score
  77 + (max base-score
  78 + (+ (* (score-char (dec pos) (dec chunk-pos)) 0.85)
  79 + (Math/pow 1.2 chunk-pos)))))
  80 + (score-char
  81 + [pos chunk-pos]
  82 + (score-or-percentage-of-previous
  83 + (cond (at-beginning? pos) 10
  84 + (after-prefix? pos) 10
  85 + (word-separator? pos) 1
  86 + (after-word-separator? pos) 8
  87 + (at-end? pos) 6
  88 + (before-suffix? pos) 6
  89 + :else 1)
  90 + pos chunk-pos))
  91 + (score-chunk
  92 + [chunk]
  93 + (let [chunk-len (count (second chunk))]
  94 + (apply +
  95 + (map score-char
  96 + (take chunk-len (iterate inc (first chunk)))
  97 + (reverse (take chunk-len
  98 + (iterate dec (dec chunk-len))))))))]
  99 + (let [chunk-scores (map score-chunk completion)
  100 + length-score (/ 10.0 (inc (- (count full) (count short))))]
  101 + [(+ (apply + chunk-scores) length-score)
  102 + (list (map list chunk-scores completion) length-score)]))))
  103 +
  104 +(defn- compute-highest-scoring-completion [short full]
  105 + (let [scored-results
  106 + (map (fn [result]
  107 + [(first (score-completion result short full))
  108 + result])
  109 + (compute-most-completions short full))
  110 + winner (first (sort (fn [[av _] [bv _]] (> av bv))
  111 + scored-results))]
  112 + [(second winner) (first winner)]))
  113 +
  114 +(defn- call-with-timeout [time-limit-in-msec proc]
  115 + "Create a thunk that returns true if given time-limit-in-msec has been
  116 + elapsed and calls proc with the thunk as an argument. Returns a 3 elements
  117 + vec: A proc result, given time-limit-in-msec has been elapsed or not,
  118 + elapsed time in millisecond."
  119 + (let [timed-out (atom false)
  120 + start! (fn []
  121 + (future (do
  122 + (Thread/sleep time-limit-in-msec)
  123 + (swap! timed-out (constantly true)))))
  124 + timed-out? (fn [] @timed-out)
  125 + started-at (System/nanoTime)]
  126 + (start!)
  127 + [(proc timed-out?)
  128 + @timed-out
  129 + (/ (double (- (System/nanoTime) started-at)) 1000000.0)]))
  130 +
  131 +(defmacro with-timeout
  132 + "Create a thunk that returns true if given time-limit-in-msec has been
  133 + elapsed and bind it to timed-out?. Then execute body."
  134 + #^{:private true}
  135 + [[timed-out? time-limit-in-msec] & body]
  136 + `(call-with-timeout ~time-limit-in-msec (fn [~timed-out?] ~@body)))
  137 +
  138 +(defstruct fuzzy-matching
  139 + :var :ns :symbol :ns-name :score :ns-chunks :var-chunks)
  140 +
  141 +(defn- fuzzy-extract-matching-info [matching string]
  142 + (let [[user-ns-name _] (symbol-name-parts string)]
  143 + (cond
  144 + (:var matching)
  145 + [(str (:symbol matching))
  146 + (cond (nil? user-ns-name) nil
  147 + :else (:ns-name matching))]
  148 + :else
  149 + [""
  150 + (str (:symbol matching))])))
  151 +
  152 +(defn- fuzzy-find-matching-vars
  153 + [string ns var-filter external-only?]
  154 + (let [compute (partial compute-highest-scoring-completion string)
  155 + ns-maps (cond
  156 + external-only? ns-publics
  157 + (= ns *ns*) ns-map
  158 + :else ns-interns)]
  159 + (map (fn [[match-result score var sym]]
  160 + (if (var? var)
  161 + (struct fuzzy-matching
  162 + var nil (or (:name ^var)
  163 + (symbol (pr-str var)))
  164 + nil
  165 + score nil match-result)
  166 + (struct fuzzy-matching
  167 + nil nil sym
  168 + nil
  169 + score nil match-result)))
  170 + (filter (fn [[match-result & _]]
  171 + (or (= string "")
  172 + (not-empty match-result)))
  173 + (map (fn [[k v]]
  174 + (if (= string "")
  175 + (conj [nil 0.0] v k)
  176 + (conj (compute (.toLowerCase (str k))) v k)))
  177 + (filter var-filter (seq (ns-maps ns))))))))
  178 +(defn- fuzzy-find-matching-nss
  179 + [string]
  180 + (let [compute (partial compute-highest-scoring-completion string)]
  181 + (map (fn [[match-result score ns ns-sym]]
  182 + (struct fuzzy-matching nil ns ns-sym (str ns-sym)
  183 + score match-result nil))
  184 + (filter (fn [[match-result & _]] (not-empty match-result))
  185 + (map (fn [[ns-sym ns]]
  186 + (conj (compute (str ns-sym)) ns ns-sym))
  187 + (concat
  188 + (map (fn [ns] [(symbol (str ns)) ns]) (all-ns))
  189 + (ns-aliases *ns*)))))))
  190 +
  191 +(defn- fuzzy-generate-matchings
  192 + [string default-ns timed-out?]
  193 + (let [take* (partial take-while (fn [_] (not (timed-out?))))
  194 + [parsed-ns-name parsed-symbol-name] (symbol-name-parts string)
  195 + find-vars
  196 + (fn find-vars
  197 + ([designator ns]
  198 + (find-vars designator ns identity))
  199 + ([designator ns var-filter]
  200 + (find-vars designator ns var-filter nil))
  201 + ([designator ns var-filter external-only?]
  202 + (take* (fuzzy-find-matching-vars designator
  203 + ns
  204 + var-filter
  205 + external-only?))))
  206 + find-nss (comp take* fuzzy-find-matching-nss)
  207 + make-duplicate-var-filter
  208 + (fn [fuzzy-ns-matchings]
  209 + (let [nss (set (map :ns-name fuzzy-ns-matchings))]
  210 + (comp not nss str :ns meta second)))
  211 + matching-greater
  212 + (fn [a b]
  213 + (cond
  214 + (> (:score a) (:score b)) -1
  215 + (< (:score a) (:score b)) 1
  216 + :else (compare (:symbol a) (:symbol b))))
  217 + fix-up
  218 + (fn [matchings parent-package-matching]
  219 + (map (fn [m]
  220 + (assoc m
  221 + :ns-name (:ns-name parent-package-matching)
  222 + :ns-chunks (:ns-chunks parent-package-matching)
  223 + :score (if (= parsed-ns-name "")
  224 + (/ (:score parent-package-matching) 100)
  225 + (+ (:score parent-package-matching)
  226 + (:score m)))))
  227 + matchings))]
  228 + (sort matching-greater
  229 + (cond
  230 + (nil? parsed-ns-name)
  231 + (concat
  232 + (find-vars parsed-symbol-name (maybe-ns default-ns))
  233 + (find-nss parsed-symbol-name))
  234 + ;; (apply concat
  235 + ;; (let [ns *ns*]
  236 + ;; (pcalls #(binding [*ns* ns]
  237 + ;; (find-vars parsed-symbol-name
  238 + ;; (maybe-ns default-ns)))
  239 + ;; #(binding [*ns* ns]
  240 + ;; (find-nss parsed-symbol-name)))))
  241 + (= "" parsed-ns-name)
  242 + (find-vars parsed-symbol-name (maybe-ns default-ns))
  243 + :else
  244 + (let [found-nss (find-nss parsed-ns-name)
  245 + find-vars1 (fn [ns-matching]
  246 + (fix-up
  247 + (find-vars parsed-symbol-name
  248 + (:ns ns-matching)
  249 + (make-duplicate-var-filter
  250 + (filter (partial = ns-matching)
  251 + found-nss))
  252 + true)
  253 + ns-matching))]
  254 + (concat
  255 + (apply concat
  256 + (map find-vars1 (sort matching-greater found-nss)))
  257 + found-nss))))))
  258 +
  259 +(defn- fuzzy-format-matching [string matching]
  260 + (let [[symbol package] (fuzzy-extract-matching-info matching string)
  261 + result (str package (when package "/") symbol)]
  262 + [result (.indexOf #^String result #^String symbol)]))
  263 +
  264 +(defn- classify-matching [m]
  265 + (let [make-var-meta (fn [m]
  266 + (fn [key]
  267 + (when-let [var (:var m)]
  268 + (when-let [var-meta ^var]
  269 + (get var-meta key)))))
  270 + vm (make-var-meta m)]
  271 + (set
  272 + (filter
  273 + identity
  274 + [(when-not (or (vm :macro) (vm :arglists))
  275 + :boundp)
  276 + (when (vm :arglists) :fboundp)
  277 + ;; (:typespec)
  278 + ;; (:class)
  279 + (when (vm :macro) :macro)
  280 + (when (special-symbol? (:symbol m)) :special-operator)
  281 + (when (:ns-name m) :package)
  282 + (when (= clojure.lang.MultiFn (vm :tag))
  283 + :generic-function)]))))
  284 +(defn- classification->string [flags]
  285 + (format (apply str (replicate 8 "%s"))
  286 + (if (or (:boundp flags)
  287 + (:constant flags)) "b" "-")
  288 + (if (:fboundp flags) "f" "-")
  289 + (if (:generic-function flags) "g" "-")
  290 + (if (:class flags) "c" "-")
  291 + (if (:typespec flags) "t" "-")
  292 + (if (:macro flags) "m" "-")
  293 + (if (:special-operator flags) "s" "-")
  294 + (if (:package flags) "p" "-")))
  295 +
  296 +(defn- fuzzy-convert-matching-for-emacs [string matching]
  297 + (let [[name added-length] (fuzzy-format-matching string matching)]
  298 + [name
  299 + (format "%.2f" (:score matching))
  300 + (concat (:ns-chunks matching)
  301 + (map (fn [[offset string]] [(+ added-length offset) string])
  302 + (:var-chunks matching)))
  303 + (classification->string (classify-matching matching))
  304 + ]))
  305 +
  306 +(defn- fuzzy-completion-set
  307 + [string default-ns limit time-limit-in-msec]
  308 + (let [[matchings interrupted? _]
  309 + (with-timeout [timed-out? time-limit-in-msec]
  310 + (vec (fuzzy-generate-matchings string default-ns timed-out?)))
  311 + subvec1 (if (and limit
  312 + (> limit 0)
  313 + (< limit (count matchings)))
  314 + (fn [v] (subvec v 0 limit))
  315 + identity)]
  316 + [(subvec1 (vec (map (partial fuzzy-convert-matching-for-emacs string)
  317 + matchings)))
  318 + interrupted?]))
  319 +
  320 +(defslimefn fuzzy-completions
  321 + [string default-package-name
  322 + _limit limit _time-limit-in-msec time-limit-in-msec]
  323 + (let [[xs x] (fuzzy-completion-set string default-package-name
  324 + limit time-limit-in-msec)]
  325 + (list
  326 + (map (fn [[symbol score chunks class]]
  327 + (list symbol score (map (partial apply list) chunks) class))
  328 + xs)
  329 + (when x 't))))
  330 +
  331 +(defslimefn fuzzy-completion-selected [_ _] nil)
  332 +
  333 +(comment
  334 + (do
  335 + (use '[clojure.test])
  336 +
  337 + (is (= '(([0 "m"] [9 "v"] [15 "b"]))
  338 + (compute-most-completions "mvb" "multiple-value-bind")))
  339 + (is (= '(([0 "zz"]) ([0 "z"] [2 "z"]) ([1 "zz"]))
  340 + (compute-most-completions "zz" "zzz")))
  341 + (is (= 103
  342 + (binding [*fuzzy-recursion-soft-limit* 2]
  343 + (count
  344 + (compute-most-completions "ZZZZZZ" "ZZZZZZZZZZZZZZZZZZZZZZZ")))))
  345 +
  346 + (are [x p s] (= x (score-completion [[p s]] s "*multiple-value+"))
  347 + '[10.625 (((10 [0 "*"])) 0.625)] 0 "*" ;; at-beginning
  348 + '[10.625 (((10 [1 "m"])) 0.625)] 1 "m" ;; after-prefix
  349 + '[1.625 (((1 [9 "-"])) 0.625)] 9 "-" ;; word-sep
  350 + '[8.625 (((8 [10 "v"])) 0.625)] 10 "v" ;; after-word-sep
  351 + '[6.625 (((6 [15 "+"])) 0.625)] 15 "+" ;; at-end
  352 + '[6.625 (((6 [14 "e"])) 0.625)] 14 "e" ;; before-suffix
  353 + '[1.625 (((1 [2 "u"])) 0.625)] 2 "u" ;; other
  354 + )
  355 + (is (= (+ 10 ;; m's score
  356 + (+ (* 10 0.85) (Math/pow 1.2 1))) ;; u's score
  357 + (let [[_ x]
  358 + (score-completion [[1 "mu"]] "mu" "*multiple-value+")]
  359 + ((comp first ffirst) x)))
  360 + "`m''s score + `u''s score (percentage of previous which is 'm''s)")
  361 +
  362 + (is (= '[([0 "zz"]) 24.7]
  363 + (compute-highest-scoring-completion "zz" "zzz")))
  364 +
  365 + (are [to? ret to proc] (= [ret to?]
  366 + (let [[x y _] (call-with-timeout to proc)]
  367 + [x y]))
  368 + false "r" 10 (fn [_] "r")
  369 + true nil 1 (fn [_] (Thread/sleep 10) nil))
  370 +
  371 + (are [symbol package input] (= [symbol package]
  372 + (fuzzy-extract-matching-info
  373 + (struct fuzzy-matching
  374 + true nil
  375 + "symbol" "ns-name"
  376 + nil nil nil)
  377 + input))
  378 + "symbol" "ns-name" "p/*"
  379 + "symbol" nil "*")
  380 + (is (= ["" "ns-name"]
  381 + (fuzzy-extract-matching-info
  382 + (struct fuzzy-matching
  383 + nil nil
  384 + "ns-name" ""
  385 + nil nil nil)
  386 + "")))
  387 +
  388 + (defmacro try! #^{:private true}
  389 + [& body]
  390 + `(do
  391 + ~@(map (fn [x] `(try ~x (catch Throwable ~'_ nil)))
  392 + body)))
  393 +
  394 + (try
  395 + (def testing-testing0 't)
  396 + (def #^{:private true} testing-testing1 't)
  397 + (are [x external-only?] (= x
  398 + (vec
  399 + (sort
  400 + (map (comp str :symbol)
  401 + (fuzzy-find-matching-vars
  402 + "testing" *ns*
  403 + (fn [[k v]]
  404 + (and (= ((comp :ns meta) v) *ns*)
  405 + (re-find #"^testing-"
  406 + (str k))))
  407 + external-only?)))))
  408 + ["testing-testing0" "testing-testing1"] nil
  409 + ["testing-testing0"] true)
  410 + (finally
  411 + (try!
  412 + (ns-unmap *ns* 'testing-testing0)
  413 + (ns-unmap *ns* 'testing-testing1))))
  414 +
  415 + (try
  416 + (create-ns 'testing-testing0)
  417 + (create-ns 'testing-testing1)
  418 + (is (= '["testing-testing0" "testing-testing1"]
  419 + (vec
  420 + (sort
  421 + (map (comp str :symbol)
  422 + (fuzzy-find-matching-nss "testing-"))))))
  423 + (finally
  424 + (try!
  425 + (remove-ns 'testing-testing0)
  426 + (remove-ns 'testing-testing1))))
  427 + )
  428 + )
3  swank/swank.clj
@@ -14,7 +14,8 @@
14 14 (swank.util.concurrent thread))
15 15 (:require (swank.util.concurrent [mbox :as mb])
16 16 (swank commands)
17   - (swank.commands basic indent contrib inspector import)))
  17 + (swank.commands basic indent completion
  18 + contrib inspector import)))
18 19
19 20 (defn ignore-protocol-version [version]
20 21 (dosync (ref-set *protocol-version* version)))
13 swank/util/java.clj
... ... @@ -0,0 +1,13 @@
  1 +(ns swank.util.java)
  2 +
  3 +(defn method-name [#^java.lang.reflect.Method method]
  4 + (.getName method))
  5 +
  6 +(defn method-static? [#^java.lang.reflect.Method method]
  7 + (java.lang.reflect.Modifier/isStatic (.getModifiers method)))
  8 +
  9 +(defn static-methods [#^Class class]
  10 + (filter method-static? (.getMethods class)))
  11 +
  12 +(defn instance-methods [#^Class class]
  13 + (remove method-static? (.getMethods class)))

0 comments on commit 6d3c19b

Please sign in to comment.
Something went wrong with that request. Please try again.