diff options
Diffstat (limited to 'src/clojure')
| -rw-r--r-- | src/clojure/contrib/repl_ln.clj | 322 |
1 files changed, 195 insertions, 127 deletions
diff --git a/src/clojure/contrib/repl_ln.clj b/src/clojure/contrib/repl_ln.clj index 32b144e2..de0bc1f1 100644 --- a/src/clojure/contrib/repl_ln.clj +++ b/src/clojure/contrib/repl_ln.clj @@ -6,8 +6,8 @@ ;; 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. +;; A repl with that provides support for lines and line numbers in the +;; input stream. ;; ;; scgilardi (gmail) ;; Created 28 November 2008 @@ -18,10 +18,12 @@ (java.io InputStreamReader OutputStreamWriter PrintWriter) (java.util Date)) (:require clojure.main) - (:use clojure.contrib.def)) + (:use (clojure.contrib cond def fcase))) ;; Private +(declare repl) + (defstruct- repl-info :name :started :name-fmt :prompt-fmt :serial :thread :depth) @@ -52,101 +54,138 @@ :depth 0) "Default/root values for repl info") -(defonce- *serial-number* (ref 0) +(defvar- +special-character+ + { (int \return) :eol + (int \newline) :eol + (int \,) :ws + (int \;) :cte + -1 :eos } + "Maps interesting character codes to keywords representing their type") + +(defonce- *serial-number* (atom 0) "Serial number counter") (defonce- *info* +info-defaults+ - "Info for this repl") + "Public 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))) +(defonce- *private* {} + "Private info for this repl") + +(defmacro- assoc! + "Replaces the map thread-locally bound to map-var with a copy that + includes updated and/or new values from keys and vals." + [map-var & key-vals] + `(set! ~map-var (assoc ~map-var ~@key-vals))) (defn- repl-name - "Returns the repl name based on *info*" + "Returns the repl name based on this repl's name-fmt" [] - (let [{:keys [name-fmt-internal serial thread depth]} *info*] - (format name-fmt-internal serial thread depth))) + (let [{:keys [name-fmt]} *private* + {:keys [serial thread depth]} *info*] + (format name-fmt 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- next-char + "Reads the next character in s and either returns it or one of the + following keywords if the character is of the corresponding type: + :ws whitespace + :eol end-of-line + :eos end-of-stream + :cte comment-to-end character" + [s] + (let [c (.read s)] + (cond-let [type] + (+special-character+ c) type + (Character/isWhitespace c) :ws + :else c))) -(defn- skip-to-eol - "Reads and skips everything until an eol character" +(defn- skip-to-end + "Skips characters on stream s until an end of stream or end of line" [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." + (loop [c (next-char s)] + (if (#{:eol :eos} c) + c + (recur (next-char s))))) + +(defn- find-readable-this-line + "Skips characters on stream s until end of stream, end of line, or a + character of interest to the Reader. Returns :eos on end of stream, :eol + on end of line, :eol or :eos after skipping to end of line or end of + stream on semicolon, or :readable otherwise. Before returning :readable, + the readable character is pushed back onto the stream." [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)))) + (loop [c (next-char s)] + (case c + :eol c + :eos c + :cte (skip-to-end s) + :ws (recur (next-char s)) + (do + (.unread s c) + :readable)))) (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." + "Read hook for clojure.main/repl that keeps the compiler's line number in + sync with that of our input stream, prompts only when there is nothing + interesting remaining to read on the previous input line, and calls the + 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))))) + (let [{:keys [prompt flush read]} *private*] + (loop [c (find-readable-this-line *in*)] + (case c + :eos eof + :eol + (do + (prompt) + (flush) + (recur (find-readable-this-line *in*))) + :readable + (do + (var-set Compiler/LINE (.getLineNumber *in*)) + (read eof)))))) + +(defn- -main + "Main entry point, starts a repl and sets up *command-line-args* and + enters user namespace" + [& args] + (repl :init + (fn [] + (set! *command-line-args* args) + (in-ns 'user)))) ;; Public +(defn repl-prompt + "Returns the current repl prompt based on this repl's prompt-fmt" + [] + (let [{:keys [prompt-fmt]} *private* + {:keys [serial thread depth]} *info* + line (.getLineNumber *in*) + namespace (ns-name *ns*)] + (format prompt-fmt serial thread depth line namespace))) + (defn set-repl-name - "Sets the repl name. Include the following codes in the name to make the - corresponding dynamic values part of it: + "Sets the repl name format to the string name-fmt. 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) + With no arguments, resets the repl name to its default: \"repl-%S\"" + ([] + (set-repl-name (+info-defaults+ :name-fmt))) + ([name-fmt] + (assoc! *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)) + (assoc! *private* :name-fmt name-fmt))) + (let [name (repl-name)] + (assoc! *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 @@ -158,22 +197,23 @@ %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) + With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \"" + ([] + (set-repl-prompt (+info-defaults+ :prompt-fmt))) + ([prompt-fmt] + (assoc! *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)) + (assoc! *private* :prompt-fmt 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))) + (assoc *info* :line line))) (defn print-repl-info "Prints info about the current repl" @@ -185,44 +225,72 @@ 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))))) - -(defn -main - [& args] - (binding [*ns* *ns* - *command-line-args* args] - (in-ns 'user) - (repl))) + "A repl that supports line numbers. For definitions and evaluations made + at the repl, the repl-name and line number will be reported as the + origin. Use set-repl-name and set-repl-prompt to customize the repl name + and prompt. This repl supports all of the keyword arguments documented + for clojure.main/repl with the following change and additions: + + - :prompt has a new default + default: #(clojure.core/print repl-prompt) + + - :in,:out,:err input, output, and error streams + default: System/in, System/out, System/err + + - :encoding java.nio.charset.Charset, encoding for in, out, err + default: RT/UTF8 + + - :name-fmt, Name format string + default: the name-fmt of the parent repl, or \"repl-%S\" + + - :prompt-fmt, Prompt format string + default: the prompt-fmt of the parent repl, or \"%S:%L %N=> \"" + [& options] + (let [{:keys [init prompt flush read eval print caught in out err + encoding name-fmt prompt-fmt] + :or {init #() + prompt #(clojure.core/print (repl-prompt)) + flush flush + read #(read *in* false %) + eval eval + print prn + caught #(.println *err* (clojure.main/repl-exception %)) + in System/in + out System/out + err System/err + encoding RT/UTF8}} + (apply hash-map options)] + (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* + (var *private*) *private*}) + (assoc! *info* + :started (Date.) + :serial (swap! *serial-number* inc) + :thread (.getId (Thread/currentThread)) + :depth (inc (:depth *info*))) + (assoc! *private* + :prompt prompt + :flush flush + :read read) + (set-repl-name (or name-fmt (:name-fmt *info*))) + (set-repl-prompt (or prompt-fmt (:prompt-fmt *info*))) + ;; unread newline to enable first prompt + (.unread *in* (int \newline)) + (clojure.main/repl + :init init + :prompt #() + :flush #() + :read read-hook + :eval eval + :print print + :caught caught) + (finally + (Var/popThreadBindings) + (prn))))) |