srepl.clj

core.clj

(ns srepl.core
  (:use [clojure.main :only [repl]]
        [clojure.pprint :only [pprint with-pprint-dispatch code-dispatch]])
  (:import (jline.console ConsoleReader)
           (jline.console.completer Completer))
  (:gen-class))

(defmulti super-dispatch class)

(defmethod super-dispatch :default [thing]
  (code-dispatch thing))

(def namespace-coloring "\u001B[32m%s\u001B[0m")

(defmethod super-dispatch clojure.lang.Var [thing]
  (print (format "#'%s/%s"
                 (format namespace-coloring (.ns thing))
                 (.sym thing))))

(defmethod super-dispatch clojure.lang.Namespace [ns]
  (print (format "#<Namespace %s>"
                 (format namespace-coloring (ns-name ns)))))

(defmethod super-dispatch clojure.lang.Named [n]
  (print
   (str
    (if (keyword? n)
      ":"
      "")
    (if (namespace n)
      (str (format namespace-coloring (namespace n)) "/" (name n))
      (name n)))))

(defn namespace-completer []
  (reify
    Completer
    (complete [_ buffer cursor canidates]
      (let [last-word (re-find #"\w+$" buffer)
            pubs (ns-map *ns*)]
        (when last-word
          (doseq [[n v] pubs
                  :when (.startsWith (str n) last-word)]
            (.add canidates (str n))
            (when (class? v)
              (.add canidates (str n ".")))))
        (- (count buffer) (count last-word))))))

(defn -main []
  (with-open [rdr (ConsoleReader.)]
    (.addCompleter rdr (namespace-completer))
    (with-pprint-dispatch super-dispatch
      (repl :print (fn [o]
                     (pprint o)
                     (flush))
            :need-prompt (constantly false)
            :read (fn [new-prompt exit]
                    (letfn [(read-line [prompt]
                              (.readLine rdr prompt))
                            (read [buf]
                              (try
                                (read-string buf)
                                (catch Exception e
                                  (if (.contains (.getMessage e) "EOF")
                                    (partial read (str buf "\n" (read-line ">")))
                                    (throw e)))))]
                      (trampoline read (read-line (str (ns-name *ns*) "=> ")))))))))