|
rlm@10
|
1 ;; Copyright (c) Rich Hickey All rights reserved. The use and
|
|
rlm@10
|
2 ;; distribution terms for this software are covered by the Eclipse Public
|
|
rlm@10
|
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found
|
|
rlm@10
|
4 ;; in the file epl-v10.html at the root of this distribution. By using this
|
|
rlm@10
|
5 ;; software in any fashion, you are agreeing to be bound by the terms of
|
|
rlm@10
|
6 ;; this license. You must not remove this notice, or any other, from this
|
|
rlm@10
|
7 ;; software.
|
|
rlm@10
|
8
|
|
rlm@10
|
9 ;; Originally contributed by Stephen C. Gilardi
|
|
rlm@10
|
10
|
|
rlm@10
|
11 (ns ^{:doc "Top-level main function for Clojure REPL and scripts."
|
|
rlm@10
|
12 :author "Stephen C. Gilardi and Rich Hickey"}
|
|
rlm@10
|
13 clojure.main
|
|
rlm@10
|
14 (:refer-clojure :exclude [with-bindings])
|
|
rlm@10
|
15 (:import (clojure.lang Compiler Compiler$CompilerException
|
|
rlm@10
|
16 LineNumberingPushbackReader RT)))
|
|
rlm@10
|
17
|
|
rlm@10
|
18 (declare main)
|
|
rlm@10
|
19
|
|
rlm@10
|
20 (defmacro with-bindings
|
|
rlm@10
|
21 "Executes body in the context of thread-local bindings for several vars
|
|
rlm@10
|
22 that often need to be set!: *ns* *warn-on-reflection* *math-context*
|
|
rlm@10
|
23 *print-meta* *print-length* *print-level* *compile-path*
|
|
rlm@10
|
24 *command-line-args* *1 *2 *3 *e"
|
|
rlm@10
|
25 [& body]
|
|
rlm@10
|
26 `(binding [*ns* *ns*
|
|
rlm@10
|
27 *warn-on-reflection* *warn-on-reflection*
|
|
rlm@10
|
28 *math-context* *math-context*
|
|
rlm@10
|
29 *print-meta* *print-meta*
|
|
rlm@10
|
30 *print-length* *print-length*
|
|
rlm@10
|
31 *print-level* *print-level*
|
|
rlm@10
|
32 *compile-path* (System/getProperty "clojure.compile.path" "classes")
|
|
rlm@10
|
33 *command-line-args* *command-line-args*
|
|
rlm@10
|
34 *assert* *assert*
|
|
rlm@10
|
35 *1 nil
|
|
rlm@10
|
36 *2 nil
|
|
rlm@10
|
37 *3 nil
|
|
rlm@10
|
38 *e nil]
|
|
rlm@10
|
39 ~@body))
|
|
rlm@10
|
40
|
|
rlm@10
|
41 (defn repl-prompt
|
|
rlm@10
|
42 "Default :prompt hook for repl"
|
|
rlm@10
|
43 []
|
|
rlm@10
|
44 (printf "%s=> " (ns-name *ns*)))
|
|
rlm@10
|
45
|
|
rlm@10
|
46 (defn skip-if-eol
|
|
rlm@10
|
47 "If the next character on stream s is a newline, skips it, otherwise
|
|
rlm@10
|
48 leaves the stream untouched. Returns :line-start, :stream-end, or :body
|
|
rlm@10
|
49 to indicate the relative location of the next character on s. The stream
|
|
rlm@10
|
50 must either be an instance of LineNumberingPushbackReader or duplicate
|
|
rlm@10
|
51 its behavior of both supporting .unread and collapsing all of CR, LF, and
|
|
rlm@10
|
52 CRLF to a single \\newline."
|
|
rlm@10
|
53 [s]
|
|
rlm@10
|
54 (let [c (.read s)]
|
|
rlm@10
|
55 (cond
|
|
rlm@10
|
56 (= c (int \newline)) :line-start
|
|
rlm@10
|
57 (= c -1) :stream-end
|
|
rlm@10
|
58 :else (do (.unread s c) :body))))
|
|
rlm@10
|
59
|
|
rlm@10
|
60 (defn skip-whitespace
|
|
rlm@10
|
61 "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
|
|
rlm@10
|
62 or :body to indicate the relative location of the next character on s.
|
|
rlm@10
|
63 Interprets comma as whitespace and semicolon as comment to end of line.
|
|
rlm@10
|
64 Does not interpret #! as comment to end of line because only one
|
|
rlm@10
|
65 character of lookahead is available. The stream must either be an
|
|
rlm@10
|
66 instance of LineNumberingPushbackReader or duplicate its behavior of both
|
|
rlm@10
|
67 supporting .unread and collapsing all of CR, LF, and CRLF to a single
|
|
rlm@10
|
68 \\newline."
|
|
rlm@10
|
69 [s]
|
|
rlm@10
|
70 (loop [c (.read s)]
|
|
rlm@10
|
71 (cond
|
|
rlm@10
|
72 (= c (int \newline)) :line-start
|
|
rlm@10
|
73 (= c -1) :stream-end
|
|
rlm@10
|
74 (= c (int \;)) (do (.readLine s) :line-start)
|
|
rlm@10
|
75 (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s))
|
|
rlm@10
|
76 :else (do (.unread s c) :body))))
|
|
rlm@10
|
77
|
|
rlm@10
|
78 (defn repl-read
|
|
rlm@10
|
79 "Default :read hook for repl. Reads from *in* which must either be an
|
|
rlm@10
|
80 instance of LineNumberingPushbackReader or duplicate its behavior of both
|
|
rlm@10
|
81 supporting .unread and collapsing all of CR, LF, and CRLF into a single
|
|
rlm@10
|
82 \\newline. repl-read:
|
|
rlm@10
|
83 - skips whitespace, then
|
|
rlm@10
|
84 - returns request-prompt on start of line, or
|
|
rlm@10
|
85 - returns request-exit on end of stream, or
|
|
rlm@10
|
86 - reads an object from the input stream, then
|
|
rlm@10
|
87 - skips the next input character if it's end of line, then
|
|
rlm@10
|
88 - returns the object."
|
|
rlm@10
|
89 [request-prompt request-exit]
|
|
rlm@10
|
90 (or ({:line-start request-prompt :stream-end request-exit}
|
|
rlm@10
|
91 (skip-whitespace *in*))
|
|
rlm@10
|
92 (let [input (read)]
|
|
rlm@10
|
93 (skip-if-eol *in*)
|
|
rlm@10
|
94 input)))
|
|
rlm@10
|
95
|
|
rlm@10
|
96 (defn- root-cause
|
|
rlm@10
|
97 "Returns the initial cause of an exception or error by peeling off all of
|
|
rlm@10
|
98 its wrappers"
|
|
rlm@10
|
99 [^Throwable throwable]
|
|
rlm@10
|
100 (loop [cause throwable]
|
|
rlm@10
|
101 (if-let [cause (.getCause cause)]
|
|
rlm@10
|
102 (recur cause)
|
|
rlm@10
|
103 cause)))
|
|
rlm@10
|
104
|
|
rlm@10
|
105 (defn repl-exception
|
|
rlm@10
|
106 "Returns CompilerExceptions in tact, but only the root cause of other
|
|
rlm@10
|
107 throwables"
|
|
rlm@10
|
108 [throwable]
|
|
rlm@10
|
109 (if (instance? Compiler$CompilerException throwable)
|
|
rlm@10
|
110 throwable
|
|
rlm@10
|
111 (root-cause throwable)))
|
|
rlm@10
|
112
|
|
rlm@10
|
113 (defn repl-caught
|
|
rlm@10
|
114 "Default :caught hook for repl"
|
|
rlm@10
|
115 [e]
|
|
rlm@10
|
116 (.println *err* (repl-exception e)))
|
|
rlm@10
|
117
|
|
rlm@10
|
118 (defn repl
|
|
rlm@10
|
119 "Generic, reusable, read-eval-print loop. By default, reads from *in*,
|
|
rlm@10
|
120 writes to *out*, and prints exception summaries to *err*. If you use the
|
|
rlm@10
|
121 default :read hook, *in* must either be an instance of
|
|
rlm@10
|
122 LineNumberingPushbackReader or duplicate its behavior of both supporting
|
|
rlm@10
|
123 .unread and collapsing CR, LF, and CRLF into a single \\newline. Options
|
|
rlm@10
|
124 are sequential keyword-value pairs. Available options and their defaults:
|
|
rlm@10
|
125
|
|
rlm@10
|
126 - :init, function of no arguments, initialization hook called with
|
|
rlm@10
|
127 bindings for set!-able vars in place.
|
|
rlm@10
|
128 default: #()
|
|
rlm@10
|
129
|
|
rlm@10
|
130 - :need-prompt, function of no arguments, called before each
|
|
rlm@10
|
131 read-eval-print except the first, the user will be prompted if it
|
|
rlm@10
|
132 returns true.
|
|
rlm@10
|
133 default: (if (instance? LineNumberingPushbackReader *in*)
|
|
rlm@10
|
134 #(.atLineStart *in*)
|
|
rlm@10
|
135 #(identity true))
|
|
rlm@10
|
136
|
|
rlm@10
|
137 - :prompt, function of no arguments, prompts for more input.
|
|
rlm@10
|
138 default: repl-prompt
|
|
rlm@10
|
139
|
|
rlm@10
|
140 - :flush, function of no arguments, flushes output
|
|
rlm@10
|
141 default: flush
|
|
rlm@10
|
142
|
|
rlm@10
|
143 - :read, function of two arguments, reads from *in*:
|
|
rlm@10
|
144 - returns its first argument to request a fresh prompt
|
|
rlm@10
|
145 - depending on need-prompt, this may cause the repl to prompt
|
|
rlm@10
|
146 before reading again
|
|
rlm@10
|
147 - returns its second argument to request an exit from the repl
|
|
rlm@10
|
148 - else returns the next object read from the input stream
|
|
rlm@10
|
149 default: repl-read
|
|
rlm@10
|
150
|
|
rlm@10
|
151 - :eval, funtion of one argument, returns the evaluation of its
|
|
rlm@10
|
152 argument
|
|
rlm@10
|
153 default: eval
|
|
rlm@10
|
154
|
|
rlm@10
|
155 - :print, function of one argument, prints its argument to the output
|
|
rlm@10
|
156 default: prn
|
|
rlm@10
|
157
|
|
rlm@10
|
158 - :caught, function of one argument, a throwable, called when
|
|
rlm@10
|
159 read, eval, or print throws an exception or error
|
|
rlm@10
|
160 default: repl-caught"
|
|
rlm@10
|
161 [& options]
|
|
rlm@10
|
162 (let [cl (.getContextClassLoader (Thread/currentThread))]
|
|
rlm@10
|
163 (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl)))
|
|
rlm@10
|
164 (let [{:keys [init need-prompt prompt flush read eval print caught]
|
|
rlm@10
|
165 :or {init #()
|
|
rlm@10
|
166 need-prompt (if (instance? LineNumberingPushbackReader *in*)
|
|
rlm@10
|
167 #(.atLineStart ^LineNumberingPushbackReader *in*)
|
|
rlm@10
|
168 #(identity true))
|
|
rlm@10
|
169 prompt repl-prompt
|
|
rlm@10
|
170 flush flush
|
|
rlm@10
|
171 read repl-read
|
|
rlm@10
|
172 eval eval
|
|
rlm@10
|
173 print prn
|
|
rlm@10
|
174 caught repl-caught}}
|
|
rlm@10
|
175 (apply hash-map options)
|
|
rlm@10
|
176 request-prompt (Object.)
|
|
rlm@10
|
177 request-exit (Object.)
|
|
rlm@10
|
178 read-eval-print
|
|
rlm@10
|
179 (fn []
|
|
rlm@10
|
180 (try
|
|
rlm@10
|
181 (let [input (read request-prompt request-exit)]
|
|
rlm@10
|
182 (or (#{request-prompt request-exit} input)
|
|
rlm@10
|
183 (let [value (eval input)]
|
|
rlm@10
|
184 (print value)
|
|
rlm@10
|
185 (set! *3 *2)
|
|
rlm@10
|
186 (set! *2 *1)
|
|
rlm@10
|
187 (set! *1 value))))
|
|
rlm@10
|
188 (catch Throwable e
|
|
rlm@10
|
189 (caught e)
|
|
rlm@10
|
190 (set! *e e))))]
|
|
rlm@10
|
191 (with-bindings
|
|
rlm@10
|
192 (try
|
|
rlm@10
|
193 (init)
|
|
rlm@10
|
194 (catch Throwable e
|
|
rlm@10
|
195 (caught e)
|
|
rlm@10
|
196 (set! *e e)))
|
|
rlm@10
|
197 (use '[clojure.repl :only (source apropos dir)])
|
|
rlm@10
|
198 (use '[clojure.java.javadoc :only (javadoc)])
|
|
rlm@10
|
199 (use '[clojure.pprint :only (pp pprint)])
|
|
rlm@10
|
200 (prompt)
|
|
rlm@10
|
201 (flush)
|
|
rlm@10
|
202 (loop []
|
|
rlm@10
|
203 (when-not
|
|
rlm@10
|
204 (try (= (read-eval-print) request-exit)
|
|
rlm@10
|
205 (catch Throwable e
|
|
rlm@10
|
206 (caught e)
|
|
rlm@10
|
207 (set! *e e)
|
|
rlm@10
|
208 nil))
|
|
rlm@10
|
209 (when (need-prompt)
|
|
rlm@10
|
210 (prompt)
|
|
rlm@10
|
211 (flush))
|
|
rlm@10
|
212 (recur))))))
|
|
rlm@10
|
213
|
|
rlm@10
|
214 (defn load-script
|
|
rlm@10
|
215 "Loads Clojure source from a file or resource given its path. Paths
|
|
rlm@10
|
216 beginning with @ or @/ are considered relative to classpath."
|
|
rlm@10
|
217 [^String path]
|
|
rlm@10
|
218 (if (.startsWith path "@")
|
|
rlm@10
|
219 (RT/loadResourceScript
|
|
rlm@10
|
220 (.substring path (if (.startsWith path "@/") 2 1)))
|
|
rlm@10
|
221 (Compiler/loadFile path)))
|
|
rlm@10
|
222
|
|
rlm@10
|
223 (defn- init-opt
|
|
rlm@10
|
224 "Load a script"
|
|
rlm@10
|
225 [path]
|
|
rlm@10
|
226 (load-script path))
|
|
rlm@10
|
227
|
|
rlm@10
|
228 (defn- eval-opt
|
|
rlm@10
|
229 "Evals expressions in str, prints each non-nil result using prn"
|
|
rlm@10
|
230 [str]
|
|
rlm@10
|
231 (let [eof (Object.)
|
|
rlm@10
|
232 reader (LineNumberingPushbackReader. (java.io.StringReader. str))]
|
|
rlm@10
|
233 (loop [input (read reader false eof)]
|
|
rlm@10
|
234 (when-not (= input eof)
|
|
rlm@10
|
235 (let [value (eval input)]
|
|
rlm@10
|
236 (when-not (nil? value)
|
|
rlm@10
|
237 (prn value))
|
|
rlm@10
|
238 (recur (read reader false eof)))))))
|
|
rlm@10
|
239
|
|
rlm@10
|
240 (defn- init-dispatch
|
|
rlm@10
|
241 "Returns the handler associated with an init opt"
|
|
rlm@10
|
242 [opt]
|
|
rlm@10
|
243 ({"-i" init-opt
|
|
rlm@10
|
244 "--init" init-opt
|
|
rlm@10
|
245 "-e" eval-opt
|
|
rlm@10
|
246 "--eval" eval-opt} opt))
|
|
rlm@10
|
247
|
|
rlm@10
|
248 (defn- initialize
|
|
rlm@10
|
249 "Common initialize routine for repl, script, and null opts"
|
|
rlm@10
|
250 [args inits]
|
|
rlm@10
|
251 (in-ns 'user)
|
|
rlm@10
|
252 (set! *command-line-args* args)
|
|
rlm@10
|
253 (doseq [[opt arg] inits]
|
|
rlm@10
|
254 ((init-dispatch opt) arg)))
|
|
rlm@10
|
255
|
|
rlm@10
|
256 (defn- repl-opt
|
|
rlm@10
|
257 "Start a repl with args and inits. Print greeting if no eval options were
|
|
rlm@10
|
258 present"
|
|
rlm@10
|
259 [[_ & args] inits]
|
|
rlm@10
|
260 (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
|
|
rlm@10
|
261 (println "Clojure" (clojure-version)))
|
|
rlm@10
|
262 (repl :init #(initialize args inits))
|
|
rlm@10
|
263 (prn)
|
|
rlm@10
|
264 (System/exit 0))
|
|
rlm@10
|
265
|
|
rlm@10
|
266 (defn- script-opt
|
|
rlm@10
|
267 "Run a script from a file, resource, or standard in with args and inits"
|
|
rlm@10
|
268 [[path & args] inits]
|
|
rlm@10
|
269 (with-bindings
|
|
rlm@10
|
270 (initialize args inits)
|
|
rlm@10
|
271 (if (= path "-")
|
|
rlm@10
|
272 (load-reader *in*)
|
|
rlm@10
|
273 (load-script path))))
|
|
rlm@10
|
274
|
|
rlm@10
|
275 (defn- null-opt
|
|
rlm@10
|
276 "No repl or script opt present, just bind args and run inits"
|
|
rlm@10
|
277 [args inits]
|
|
rlm@10
|
278 (with-bindings
|
|
rlm@10
|
279 (initialize args inits)))
|
|
rlm@10
|
280
|
|
rlm@10
|
281 (defn- help-opt
|
|
rlm@10
|
282 "Print help text for main"
|
|
rlm@10
|
283 [_ _]
|
|
rlm@10
|
284 (println (:doc (meta (var main)))))
|
|
rlm@10
|
285
|
|
rlm@10
|
286 (defn- main-dispatch
|
|
rlm@10
|
287 "Returns the handler associated with a main option"
|
|
rlm@10
|
288 [opt]
|
|
rlm@10
|
289 (or
|
|
rlm@10
|
290 ({"-r" repl-opt
|
|
rlm@10
|
291 "--repl" repl-opt
|
|
rlm@10
|
292 nil null-opt
|
|
rlm@10
|
293 "-h" help-opt
|
|
rlm@10
|
294 "--help" help-opt
|
|
rlm@10
|
295 "-?" help-opt} opt)
|
|
rlm@10
|
296 script-opt))
|
|
rlm@10
|
297
|
|
rlm@10
|
298 (defn- legacy-repl
|
|
rlm@10
|
299 "Called by the clojure.lang.Repl.main stub to run a repl with args
|
|
rlm@10
|
300 specified the old way"
|
|
rlm@10
|
301 [args]
|
|
rlm@10
|
302 (println "WARNING: clojure.lang.Repl is deprecated.
|
|
rlm@10
|
303 Instead, use clojure.main like this:
|
|
rlm@10
|
304 java -cp clojure.jar clojure.main -i init.clj -r args...")
|
|
rlm@10
|
305 (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
|
|
rlm@10
|
306 (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits))))
|
|
rlm@10
|
307
|
|
rlm@10
|
308 (defn- legacy-script
|
|
rlm@10
|
309 "Called by the clojure.lang.Script.main stub to run a script with args
|
|
rlm@10
|
310 specified the old way"
|
|
rlm@10
|
311 [args]
|
|
rlm@10
|
312 (println "WARNING: clojure.lang.Script is deprecated.
|
|
rlm@10
|
313 Instead, use clojure.main like this:
|
|
rlm@10
|
314 java -cp clojure.jar clojure.main -i init.clj script.clj args...")
|
|
rlm@10
|
315 (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
|
|
rlm@10
|
316 (null-opt args (map vector (repeat "-i") inits))))
|
|
rlm@10
|
317
|
|
rlm@10
|
318 (defn main
|
|
rlm@10
|
319 "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*]
|
|
rlm@10
|
320
|
|
rlm@10
|
321 With no options or args, runs an interactive Read-Eval-Print Loop
|
|
rlm@10
|
322
|
|
rlm@10
|
323 init options:
|
|
rlm@10
|
324 -i, --init path Load a file or resource
|
|
rlm@10
|
325 -e, --eval string Evaluate expressions in string; print non-nil values
|
|
rlm@10
|
326
|
|
rlm@10
|
327 main options:
|
|
rlm@10
|
328 -r, --repl Run a repl
|
|
rlm@10
|
329 path Run a script from from a file or resource
|
|
rlm@10
|
330 - Run a script from standard input
|
|
rlm@10
|
331 -h, -?, --help Print this help message and exit
|
|
rlm@10
|
332
|
|
rlm@10
|
333 operation:
|
|
rlm@10
|
334
|
|
rlm@10
|
335 - Establishes thread-local bindings for commonly set!-able vars
|
|
rlm@10
|
336 - Enters the user namespace
|
|
rlm@10
|
337 - Binds *command-line-args* to a seq of strings containing command line
|
|
rlm@10
|
338 args that appear after any main option
|
|
rlm@10
|
339 - Runs all init options in order
|
|
rlm@10
|
340 - Runs a repl or script if requested
|
|
rlm@10
|
341
|
|
rlm@10
|
342 The init options may be repeated and mixed freely, but must appear before
|
|
rlm@10
|
343 any main option. The appearance of any eval option before running a repl
|
|
rlm@10
|
344 suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\".
|
|
rlm@10
|
345
|
|
rlm@10
|
346 Paths may be absolute or relative in the filesystem or relative to
|
|
rlm@10
|
347 classpath. Classpath-relative paths have prefix of @ or @/"
|
|
rlm@10
|
348 [& args]
|
|
rlm@10
|
349 (try
|
|
rlm@10
|
350 (if args
|
|
rlm@10
|
351 (loop [[opt arg & more :as args] args inits []]
|
|
rlm@10
|
352 (if (init-dispatch opt)
|
|
rlm@10
|
353 (recur more (conj inits [opt arg]))
|
|
rlm@10
|
354 ((main-dispatch opt) args inits)))
|
|
rlm@10
|
355 (repl-opt nil nil))
|
|
rlm@10
|
356 (finally
|
|
rlm@10
|
357 (flush))))
|
|
rlm@10
|
358
|
