Merge: the prompt remembers what was typed at it
This commit is contained in:
commit
14c246c27c
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
|
||||
230
emacs/test-flan-repl.el
Normal file
230
emacs/test-flan-repl.el
Normal file
@ -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
|
||||
Loading…
x
Reference in New Issue
Block a user