From ab7e0e084dd98835619b5b0560815806aacff218 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 20 Sep 2013 11:32:07 +0100
Subject: [PATCH] added the actual working files :-)

---
 project.clj        |  7 ++++
 src/fedit/core.clj | 99 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 106 insertions(+)
 create mode 100644 project.clj
 create mode 100644 src/fedit/core.clj

diff --git a/project.clj b/project.clj
new file mode 100644
index 0000000..7d0c6cf
--- /dev/null
+++ b/project.clj
@@ -0,0 +1,7 @@
+(defproject fedit "0.1.0-SNAPSHOT"
+  :description "An attempt to reconstruct the Cambridge Lisp 'fedit' in core editor, as a precursor to attempting to reconstruct the InterLisp DEdit editor"
+  :url "http://example.com/FIXME"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :dependencies [[org.clojure/clojure "1.5.1"]]
+  :clean-targets ["classes" "bin"])
diff --git a/src/fedit/core.clj b/src/fedit/core.clj
new file mode 100644
index 0000000..f041969
--- /dev/null
+++ b/src/fedit/core.clj
@@ -0,0 +1,99 @@
+(ns fedit.core
+  (:use clojure.repl))
+
+(defn clear-terminal
+  "Clear the terminal screen - should be possible to do this by printing a \f, but
+   that does not seem to work."
+  []
+  (dotimes [_ 25] (println)))
+
+(defn print-indent
+  "indent this many spaces and then print this s-expression"
+  [x spaces]
+  (dotimes [_ spaces] (print " "))
+  (println x)
+  x)
+
+(defn recursively-frob-strings 
+  "Walk this s-expression, replacing strings with quoted strings.
+
+   TODO: does not fix strings in vectors"
+  [sexpr]
+  (cond 
+    (nil? sexpr) nil
+    (symbol? sexpr) sexpr
+    (empty? sexpr) ()
+    (list? sexpr)(cons (recursively-frob-strings (first sexpr))(recursively-frob-strings (rest sexpr)))
+    (string? sexpr)(str "\"" sexpr "\"")
+    true sexpr))
+
+(defn rereadable-print-str 
+  "print-str doesn't produce a re-readable output, because it does not surround 
+   embedded strings with quotation marks. This attempts to fix this problem."
+  [sexpr]
+  (let [fixed (recursively-frob-strings sexpr)]
+    (print-str fixed))) 
+
+(defn pretty-print 
+  "Print this s-expression neatly indented. 
+
+   TODO: Does not yet handle vectors intelligently"
+  ([sexpr] (pretty-print sexpr 0))
+  ([sexpr indent]  
+  (cond 
+    (string? sexpr)
+    (let [printform (str "\"" sexpr "\"")](print-indent printform indent))
+    (list? sexpr)
+    (let [asstring (rereadable-print-str sexpr)]
+      ;; print-str isn't right here because it does not substitute in quotation marks around strings
+      ;; need to write a new function of my own.
+      (cond 
+        (< (+ indent (count asstring)) 80) (print-indent asstring indent)
+              true (do 
+                    (let [firstline (str "(" (rereadable-print-str (first sexpr)))] 
+                      (print-indent firstline indent))
+                    (doall (map (fn [x] (pretty-print x (+ indent 2))) (rest sexpr)))
+                    (print-indent ")" indent))))
+    true (print-indent sexpr indent))
+  sexpr))
+
+(defn read-char
+  "Ultimately this will read a single character, probably requiring some Java hackery; but for now
+   just read"
+  []
+  (read))
+
+(defn prompt-and-read 
+  "Show a prompt, and read a form from the input
+   TODO: the read should be on the same line as the prompt - again, possibly some hackery needed."
+  [prompt]
+  ;; print, on its own, does not flush the buffer.
+  (println prompt)
+  (read))
+
+(defn sedit
+  "Edit an S-Expression, and return a modified version of it" 
+  [sexpr]
+  (clear-terminal)
+  (pretty-print sexpr)
+  (cond (list? sexpr) (println "Enter one character: a:CAR; d:CDR; s:Substitute; x:Cut; r:Return")
+    true (println "Enter one character: s:Substitute; x:Cut; r:Return"))
+  (let [key (read-char)]
+    (cond
+      (= key 'x) nil
+      (= key 's) (prompt-and-read "==?")
+      (and (= key 'a)(list? sexpr)(> (count sexpr) 0)) 
+      (let [car (sedit (first sexpr)) cdr (rest sexpr)](sedit (cons car cdr)))
+      (and (= key 'd)(list? sexpr)) 
+      (let [car (first sexpr) cdr (sedit (rest sexpr))](sedit (cons car cdr)))
+      (= key 'r) sexpr
+      true (sedit sexpr))))
+
+(defn fedit
+  "Edit a named function or macro, and recompile the result.
+   TODO: recompiles into the current namespace, not the original namespace. Is this the
+   right behaviour?"
+  [name]
+  (let [sexpr (sedit (read-string (source-fn name)))]
+  (eval sexpr)))
+