1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/repl_ln.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,274 @@
     1.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  A repl with that provides support for lines and line numbers in the
    1.13 +;;  input stream.
    1.14 +;;
    1.15 +;;  scgilardi (gmail)
    1.16 +;;  Created 28 November 2008
    1.17 +
    1.18 +(ns 
    1.19 +  ^{:author "Stephen C. Gilardi",
    1.20 +     :doc "A repl with that provides support for lines and line numbers in the
    1.21 +           input stream."}
    1.22 +  clojure.contrib.repl-ln
    1.23 +  (:gen-class)
    1.24 +  (:import (clojure.lang Compiler LineNumberingPushbackReader RT Var)
    1.25 +           (java.io InputStreamReader OutputStreamWriter PrintWriter)
    1.26 +           java.util.Date)
    1.27 +  (:require clojure.main)
    1.28 +  (:use [clojure.contrib.def
    1.29 +         :only (defmacro- defonce- defstruct- defvar-)]))
    1.30 +
    1.31 +;; Private
    1.32 +
    1.33 +(declare repl)
    1.34 +
    1.35 +(defstruct- repl-info
    1.36 +  :name :started :name-fmt :prompt-fmt :serial :thread :depth)
    1.37 +
    1.38 +(defvar- +name-formats+
    1.39 +  {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d"}
    1.40 +  "For set-name, maps our dynamic value codes to arg positions in
    1.41 +  the call to format in repl-name")
    1.42 +
    1.43 +(defvar- +prompt-formats+
    1.44 +  {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d" "%L" "%4$d" "%N" "%5$s"}
    1.45 +  "For set-prompt, maps our dynamic value codes to arg positions in
    1.46 +  the call to format in repl-prompt")
    1.47 +
    1.48 +(defvar- +info-format+
    1.49 +  ["Name:       %s"
    1.50 +   "Started:    %s"
    1.51 +   "Name-fmt:   \"%s\""
    1.52 +   "Prompt-fmt: \"%s\""
    1.53 +   "Serial:     %d"
    1.54 +   "Thread:     %d"
    1.55 +   "Depth:      %d"
    1.56 +   "Line:       %d"])
    1.57 +
    1.58 +(defvar- +info-defaults+
    1.59 +  (struct-map repl-info
    1.60 +    :name-fmt   "repl-%S"
    1.61 +    :prompt-fmt "%S:%L %N=> "
    1.62 +    :depth      0)
    1.63 +  "Default/root values for repl info")
    1.64 +
    1.65 +(defonce- *serial-number* (atom 0)
    1.66 +  "Serial number counter")
    1.67 +
    1.68 +(defonce- *info* +info-defaults+
    1.69 +  "Public info for this repl")
    1.70 +
    1.71 +(defonce- *private* {}
    1.72 +  "Private info for this repl")
    1.73 +
    1.74 +(defmacro- update
    1.75 +  "Replaces the map thread-locally bound to map-var with a copy that
    1.76 +  includes updated and/or new values from keys and vals."
    1.77 +  [map-var & key-vals]
    1.78 +  `(set! ~map-var (assoc ~map-var ~@key-vals)))
    1.79 +
    1.80 +(defn- repl-name
    1.81 +  "Returns the repl name based on this repl's name-fmt"
    1.82 +  []
    1.83 +  (let [{:keys [name-fmt]} *private*
    1.84 +        {:keys [serial thread depth]} *info*]
    1.85 +    (format name-fmt serial thread depth)))
    1.86 +
    1.87 +(defn- prompt-hook
    1.88 +  []
    1.89 +  (let [prompt (*private* :prompt)]
    1.90 +    (var-set Compiler/LINE (.getLineNumber *in*))
    1.91 +    (prompt)))
    1.92 +
    1.93 +(defn- process-inits
    1.94 +  "Processes initial pairs of args of the form:
    1.95 +
    1.96 +    -i     filepath, or
    1.97 +    --init filepath
    1.98 +
    1.99 +  by loading the referenced files, then accepts an optional terminating arg
   1.100 +  of the form:
   1.101 +
   1.102 +    -r, or
   1.103 +    --repl
   1.104 +
   1.105 +  Returns a seq of any remaining args."
   1.106 +  [args]
   1.107 +  (loop [[init filename & more :as args] args]
   1.108 +    (if (#{"-i" "--init"} init)
   1.109 +      (do
   1.110 +        (clojure.main/load-script filename)
   1.111 +        (recur more))
   1.112 +      (if (#{"-r" "--repl"} init)
   1.113 +        (rest args)
   1.114 +        args))))
   1.115 +
   1.116 +(defn- process-command-line
   1.117 +  "Args are strings passed in from the command line. Loads any requested
   1.118 +  init files and binds *command-line-args* to a seq of the remaining args"
   1.119 +  [args]
   1.120 +  (set! *command-line-args* (process-inits args)))
   1.121 +
   1.122 +(defn stream-repl
   1.123 +  "Repl entry point that provides convenient overriding of input, output,
   1.124 +  and err streams via sequential keyword-value pairs. Default values
   1.125 +  for :in, :out, and :err are streams associated with System/in,
   1.126 +  System/out, and System/err using UTF-8 encoding. Also supports all the
   1.127 +  options provided by clojure.contrib.repl-ln/repl."
   1.128 +  [& options]
   1.129 +  (let [enc RT/UTF8
   1.130 +        {:keys [in out err]
   1.131 +         :or {in (LineNumberingPushbackReader.
   1.132 +                  (InputStreamReader. System/in enc))
   1.133 +              out (OutputStreamWriter. System/out enc)
   1.134 +              err (PrintWriter. (OutputStreamWriter. System/err enc))}}
   1.135 +        (apply hash-map options)]
   1.136 +    (binding [*in* in *out* out *err* err]
   1.137 +      (apply repl options))))
   1.138 +
   1.139 +(defn- -main
   1.140 +  "Main entry point, starts a repl enters the user namespace and processes
   1.141 +  command line args."
   1.142 +  [& args]
   1.143 +  (repl :init
   1.144 +        (fn []
   1.145 +          (println "Clojure" (clojure-version))
   1.146 +          (in-ns 'user)
   1.147 +          (process-command-line args))))
   1.148 +
   1.149 +;; Public
   1.150 +
   1.151 +(defn repl-prompt
   1.152 +  "Returns the current repl prompt based on this repl's prompt-fmt"
   1.153 +  []
   1.154 +  (let [{:keys [prompt-fmt]} *private*
   1.155 +        {:keys [serial thread depth]} *info*
   1.156 +        line (.getLineNumber *in*)
   1.157 +        namespace (ns-name *ns*)]
   1.158 +    (format prompt-fmt serial thread depth line namespace)))
   1.159 +
   1.160 +(defn set-repl-name
   1.161 +  "Sets the repl name format to the string name-fmt. Include the following
   1.162 +  codes in the name to make the corresponding dynamic values part of it:
   1.163 +
   1.164 +    %S - repl serial number
   1.165 +    %T - thread id
   1.166 +    %D - nesting depth in this thread
   1.167 +
   1.168 +  With no arguments, resets the repl name to its default: \"repl-%S\""
   1.169 +  ([]
   1.170 +     (set-repl-name (+info-defaults+ :name-fmt)))
   1.171 +  ([name-fmt]
   1.172 +     (update *info* :name-fmt name-fmt)
   1.173 +     (loop [[[code fmt] & more] (seq +name-formats+)
   1.174 +            name-fmt name-fmt]
   1.175 +       (if code
   1.176 +         (recur more (.replace name-fmt code fmt))
   1.177 +         (update *private* :name-fmt name-fmt)))
   1.178 +     (let [name (repl-name)]
   1.179 +       (update *info* :name name)
   1.180 +       (var-set Compiler/SOURCE name))
   1.181 +     nil))
   1.182 +
   1.183 +(defn set-repl-prompt
   1.184 +  "Sets the repl prompt. Include the following codes in the prompt to make
   1.185 +  the corresponding dynamic values part of it:
   1.186 +
   1.187 +    %S - repl serial number
   1.188 +    %T - thread id
   1.189 +    %D - nesting depth in this thread
   1.190 +    %L - input line number
   1.191 +    %N - namespace name
   1.192 +
   1.193 +  With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \""
   1.194 +  ([]
   1.195 +     (set-repl-prompt (+info-defaults+ :prompt-fmt)))
   1.196 +  ([prompt-fmt]
   1.197 +     (update *info* :prompt-fmt prompt-fmt)
   1.198 +     (loop [[[code fmt] & more] (seq +prompt-formats+)
   1.199 +            prompt-fmt prompt-fmt]
   1.200 +       (if code
   1.201 +         (recur more (.replace prompt-fmt code fmt))
   1.202 +         (update *private* :prompt-fmt prompt-fmt)))
   1.203 +     nil))
   1.204 +
   1.205 +(defn repl-info
   1.206 +  "Returns a map of info about the current repl"
   1.207 +  []
   1.208 +  (let [line (.getLineNumber *in*)]
   1.209 +    (assoc *info* :line line)))
   1.210 +
   1.211 +(defn print-repl-info
   1.212 +  "Prints info about the current repl"
   1.213 +  []
   1.214 +  (let [{:keys [name started name-fmt prompt-fmt serial thread depth line]}
   1.215 +        (repl-info)]
   1.216 +    (printf
   1.217 +     (apply str (interleave +info-format+ (repeat "\n")))
   1.218 +     name started name-fmt prompt-fmt serial thread depth line)))
   1.219 +
   1.220 +(defn repl
   1.221 +  "A repl that supports line numbers. For definitions and evaluations made
   1.222 +  at the repl, the repl-name and line number will be reported as the
   1.223 +  origin. Use set-repl-name and set-repl-prompt to customize the repl name
   1.224 +  and prompt. This repl supports all of the keyword arguments documented
   1.225 +  for clojure.main/repl with the following change and additions:
   1.226 +
   1.227 +       - :prompt has a new default
   1.228 +         default: #(clojure.core/print (repl-prompt))
   1.229 +
   1.230 +       - :name-fmt, Name format string
   1.231 +         default: the name-fmt of the parent repl, or \"repl-%S\"
   1.232 +
   1.233 +       - :prompt-fmt, Prompt format string
   1.234 +         default: the prompt-fmt of the parent repl, or \"%S:%L %N=> \""
   1.235 +  [& options]
   1.236 +  (let [{:keys [init need-prompt prompt flush read eval print caught
   1.237 +                name-fmt prompt-fmt]
   1.238 +         :or {init        #()
   1.239 +              need-prompt (if (instance? LineNumberingPushbackReader *in*)
   1.240 +                            #(.atLineStart *in*)
   1.241 +                            #(identity true))
   1.242 +              prompt      #(clojure.core/print (repl-prompt))
   1.243 +              flush       flush
   1.244 +              read        clojure.main/repl-read
   1.245 +              eval        eval
   1.246 +              print       prn
   1.247 +              caught      clojure.main/repl-caught
   1.248 +              name-fmt    (*info* :name-fmt)
   1.249 +              prompt-fmt  (*info* :prompt-fmt)}}
   1.250 +              (apply hash-map options)]
   1.251 +    (try
   1.252 +     (Var/pushThreadBindings
   1.253 +      {Compiler/SOURCE (var-get Compiler/SOURCE)
   1.254 +       Compiler/LINE (var-get Compiler/LINE)
   1.255 +       (var *info*) *info*
   1.256 +       (var *private*) {}})
   1.257 +     (update *info*
   1.258 +             :started (Date.)
   1.259 +             :serial (swap! *serial-number* inc)
   1.260 +             :thread (.getId (Thread/currentThread))
   1.261 +             :depth (inc (*info* :depth)))
   1.262 +     (update *private*
   1.263 +             :prompt prompt)
   1.264 +     (set-repl-name name-fmt)
   1.265 +     (set-repl-prompt prompt-fmt)
   1.266 +     (clojure.main/repl
   1.267 +      :init init
   1.268 +      :need-prompt need-prompt
   1.269 +      :prompt prompt-hook
   1.270 +      :flush flush
   1.271 +      :read read
   1.272 +      :eval eval
   1.273 +      :print print
   1.274 +      :caught caught)
   1.275 +     (finally
   1.276 +      (Var/popThreadBindings)
   1.277 +      (prn)))))