Merge: the prompt remembers what was typed at it

emacs/MANUAL.md

@@ -200,6 +200,19 @@ that is what the program calls it.
 That is separate from the REPL, because the program's stdout belongs to the
 program.
 
+**History.** `<up>` and `<down>` walk it while you are on the line you are
+typing, filtered by whatever you have typed so far — `(sim` then `<up>` reaches
+only the forms that start that way. Anywhere above the prompt the same keys move
+by line, so the transcript is still something you can scroll back through.
+`M-p`, `M-n` and `M-r` are comint's own and unchanged.
+
+It survives quitting Emacs. The file is `flan-repl-history` under
+`user-emacs-directory`, so `no-littering` and a moved state directory both take
+it with them; set `flan-repl-history-file` to nil to keep history for the
+session only, or `flan-repl-history-size` to keep more or less than 500 entries.
+A form typed over several lines is saved whole and comes back whole, and RET on
+one recalled sends all of it.
+
 ---
 
 ## When the program stops

emacs/flan-repl.el

@@ -54,6 +54,30 @@
   :type 'string
   :group 'flan)
 
+(defcustom flan-repl-history-file (locate-user-emacs-file "flan-repl-history")
+  "File the prompt's input history is kept in between sessions.
+`locate-user-emacs-file' rather than a path of this file's own choosing: it
+follows `user-emacs-directory', which is what `no-littering' and anyone who
+has moved their state elsewhere have already redirected.  nil keeps history
+for the session only."
+  :type '(choice file (const :tag "Do not keep history between sessions" nil))
+  :group 'flan)
+
+(defcustom flan-repl-history-size 500
+  "How many inputs the prompt remembers."
+  :type 'integer
+  :group 'flan)
+
+(defconst flan-repl--history-separator "\n\f\n"
+  "What separates two entries in the history file.
+Comint separates them with a newline, which is also what is *inside* a form
+typed over several lines: written that way, one such form comes back as
+several broken ones.  A form feed alone on a line cannot occur inside a form,
+so the file survives the round trip.
+Let-bound around each call rather than set in the buffer, because
+`comint-write-input-ring' reads this variable inside a temporary buffer where
+a buffer-local value is not visible.")
+
 (defvar flan-repl-prompt "flan> "
   "Prompt shown in `flan-repl-mode'.")
 
@@ -62,6 +86,8 @@
     (define-key map (kbd "C-c C-o") #'flan-show-output)
     (define-key map (kbd "C-c C-d") #'flan-describe)
     (define-key map (kbd "C-c C-q") #'flan-disconnect)
+    (define-key map (kbd "<up>") #'flan-repl-previous-input)
+    (define-key map (kbd "<down>") #'flan-repl-next-input)
     map)
   "Keymap for `flan-repl-mode'.")
 
@@ -79,7 +105,126 @@
   ;; does, and against the same program: they read the client's cache, which
   ;; is program-scoped, which is exactly what a prompt is.
   (flan-dev-setup)
-  (setq-local font-lock-defaults '(flan-font-lock-keywords)))
+  (setq-local font-lock-defaults '(flan-font-lock-keywords))
+  (setq-local comint-input-ring-size flan-repl-history-size)
+  (setq-local comint-input-ring-file-name
+              (and flan-repl-history-file
+                   (expand-file-name flan-repl-history-file)))
+  ;; comint made the ring before this body ran, sized from the global value.
+  (setq-local comint-input-ring (make-ring comint-input-ring-size))
+  (let ((comint-input-ring-separator flan-repl--history-separator))
+    ;; Silent: a first session has no file yet, and saying so is not news.
+    (comint-read-input-ring t))
+  (add-hook 'kill-buffer-hook #'flan-repl--save-history nil t))
+
+;;; History
+
+(defun flan-repl--history-entries (file)
+  "How many entries FILE holds.
+Counted rather than trusted to the ring, because the file may have been
+written by another Emacs since this buffer read it."
+  (if (not (file-readable-p file))
+      0
+    (with-temp-buffer
+      (insert-file-contents file)
+      (let ((n 0))
+        (goto-char (point-min))
+        (while (search-forward flan-repl--history-separator nil t)
+          (setq n (1+ n)))
+        n))))
+
+(defun flan-repl--save-history ()
+  "Write this buffer's input ring to `comint-input-ring-file-name'.
+Refused in the two cases where writing loses more than it keeps: a ring with
+nothing in it, which would empty the file, and a ring shorter than the file
+already is, which is what a second Emacs having saved a longer history since
+this buffer started looks like.  A write replaces the file whole, so either
+would throw away somebody's session."
+  (when (and comint-input-ring-file-name
+             (ring-p comint-input-ring)
+             (not (ring-empty-p comint-input-ring))
+             (>= (ring-length comint-input-ring)
+                 (flan-repl--history-entries comint-input-ring-file-name)))
+    (let ((comint-input-ring-separator flan-repl--history-separator))
+      (comint-write-input-ring))))
+
+(defun flan-repl--save-all-history ()
+  "Save every REPL buffer's history.
+`kill-buffer-hook' does not run for a buffer Emacs is exiting out from under,
+so quitting without killing the prompt first would otherwise lose the day."
+  (dolist (buf (buffer-list))
+    (with-current-buffer buf
+      (when (derived-mode-p 'flan-repl-mode)
+        (flan-repl--save-history)))))
+
+;; Not in batch.  A batch Emacs exits through `kill-emacs' like any other, and
+;; the prompt a test opened is nobody's session: the sweep would write the
+;; person running the test their own history file, out of a ring made of
+;; fixtures.
+(unless noninteractive
+  (add-hook 'kill-emacs-hook #'flan-repl--save-all-history))
+
+;;; Recall
+
+;; `<up>' at a prompt means history to nearly everyone who has used a shell,
+;; and `M-p' means it to nearly nobody who has not used Emacs.  But the text
+;; above the prompt is a transcript people scroll back through, and a blunt
+;; binding would make that impossible — so the key is history only where there
+;; is input for it to replace, and plain line motion everywhere else.  Inside a
+;; form typed over several lines it still moves between them, and reaches
+;; history from the first one.
+;;
+;; The search is prefix-filtered by what is already typed, which is comint's
+;; `...-from-input' pair and the same thing a shell's up-arrow does.
+
+(defun flan-repl--input-start ()
+  "Where the text being typed begins, or nil if there is no process."
+  (let ((proc (get-buffer-process (current-buffer))))
+    (and proc (marker-position (process-mark proc)))))
+
+(defun flan-repl--on-first-input-line-p ()
+  "Is point on the first line of the input, with history above it?"
+  (let ((start (flan-repl--input-start)))
+    ;; `forward-line' rather than `line-beginning-position': the prompt is a
+    ;; field, and field-constrained motion answers this question by accident
+    ;; rather than by the rule meant here.
+    (and start (<= start (point))
+         (<= (save-excursion (forward-line 0) (point)) start))))
+
+(defun flan-repl--on-last-input-line-p ()
+  "Is point on the last line of the input?"
+  (let ((start (flan-repl--input-start)))
+    (and start (<= start (point))
+         (save-excursion (forward-line 1) (eobp)))))
+
+(defun flan-repl-previous-input (n)
+  "Recall the previous matching input, or move up a line above the input."
+  (interactive "p")
+  (if (flan-repl--on-first-input-line-p)
+      (progn
+        ;; comint tells a continued search from a fresh one by looking at
+        ;; `last-command' for its own name, which a wrapper's press never
+        ;; leaves there: without the hand-off the second `<up>' searches again
+        ;; from the entry the first one inserted and never moves.
+        (setq this-command 'comint-previous-matching-input-from-input)
+        (comint-previous-matching-input-from-input n))
+    ;; Same reason in the other direction: `line-move' keeps the column it is
+    ;; aiming for only while the line-motion commands follow each other.
+    (setq this-command 'previous-line)
+    ;; `previous-line' and not `forward-line': the byte compiler's advice
+    ;; against it is for code moving over text, and this is a keypress asking
+    ;; for what the key does everywhere else — visual lines, kept column.
+    (with-no-warnings (previous-line n))))
+
+(defun flan-repl-next-input (n)
+  "Recall the next matching input, or move down a line above the input."
+  (interactive "p")
+  (if (flan-repl--on-last-input-line-p)
+      (progn
+        (setq this-command 'comint-next-matching-input-from-input)
+        (comint-next-matching-input-from-input n))
+    (setq this-command 'next-line)
+    (with-no-warnings (next-line n))))
 
 (defun flan-repl--complete-p (text)
   "Is TEXT a whole form?
@@ -123,7 +268,16 @@ should open a line, not send something the reader will reject."
                 (process-mark (get-buffer-process (current-buffer)))
                 (point-max))))
     (if (flan-repl--complete-p input)
-        (comint-send-input)
+        (progn
+          ;; `comint-send-input' sends the process mark to *point*, and
+          ;; `comint-eol-on-send' carries it no further than the end of one
+          ;; line.  Completeness above was judged over the whole input, so the
+          ;; whole input is what goes: otherwise RET in the middle of a form
+          ;; typed over several lines, or on one just recalled — history leaves
+          ;; point where the typing stopped — sends a fragment the reader will
+          ;; reject.
+          (goto-char (point-max))
+          (comint-send-input))
       (insert "\n"))))
 
 (define-key flan-repl-mode-map (kbd "RET") #'flan-repl-return)

emacs/test-flan-cider.el

@@ -1209,6 +1209,14 @@ stopped program, which is the case where it should fire."
                         (file-name-directory load-file-name))
       nil t)
 
+;; The prompt's history, which needs no daemon either: what a key does at the
+;; prompt and what survives in the history file are both settled by the ring
+;; and by where point is.  Evaluation is the half that needs a program, and
+;; test_emacs drives that.  Loaded here for the same reason as the two above.
+(load (expand-file-name "test-flan-repl.el"
+                        (file-name-directory load-file-name))
+      nil t)
+
 (message "\n%d checks, %d failures" test-flan--ran test-flan--failures)
 (kill-emacs (if (> test-flan--failures 0) 1 0))
 

emacs/test-flan-repl.el

@@ -0,0 +1,230 @@
+;;; test-flan-repl.el --- The prompt's history, at a stub prompt  -*- lexical-binding: t; -*-
+
+;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
+;; test-flan-mode.el gives: `emacs/*.el' is already a dependency of that
+;; stanza, so a file here needs no build change to be run.
+;;
+;; Nothing here needs a daemon, and that is not a shortcut.  History is a
+;; function from *a ring and where point is* to *what the buffer says*, and the
+;; failures worth catching are all on that side: an up-arrow that recalls where
+;; someone meant to scroll, a second press that does not move because comint
+;; cannot see its own name in `last-command', a form typed over several lines
+;; that comes back out of the file in pieces.  Evaluation is the other half and
+;; test_emacs drives it against a real program.
+;;
+;; The one thing that must be borrowed from the real thing is the process: the
+;; input line is wherever the process mark is, so a prompt with no process
+;; behind it has no input line to be on.  It is the same `cat' stub
+;; `flan-repl' starts, for the same reason its comment gives.
+
+;;; Code:
+
+(require 'flan-repl)
+(require 'ring)
+
+(declare-function test-flan--check "test-flan-cider" (name ok))
+(declare-function test-flan--caught "test-flan-cider" (thunk))
+
+(defvar test-flan-repl--history
+  (make-temp-name (expand-file-name "flan-repl-history-"
+                                    temporary-file-directory))
+  "Where these checks keep history.
+Never the user's own file: `kill-emacs-hook' saves every REPL buffer, and a
+batch run exits through `kill-emacs' like any other.")
+
+(defun test-flan-repl--buffer (&optional inputs)
+  "A live `flan-repl-mode' buffer at a fresh prompt, with INPUTS in its ring.
+INPUTS are given oldest first, the order they would have been typed in."
+  (let ((buf (get-buffer-create "*test-flan-repl*")))
+    (with-current-buffer buf
+      (let ((flan-repl-history-file test-flan-repl--history))
+        (flan-repl-mode))
+      (let ((proc (start-process "test-flan-repl" buf "cat")))
+        (set-process-query-on-exit-flag proc nil)
+        (comint-output-filter proc flan-repl-prompt))
+      (dolist (input inputs) (ring-insert comint-input-ring input))
+      (setq comint-input-ring-index nil)
+      ;; The keypresses below are checked for what they do, so they are run
+      ;; through the map the same way a keypress reaches them.
+      (setq last-command nil))
+    buf))
+
+(defun test-flan-repl--press (key)
+  "Run KEY's binding in the current buffer the way a keypress would.
+Through `call-interactively' and with `last-command' carried across, because
+both are what the commands under test read: the binding is half the claim, and
+comint's search reads the command that ran before it."
+  (let ((cmd (key-binding (kbd key)))
+        ;; Quiet: comint says which history item it landed on, and in batch
+        ;; that lands in the middle of the line a result is printed on.
+        (inhibit-message t))
+    (setq this-command cmd)
+    (call-interactively cmd)
+    (setq last-command this-command)))
+
+(defun test-flan-repl--input ()
+  "The text currently typed at the prompt."
+  (buffer-substring-no-properties
+   (process-mark (get-buffer-process (current-buffer)))
+   (point-max)))
+
+(defun test-flan-repl--done (buf)
+  "Finish with BUF, writing no history on the way out.
+The hook has to come off the buffer rather than be bound away around the kill:
+it is buffer-local, and a `let' outside the buffer does not reach it.  Saving
+here would make every check below read a file the one above it happened to
+leave, which is a test of the order they are written in."
+  (with-current-buffer buf
+    (remove-hook 'kill-buffer-hook #'flan-repl--save-history t)
+    (let ((proc (get-buffer-process buf)))
+      (when proc (delete-process proc))))
+  (kill-buffer buf))
+
+;;; Up-arrow at the prompt
+
+(let ((buf (test-flan-repl--buffer '("(+ 1 2)" "(foo 1)"))))
+  (with-current-buffer buf
+    (test-flan-repl--press "<up>")
+    (test-flan--check "up at the prompt recalls the last input"
+                      (equal (test-flan-repl--input) "(foo 1)"))
+    (test-flan-repl--press "<up>")
+    ;; The press that discriminates: comint decides whether a press continues
+    ;; the search by looking for its own command name in `last-command', and a
+    ;; wrapper that does not hand it over searches again from the entry it just
+    ;; inserted, so the first press looks perfect and the second does nothing.
+    (test-flan--check "and a second press reaches the one before it"
+                      (equal (test-flan-repl--input) "(+ 1 2)"))
+    (test-flan-repl--press "<down>")
+    (test-flan--check "down comes back up the ring"
+                      (equal (test-flan-repl--input) "(foo 1)")))
+  (test-flan-repl--done buf))
+
+(let ((buf (test-flan-repl--buffer '("(+ 1 2)" "(foo 1)" "(bar 2)"))))
+  (with-current-buffer buf
+    (insert "(f")
+    (test-flan-repl--press "<up>")
+    (test-flan--check "what is already typed filters the search, as a shell does"
+                      (equal (test-flan-repl--input) "(foo 1)")))
+  (test-flan-repl--done buf))
+
+;;; Up-arrow above the prompt
+
+(let ((buf (test-flan-repl--buffer '("(+ 1 2)"))))
+  (with-current-buffer buf
+    ;; The transcript above the prompt is read by scrolling back through it,
+    ;; which a blunt history binding would make impossible.
+    (comint-output-filter (get-buffer-process buf)
+                          (concat "3\n" flan-repl-prompt))
+    (goto-char (point-min))
+    (let ((line-move-visual nil)
+          (where (point)))
+      (test-flan-repl--press "<down>")
+      (test-flan--check "down above the input moves a line, and recalls nothing"
+                        (and (> (point) where)
+                             (string-empty-p (test-flan-repl--input))))
+      (test-flan-repl--press "<up>")
+      (test-flan--check "and up moves back"
+                        (and (= (point) where)
+                             (string-empty-p (test-flan-repl--input))))))
+  (test-flan-repl--done buf))
+
+;;; A form typed over several lines
+
+(let ((buf (test-flan-repl--buffer)))
+  (with-current-buffer buf
+    (let ((line-move-visual nil))
+      (insert "(defn f [x]")
+      (test-flan-repl--press "RET")
+      (test-flan--check "RET on a half-typed form opens a line instead of sending"
+                        (equal (test-flan-repl--input) "(defn f [x]\n"))
+      ;; The line RET just opened is empty and is the last one, so `<down>'
+      ;; does go to history — with a prefix that spans the newline and matches
+      ;; nothing, which comint refuses rather than answering.  What matters is
+      ;; that the half-typed form is still there afterwards.
+      (test-flan--check "down on the opened line leaves the half-typed form alone"
+                        (and (test-flan--caught
+                              (lambda () (test-flan-repl--press "<down>")))
+                             (equal (test-flan-repl--input) "(defn f [x]\n")))
+      (insert "  (+ x 1))")
+      (test-flan-repl--press "<up>")
+      ;; Inside the form the key is line motion, not history: the lines of one
+      ;; input are as much a thing to move around in as the transcript is.
+      (test-flan--check "up inside the form moves between its lines"
+                        (and (equal (test-flan-repl--input) "(defn f [x]\n  (+ x 1))")
+                             (flan-repl--on-first-input-line-p)))))
+  (test-flan-repl--done buf))
+
+(let* ((buf (test-flan-repl--buffer '("(defn f [x]\n  (+ x 1))")))
+       (sent nil))
+  (with-current-buffer buf
+    (setq-local comint-input-sender (lambda (_proc text) (setq sent text)))
+    (test-flan-repl--press "<up>")
+    ;; History leaves point where the typing stopped, which for an empty prompt
+    ;; is the start of what was just recalled.  `comint-send-input' sends only
+    ;; as far as point, so a recalled form is exactly the case where sending
+    ;; the line under point would send nothing at all.
+    (test-flan-repl--press "RET")
+    (test-flan--check "a recalled multi-line form is sent whole"
+                      (equal sent "(defn f [x]\n  (+ x 1))")))
+  (test-flan-repl--done buf))
+
+;;; The file between sessions
+
+(let ((buf (test-flan-repl--buffer '("(+ 1 2)" "(defn f [x]\n  (+ x 1))"))))
+  (with-current-buffer buf (flan-repl--save-history))
+  (test-flan-repl--done buf)
+  (test-flan--check "the history file is written"
+                    (file-readable-p test-flan-repl--history))
+  (let ((buf (test-flan-repl--buffer)))
+    (with-current-buffer buf
+      (test-flan--check "a new session reads back what the last one typed"
+                        (and (= (ring-length comint-input-ring) 2)
+                             (equal (ring-ref comint-input-ring 1) "(+ 1 2)")))
+      ;; Comint separates entries with a newline, which is also what is inside
+      ;; a form typed over several lines; with that separator this entry comes
+      ;; back as two broken ones.
+      (test-flan--check "including a form written over several lines, in one piece"
+                        (equal (ring-ref comint-input-ring 0)
+                               "(defn f [x]\n  (+ x 1))"))
+      (test-flan-repl--press "<up>")
+      (test-flan--check "and up recalls it"
+                        (equal (test-flan-repl--input) "(defn f [x]\n  (+ x 1))")))
+    (test-flan-repl--done buf)))
+
+(let ((buf (test-flan-repl--buffer)))
+  (with-current-buffer buf
+    (flan-repl--save-history)
+    (test-flan--check "a session that typed nothing does not empty the file"
+                      (= (flan-repl--history-entries test-flan-repl--history) 2)))
+  (test-flan-repl--done buf))
+
+(let ((buf (test-flan-repl--buffer)))
+  (with-current-buffer buf
+    ;; What a second Emacs having saved a longer history looks like from here.
+    ;; A write replaces the file whole, so the short ring would throw the other
+    ;; session away.
+    (setq comint-input-ring (make-ring flan-repl-history-size))
+    (ring-insert comint-input-ring "(only-this)")
+    (flan-repl--save-history)
+    (test-flan--check "nor does a ring shorter than the file replace it"
+                      (= (flan-repl--history-entries test-flan-repl--history) 2)))
+  (test-flan-repl--done buf))
+
+(when (file-exists-p test-flan-repl--history)
+  (delete-file test-flan-repl--history))
+
+;; And the hook itself, which is what makes any of the above happen without
+;; being asked: this is the only check that kills a REPL buffer the way a
+;; person does.
+(let* ((test-flan-repl--history
+        (make-temp-name (expand-file-name "flan-repl-killed-"
+                                          temporary-file-directory)))
+       (buf (test-flan-repl--buffer '("(kept)"))))
+  (kill-buffer buf)
+  (test-flan--check "killing the prompt saves what was typed at it"
+                    (= (flan-repl--history-entries test-flan-repl--history) 1))
+  (when (file-exists-p test-flan-repl--history)
+    (delete-file test-flan-repl--history)))
+
+(provide 'test-flan-repl)
+;;; test-flan-repl.el ends here