This repository has been archived by the owner on Jan 23, 2018. It is now read-only.
forked from jochu/swank-clojure
-
Notifications
You must be signed in to change notification settings - Fork 83
/
swank.clj
110 lines (102 loc) · 3.92 KB
/
swank.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
(ns swank.swank
(:use [swank core util]
[swank.core connection server]
[swank.util.concurrent thread]
[swank.util.net sockets]
[swank.commands.basic :only [get-thread-list]]
[clojure.main :only [repl]])
(:require [swank.commands]
[swank.commands basic indent completion
contrib inspector])
(:import [java.lang System Thread]
[java.io File])
(:gen-class))
(def current-server (atom nil))
(defn ignore-protocol-version [version]
(reset! protocol-version version))
(defn- connection-serve [conn]
(let [#^Thread control
(dothread-swank
(thread-set-name "Swank Control Thread")
(try
(control-loop conn)
(catch Exception e
(when-not @shutting-down?
(.println System/err "exception in control loop")
(.printStackTrace e))
nil))
(close-socket! (conn :socket)))
read
(dothread-swank
(thread-set-name "Swank Read Loop Thread")
(try
(read-loop conn control)
(catch Exception e
;; This could be put somewhere better
(when-not @shutting-down?
(.println System/err "exception in read loop")
(.printStackTrace e)
(.interrupt control)
(dosync (alter connections (partial remove #{conn})))))))]
(dosync
(ref-set (conn :control-thread) control)
(ref-set (conn :read-thread) read))))
(defn load-cdt-with-dynamic-classloader []
;; cdt requires a dynamic classloader for tools.jar add-classpath
;; lein swank doesn't seem to provide one. Loading the backend
;; like this works around that problem.
(.start (Thread. #(do (use 'swank.core.cdt-backends)
(eval '(cdt-backend-init))))))
(defn start-server
"Start the server and write the listen port number to
PORT-FILE. This is the entry point for Emacs."
[& opts]
(if @current-server
(println System/err "Swank server already running")
(do
(reset! shutting-down? false)
(let [opts (apply hash-map opts)]
(reset! color-support? (:colors? opts false))
(reset! exit-on-quit? (:exit-on-quit opts true))
(when (:load-cdt-on-startup opts)
(load-cdt-with-dynamic-classloader))
(reset! current-server
(setup-server (get opts :port 0)
simple-announce
connection-serve
opts))
(when (:block opts)
(doseq [#^Thread t (get-thread-list)]
(.join t)))))))
(defn stop-server
"Stop the currently running server, shutdown its threads, and release the port."
[]
(if @current-server
(do
(reset! shutting-down? true)
(doseq [c @connections]
(doseq [t [:control-thread :read-thread :repl-thread]]
(when-let [^Thread thread @(c t)]
(.interrupt thread))))
(close-server-socket! @current-server)
(dosync (ref-set connections []))
(reset! current-server nil))
(println System/err "Swank server not running")))
(defn start-repl
"Start the server wrapped in a repl. Use this to embed swank in your code."
([port & opts]
(let [stop (atom false)
port (if (string? port) (Integer/parseInt port) (int port))
opts (assoc (apply hash-map opts) :port port)]
(repl :read (fn [rprompt rexit]
(if @stop rexit
(do (reset! stop true)
`(start-server ~@(apply concat opts)))))
:need-prompt (constantly false))))
([] (start-repl (or (System/getenv "PORT") 4005))))
(defn -main [port & opts]
(apply start-server
(for [a (concat [":port" port] opts)]
(cond (re-find #"^\d+$" a) (Integer/parseInt a)
(re-find #"^:\w+$" a) (keyword (subs a 1))
:else a))))