Say what landed and what it cost, and flash the form it came from

An install that reports nothing is indistinguishable from one that failed
silently, which is the one thing this loop cannot afford: the whole promise is
that the running program now has the body you just wrote.

The names come from the reply rather than from what was typed, because the
daemon is the one that knows which of them it installed — a `defvar' the
program already had is not among them, and the reply already says so with
`:note'. That case now reads "nothing to install" instead of quoting a
build time for a build that did not happen. `:fns` and `:names' are reported
separately for the same reason: a buffer of five functions and two vars
should not report as five of anything.

A long list is counted and then sampled rather than truncated, since an echo
area cut off in the middle of the tenth name tells you neither how many there
were nor which.

And the region that was sent is flashed, which answers a question the echo
area cannot: `beginning-of-defun' may well have found a different form from
the one you thought point was in.
This commit is contained in:
Joseph Ferano 2026-09-11 17:50:00 +07:00
parent 12f99702b4
commit 9e7eba1479
2 changed files with 95 additions and 22 deletions

View File

@ -25,6 +25,7 @@
(require 'subr-x) (require 'subr-x)
(require 'seq) (require 'seq)
(require 'pcase) (require 'pcase)
(require 'pulse)
(defgroup flan-dev nil (defgroup flan-dev nil
"Talking to a running Flan program." "Talking to a running Flan program."
@ -36,9 +37,15 @@
:type 'string) :type 'string)
(defcustom flan-dev-echo-result t (defcustom flan-dev-echo-result t
"Whether a successful evaluation reports in the echo area." "Whether an accepted evaluation reports in the echo area.
Turning this off makes a successful evaluation indistinguishable from one
that quietly did nothing, which is why it is on."
:type 'boolean) :type 'boolean)
(defcustom flan-dev-names-shown 4
"How many installed names to name before falling back to counting them."
:type 'integer)
(defcustom flan-dev-output-buffer "*flan-output*" (defcustom flan-dev-output-buffer "*flan-output*"
"Buffer the running program's own output is appended to." "Buffer the running program's own output is appended to."
:type 'string) :type 'string)
@ -350,6 +357,22 @@ Returns non-nil when it put an overlay somewhere."
;;; Evaluating ;;; Evaluating
;; An install that says nothing is indistinguishable from one that failed
;; silently, so every accepted evaluation reports what landed in the running
;; program and what it cost. The names come from the reply rather than from
;; what was typed: the daemon is the one that knows which of them it installed,
;; and a `defvar' the program already had is not among them.
(defun flan-dev--names-phrase (names fallback)
"NAMES as a phrase for the echo area, or FALLBACK when there are none.
Long lists are counted and then sampled: an echo area truncated in the middle
of the tenth name tells you neither how many there were nor which."
(cond
((null names) fallback)
((<= (length names) flan-dev-names-shown) (string-join names ", "))
(t (format "%d names (%s, …)" (length names)
(string-join (seq-take names flan-dev-names-shown) ", ")))))
(defun flan-dev--report (reply what) (defun flan-dev--report (reply what)
"Report REPLY, describing WHAT was sent." "Report REPLY, describing WHAT was sent."
(if (equal (plist-get reply :status) "ok") (if (equal (plist-get reply :status) "ok")
@ -360,18 +383,25 @@ Returns non-nil when it put an overlay somewhere."
;; Accepted, so whatever the last rejection marked is no longer true. ;; Accepted, so whatever the last rejection marked is no longer true.
(flan-dev-clear-errors) (flan-dev-clear-errors)
(when flan-dev-echo-result (when flan-dev-echo-result
(if value (cond
;; An expression's value, rendered inside the running program — ;; An expression's value, rendered inside the running program —
;; nothing was marshalled back, because nothing could be. ;; nothing was marshalled back, because nothing could be.
(message "=> %s" value) (value (message "=> %s" value))
(if note ;; The daemon accepted it and had nothing to send. Say so rather
;; The daemon accepted it and had nothing to send. Say so rather ;; than claiming an install that did not happen.
;; than claiming an install that did not happen. (note (message "flan: %s — %s"
(message "%s: %s" (if names (string-join names ", ") what) note) (flan-dev--names-phrase names what) note))
(message "%s installed in %.0fms" (t
(if fns (string-join fns ", ") ;; `:fns' are the bodies that were installed and `:names' is
(if names (string-join names ", ") what)) ;; everything the evaluation declared; a buffer of five functions
(or (plist-get reply :ms) 0)))))) ;; and two vars should not report as "five".
(message "flan: %s installed in %.0f ms%s"
(flan-dev--names-phrase fns what)
(or (plist-get reply :ms) 0)
(let ((vars (seq-difference names fns)))
(if vars (format " (also %s)"
(flan-dev--names-phrase vars ""))
"")))))))
;; The daemon reports where, so mark it there. This must not itself ;; The daemon reports where, so mark it there. This must not itself
;; signal: the error the caller is owed is the daemon's, and losing it to a ;; signal: the error the caller is owed is the daemon's, and losing it to a
;; bad location would report the wrong thing entirely. ;; bad location would report the wrong thing entirely.
@ -381,14 +411,20 @@ Returns non-nil when it put an overlay somewhere."
(user-error "flan: %s%s" (or msg "rejected") (user-error "flan: %s%s" (or msg "rejected")
(if loc (format " (%s)" loc) ""))))) (if loc (format " (%s)" loc) "")))))
(defun flan-dev--eval (code what) (defun flan-dev--eval (code what &optional start end)
"Send CODE to the running program. WHAT names it for the echo area." "Send CODE to the running program. WHAT names it for the echo area.
START and END, when given, are the region it came from, flashed on success."
(flan-dev--report (flan-dev--report
(flan-dev--request (flan-dev--request
;; buffer-file-name so an error points at the file being edited rather than ;; buffer-file-name so an error points at the file being edited rather than
;; at the daemon's placeholder. ;; at the daemon's placeholder.
(list :op "eval" :code code :file (or buffer-file-name "<buffer>"))) (list :op "eval" :code code :file (or buffer-file-name "<buffer>")))
what)) what)
;; `flan-dev--report' signals on a rejection, so reaching here means it
;; landed. Flashing the text that was sent answers "which form did that
;; take?" — the question the echo area cannot, because point may be nowhere
;; near the defn `beginning-of-defun' actually found.
(when (and start end) (pulse-momentary-highlight-region start end)))
(defun flan-dev--text (start end) (defun flan-dev--text (start end)
"The buffer text from START to END, on the line it is actually written on. "The buffer text from START to END, on the line it is actually written on.
@ -420,7 +456,7 @@ columns already were, because a top-level form starts at column 1."
"Recompile the top-level form at point and install it in the running program." "Recompile the top-level form at point and install it in the running program."
(interactive) (interactive)
(let ((b (flan-dev--defun-bounds))) (let ((b (flan-dev--defun-bounds)))
(flan-dev--eval (flan-dev--text (car b) (cdr b)) "form"))) (flan-dev--eval (flan-dev--text (car b) (cdr b)) "form" (car b) (cdr b))))
;;;###autoload ;;;###autoload
(defun flan-eval-buffer () (defun flan-eval-buffer ()
@ -447,7 +483,7 @@ arrive in the same load or the first refers to storage that does not exist."
(defun flan-eval-region (start end) (defun flan-eval-region (start end)
"Recompile the top-level forms between START and END." "Recompile the top-level forms between START and END."
(interactive "r") (interactive "r")
(flan-dev--eval (flan-dev--text start end) "region")) (flan-dev--eval (flan-dev--text start end) "region" start end))
(provide 'flan-dev) (provide 'flan-dev)
;;; flan-dev.el ends here ;;; flan-dev.el ends here

View File

@ -16,6 +16,18 @@
(defvar test-flan--failures 0) (defvar test-flan--failures 0)
(defmacro test-flan--said (&rest body)
"Run BODY and return the last thing it put in the echo area.
`current-message' is nil under --batch, so the echo area is watched where it
is written instead the real `message' call the real command makes."
`(let* ((said nil)
(probe (lambda (fmt &rest args)
(when fmt (setq said (apply #'format fmt args))))))
(advice-add 'message :before probe)
(unwind-protect (progn ,@body)
(advice-remove 'message probe))
said))
(defun test-flan--check (name ok) (defun test-flan--check (name ok)
(if ok (message " ok %s" name) (if ok (message " ok %s" name)
(setq test-flan--failures (1+ test-flan--failures)) (setq test-flan--failures (1+ test-flan--failures))
@ -151,10 +163,35 @@
(search-forward "(+ ticks nonsense)") (search-forward "(+ ticks nonsense)")
(replace-match "(+ ticks 41)") (replace-match "(+ ticks 41)")
(search-backward "(defn step") (search-backward "(defn step")
(flan-eval-defun) ;; A silent success is indistinguishable from a silent failure, so an
(test-flan--check "an accepted evaluation clears it" ;; accepted evaluation says what landed in the running program and what it
(null (seq-filter (lambda (o) (overlay-get o 'flan-dev-error)) ;; cost. The name comes from the *reply*: the daemon is the one that knows
(overlays-in (point-min) (point-max)))))) ;; which names it installed.
(let ((said (test-flan--said (flan-eval-defun))))
(test-flan--check "an accepted evaluation clears it"
(null (seq-filter (lambda (o) (overlay-get o 'flan-dev-error))
(overlays-in (point-min) (point-max)))))
(test-flan--check "and says which name landed"
(and said (string-match-p "\\_<step\\_>" said)))
(test-flan--check "and how long it took"
(and said (string-match-p "[0-9]+ ms" said)))))
;; A declaration the program already has installs nothing, and must say so
;; rather than reporting a time for a build that did not happen.
(let ((said (test-flan--said
(flan-dev--eval "(defvar ticks i64)" "form"))))
(test-flan--check "an evaluation with nothing to install says so"
(and said (string-match-p "nothing to install" said)
(not (string-match-p "installed" said)))))
;; Many names are counted and sampled. An echo area truncated in the middle
;; of the tenth name says neither how many there were nor which.
(test-flan--check "a long list of names is counted, not cut off"
(equal (flan-dev--names-phrase
'("a" "b" "c" "d" "e" "f") "fallback")
"6 names (a, b, c, d, …)"))
(test-flan--check "a short one is just named"
(equal (flan-dev--names-phrase '("a" "b") "fallback") "a, b"))
;; The session is not poisoned by that: a good form still lands. ;; The session is not poisoned by that: a good form still lands.
(flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form") (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form")