rlm@10
|
1 ;; Copyright (c) Stephen C. Gilardi. 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
|
rlm@10
|
4 ;; be found in the file epl-v10.html at the root of this distribution. By
|
rlm@10
|
5 ;; using this software in any fashion, you are agreeing to be bound by the
|
rlm@10
|
6 ;; terms of this license. You must not remove this notice, or any other,
|
rlm@10
|
7 ;; from this software.
|
rlm@10
|
8 ;;
|
rlm@10
|
9 ;; A repl with that provides support for lines and line numbers in the
|
rlm@10
|
10 ;; input stream.
|
rlm@10
|
11 ;;
|
rlm@10
|
12 ;; scgilardi (gmail)
|
rlm@10
|
13 ;; Created 28 November 2008
|
rlm@10
|
14
|
rlm@10
|
15 (ns
|
rlm@10
|
16 ^{:author "Stephen C. Gilardi",
|
rlm@10
|
17 :doc "A repl with that provides support for lines and line numbers in the
|
rlm@10
|
18 input stream."}
|
rlm@10
|
19 clojure.contrib.repl-ln
|
rlm@10
|
20 (:gen-class)
|
rlm@10
|
21 (:import (clojure.lang Compiler LineNumberingPushbackReader RT Var)
|
rlm@10
|
22 (java.io InputStreamReader OutputStreamWriter PrintWriter)
|
rlm@10
|
23 java.util.Date)
|
rlm@10
|
24 (:require clojure.main)
|
rlm@10
|
25 (:use [clojure.contrib.def
|
rlm@10
|
26 :only (defmacro- defonce- defstruct- defvar-)]))
|
rlm@10
|
27
|
rlm@10
|
28 ;; Private
|
rlm@10
|
29
|
rlm@10
|
30 (declare repl)
|
rlm@10
|
31
|
rlm@10
|
32 (defstruct- repl-info
|
rlm@10
|
33 :name :started :name-fmt :prompt-fmt :serial :thread :depth)
|
rlm@10
|
34
|
rlm@10
|
35 (defvar- +name-formats+
|
rlm@10
|
36 {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d"}
|
rlm@10
|
37 "For set-name, maps our dynamic value codes to arg positions in
|
rlm@10
|
38 the call to format in repl-name")
|
rlm@10
|
39
|
rlm@10
|
40 (defvar- +prompt-formats+
|
rlm@10
|
41 {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d" "%L" "%4$d" "%N" "%5$s"}
|
rlm@10
|
42 "For set-prompt, maps our dynamic value codes to arg positions in
|
rlm@10
|
43 the call to format in repl-prompt")
|
rlm@10
|
44
|
rlm@10
|
45 (defvar- +info-format+
|
rlm@10
|
46 ["Name: %s"
|
rlm@10
|
47 "Started: %s"
|
rlm@10
|
48 "Name-fmt: \"%s\""
|
rlm@10
|
49 "Prompt-fmt: \"%s\""
|
rlm@10
|
50 "Serial: %d"
|
rlm@10
|
51 "Thread: %d"
|
rlm@10
|
52 "Depth: %d"
|
rlm@10
|
53 "Line: %d"])
|
rlm@10
|
54
|
rlm@10
|
55 (defvar- +info-defaults+
|
rlm@10
|
56 (struct-map repl-info
|
rlm@10
|
57 :name-fmt "repl-%S"
|
rlm@10
|
58 :prompt-fmt "%S:%L %N=> "
|
rlm@10
|
59 :depth 0)
|
rlm@10
|
60 "Default/root values for repl info")
|
rlm@10
|
61
|
rlm@10
|
62 (defonce- *serial-number* (atom 0)
|
rlm@10
|
63 "Serial number counter")
|
rlm@10
|
64
|
rlm@10
|
65 (defonce- *info* +info-defaults+
|
rlm@10
|
66 "Public info for this repl")
|
rlm@10
|
67
|
rlm@10
|
68 (defonce- *private* {}
|
rlm@10
|
69 "Private info for this repl")
|
rlm@10
|
70
|
rlm@10
|
71 (defmacro- update
|
rlm@10
|
72 "Replaces the map thread-locally bound to map-var with a copy that
|
rlm@10
|
73 includes updated and/or new values from keys and vals."
|
rlm@10
|
74 [map-var & key-vals]
|
rlm@10
|
75 `(set! ~map-var (assoc ~map-var ~@key-vals)))
|
rlm@10
|
76
|
rlm@10
|
77 (defn- repl-name
|
rlm@10
|
78 "Returns the repl name based on this repl's name-fmt"
|
rlm@10
|
79 []
|
rlm@10
|
80 (let [{:keys [name-fmt]} *private*
|
rlm@10
|
81 {:keys [serial thread depth]} *info*]
|
rlm@10
|
82 (format name-fmt serial thread depth)))
|
rlm@10
|
83
|
rlm@10
|
84 (defn- prompt-hook
|
rlm@10
|
85 []
|
rlm@10
|
86 (let [prompt (*private* :prompt)]
|
rlm@10
|
87 (var-set Compiler/LINE (.getLineNumber *in*))
|
rlm@10
|
88 (prompt)))
|
rlm@10
|
89
|
rlm@10
|
90 (defn- process-inits
|
rlm@10
|
91 "Processes initial pairs of args of the form:
|
rlm@10
|
92
|
rlm@10
|
93 -i filepath, or
|
rlm@10
|
94 --init filepath
|
rlm@10
|
95
|
rlm@10
|
96 by loading the referenced files, then accepts an optional terminating arg
|
rlm@10
|
97 of the form:
|
rlm@10
|
98
|
rlm@10
|
99 -r, or
|
rlm@10
|
100 --repl
|
rlm@10
|
101
|
rlm@10
|
102 Returns a seq of any remaining args."
|
rlm@10
|
103 [args]
|
rlm@10
|
104 (loop [[init filename & more :as args] args]
|
rlm@10
|
105 (if (#{"-i" "--init"} init)
|
rlm@10
|
106 (do
|
rlm@10
|
107 (clojure.main/load-script filename)
|
rlm@10
|
108 (recur more))
|
rlm@10
|
109 (if (#{"-r" "--repl"} init)
|
rlm@10
|
110 (rest args)
|
rlm@10
|
111 args))))
|
rlm@10
|
112
|
rlm@10
|
113 (defn- process-command-line
|
rlm@10
|
114 "Args are strings passed in from the command line. Loads any requested
|
rlm@10
|
115 init files and binds *command-line-args* to a seq of the remaining args"
|
rlm@10
|
116 [args]
|
rlm@10
|
117 (set! *command-line-args* (process-inits args)))
|
rlm@10
|
118
|
rlm@10
|
119 (defn stream-repl
|
rlm@10
|
120 "Repl entry point that provides convenient overriding of input, output,
|
rlm@10
|
121 and err streams via sequential keyword-value pairs. Default values
|
rlm@10
|
122 for :in, :out, and :err are streams associated with System/in,
|
rlm@10
|
123 System/out, and System/err using UTF-8 encoding. Also supports all the
|
rlm@10
|
124 options provided by clojure.contrib.repl-ln/repl."
|
rlm@10
|
125 [& options]
|
rlm@10
|
126 (let [enc RT/UTF8
|
rlm@10
|
127 {:keys [in out err]
|
rlm@10
|
128 :or {in (LineNumberingPushbackReader.
|
rlm@10
|
129 (InputStreamReader. System/in enc))
|
rlm@10
|
130 out (OutputStreamWriter. System/out enc)
|
rlm@10
|
131 err (PrintWriter. (OutputStreamWriter. System/err enc))}}
|
rlm@10
|
132 (apply hash-map options)]
|
rlm@10
|
133 (binding [*in* in *out* out *err* err]
|
rlm@10
|
134 (apply repl options))))
|
rlm@10
|
135
|
rlm@10
|
136 (defn- -main
|
rlm@10
|
137 "Main entry point, starts a repl enters the user namespace and processes
|
rlm@10
|
138 command line args."
|
rlm@10
|
139 [& args]
|
rlm@10
|
140 (repl :init
|
rlm@10
|
141 (fn []
|
rlm@10
|
142 (println "Clojure" (clojure-version))
|
rlm@10
|
143 (in-ns 'user)
|
rlm@10
|
144 (process-command-line args))))
|
rlm@10
|
145
|
rlm@10
|
146 ;; Public
|
rlm@10
|
147
|
rlm@10
|
148 (defn repl-prompt
|
rlm@10
|
149 "Returns the current repl prompt based on this repl's prompt-fmt"
|
rlm@10
|
150 []
|
rlm@10
|
151 (let [{:keys [prompt-fmt]} *private*
|
rlm@10
|
152 {:keys [serial thread depth]} *info*
|
rlm@10
|
153 line (.getLineNumber *in*)
|
rlm@10
|
154 namespace (ns-name *ns*)]
|
rlm@10
|
155 (format prompt-fmt serial thread depth line namespace)))
|
rlm@10
|
156
|
rlm@10
|
157 (defn set-repl-name
|
rlm@10
|
158 "Sets the repl name format to the string name-fmt. Include the following
|
rlm@10
|
159 codes in the name to make the corresponding dynamic values part of it:
|
rlm@10
|
160
|
rlm@10
|
161 %S - repl serial number
|
rlm@10
|
162 %T - thread id
|
rlm@10
|
163 %D - nesting depth in this thread
|
rlm@10
|
164
|
rlm@10
|
165 With no arguments, resets the repl name to its default: \"repl-%S\""
|
rlm@10
|
166 ([]
|
rlm@10
|
167 (set-repl-name (+info-defaults+ :name-fmt)))
|
rlm@10
|
168 ([name-fmt]
|
rlm@10
|
169 (update *info* :name-fmt name-fmt)
|
rlm@10
|
170 (loop [[[code fmt] & more] (seq +name-formats+)
|
rlm@10
|
171 name-fmt name-fmt]
|
rlm@10
|
172 (if code
|
rlm@10
|
173 (recur more (.replace name-fmt code fmt))
|
rlm@10
|
174 (update *private* :name-fmt name-fmt)))
|
rlm@10
|
175 (let [name (repl-name)]
|
rlm@10
|
176 (update *info* :name name)
|
rlm@10
|
177 (var-set Compiler/SOURCE name))
|
rlm@10
|
178 nil))
|
rlm@10
|
179
|
rlm@10
|
180 (defn set-repl-prompt
|
rlm@10
|
181 "Sets the repl prompt. Include the following codes in the prompt to make
|
rlm@10
|
182 the corresponding dynamic values part of it:
|
rlm@10
|
183
|
rlm@10
|
184 %S - repl serial number
|
rlm@10
|
185 %T - thread id
|
rlm@10
|
186 %D - nesting depth in this thread
|
rlm@10
|
187 %L - input line number
|
rlm@10
|
188 %N - namespace name
|
rlm@10
|
189
|
rlm@10
|
190 With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \""
|
rlm@10
|
191 ([]
|
rlm@10
|
192 (set-repl-prompt (+info-defaults+ :prompt-fmt)))
|
rlm@10
|
193 ([prompt-fmt]
|
rlm@10
|
194 (update *info* :prompt-fmt prompt-fmt)
|
rlm@10
|
195 (loop [[[code fmt] & more] (seq +prompt-formats+)
|
rlm@10
|
196 prompt-fmt prompt-fmt]
|
rlm@10
|
197 (if code
|
rlm@10
|
198 (recur more (.replace prompt-fmt code fmt))
|
rlm@10
|
199 (update *private* :prompt-fmt prompt-fmt)))
|
rlm@10
|
200 nil))
|
rlm@10
|
201
|
rlm@10
|
202 (defn repl-info
|
rlm@10
|
203 "Returns a map of info about the current repl"
|
rlm@10
|
204 []
|
rlm@10
|
205 (let [line (.getLineNumber *in*)]
|
rlm@10
|
206 (assoc *info* :line line)))
|
rlm@10
|
207
|
rlm@10
|
208 (defn print-repl-info
|
rlm@10
|
209 "Prints info about the current repl"
|
rlm@10
|
210 []
|
rlm@10
|
211 (let [{:keys [name started name-fmt prompt-fmt serial thread depth line]}
|
rlm@10
|
212 (repl-info)]
|
rlm@10
|
213 (printf
|
rlm@10
|
214 (apply str (interleave +info-format+ (repeat "\n")))
|
rlm@10
|
215 name started name-fmt prompt-fmt serial thread depth line)))
|
rlm@10
|
216
|
rlm@10
|
217 (defn repl
|
rlm@10
|
218 "A repl that supports line numbers. For definitions and evaluations made
|
rlm@10
|
219 at the repl, the repl-name and line number will be reported as the
|
rlm@10
|
220 origin. Use set-repl-name and set-repl-prompt to customize the repl name
|
rlm@10
|
221 and prompt. This repl supports all of the keyword arguments documented
|
rlm@10
|
222 for clojure.main/repl with the following change and additions:
|
rlm@10
|
223
|
rlm@10
|
224 - :prompt has a new default
|
rlm@10
|
225 default: #(clojure.core/print (repl-prompt))
|
rlm@10
|
226
|
rlm@10
|
227 - :name-fmt, Name format string
|
rlm@10
|
228 default: the name-fmt of the parent repl, or \"repl-%S\"
|
rlm@10
|
229
|
rlm@10
|
230 - :prompt-fmt, Prompt format string
|
rlm@10
|
231 default: the prompt-fmt of the parent repl, or \"%S:%L %N=> \""
|
rlm@10
|
232 [& options]
|
rlm@10
|
233 (let [{:keys [init need-prompt prompt flush read eval print caught
|
rlm@10
|
234 name-fmt prompt-fmt]
|
rlm@10
|
235 :or {init #()
|
rlm@10
|
236 need-prompt (if (instance? LineNumberingPushbackReader *in*)
|
rlm@10
|
237 #(.atLineStart *in*)
|
rlm@10
|
238 #(identity true))
|
rlm@10
|
239 prompt #(clojure.core/print (repl-prompt))
|
rlm@10
|
240 flush flush
|
rlm@10
|
241 read clojure.main/repl-read
|
rlm@10
|
242 eval eval
|
rlm@10
|
243 print prn
|
rlm@10
|
244 caught clojure.main/repl-caught
|
rlm@10
|
245 name-fmt (*info* :name-fmt)
|
rlm@10
|
246 prompt-fmt (*info* :prompt-fmt)}}
|
rlm@10
|
247 (apply hash-map options)]
|
rlm@10
|
248 (try
|
rlm@10
|
249 (Var/pushThreadBindings
|
rlm@10
|
250 {Compiler/SOURCE (var-get Compiler/SOURCE)
|
rlm@10
|
251 Compiler/LINE (var-get Compiler/LINE)
|
rlm@10
|
252 (var *info*) *info*
|
rlm@10
|
253 (var *private*) {}})
|
rlm@10
|
254 (update *info*
|
rlm@10
|
255 :started (Date.)
|
rlm@10
|
256 :serial (swap! *serial-number* inc)
|
rlm@10
|
257 :thread (.getId (Thread/currentThread))
|
rlm@10
|
258 :depth (inc (*info* :depth)))
|
rlm@10
|
259 (update *private*
|
rlm@10
|
260 :prompt prompt)
|
rlm@10
|
261 (set-repl-name name-fmt)
|
rlm@10
|
262 (set-repl-prompt prompt-fmt)
|
rlm@10
|
263 (clojure.main/repl
|
rlm@10
|
264 :init init
|
rlm@10
|
265 :need-prompt need-prompt
|
rlm@10
|
266 :prompt prompt-hook
|
rlm@10
|
267 :flush flush
|
rlm@10
|
268 :read read
|
rlm@10
|
269 :eval eval
|
rlm@10
|
270 :print print
|
rlm@10
|
271 :caught caught)
|
rlm@10
|
272 (finally
|
rlm@10
|
273 (Var/popThreadBindings)
|
rlm@10
|
274 (prn)))))
|