diff options
Diffstat (limited to 'vim/bundle/slimv/swank-clojure/swank/util')
10 files changed, 417 insertions, 0 deletions
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")) |