1 files changed, 159 insertions, 0 deletions
diff --git a/vim/bundle/slimv/swank-clojure/swank/rpc.clj b/vim/bundle/slimv/swank-clojure/swank/rpc.clj
new file mode 100644
index 0000000..5f40a57
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/rpc.clj
@@ -0,0 +1,159 @@
+;;; This code has been placed in the Public Domain.  All warranties are disclaimed.
+(ns #^{:doc "Pass remote calls and responses between lisp systems using the swank-rpc protocol."
+       :author "Terje Norderhaug <terje@in-progress.com>"}
+  swank.rpc
+  (:use (swank util)
+        (swank.util io))
+  (:import (java.io Writer Reader PushbackReader StringReader)))
+
+;; ERROR HANDLING
+
+(def swank-protocol-error (Exception. "Swank protocol error."))
+
+;; LOGGING
+
+(def log-events false)
+
+(def log-output nil)
+
+(defn log-event [format-string & args]
+  (when log-events
+    (.write (or log-output *out*) (apply format format-string args))
+    (.flush (or log-output *out*))
+    nil))
+
+;; INPUT
+
+(defn- read-form
+   "Read a form that conforms to the swank rpc protocol"
+  ([#^Reader rdr]
+    (let [c (.read rdr)]
+      (condp = (char c)
+          \" (let [sb (StringBuilder.)]
+               (loop []
+                (let [c (.read rdr)]
+                 (if (= c -1)
+                   (throw (java.io.EOFException. "Incomplete reading of quoted string."))
+                   (condp = (char c)
+                     \" (str sb)
+                     \\ (do (.append sb (char (.read rdr)))
+                            (recur))
+                    (do (.append sb (char c))
+                        (recur)))))))
+          \( (loop [result []]
+               (let [form (read-form rdr)]
+                     (let [c (.read rdr)]
+                       (if (= c -1)
+                         (throw (java.io.EOFException. "Incomplete reading of list."))
+                         (condp = (char c)
+                           \) (sequence (conj result form))
+                           \space (recur (conj result form)))))))
+          \' (list 'quote (read-form rdr))
+          (let [sb (StringBuilder.)]
+            (loop [c c]
+              (if (not= c -1)
+                (condp = (char c)
+                  \\ (do (.append sb (char (.read rdr)))
+                         (recur (.read rdr)))
+                  \space (.unread rdr c)
+                  \) (.unread rdr c)
+                  (do (.append sb (char c))
+                      (recur (.read rdr))))))
+            (let [str (str sb)]
+              (cond
+                (. Character isDigit c) (Integer/parseInt str)
+                (= "nil" str) nil
+                (= "t" str) true
+                :else (symbol str))))))))
+
+(defn- read-packet
+  ([#^Reader reader]
+     (let [len (Integer/parseInt (read-chars reader 6 swank-protocol-error) 16)]
+       (read-chars reader len swank-protocol-error))))
+
+(defn decode-message
+   "Read an rpc message encoded using the swank rpc protocol."
+  ([#^Reader rdr]
+    (let [packet (read-packet rdr)]
+       (log-event "READ: %s\n" packet)
+       (try
+         (with-open [rdr (PushbackReader. (StringReader. packet))]
+           (read-form rdr))
+         (catch Exception e
+           (list :reader-error packet e))))))
+
+; (with-open [rdr (StringReader. "00001f(swank:a 123 (%b% (t nil) \"c\"))")] (decode-message rdr))
+
+
+;; OUTPUT
+
+(defmulti print-object (fn [x writer] (type x)))
+
+(defmethod print-object :default [o, #^Writer w]
+  (print-method o w))
+
+(defmethod print-object Boolean [o, #^Writer w]
+  (.write w (if o "t" "nil")))
+
+(defmethod print-object String [#^String s, #^Writer w]
+  (let [char-escape-string {\" "\\\""
+                            \\  "\\\\"}]
+    (do (.append w \")
+      (dotimes [n (count s)]
+        (let [c (.charAt s n)
+              e (char-escape-string c)]
+          (if e (.write w e) (.append w c))))
+      (.append w \"))
+  nil))
+
+(defmethod print-object clojure.lang.ISeq [o, #^Writer w]
+  (.write w "(")
+  (print-object (first o) w)
+  (doseq [item (rest o)]
+    (.write w " ")
+    (print-object item w))
+  (.write w ")"))
+
+(defn- write-form
+  ([#^Writer writer message]
+    (print-object message writer)))
+
+(defn- write-packet
+  ([#^Writer writer str]
+   (let [len (.length str)]
+    (doto writer
+          (.write (format "%06x" len))
+          (.write str)
+          (.flush)))))
+
+(defn encode-message
+  "Write an rpc message encoded using the swank rpc protocol."
+  ([#^Writer writer message]
+     (let [str (with-out-str
+                  (write-form *out* message)) ]
+       (log-event "WRITE: %s\n" str)
+       (write-packet writer str))))
+
+; (with-out-str (encode-message *out* "hello"))
+; (with-out-str (encode-message *out* '(a 123 (swank:b (true false) "c"))))
+
+
+;; DISPATCH
+
+(defonce rpc-fn-map {})
+
+(defn register-dispatch
+  ([name fn]
+    (register-dispatch name fn #'rpc-fn-map))
+  ([name fn fn-map]
+    (alter-var-root fn-map assoc name fn)))
+
+(defn dispatch-message
+  ([message fn-map]
+    (let [operation (first message)
+          operands (rest message)
+          fn (fn-map operation)]
+        (assert fn)
+        (apply fn operands)))
+  ([message]
+   (dispatch-message message rpc-fn-map)))