rlm@10: ;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
rlm@10: ;;  distribution terms for this software are covered by the Eclipse Public
rlm@10: ;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
rlm@10: ;;  be found in the file epl-v10.html at the root of this distribution.  By
rlm@10: ;;  using this software in any fashion, you are agreeing to be bound by the
rlm@10: ;;  terms of this license.  You must not remove this notice, or any other,
rlm@10: ;;  from this software.
rlm@10: ;;
rlm@10: ;;  A repl with that provides support for lines and line numbers in the
rlm@10: ;;  input stream.
rlm@10: ;;
rlm@10: ;;  scgilardi (gmail)
rlm@10: ;;  Created 28 November 2008
rlm@10: 
rlm@10: (ns 
rlm@10:   ^{:author "Stephen C. Gilardi",
rlm@10:      :doc "A repl with that provides support for lines and line numbers in the
rlm@10:            input stream."}
rlm@10:   clojure.contrib.repl-ln
rlm@10:   (:gen-class)
rlm@10:   (:import (clojure.lang Compiler LineNumberingPushbackReader RT Var)
rlm@10:            (java.io InputStreamReader OutputStreamWriter PrintWriter)
rlm@10:            java.util.Date)
rlm@10:   (:require clojure.main)
rlm@10:   (:use [clojure.contrib.def
rlm@10:          :only (defmacro- defonce- defstruct- defvar-)]))
rlm@10: 
rlm@10: ;; Private
rlm@10: 
rlm@10: (declare repl)
rlm@10: 
rlm@10: (defstruct- repl-info
rlm@10:   :name :started :name-fmt :prompt-fmt :serial :thread :depth)
rlm@10: 
rlm@10: (defvar- +name-formats+
rlm@10:   {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d"}
rlm@10:   "For set-name, maps our dynamic value codes to arg positions in
rlm@10:   the call to format in repl-name")
rlm@10: 
rlm@10: (defvar- +prompt-formats+
rlm@10:   {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d" "%L" "%4$d" "%N" "%5$s"}
rlm@10:   "For set-prompt, maps our dynamic value codes to arg positions in
rlm@10:   the call to format in repl-prompt")
rlm@10: 
rlm@10: (defvar- +info-format+
rlm@10:   ["Name:       %s"
rlm@10:    "Started:    %s"
rlm@10:    "Name-fmt:   \"%s\""
rlm@10:    "Prompt-fmt: \"%s\""
rlm@10:    "Serial:     %d"
rlm@10:    "Thread:     %d"
rlm@10:    "Depth:      %d"
rlm@10:    "Line:       %d"])
rlm@10: 
rlm@10: (defvar- +info-defaults+
rlm@10:   (struct-map repl-info
rlm@10:     :name-fmt   "repl-%S"
rlm@10:     :prompt-fmt "%S:%L %N=> "
rlm@10:     :depth      0)
rlm@10:   "Default/root values for repl info")
rlm@10: 
rlm@10: (defonce- *serial-number* (atom 0)
rlm@10:   "Serial number counter")
rlm@10: 
rlm@10: (defonce- *info* +info-defaults+
rlm@10:   "Public info for this repl")
rlm@10: 
rlm@10: (defonce- *private* {}
rlm@10:   "Private info for this repl")
rlm@10: 
rlm@10: (defmacro- update
rlm@10:   "Replaces the map thread-locally bound to map-var with a copy that
rlm@10:   includes updated and/or new values from keys and vals."
rlm@10:   [map-var & key-vals]
rlm@10:   `(set! ~map-var (assoc ~map-var ~@key-vals)))
rlm@10: 
rlm@10: (defn- repl-name
rlm@10:   "Returns the repl name based on this repl's name-fmt"
rlm@10:   []
rlm@10:   (let [{:keys [name-fmt]} *private*
rlm@10:         {:keys [serial thread depth]} *info*]
rlm@10:     (format name-fmt serial thread depth)))
rlm@10: 
rlm@10: (defn- prompt-hook
rlm@10:   []
rlm@10:   (let [prompt (*private* :prompt)]
rlm@10:     (var-set Compiler/LINE (.getLineNumber *in*))
rlm@10:     (prompt)))
rlm@10: 
rlm@10: (defn- process-inits
rlm@10:   "Processes initial pairs of args of the form:
rlm@10: 
rlm@10:     -i     filepath, or
rlm@10:     --init filepath
rlm@10: 
rlm@10:   by loading the referenced files, then accepts an optional terminating arg
rlm@10:   of the form:
rlm@10: 
rlm@10:     -r, or
rlm@10:     --repl
rlm@10: 
rlm@10:   Returns a seq of any remaining args."
rlm@10:   [args]
rlm@10:   (loop [[init filename & more :as args] args]
rlm@10:     (if (#{"-i" "--init"} init)
rlm@10:       (do
rlm@10:         (clojure.main/load-script filename)
rlm@10:         (recur more))
rlm@10:       (if (#{"-r" "--repl"} init)
rlm@10:         (rest args)
rlm@10:         args))))
rlm@10: 
rlm@10: (defn- process-command-line
rlm@10:   "Args are strings passed in from the command line. Loads any requested
rlm@10:   init files and binds *command-line-args* to a seq of the remaining args"
rlm@10:   [args]
rlm@10:   (set! *command-line-args* (process-inits args)))
rlm@10: 
rlm@10: (defn stream-repl
rlm@10:   "Repl entry point that provides convenient overriding of input, output,
rlm@10:   and err streams via sequential keyword-value pairs. Default values
rlm@10:   for :in, :out, and :err are streams associated with System/in,
rlm@10:   System/out, and System/err using UTF-8 encoding. Also supports all the
rlm@10:   options provided by clojure.contrib.repl-ln/repl."
rlm@10:   [& options]
rlm@10:   (let [enc RT/UTF8
rlm@10:         {:keys [in out err]
rlm@10:          :or {in (LineNumberingPushbackReader.
rlm@10:                   (InputStreamReader. System/in enc))
rlm@10:               out (OutputStreamWriter. System/out enc)
rlm@10:               err (PrintWriter. (OutputStreamWriter. System/err enc))}}
rlm@10:         (apply hash-map options)]
rlm@10:     (binding [*in* in *out* out *err* err]
rlm@10:       (apply repl options))))
rlm@10: 
rlm@10: (defn- -main
rlm@10:   "Main entry point, starts a repl enters the user namespace and processes
rlm@10:   command line args."
rlm@10:   [& args]
rlm@10:   (repl :init
rlm@10:         (fn []
rlm@10:           (println "Clojure" (clojure-version))
rlm@10:           (in-ns 'user)
rlm@10:           (process-command-line args))))
rlm@10: 
rlm@10: ;; Public
rlm@10: 
rlm@10: (defn repl-prompt
rlm@10:   "Returns the current repl prompt based on this repl's prompt-fmt"
rlm@10:   []
rlm@10:   (let [{:keys [prompt-fmt]} *private*
rlm@10:         {:keys [serial thread depth]} *info*
rlm@10:         line (.getLineNumber *in*)
rlm@10:         namespace (ns-name *ns*)]
rlm@10:     (format prompt-fmt serial thread depth line namespace)))
rlm@10: 
rlm@10: (defn set-repl-name
rlm@10:   "Sets the repl name format to the string name-fmt. Include the following
rlm@10:   codes in the name to make the corresponding dynamic values part of it:
rlm@10: 
rlm@10:     %S - repl serial number
rlm@10:     %T - thread id
rlm@10:     %D - nesting depth in this thread
rlm@10: 
rlm@10:   With no arguments, resets the repl name to its default: \"repl-%S\""
rlm@10:   ([]
rlm@10:      (set-repl-name (+info-defaults+ :name-fmt)))
rlm@10:   ([name-fmt]
rlm@10:      (update *info* :name-fmt name-fmt)
rlm@10:      (loop [[[code fmt] & more] (seq +name-formats+)
rlm@10:             name-fmt name-fmt]
rlm@10:        (if code
rlm@10:          (recur more (.replace name-fmt code fmt))
rlm@10:          (update *private* :name-fmt name-fmt)))
rlm@10:      (let [name (repl-name)]
rlm@10:        (update *info* :name name)
rlm@10:        (var-set Compiler/SOURCE name))
rlm@10:      nil))
rlm@10: 
rlm@10: (defn set-repl-prompt
rlm@10:   "Sets the repl prompt. Include the following codes in the prompt to make
rlm@10:   the corresponding dynamic values part of it:
rlm@10: 
rlm@10:     %S - repl serial number
rlm@10:     %T - thread id
rlm@10:     %D - nesting depth in this thread
rlm@10:     %L - input line number
rlm@10:     %N - namespace name
rlm@10: 
rlm@10:   With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \""
rlm@10:   ([]
rlm@10:      (set-repl-prompt (+info-defaults+ :prompt-fmt)))
rlm@10:   ([prompt-fmt]
rlm@10:      (update *info* :prompt-fmt prompt-fmt)
rlm@10:      (loop [[[code fmt] & more] (seq +prompt-formats+)
rlm@10:             prompt-fmt prompt-fmt]
rlm@10:        (if code
rlm@10:          (recur more (.replace prompt-fmt code fmt))
rlm@10:          (update *private* :prompt-fmt prompt-fmt)))
rlm@10:      nil))
rlm@10: 
rlm@10: (defn repl-info
rlm@10:   "Returns a map of info about the current repl"
rlm@10:   []
rlm@10:   (let [line (.getLineNumber *in*)]
rlm@10:     (assoc *info* :line line)))
rlm@10: 
rlm@10: (defn print-repl-info
rlm@10:   "Prints info about the current repl"
rlm@10:   []
rlm@10:   (let [{:keys [name started name-fmt prompt-fmt serial thread depth line]}
rlm@10:         (repl-info)]
rlm@10:     (printf
rlm@10:      (apply str (interleave +info-format+ (repeat "\n")))
rlm@10:      name started name-fmt prompt-fmt serial thread depth line)))
rlm@10: 
rlm@10: (defn repl
rlm@10:   "A repl that supports line numbers. For definitions and evaluations made
rlm@10:   at the repl, the repl-name and line number will be reported as the
rlm@10:   origin. Use set-repl-name and set-repl-prompt to customize the repl name
rlm@10:   and prompt. This repl supports all of the keyword arguments documented
rlm@10:   for clojure.main/repl with the following change and additions:
rlm@10: 
rlm@10:        - :prompt has a new default
rlm@10:          default: #(clojure.core/print (repl-prompt))
rlm@10: 
rlm@10:        - :name-fmt, Name format string
rlm@10:          default: the name-fmt of the parent repl, or \"repl-%S\"
rlm@10: 
rlm@10:        - :prompt-fmt, Prompt format string
rlm@10:          default: the prompt-fmt of the parent repl, or \"%S:%L %N=> \""
rlm@10:   [& options]
rlm@10:   (let [{:keys [init need-prompt prompt flush read eval print caught
rlm@10:                 name-fmt prompt-fmt]
rlm@10:          :or {init        #()
rlm@10:               need-prompt (if (instance? LineNumberingPushbackReader *in*)
rlm@10:                             #(.atLineStart *in*)
rlm@10:                             #(identity true))
rlm@10:               prompt      #(clojure.core/print (repl-prompt))
rlm@10:               flush       flush
rlm@10:               read        clojure.main/repl-read
rlm@10:               eval        eval
rlm@10:               print       prn
rlm@10:               caught      clojure.main/repl-caught
rlm@10:               name-fmt    (*info* :name-fmt)
rlm@10:               prompt-fmt  (*info* :prompt-fmt)}}
rlm@10:               (apply hash-map options)]
rlm@10:     (try
rlm@10:      (Var/pushThreadBindings
rlm@10:       {Compiler/SOURCE (var-get Compiler/SOURCE)
rlm@10:        Compiler/LINE (var-get Compiler/LINE)
rlm@10:        (var *info*) *info*
rlm@10:        (var *private*) {}})
rlm@10:      (update *info*
rlm@10:              :started (Date.)
rlm@10:              :serial (swap! *serial-number* inc)
rlm@10:              :thread (.getId (Thread/currentThread))
rlm@10:              :depth (inc (*info* :depth)))
rlm@10:      (update *private*
rlm@10:              :prompt prompt)
rlm@10:      (set-repl-name name-fmt)
rlm@10:      (set-repl-prompt prompt-fmt)
rlm@10:      (clojure.main/repl
rlm@10:       :init init
rlm@10:       :need-prompt need-prompt
rlm@10:       :prompt prompt-hook
rlm@10:       :flush flush
rlm@10:       :read read
rlm@10:       :eval eval
rlm@10:       :print print
rlm@10:       :caught caught)
rlm@10:      (finally
rlm@10:       (Var/popThreadBindings)
rlm@10:       (prn)))))