1 files changed, 274 insertions, 0 deletions
diff --git a/src/main/clojure/clojure/contrib/repl_ln.clj b/src/main/clojure/clojure/contrib/repl_ln.clj
new file mode 100644
index 00000000..7b8ef052
--- /dev/null
+++ b/src/main/clojure/clojure/contrib/repl_ln.clj
@@ -0,0 +1,274 @@
+;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html 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 that provides support for lines and line numbers in the
+;;  input stream.
+;;
+;;  scgilardi (gmail)
+;;  Created 28 November 2008
+
+(ns 
+  #^{:author "Stephen C. Gilardi",
+     :doc "A repl with that provides support for lines and line numbers in the
+           input stream."}
+  clojure.contrib.repl-ln
+  (:gen-class)
+  (:import (clojure.lang Compiler LineNumberingPushbackReader RT Var)
+           (java.io InputStreamReader OutputStreamWriter PrintWriter)
+           java.util.Date)
+  (:require clojure.main)
+  (:use [clojure.contrib.def
+         :only (defmacro- defonce- defstruct- defvar-)]))
+
+;; Private
+
+(declare repl)
+
+(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* (atom 0)
+  "Serial number counter")
+
+(defonce- *info* +info-defaults+
+  "Public info for this repl")
+
+(defonce- *private* {}
+  "Private info for this repl")
+
+(defmacro- update
+  "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 this repl's name-fmt"
+  []
+  (let [{:keys [name-fmt]} *private*
+        {:keys [serial thread depth]} *info*]
+    (format name-fmt serial thread depth)))
+
+(defn- prompt-hook
+  []
+  (let [prompt (*private* :prompt)]
+    (var-set Compiler/LINE (.getLineNumber *in*))
+    (prompt)))
+
+(defn- process-inits
+  "Processes initial pairs of args of the form:
+
+    -i     filepath, or
+    --init filepath
+
+  by loading the referenced files, then accepts an optional terminating arg
+  of the form:
+
+    -r, or
+    --repl
+
+  Returns a seq of any remaining args."
+  [args]
+  (loop [[init filename & more :as args] args]
+    (if (#{"-i" "--init"} init)
+      (do
+        (clojure.main/load-script filename)
+        (recur more))
+      (if (#{"-r" "--repl"} init)
+        (rest args)
+        args))))
+
+(defn- process-command-line
+  "Args are strings passed in from the command line. Loads any requested
+  init files and binds *command-line-args* to a seq of the remaining args"
+  [args]
+  (set! *command-line-args* (process-inits args)))
+
+(defn stream-repl
+  "Repl entry point that provides convenient overriding of input, output,
+  and err streams via sequential keyword-value pairs. Default values
+  for :in, :out, and :err are streams associated with System/in,
+  System/out, and System/err using UTF-8 encoding. Also supports all the
+  options provided by clojure.contrib.repl-ln/repl."
+  [& options]
+  (let [enc RT/UTF8
+        {:keys [in out err]
+         :or {in (LineNumberingPushbackReader.
+                  (InputStreamReader. System/in enc))
+              out (OutputStreamWriter. System/out enc)
+              err (PrintWriter. (OutputStreamWriter. System/err enc))}}
+        (apply hash-map options)]
+    (binding [*in* in *out* out *err* err]
+      (apply repl options))))
+
+(defn- -main
+  "Main entry point, starts a repl enters the user namespace and processes
+  command line args."
+  [& args]
+  (repl :init
+        (fn []
+          (println "Clojure" (clojure-version))
+          (in-ns 'user)
+          (process-command-line args))))
+
+;; 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 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
+
+  With no arguments, resets the repl name to its default: \"repl-%S\""
+  ([]
+     (set-repl-name (+info-defaults+ :name-fmt)))
+  ([name-fmt]
+     (update *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))
+         (update *private* :name-fmt name-fmt)))
+     (let [name (repl-name)]
+       (update *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
+
+  With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \""
+  ([]
+     (set-repl-prompt (+info-defaults+ :prompt-fmt)))
+  ([prompt-fmt]
+     (update *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))
+         (update *private* :prompt-fmt prompt-fmt)))
+     nil))
+
+(defn repl-info
+  "Returns a map of info about the current repl"
+  []
+  (let [line (.getLineNumber *in*)]
+    (assoc *info* :line line)))
+
+(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. 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))
+
+       - :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 need-prompt prompt flush read eval print caught
+                name-fmt prompt-fmt]
+         :or {init        #()
+              need-prompt (if (instance? LineNumberingPushbackReader *in*)
+                            #(.atLineStart *in*)
+                            #(identity true))
+              prompt      #(clojure.core/print (repl-prompt))
+              flush       flush
+              read        clojure.main/repl-read
+              eval        eval
+              print       prn
+              caught      clojure.main/repl-caught
+              name-fmt    (*info* :name-fmt)
+              prompt-fmt  (*info* :prompt-fmt)}}
+              (apply hash-map options)]
+    (try
+     (Var/pushThreadBindings
+      {Compiler/SOURCE (var-get Compiler/SOURCE)
+       Compiler/LINE (var-get Compiler/LINE)
+       (var *info*) *info*
+       (var *private*) {}})
+     (update *info*
+             :started (Date.)
+             :serial (swap! *serial-number* inc)
+             :thread (.getId (Thread/currentThread))
+             :depth (inc (*info* :depth)))
+     (update *private*
+             :prompt prompt)
+     (set-repl-name name-fmt)
+     (set-repl-prompt prompt-fmt)
+     (clojure.main/repl
+      :init init
+      :need-prompt need-prompt
+      :prompt prompt-hook
+      :flush flush
+      :read read
+      :eval eval
+      :print print
+      :caught caught)
+     (finally
+      (Var/popThreadBindings)
+      (prn)))))