;;  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)))))