my-repl.clj

(import '(javax.swing JFrame JTextArea JPanel UIManager SwingUtilities JScrollPane BoxLayout)
        '(java.awt.event ActionListener KeyAdapter)
        '(java.io StringReader PrintWriter PushbackReader Writer StringReader OutputStreamWriter)
        '(java.awt GridLayout FlowLayout)
        '(java.util.concurrent LinkedBlockingQueue ArrayBlockingQueue)
        '(clojure.lang IDeref Associative LineNumberingPushbackReader))

(. UIManager (setLookAndFeel (. UIManager (getSystemLookAndFeelClassName))))

(defn fn->kl [fun]
  (proxy [KeyAdapter] []
    (keyTyped [event] (fun event))))
                                                                                                       
(defmacro EDT [& body]                                                                                 
  `(SwingUtilities/invokeLater (fn [] ~@body)))                                                        

(defn jta->ops [jta]
  (let [buffer (StringBuffer.)]
    (proxy [java.io.OutputStream IDeref] []
      (deref [] buffer)
      (flush []
             (when (< 0 (.length buffer))
              (let [sb (.toString buffer)]
                (EDT (.append jta sb))
                (.setLength buffer 0))))
      (close [] (.flush this))
      (write
        ([i] (.append buffer (char i)))
        ([buf off len]
         (doseq [i (take len (drop off buf))]
           (.append buffer (char i))))))))


(defn start-repl-thread [output transfer-q]
  (.start
    (Thread.
      #(binding [*out* (-> output jta->ops OutputStreamWriter. PrintWriter.)]
         (clojure.main/repl
           :caught (fn [x] (.printStackTrace x *out*) (.flush *out*) (println ""))
           :need-prompt (constantly false)
           :read (fn [a b]
                   (binding [*in* (.take transfer-q)]
                     (clojure.main/repl-read a b)))
           :print (fn [x]
                    (EDT (.append output (prn-str x)))))))))

(defn add-ctrl-enter-listener [text-area transfer-q]
  (EDT
    (.addKeyListener text-area
                     (fn->kl
                       (fn [event]
                         (when (and (= \newline (:keyChar (bean event)))
                                    (:controlDown (bean event)))
                           (.put transfer-q (-> event .getSource .getSelectedText
                                              StringReader. LineNumberingPushbackReader.))))))))

(defn start-gui [window text-area output]
  (EDT
    (doto (.getContentPane window)
      (.setLayout (BoxLayout. (.getContentPane window) (. BoxLayout Y_AXIS)))
      (.add (JScrollPane.
              (doto text-area
                (.setLineWrap true)
                (.setTabSize 2)
                (.setColumns 80)
                (.setRows 25))))
      (.add (JScrollPane.
              (doto output
                (.setLineWrap true)
                (.setTabSize 2)
                (.setColumns 80)
                (.setRows 5)
                (.setEditable false)))))
    (doto window
      .pack
      (.setVisible true))))

(let [text-area (JTextArea.)
      output (JTextArea.)
      transfer-q (ArrayBlockingQueue. 1)]
  (start-repl-thread output transfer-q)
  (add-ctrl-enter-listener text-area transfer-q)
  (start-gui (JFrame. "Clojure") text-area output))