1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/main.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,358 @@
     1.4 +;; Copyright (c) Rich Hickey 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 be found
     1.7 +;; in the file epl-v10.html at the root of this distribution. By using this
     1.8 +;; software in any fashion, you are agreeing to be bound by the terms of
     1.9 +;; this license. You must not remove this notice, or any other, from this
    1.10 +;; software.
    1.11 +
    1.12 +;; Originally contributed by Stephen C. Gilardi
    1.13 +
    1.14 +(ns ^{:doc "Top-level main function for Clojure REPL and scripts."
    1.15 +       :author "Stephen C. Gilardi and Rich Hickey"}
    1.16 +  clojure.main
    1.17 +  (:refer-clojure :exclude [with-bindings])
    1.18 +  (:import (clojure.lang Compiler Compiler$CompilerException
    1.19 +                         LineNumberingPushbackReader RT)))
    1.20 +
    1.21 +(declare main)
    1.22 +
    1.23 +(defmacro with-bindings
    1.24 +  "Executes body in the context of thread-local bindings for several vars
    1.25 +  that often need to be set!: *ns* *warn-on-reflection* *math-context*
    1.26 +  *print-meta* *print-length* *print-level* *compile-path*
    1.27 +  *command-line-args* *1 *2 *3 *e"
    1.28 +  [& body]
    1.29 +  `(binding [*ns* *ns*
    1.30 +             *warn-on-reflection* *warn-on-reflection*
    1.31 +             *math-context* *math-context*
    1.32 +             *print-meta* *print-meta*
    1.33 +             *print-length* *print-length*
    1.34 +             *print-level* *print-level*
    1.35 +             *compile-path* (System/getProperty "clojure.compile.path" "classes")
    1.36 +             *command-line-args* *command-line-args*
    1.37 +             *assert* *assert*
    1.38 +             *1 nil
    1.39 +             *2 nil
    1.40 +             *3 nil
    1.41 +             *e nil]
    1.42 +     ~@body))
    1.43 +
    1.44 +(defn repl-prompt
    1.45 +  "Default :prompt hook for repl"
    1.46 +  []
    1.47 +  (printf "%s=> " (ns-name *ns*)))
    1.48 +
    1.49 +(defn skip-if-eol
    1.50 +  "If the next character on stream s is a newline, skips it, otherwise
    1.51 +  leaves the stream untouched. Returns :line-start, :stream-end, or :body
    1.52 +  to indicate the relative location of the next character on s. The stream
    1.53 +  must either be an instance of LineNumberingPushbackReader or duplicate
    1.54 +  its behavior of both supporting .unread and collapsing all of CR, LF, and
    1.55 +  CRLF to a single \\newline."
    1.56 +  [s]
    1.57 +  (let [c (.read s)]
    1.58 +    (cond
    1.59 +     (= c (int \newline)) :line-start
    1.60 +     (= c -1) :stream-end
    1.61 +     :else (do (.unread s c) :body))))
    1.62 +
    1.63 +(defn skip-whitespace
    1.64 +  "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
    1.65 +  or :body to indicate the relative location of the next character on s.
    1.66 +  Interprets comma as whitespace and semicolon as comment to end of line.
    1.67 +  Does not interpret #! as comment to end of line because only one
    1.68 +  character of lookahead is available. The stream must either be an
    1.69 +  instance of LineNumberingPushbackReader or duplicate its behavior of both
    1.70 +  supporting .unread and collapsing all of CR, LF, and CRLF to a single
    1.71 +  \\newline."
    1.72 +  [s]
    1.73 +  (loop [c (.read s)]
    1.74 +    (cond
    1.75 +     (= c (int \newline)) :line-start
    1.76 +     (= c -1) :stream-end
    1.77 +     (= c (int \;)) (do (.readLine s) :line-start)
    1.78 +     (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s))
    1.79 +     :else (do (.unread s c) :body))))
    1.80 +
    1.81 +(defn repl-read
    1.82 +  "Default :read hook for repl. Reads from *in* which must either be an
    1.83 +  instance of LineNumberingPushbackReader or duplicate its behavior of both
    1.84 +  supporting .unread and collapsing all of CR, LF, and CRLF into a single
    1.85 +  \\newline. repl-read:
    1.86 +    - skips whitespace, then
    1.87 +      - returns request-prompt on start of line, or
    1.88 +      - returns request-exit on end of stream, or
    1.89 +      - reads an object from the input stream, then
    1.90 +        - skips the next input character if it's end of line, then
    1.91 +        - returns the object."
    1.92 +  [request-prompt request-exit]
    1.93 +  (or ({:line-start request-prompt :stream-end request-exit}
    1.94 +       (skip-whitespace *in*))
    1.95 +      (let [input (read)]
    1.96 +        (skip-if-eol *in*)
    1.97 +        input)))
    1.98 +
    1.99 +(defn- root-cause
   1.100 +  "Returns the initial cause of an exception or error by peeling off all of
   1.101 +  its wrappers"
   1.102 +  [^Throwable throwable]
   1.103 +  (loop [cause throwable]
   1.104 +    (if-let [cause (.getCause cause)]
   1.105 +      (recur cause)
   1.106 +      cause)))
   1.107 +
   1.108 +(defn repl-exception
   1.109 +  "Returns CompilerExceptions in tact, but only the root cause of other
   1.110 +  throwables"
   1.111 +  [throwable]
   1.112 +  (if (instance? Compiler$CompilerException throwable)
   1.113 +    throwable
   1.114 +    (root-cause throwable)))
   1.115 +
   1.116 +(defn repl-caught
   1.117 +  "Default :caught hook for repl"
   1.118 +  [e]
   1.119 +  (.println *err* (repl-exception e)))
   1.120 +
   1.121 +(defn repl
   1.122 +  "Generic, reusable, read-eval-print loop. By default, reads from *in*,
   1.123 +  writes to *out*, and prints exception summaries to *err*. If you use the
   1.124 +  default :read hook, *in* must either be an instance of
   1.125 +  LineNumberingPushbackReader or duplicate its behavior of both supporting
   1.126 +  .unread and collapsing CR, LF, and CRLF into a single \\newline. Options
   1.127 +  are sequential keyword-value pairs. Available options and their defaults:
   1.128 +
   1.129 +     - :init, function of no arguments, initialization hook called with
   1.130 +       bindings for set!-able vars in place.
   1.131 +       default: #()
   1.132 +
   1.133 +     - :need-prompt, function of no arguments, called before each
   1.134 +       read-eval-print except the first, the user will be prompted if it
   1.135 +       returns true.
   1.136 +       default: (if (instance? LineNumberingPushbackReader *in*)
   1.137 +                  #(.atLineStart *in*)
   1.138 +                  #(identity true))
   1.139 +
   1.140 +     - :prompt, function of no arguments, prompts for more input.
   1.141 +       default: repl-prompt
   1.142 +
   1.143 +     - :flush, function of no arguments, flushes output
   1.144 +       default: flush
   1.145 +
   1.146 +     - :read, function of two arguments, reads from *in*:
   1.147 +         - returns its first argument to request a fresh prompt
   1.148 +           - depending on need-prompt, this may cause the repl to prompt
   1.149 +             before reading again
   1.150 +         - returns its second argument to request an exit from the repl
   1.151 +         - else returns the next object read from the input stream
   1.152 +       default: repl-read
   1.153 +
   1.154 +     - :eval, funtion of one argument, returns the evaluation of its
   1.155 +       argument
   1.156 +       default: eval
   1.157 +
   1.158 +     - :print, function of one argument, prints its argument to the output
   1.159 +       default: prn
   1.160 +
   1.161 +     - :caught, function of one argument, a throwable, called when
   1.162 +       read, eval, or print throws an exception or error
   1.163 +       default: repl-caught"
   1.164 +  [& options]
   1.165 +  (let [cl (.getContextClassLoader (Thread/currentThread))]
   1.166 +    (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl)))
   1.167 +  (let [{:keys [init need-prompt prompt flush read eval print caught]
   1.168 +         :or {init        #()
   1.169 +              need-prompt (if (instance? LineNumberingPushbackReader *in*)
   1.170 +                            #(.atLineStart ^LineNumberingPushbackReader *in*)
   1.171 +                            #(identity true))
   1.172 +              prompt      repl-prompt
   1.173 +              flush       flush
   1.174 +              read        repl-read
   1.175 +              eval        eval
   1.176 +              print       prn
   1.177 +              caught      repl-caught}}
   1.178 +        (apply hash-map options)
   1.179 +        request-prompt (Object.)
   1.180 +        request-exit (Object.)
   1.181 +        read-eval-print
   1.182 +        (fn []
   1.183 +          (try
   1.184 +           (let [input (read request-prompt request-exit)]
   1.185 +             (or (#{request-prompt request-exit} input)
   1.186 +                 (let [value (eval input)]
   1.187 +                   (print value)
   1.188 +                   (set! *3 *2)
   1.189 +                   (set! *2 *1)
   1.190 +                   (set! *1 value))))
   1.191 +           (catch Throwable e
   1.192 +             (caught e)
   1.193 +             (set! *e e))))]
   1.194 +    (with-bindings
   1.195 +     (try
   1.196 +      (init)
   1.197 +      (catch Throwable e
   1.198 +        (caught e)
   1.199 +        (set! *e e)))
   1.200 +     (use '[clojure.repl :only (source apropos dir)])
   1.201 +     (use '[clojure.java.javadoc :only (javadoc)])
   1.202 +     (use '[clojure.pprint :only (pp pprint)])
   1.203 +     (prompt)
   1.204 +     (flush)
   1.205 +     (loop []
   1.206 +       (when-not 
   1.207 +       	 (try (= (read-eval-print) request-exit)
   1.208 +	  (catch Throwable e
   1.209 +	   (caught e)
   1.210 +	   (set! *e e)
   1.211 +	   nil))
   1.212 +         (when (need-prompt)
   1.213 +           (prompt)
   1.214 +           (flush))
   1.215 +         (recur))))))
   1.216 +
   1.217 +(defn load-script
   1.218 +  "Loads Clojure source from a file or resource given its path. Paths
   1.219 +  beginning with @ or @/ are considered relative to classpath."
   1.220 +  [^String path]
   1.221 +  (if (.startsWith path "@")
   1.222 +    (RT/loadResourceScript
   1.223 +     (.substring path (if (.startsWith path "@/") 2 1)))
   1.224 +    (Compiler/loadFile path)))
   1.225 +
   1.226 +(defn- init-opt
   1.227 +  "Load a script"
   1.228 +  [path]
   1.229 +  (load-script path))
   1.230 +
   1.231 +(defn- eval-opt
   1.232 +  "Evals expressions in str, prints each non-nil result using prn"
   1.233 +  [str]
   1.234 +  (let [eof (Object.)
   1.235 +        reader (LineNumberingPushbackReader. (java.io.StringReader. str))]
   1.236 +      (loop [input (read reader false eof)]
   1.237 +        (when-not (= input eof)
   1.238 +          (let [value (eval input)]
   1.239 +            (when-not (nil? value)
   1.240 +              (prn value))
   1.241 +            (recur (read reader false eof)))))))
   1.242 +
   1.243 +(defn- init-dispatch
   1.244 +  "Returns the handler associated with an init opt"
   1.245 +  [opt]
   1.246 +  ({"-i"     init-opt
   1.247 +    "--init" init-opt
   1.248 +    "-e"     eval-opt
   1.249 +    "--eval" eval-opt} opt))
   1.250 +
   1.251 +(defn- initialize
   1.252 +  "Common initialize routine for repl, script, and null opts"
   1.253 +  [args inits]
   1.254 +  (in-ns 'user)
   1.255 +  (set! *command-line-args* args)
   1.256 +  (doseq [[opt arg] inits]
   1.257 +    ((init-dispatch opt) arg)))
   1.258 +
   1.259 +(defn- repl-opt
   1.260 +  "Start a repl with args and inits. Print greeting if no eval options were
   1.261 +  present"
   1.262 +  [[_ & args] inits]
   1.263 +  (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
   1.264 +    (println "Clojure" (clojure-version)))
   1.265 +  (repl :init #(initialize args inits))
   1.266 +  (prn)
   1.267 +  (System/exit 0))
   1.268 +
   1.269 +(defn- script-opt
   1.270 +  "Run a script from a file, resource, or standard in with args and inits"
   1.271 +  [[path & args] inits]
   1.272 +  (with-bindings
   1.273 +    (initialize args inits)
   1.274 +    (if (= path "-")
   1.275 +      (load-reader *in*)
   1.276 +      (load-script path))))
   1.277 +
   1.278 +(defn- null-opt
   1.279 +  "No repl or script opt present, just bind args and run inits"
   1.280 +  [args inits]
   1.281 +  (with-bindings
   1.282 +    (initialize args inits)))
   1.283 +
   1.284 +(defn- help-opt
   1.285 +  "Print help text for main"
   1.286 +  [_ _]
   1.287 +  (println (:doc (meta (var main)))))
   1.288 +
   1.289 +(defn- main-dispatch
   1.290 +  "Returns the handler associated with a main option"
   1.291 +  [opt]
   1.292 +  (or
   1.293 +   ({"-r"     repl-opt
   1.294 +     "--repl" repl-opt
   1.295 +     nil      null-opt
   1.296 +     "-h"     help-opt
   1.297 +     "--help" help-opt
   1.298 +     "-?"     help-opt} opt)
   1.299 +   script-opt))
   1.300 +
   1.301 +(defn- legacy-repl
   1.302 +  "Called by the clojure.lang.Repl.main stub to run a repl with args
   1.303 +  specified the old way"
   1.304 +  [args]
   1.305 +  (println "WARNING: clojure.lang.Repl is deprecated.
   1.306 +Instead, use clojure.main like this:
   1.307 +java -cp clojure.jar clojure.main -i init.clj -r args...")
   1.308 +  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
   1.309 +    (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits))))
   1.310 +
   1.311 +(defn- legacy-script
   1.312 +  "Called by the clojure.lang.Script.main stub to run a script with args
   1.313 +  specified the old way"
   1.314 +  [args]
   1.315 +  (println "WARNING: clojure.lang.Script is deprecated.
   1.316 +Instead, use clojure.main like this:
   1.317 +java -cp clojure.jar clojure.main -i init.clj script.clj args...")
   1.318 +  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
   1.319 +    (null-opt args (map vector (repeat "-i") inits))))
   1.320 +
   1.321 +(defn main
   1.322 +  "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*]
   1.323 +
   1.324 +  With no options or args, runs an interactive Read-Eval-Print Loop
   1.325 +
   1.326 +  init options:
   1.327 +    -i, --init path   Load a file or resource
   1.328 +    -e, --eval string Evaluate expressions in string; print non-nil values
   1.329 +
   1.330 +  main options:
   1.331 +    -r, --repl        Run a repl
   1.332 +    path              Run a script from from a file or resource
   1.333 +    -                 Run a script from standard input
   1.334 +    -h, -?, --help    Print this help message and exit
   1.335 +
   1.336 +  operation:
   1.337 +
   1.338 +    - Establishes thread-local bindings for commonly set!-able vars
   1.339 +    - Enters the user namespace
   1.340 +    - Binds *command-line-args* to a seq of strings containing command line
   1.341 +      args that appear after any main option
   1.342 +    - Runs all init options in order
   1.343 +    - Runs a repl or script if requested
   1.344 +
   1.345 +  The init options may be repeated and mixed freely, but must appear before
   1.346 +  any main option. The appearance of any eval option before running a repl
   1.347 +  suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\".
   1.348 +
   1.349 +  Paths may be absolute or relative in the filesystem or relative to
   1.350 +  classpath. Classpath-relative paths have prefix of @ or @/"
   1.351 +  [& args]
   1.352 +  (try
   1.353 +   (if args
   1.354 +     (loop [[opt arg & more :as args] args inits []]
   1.355 +       (if (init-dispatch opt)
   1.356 +         (recur more (conj inits [opt arg]))
   1.357 +         ((main-dispatch opt) args inits)))
   1.358 +     (repl-opt nil nil))
   1.359 +   (finally 
   1.360 +     (flush))))
   1.361 +