summaryrefslogtreecommitdiff
path: root/vim/bundle/slimv/swank-clojure/swank/core
diff options
context:
space:
mode:
authorNick Shipp <nick@shipp.ninja>2017-05-07 09:04:01 -0400
committerNick Shipp <nick@shipp.ninja>2017-05-07 09:04:01 -0400
commitc012f55efda29f09179e921cf148d79deb57616e (patch)
treeff0ad37f22622d51194cab192a2aa4b0106d7ad0 /vim/bundle/slimv/swank-clojure/swank/core
parent4ca8f6608883d230131f8a9e8b6d6c091c516049 (diff)
Much maturering of vim configs
Diffstat (limited to 'vim/bundle/slimv/swank-clojure/swank/core')
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/connection.clj68
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/hooks.clj4
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/protocol.clj50
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/server.clj102
-rw-r--r--vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj29
5 files changed, 253 insertions, 0 deletions
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/connection.clj b/vim/bundle/slimv/swank-clojure/swank/core/connection.clj
new file mode 100644
index 0000000..1b78bc6
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/connection.clj
@@ -0,0 +1,68 @@
+(ns swank.core.connection
+ (:use (swank util)
+ (swank.util sys)
+ (swank.core protocol))
+ (:import (java.net ServerSocket Socket InetAddress)
+ (java.io InputStreamReader OutputStreamWriter)))
+
+(def #^{:dynamic true} *current-connection*)
+(def default-encoding "iso-8859-1")
+
+(defmacro with-connection [conn & body]
+ `(binding [*current-connection* ~conn] ~@body))
+
+(def encoding-map
+ {"latin-1" "iso-8859-1"
+ "latin-1-unix" "iso-8859-1"
+ "iso-latin-1-unix" "iso-8859-1"
+ "iso-8859-1" "iso-8859-1"
+ "iso-8859-1-unix" "iso-8859-1"
+
+ "utf-8" "utf-8"
+ "utf-8-unix" "utf-8"
+
+ "euc-jp" "euc-jp"
+ "euc-jp-unix" "euc-jp"
+
+ "us-ascii" "us-ascii"
+ "us-ascii-unix" "us-ascii"})
+
+(defn make-connection ;; rename to make-swank-connection
+ "Given a `socket', creates a swank connection. Accepts an optional
+ argument `encoding' to define the encoding of the connection. If
+ encoding is nil, then the default encoding will be used.
+
+ See also: `default-encoding', `start-server-socket!'"
+ ([#^Socket socket] (make-connection socket default-encoding))
+ ([#^Socket socket encoding]
+ (let [#^String
+ encoding (or (encoding-map encoding encoding) default-encoding)]
+ {:socket socket
+ :reader (InputStreamReader. (.getInputStream socket) encoding)
+ :writer (OutputStreamWriter. (.getOutputStream socket) encoding)
+ :writer-redir (ref nil)
+
+ :indent-cache (ref {})
+ :indent-cache-pkg (ref nil)
+
+ :control-thread (ref nil)
+ :read-thread (ref nil)
+ :repl-thread (ref nil)})))
+
+(defn read-from-connection
+ "Reads a single message from a swank-connection.
+
+ See also: `write-to-connection', `read-swank-message',
+ `make-swank-connection'"
+ ([] (read-from-connection *current-connection*))
+ ([conn]
+ (read-swank-message (conn :reader))))
+
+(defn write-to-connection
+ "Writes a single message to a swank-connection.
+
+ See also: `read-from-connection', `write-swank-message',
+ `make-swank-connection'"
+ ([msg] (write-to-connection *current-connection* msg))
+ ([conn msg]
+ (write-swank-message (conn :writer) msg)))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj b/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
new file mode 100644
index 0000000..93b5963
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/hooks.clj
@@ -0,0 +1,4 @@
+(ns swank.core.hooks
+ (:use (swank.util hooks)))
+
+(defhook pre-reply-hook) \ No newline at end of file
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj b/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
new file mode 100644
index 0000000..409d189
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/protocol.clj
@@ -0,0 +1,50 @@
+(ns swank.core.protocol
+ (:use (swank util)
+ (swank.util io))
+ (:require swank.rpc))
+
+;; Read forms
+(def #^{:private true}
+ namespace-re #"(^\(:emacs-rex \([a-zA-Z][a-zA-Z0-9]+):")
+
+(defn- fix-namespace
+ "Changes the namespace of a function call from pkg:fn to ns/fn. If
+ no pkg exists, then nothing is done."
+ ([text] (.replaceAll (re-matcher namespace-re text) "$1/")))
+
+(defn write-swank-message
+ "Given a `writer' (java.io.Writer) and a `message' (typically an
+ sexp), encode the message according to the swank protocol and
+ write the message into the writer."
+ ([#^java.io.Writer writer message]
+ (swank.rpc/encode-message writer message))
+ {:tag String})
+
+(def read-fail-exception (Exception. "Error reading swank message"))
+
+(defn read-swank-message
+ "Given a `reader' (java.io.Reader), read the message as a clojure
+ form (typically a sexp). This method will block until a message is
+ completely transfered.
+
+ Note: This function will do some amount of Common Lisp -> clojure
+ conversions. This is due to the fact that several slime functions
+ like to treat everything it's talking to as a common lisp
+ implementation.
+ - If an :emacs-rex form is received and the first form contains a
+ common lisp package designation, this will convert it to use a
+ clojure designation.
+ - t will be converted to true
+
+ See also `write-swank-message'."
+ ([#^java.io.Reader reader]
+ (let [len (Integer/parseInt (read-chars reader 6 read-fail-exception) 16)
+ msg (read-chars reader len read-fail-exception)
+ form (try
+ (read-string (fix-namespace msg))
+ (catch Exception ex
+ (.println System/err (format "unreadable message: %s" msg))
+ (throw ex)))]
+ (if (seq? form)
+ (deep-replace {'t true} form)
+ form))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/server.clj b/vim/bundle/slimv/swank-clojure/swank/core/server.clj
new file mode 100644
index 0000000..1c9f70a
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/server.clj
@@ -0,0 +1,102 @@
+(ns swank.core.server
+ (:use (swank util core)
+ (swank.util sys io)
+ (swank.util.concurrent thread)
+ (swank.util.net sockets)
+ (swank.core connection protocol))
+ (:import (java.io File FileReader BufferedReader InputStreamReader OutputStreamWriter)
+ (java.net Socket)))
+
+;; The swank.core.server is the layer above swank.util.net.sockets
+;; - Manages the socket server
+;; - Accepts and authenticates incoming connections
+;; - Creates swank.core.connections
+;; - Spins up new threads
+
+(defonce connections (ref []))
+
+(def slime-secret-path (str (user-home-path) File/separator ".slime-secret"))
+
+(defn- slime-secret
+ "Returns the first line from the slime-secret file, path found in
+ slime-secret-path (default: .slime-secret in the user's home
+ directory).
+
+ See also: `accept-authenticated-connection'"
+ ([] (failing-gracefully
+ (let [slime-secret-file (File. (str (user-home-path) File/separator ".slime-secret"))]
+ (when (and (.isFile slime-secret-file) (.canRead slime-secret-file))
+ (with-open [secret (BufferedReader. (FileReader. slime-secret-file))]
+ (.readLine secret)))))))
+
+(defn- accept-authenticated-connection ;; rename to authenticate-socket, takes in a connection
+ "Accepts and returns new connection if it is from an authenticated
+ machine. Otherwise, return nil.
+
+ Authentication depends on the contents of a slime-secret file on
+ both the server (swank) and the client (emacs slime). If no
+ slime-secret file is provided on the server side, all connections
+ are accepted.
+
+ See also: `slime-secret'"
+ ([#^Socket socket opts]
+ (returning [conn (make-connection socket (get opts :encoding default-encoding))]
+ (if-let [secret (slime-secret)]
+ (when-not (= (read-from-connection conn) secret)
+ (close-socket! socket))
+ conn))))
+
+(defn- make-output-redirection
+ ([conn]
+ (call-on-flush-stream
+ #(with-connection conn
+ (send-to-emacs `(:write-string ~%)))))
+ {:tag java.io.StringWriter})
+
+(defn- socket-serve [connection-serve socket opts]
+ (with-connection (accept-authenticated-connection socket opts)
+ (let [out-redir (java.io.PrintWriter. (make-output-redirection
+ *current-connection*))]
+ (binding [*out* out-redir
+ *err* out-redir]
+ (dosync (ref-set (*current-connection* :writer-redir) *out*))
+ (dosync (alter connections conj *current-connection*))
+ (connection-serve *current-connection*)))))
+
+;; Setup frontent
+(defn start-swank-socket-server!
+ "Starts and returns the socket server as a swank host. Takes an
+ optional set of options as a map:
+
+ :announce - an fn that will be called and provided with the
+ listening port of the newly established server. Default: none."
+ ([server connection-serve] (start-swank-socket-server! connection-serve {}))
+ ([server connection-serve options]
+ (start-server-socket! server connection-serve)
+ (when-let [announce (options :announce)]
+ (announce (.getLocalPort server)))
+ server))
+
+(defn setup-server
+ "The port it started on will be called as an argument to (announce-fn
+ port). A connection will then be created and (connection-serve conn)
+ will then be called."
+ [port announce-fn connection-serve opts]
+ (start-swank-socket-server!
+ (make-server-socket {:port port
+ :host (opts :host "localhost")
+ :backlog (opts :backlog 0)})
+ #(socket-serve connection-serve % opts)
+ {:announce announce-fn}))
+
+;; Announcement functions
+(defn simple-announce [port]
+ (println "Connection opened on local port " port))
+
+(defn announce-port-to-file
+ "Writes the given port number into a file."
+ ([#^String file port]
+ (with-open [out (new java.io.FileWriter file)]
+ (doto out
+ (.write (str port "\n"))
+ (.flush)))))
diff --git a/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj b/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
new file mode 100644
index 0000000..246a3d2
--- /dev/null
+++ b/vim/bundle/slimv/swank-clojure/swank/core/threadmap.clj
@@ -0,0 +1,29 @@
+(ns swank.core.threadmap
+ (:use (swank util)
+ (swank.util.concurrent thread)))
+
+(defonce thread-map-next-id (ref 1))
+(defonce thread-map (ref {}))
+
+(defn- thread-map-clean []
+ (doseq [[id t] @thread-map]
+ (when (or (nil? t)
+ (not (thread-alive? t)))
+ (dosync
+ (alter thread-map dissoc id)))))
+
+(defn- get-thread-id [thread]
+ (if-let [entry (find-first #(= (val %) thread) @thread-map)]
+ (key entry)
+ (let [next-id @thread-map-next-id]
+ (alter thread-map assoc next-id thread)
+ (alter thread-map-next-id inc)
+ next-id)))
+
+(defn thread-map-id [thread]
+ (returning [id (dosync (get-thread-id thread))]
+ (thread-map-clean)))
+
+(defn find-thread [id]
+ (@thread-map id))
+