comparison src/clojure/contrib/repl_ln.clj @ 10:ef7dbbd6452c

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