Joseph Ferano
e83a50b5c3
*flan-output* is gone. The program's output lands in the daemon's buffer always — renamed *flan-dev* to *flan* — and at the REPL when one is open, inserted above the prompt, output first and the value after it. A rejection puts its message in *flan-diagnostics*, which now pops up, and leaves one line at the prompt pointing there; the diagnostics buffer got a major mode of its own, read-only with n/p/RET, and the memory sites from flan-check-memory render into it as one section below the errors, replaced whole on every ask. Two clears at the REPL, on CIDER's keys: C-c C-o for the last send's output, C-c M-o for the transcript. No daemon changes: output already rides every reply's :output, so both destinations are editor-side routing.
392 lines
18 KiB
EmacsLisp
392 lines
18 KiB
EmacsLisp
;;; flan-repl.el --- A prompt for a running Flan program -*- lexical-binding: t; -*-
|
|
|
|
;; Author: Joseph Ferano <joseph@ferano.io>
|
|
;; Version: 0.1.0
|
|
;; Package-Requires: ((emacs "29.1"))
|
|
;; Keywords: languages, lisp, tools
|
|
|
|
;; The headers above are what make this directory installable. M-x
|
|
;; package-install-file on it reads them, and a file with no Version: is not a
|
|
;; package as far as package.el is concerned -- until now the client was
|
|
;; reachable only by adding it to load-path by hand, which is a thing to
|
|
;; explain to every person who wants to try it.
|
|
;;
|
|
;; 29.1 is the floor because it is the oldest Emacs any of this has been run
|
|
;; against, not because some function here is known to need it. dape, which
|
|
;; flan-dape drives, asks for 29.1 as well and is a soft dependency: it is
|
|
;; reached through declare-function, so the rest of the client loads and works
|
|
;; without it and it is deliberately not listed above. The compiler this talks
|
|
;; to is not an Emacs package and cannot be listed here either -- emacs/MANUAL.md
|
|
;; says what has to be on PATH.
|
|
|
|
;; A buffer to type expressions at, sent to the program `flan dev' is running
|
|
;; and answered with the value they had *there*. It adds no protocol and no
|
|
;; compiler support: every line goes through the same `eval-expr' request that
|
|
;; C-x C-e uses.
|
|
;;
|
|
;; Derived from `comint-mode', for the same reason `flan-mode' derives from
|
|
;; `lisp-mode': history, the input ring, and kill/yank behaviour already exist
|
|
;; and are not worth rewriting. There is no subprocess behind it — the
|
|
;; "process" is a stub comint needs in order to have a prompt at all.
|
|
;;
|
|
;; Two things about it that are decisions, not accidents:
|
|
;;
|
|
;; - **It is program-scoped.** A name typed here resolves against the running
|
|
;; program's top-level namespace, so in sand you write `sim/settle' and not
|
|
;; `settle'. A buffer visiting a package's own file gets the alias applied
|
|
;; for it, because the file says which package it belongs to; a prompt has no
|
|
;; file and nothing to derive it from.
|
|
;;
|
|
;; - **A value and the program's output are different things**, and both are
|
|
;; here. The value of the expression appears at the prompt; anything the
|
|
;; program printed while evaluating it — riding along on the same reply —
|
|
;; is inserted above it, output first, then the value, the way a terminal
|
|
;; REPL reads. The daemon's buffer (*flan*) mirrors the output, so it is
|
|
;; still somewhere when no prompt is open.
|
|
;;
|
|
;; When a compile fails, the prompt gets one line — "1 error — see
|
|
;; *flan-diagnostics*" — and the message itself goes to the diagnostics
|
|
;; list, which pops up. The full Elm-style error is worth a buffer with
|
|
;; navigation; the prompt is not that buffer.
|
|
|
|
;;; Code:
|
|
|
|
(require 'comint)
|
|
(require 'flan-mode)
|
|
(require 'flan)
|
|
|
|
(defcustom flan-repl-buffer "*flan-repl*"
|
|
"Name of the Flan REPL buffer."
|
|
: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'.")
|
|
|
|
(defvar flan-repl-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
;; The two clears, on CIDER's keys: C-c C-o takes down what the last send
|
|
;; printed, C-c M-o takes the whole transcript.
|
|
(define-key map (kbd "C-c C-o") #'flan-repl-clear-output)
|
|
(define-key map (kbd "C-c M-o") #'flan-repl-clear)
|
|
(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'.")
|
|
|
|
(define-derived-mode flan-repl-mode comint-mode "Flan-REPL"
|
|
"Type expressions; they are evaluated in the running program.
|
|
|
|
\\{flan-repl-mode-map}"
|
|
:syntax-table flan-mode-syntax-table
|
|
(setq-local comint-prompt-regexp (concat "^" (regexp-quote flan-repl-prompt)))
|
|
(setq-local comint-prompt-read-only t)
|
|
(setq-local comint-input-sender #'flan-repl--send)
|
|
;; Nothing is echoed back by a process, because there is no process.
|
|
(setq-local comint-process-echoes nil)
|
|
;; The prompt gets completion, eldoc and M-. for the same names a buffer
|
|
;; does, and against the same program: they read the client's cache, which
|
|
;; is program-scoped, which is exactly what a prompt is.
|
|
(flan-setup)
|
|
(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?
|
|
Parens balanced and not inside a string or comment. RET on a half-typed form
|
|
should open a line, not send something the reader will reject."
|
|
(let ((state (with-temp-buffer
|
|
(set-syntax-table flan-mode-syntax-table)
|
|
(insert text)
|
|
(parse-partial-sexp (point-min) (point-max)))))
|
|
(and (<= (nth 0 state) 0) ; depth
|
|
(not (nth 3 state)) ; in a string
|
|
(not (nth 4 state))))) ; in a comment
|
|
|
|
(defun flan-repl--output (text)
|
|
"Insert TEXT into the REPL buffer above the next prompt."
|
|
(let ((proc (get-buffer-process (current-buffer))))
|
|
(comint-output-filter proc (concat text "\n" flan-repl-prompt))))
|
|
|
|
(defun flan-repl--insert-output (text)
|
|
"Insert TEXT, the program's own output, before the prompt.
|
|
Two moments call this and the same rule serves both. During a send there
|
|
is no prompt yet — the process mark sits at the end of the input just sent —
|
|
so the text goes at the mark, before the value and the prompt that follow.
|
|
Between sends the mark sits after the prompt, and the text goes above the
|
|
prompt's line, so the prompt and whatever is being typed at it do not move."
|
|
(let ((proc (get-buffer-process (current-buffer))))
|
|
(when (process-live-p proc)
|
|
(let ((mark (process-mark proc))
|
|
(text (if (string-suffix-p "\n" text) text (concat text "\n")))
|
|
(inhibit-read-only t))
|
|
(save-excursion
|
|
(goto-char mark)
|
|
(forward-line 0)
|
|
(let ((at (point)))
|
|
(insert text)
|
|
;; Inserting at the mark itself leaves the mark *before* the
|
|
;; text — a plain marker does not advance — and the value the
|
|
;; reply carries would then land above the output it caused.
|
|
(when (>= at (marker-position mark))
|
|
(set-marker mark (point)))))))))
|
|
|
|
(defun flan-repl--buffer ()
|
|
"The REPL buffer, for the two clear commands, from wherever they are run."
|
|
(let ((buf (if (derived-mode-p 'flan-repl-mode)
|
|
(current-buffer)
|
|
(get-buffer flan-repl-buffer))))
|
|
(unless (buffer-live-p buf)
|
|
(user-error "flan: no REPL buffer; C-c C-r opens one"))
|
|
buf))
|
|
|
|
;;;###autoload
|
|
(defun flan-repl-clear ()
|
|
"Erase the whole REPL transcript and leave a fresh prompt.
|
|
The input history is untouched: it is the screen that goes, not the ring."
|
|
(interactive)
|
|
(with-current-buffer (flan-repl--buffer)
|
|
(let ((proc (get-buffer-process (current-buffer)))
|
|
(inhibit-read-only t))
|
|
(erase-buffer)
|
|
(when (process-live-p proc)
|
|
(set-marker (process-mark proc) (point-max))
|
|
(comint-output-filter proc flan-repl-prompt)))))
|
|
|
|
;;;###autoload
|
|
(defun flan-repl-clear-output ()
|
|
"Erase what the last send produced — output, value or error line.
|
|
The input that produced it stays, and so does the prompt; this is for a
|
|
send whose output buried the transcript, not for starting over — that is
|
|
`flan-repl-clear'."
|
|
(interactive)
|
|
(with-current-buffer (flan-repl--buffer)
|
|
(let* ((proc (get-buffer-process (current-buffer)))
|
|
(mark (and (process-live-p proc) (process-mark proc)))
|
|
(start (and (marker-position comint-last-input-end)
|
|
(marker-position comint-last-input-end)))
|
|
(end (and mark (save-excursion (goto-char mark)
|
|
(forward-line 0) (point))))
|
|
(inhibit-read-only t))
|
|
(if (not (and start end (< start end)))
|
|
(message "flan: nothing to clear")
|
|
(delete-region start end)))))
|
|
|
|
(defun flan-repl--send (_proc text)
|
|
"Evaluate TEXT in the running program and show what it was."
|
|
(let ((code (string-trim text)))
|
|
(cond
|
|
((string-empty-p code) (flan-repl--output ""))
|
|
(t
|
|
(let ((reply (condition-case err
|
|
(flan--request
|
|
(list :op "eval-expr" :code code :file "<repl>"))
|
|
;; :client marks a failure of the *connection* — no
|
|
;; daemon, no reply — which is not a compiler message
|
|
;; and has no place in the diagnostics list.
|
|
(error (list :status "error" :client t
|
|
:message (error-message-string err))))))
|
|
(cond
|
|
((equal (plist-get reply :status) "ok")
|
|
(flan-repl--output (or (plist-get reply :value) "")))
|
|
((plist-get reply :client)
|
|
(flan-repl--output
|
|
(concat "error: " (or (plist-get reply :message) "rejected"))))
|
|
(t
|
|
;; A rejection. The message goes where every compiler message
|
|
;; goes — the diagnostics list, which `flan--record-diagnostic'
|
|
;; shows — and the prompt gets the one-line pointer.
|
|
(ignore-errors
|
|
(flan--record-diagnostic (plist-get reply :loc)
|
|
(or (plist-get reply :message)
|
|
"rejected")))
|
|
(flan-repl--output
|
|
(format "1 error — see %s" flan-diagnostics-buffer)))))))))
|
|
|
|
(defun flan-repl-return ()
|
|
"Send the input if it is a whole form, otherwise open a line."
|
|
(interactive)
|
|
(let ((input (buffer-substring-no-properties
|
|
(process-mark (get-buffer-process (current-buffer)))
|
|
(point-max))))
|
|
(if (flan-repl--complete-p 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)
|
|
|
|
;;;###autoload
|
|
(defun flan-repl ()
|
|
"Open a prompt on the program `flan dev' is running.
|
|
Connects first if it has to."
|
|
(interactive)
|
|
(unless (and flan--connection (process-live-p flan--connection))
|
|
(call-interactively #'flan-connect))
|
|
(let ((buf (get-buffer-create flan-repl-buffer)))
|
|
(with-current-buffer buf
|
|
(unless (derived-mode-p 'flan-repl-mode)
|
|
(flan-repl-mode)
|
|
;; comint wants a process to hang a prompt and a process mark off.
|
|
;; There is nothing to run, so this one does nothing and is never
|
|
;; written to; every request goes over the daemon's socket instead.
|
|
(let ((proc (start-process "flan-repl" buf "cat")))
|
|
(set-process-query-on-exit-flag proc nil)
|
|
(comint-output-filter proc flan-repl-prompt))))
|
|
(pop-to-buffer buf)))
|
|
|
|
(provide 'flan-repl)
|
|
;;; flan-repl.el ends here
|