Joseph Ferano
541c845688
Two things were missing from the REPL's history rather than broken in it. The ring worked; nothing reached it by the key almost everyone presses, and nothing survived quitting Emacs. `<up>' and `<down>' are history on the line being typed and line motion everywhere else. The conditional is the whole point: the text above the prompt is a transcript people scroll back through, and a blunt binding would take that away to buy something `M-p' already does. Inside a form typed over several lines the keys still move between them, and reach history from the first. The search is prefix-filtered, which is comint's `...-from-input' pair and what a shell does. Each wrapper hands `this-command' over to the comint command it delegates to, because comint tells a continued search from a fresh one by looking for its own name in `last-command' -- without it the first press looks perfect and the second never moves. History is kept in `flan-repl-history' under `user-emacs-directory', through `locate-user-emacs-file' so that no-littering and a moved state directory take it along; the file and the size are both defcustoms. It is read when the mode starts and written on kill and on exit, but not when the ring is empty and not when the ring is shorter than the file -- a write replaces the file whole, so either would throw away a session somebody else's Emacs saved. The exit sweep is not installed in batch, where every prompt belongs to a test and the file it would land in belongs to whoever ran it. Entries are separated by a form feed on its own line rather than by comint's newline, which is also what is inside a multi-line form: with the default the file shreds one such form into fragments. The separator is let-bound around each call instead of set in the buffer, because `comint-write-input-ring' reads it inside a temporary buffer where a buffer-local value is invisible. And the multi-line case the recall made reachable: `comint-send-input' sends the process mark to *point*, and `comint-eol-on-send' carries it no further than one line, while `flan-repl-return' judged completeness over the whole input. Recall parks point where the typing stopped -- for an empty prompt, at the start of what was just recalled -- so RET on a recalled form sent nothing at all. It now sends what it measured. emacs/test-flan-repl.el covers both halves from a stub prompt, loaded from test-flan-cider.el 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. No daemon: history is a function from a ring and a position to what the buffer says. Seventeen checks, which cost that suite nothing measurable -- the whole of it still runs in 0.15s.
231 lines
11 KiB
EmacsLisp
231 lines
11 KiB
EmacsLisp
;;; 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
|