diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 3a43981..9ba1fb8 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -175,6 +175,19 @@ that is what the program calls it. That is separate from the REPL, because the program's stdout belongs to the program. +**History.** `` and `` walk it while you are on the line you are +typing, filtered by whatever you have typed so far — `(sim` then `` 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 diff --git a/emacs/flan-repl.el b/emacs/flan-repl.el index f66256a..e37995c 100644 --- a/emacs/flan-repl.el +++ b/emacs/flan-repl.el @@ -35,6 +35,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'.") @@ -43,6 +67,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 "") #'flan-repl-previous-input) + (define-key map (kbd "") #'flan-repl-next-input) map) "Keymap for `flan-repl-mode'.") @@ -60,7 +86,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 + +;; `' 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 `' 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? @@ -104,7 +249,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) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 767ef19..554bce4 100644 --- a/emacs/test-flan-cider.el +++ b/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)) diff --git a/emacs/test-flan-repl.el b/emacs/test-flan-repl.el new file mode 100644 index 0000000..41be98c --- /dev/null +++ b/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 "") + (test-flan--check "up at the prompt recalls the last input" + (equal (test-flan-repl--input) "(foo 1)")) + (test-flan-repl--press "") + ;; 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 "") + (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 "") + (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 "") + (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 "") + (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 `' + ;; 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 ""))) + (equal (test-flan-repl--input) "(defn f [x]\n"))) + (insert " (+ x 1))") + (test-flan-repl--press "") + ;; 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 "") + ;; 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 "") + (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