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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
;; distribution terms for this software are covered by the Common Public
;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found
;; in the file CPL.TXT at the root of this distribution. By using this
;; software in any fashion, you are agreeing to be bound by the terms of
;; this license. You must not remove this notice, or any other, from this
;; software.
;;
;; A repl with a custom "read" hook that provides support for line
;; numbers.
;;
;; scgilardi (gmail)
;; Created 28 November 2008
(ns clojure.contrib.repl-ln
(:import (clojure.lang Compiler LineNumberingPushbackReader RT Var)
(java.io InputStreamReader OutputStreamWriter PrintWriter)
(java.util Date))
(:use clojure.contrib.def))
;; Private
(defstruct- repl-info
:name :started :name-fmt :prompt-fmt :serial :thread :depth)
(defvar- +name-formats+
{"%S" "%1$d" "%T" "%2$d" "%D" "%3$d"}
"For set-name, maps our dynamic value codes to arg positions in
the call to format in repl-name")
(defvar- +prompt-formats+
{"%S" "%1$d" "%T" "%2$d" "%D" "%3$d" "%L" "%4$d" "%N" "%5$s"}
"For set-prompt, maps our dynamic value codes to arg positions in
the call to format in repl-prompt")
(defvar- +info-format+
["Name: %s"
"Started: %s"
"Name-fmt: \"%s\""
"Prompt-fmt: \"%s\""
"Serial: %d"
"Thread: %d"
"Depth: %d"
"Line: %d"])
(defvar- +info-defaults+
(struct-map repl-info
:name-fmt "repl-%S"
:prompt-fmt "%S:%L %N=> "
:depth 0)
"Default/root values for repl info")
(defonce- *serial-number* (ref 0)
"Serial number counter")
(defonce- *info* +info-defaults+
"Info for this repl")
(defn- set-info!
"Replaces the value thread-locally bound to *info* with a new map with
updated values. Args are sequential inline key value pairs."
[& args]
(set! *info* (apply assoc *info* args)))
(defn- repl-name
"Returns the repl name based on *info*"
[]
(let [{:keys [name-fmt-internal serial thread depth]} *info*]
(format name-fmt-internal serial thread depth)))
(defn- repl-prompt
"Returns the repl prompt based on *info*, line number, and namespace"
[]
(let [{:keys [prompt-fmt-internal serial thread depth]} *info*
line (.getLineNumber *in*)
namespace (ns-name *ns*)]
(format prompt-fmt-internal serial thread depth line namespace)))
(defn- whitespace?
"Returns logical true if c is whitespace in Clojure"
[c]
(or (Character/isWhitespace c) (= c (int \,))))
(defn- eol?
"Returns logical true if c is an eol character"
[c]
(#{\return \newline} (char c)))
(defn- skip-to-eol
"Reads and skips everything until an eol character"
[s]
(loop [c (.read s)]
(when-not (eol? c)
(recur (.read s)))))
(defn- skip-whitespace
"Reads and skips whitespace characters from stream s. Returns :eos on end
of stream, :eol on end of line, :eol after skipping rest of line on
semicolon, or false otherwise."
[s]
(loop [c (.read s)]
(cond (= c -1) :eos
(eol? c) :eol
(= c (int \;)) (do (skip-to-eol s) :eol)
(whitespace? c) (recur (.read s))
:else (do (.unread s c) false))))
(defn- read-hook
"Read hook that keeps the compiler's line number in sync with that of our
input stream, prompts only when there is nothing remaining to read on the
previous input line, and calls the Clojure reader only when there's
something interesting to read on the current line."
[eof]
(loop [c (skip-whitespace *in*)]
(cond (= c :eos) eof
(= c :eol)
(do
(print (repl-prompt))
(flush)
(recur (skip-whitespace *in*)))
:else
(do
(var-set Compiler/LINE (.getLineNumber *in*))
(read *in* false eof)))))
;; Public
(defn set-repl-name
"Sets the repl name. Include the following codes in the name to make the
corresponding dynamic values part of it:
%S - repl serial number
%T - thread id
%D - nesting depth in this thread
The default name is \"repl-%S\""
[name-fmt]
(set-info! :name-fmt name-fmt)
(loop [[[code fmt] & more] (seq +name-formats+)
name-fmt name-fmt]
(if code
(recur more (.replace name-fmt code fmt))
(set-info! :name-fmt-internal name-fmt)))
(let [name (repl-name)]
(set-info! :name name)
(var-set Compiler/SOURCE name))
nil)
(defn set-repl-prompt
"Sets the repl prompt. Include the following codes in the prompt to make
the corresponding dynamic values part of it:
%S - repl serial number
%T - thread id
%D - nesting depth in this thread
%L - input line number
%N - namespace name
The default prompt is \"%S:%L %N=> \""
[prompt-fmt]
(set-info! :prompt-fmt prompt-fmt)
(loop [[[code fmt] & more] (seq +prompt-formats+)
prompt-fmt prompt-fmt]
(if code
(recur more (.replace prompt-fmt code fmt))
(set-info! :prompt-fmt-internal prompt-fmt)))
nil)
(defn repl-info
"Returns a map of info about the current repl"
[]
(let [line (.getLineNumber *in*)]
(dissoc (assoc *info* :line line)
:name-fmt-internal :prompt-fmt-internal)))
(defn print-repl-info
"Prints info about the current repl"
[]
(let [{:keys [name started name-fmt prompt-fmt serial thread depth line]}
(repl-info)]
(printf
(apply str (interleave +info-format+ (repeat "\n")))
name started name-fmt prompt-fmt serial thread depth line)))
(defn repl
"A repl that supports line numbers. The default prompt displays repl
serial number, line number, and namespace. The default repl name contains
the repl serial number. Thrown exceptions display the repl name and line
number; metadata for defs made at the repl identify their origin by repl
name and line number. Use set-repl-name and set-repl-prompt to customize
the repl name and prompt"
([]
(repl System/in System/out System/err RT/UTF8))
([in out err encoding]
(try
(Var/pushThreadBindings
{RT/IN (LineNumberingPushbackReader.
(InputStreamReader. in encoding))
RT/OUT (OutputStreamWriter. out encoding)
RT/ERR (PrintWriter. (OutputStreamWriter. err encoding) true)
Compiler/SOURCE (var-get Compiler/SOURCE)
Compiler/LINE (var-get Compiler/LINE)
(var *info*) *info*})
(set-info!
:started (Date.)
:serial (dosync (alter *serial-number* inc))
:thread (.getId (Thread/currentThread))
:depth (inc (:depth *info*)))
(set-repl-name (:name-fmt *info*))
(set-repl-prompt (:prompt-fmt *info*))
;; unread newline to enable first prompt
(.unread *in* (int \newline))
(clojure.main/repl
:prompt #()
:flush #()
:read read-hook)
(finally
(Var/popThreadBindings)
(prn)))))
|
