Add support for Scheme and Racket language.

sources_non_forked/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)))))

sources_non_forked/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))) 

sources_non_forked/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 []
+  )

sources_non_forked/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))

sources_non_forked/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)))

sources_non_forked/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})

sources_non_forked/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)))

sources_non_forked/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)))

sources_non_forked/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))))

sources_non_forked/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"))