annotate 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
rev   line source
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)))))