From e83a50b5c3c33f74a8b5a61c1118edae3dc2b662 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 21:05:50 +0700 Subject: [PATCH] Two streams and one list: the buffer story consolidated MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit *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. --- emacs/flan-mode.el | 10 ++- emacs/flan-repl.el | 112 +++++++++++++++++++++++++---- emacs/flan.el | 175 +++++++++++++++++++++++++++++++++++++-------- emacs/test-flan.el | 106 +++++++++++++++++++++------ 4 files changed, 337 insertions(+), 66 deletions(-) diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 0c2ca04..6d2afa9 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -78,8 +78,9 @@ (autoload 'flan-connect "flan" nil t) (autoload 'flan-disconnect "flan" nil t) (autoload 'flan-describe "flan" nil t) -(autoload 'flan-show-output "flan" nil t) (autoload 'flan-repl "flan-repl" nil t) +(autoload 'flan-repl-clear "flan-repl" nil t) +(autoload 'flan-repl-clear-output "flan-repl" nil t) (autoload 'flan-break "flan" nil t) ;; The two CIDER-shaped buffers. They reach the daemon through an indirection ;; of their own so that fixtures can drive them, so autoloading is all the @@ -317,7 +318,12 @@ For `syntax-propertize-function'." (define-key map (kbd "C-c C-z") #'flan-connect) (define-key map (kbd "C-c C-q") #'flan-disconnect) (define-key map (kbd "C-c C-d") #'flan-describe) - (define-key map (kbd "C-c C-o") #'flan-show-output) + ;; The REPL's two clears, reachable from the file being edited: results + ;; land in *flan-repl* whichever buffer the send came from, so the keys + ;; that take them down belong here too. CIDER's pair: C-c C-o for the + ;; last send's output, C-c M-o for 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-r") #'flan-repl) ;; C-c C-b opens the buffer rather than the minibuffer prompt: it shows the ;; same restarts plus the condition and the stack, and — the reason it diff --git a/emacs/flan-repl.el b/emacs/flan-repl.el index 2276442..f3b3c6e 100644 --- a/emacs/flan-repl.el +++ b/emacs/flan-repl.el @@ -37,11 +37,17 @@ ;; 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 arrive by -;; different routes. The value of the expression appears at the prompt; -;; anything the program printed while evaluating it goes to *flan-output*, -;; riding along on the same reply. Showing them in one place would be -;; convenient and wrong. +;; - **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: @@ -83,7 +89,10 @@ a buffer-local value is not visible.") (defvar flan-repl-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-o") #'flan-show-output) + ;; 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 "") #'flan-repl-previous-input) @@ -243,6 +252,70 @@ should open a line, not send something the reader will reject." (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))) @@ -252,14 +325,27 @@ should open a line, not send something the reader will reject." (let ((reply (condition-case err (flan--request (list :op "eval-expr" :code code :file "")) - (error (list :status "error" + ;; :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)))))) - (flan-repl--output - (if (equal (plist-get reply :status) "ok") - (or (plist-get reply :value) "") - (concat "error: " (or (plist-get reply :message) "rejected") - (let ((loc (plist-get reply :loc))) - (if loc (concat " (" loc ")") "")))))))))) + (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." diff --git a/emacs/flan.el b/emacs/flan.el index 6e16b11..e306533 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -116,17 +116,17 @@ could be drawn at all, as at the REPL." "How many installed names to name before falling back to counting them." :type 'integer) -(defcustom flan-output-buffer "*flan-output*" - "Buffer the running program's own output is appended to." - :type 'string) - -(defcustom flan-daemon-buffer "*flan-dev*" +(defcustom flan-daemon-buffer "*flan*" "Buffer the daemon's own output goes to. This is where a build that failed says so: the daemon compiles the program before it binds its socket, so a program that does not compile produces no socket at all and this buffer is the only account of why. It is also where a build that is merely slow can be watched, which is what the reply timeout -below points at." +below points at. + +The program's own output lands here too, mirrored from wherever else it +goes: a REPL shows it when one is open, and this buffer is where it is +regardless, so a println is never lost for want of a prompt." :type 'string) (defcustom flan-diagnostics-buffer "*flan-diagnostics*" @@ -138,7 +138,11 @@ want to keep: to quote one somewhere else you had to find it again in *Messages*, among everything else Emacs had said since. This is the other half — one entry per message, in the order they arrived, never cleared by anything but you. `M-x flan-clear-diagnostics' when it has grown past being -useful." +useful. + +Everything the compiler reports is in here: the errors, and below them the +allocation sites `flan-check-memory' asks for, as one section replaced on +every ask." :type 'string) (defcustom flan-reply-timeout 30 @@ -329,17 +333,36 @@ Reconnecting happens before a send, never after one." (erase-buffer) (flan--no-reply proc)))))) +;; Written by `flan--append-output' when a REPL is open; defined in +;; flan-repl.el, which requires this file, so the reference here has to be a +;; declaration and a guard rather than a `require'. +(declare-function flan-repl--insert-output "flan-repl" (text)) + +(defun flan--repl-buffer () + "The live REPL buffer, or nil when none has been opened." + (and (featurep 'flan-repl) + (bound-and-true-p flan-repl-buffer) + (get-buffer flan-repl-buffer))) + (defun flan--append-output (text) - "Append TEXT, the running program's own output, to its buffer." + "Append TEXT, the running program's own output, where it can be read. +Two places. The daemon's log always gets it, so output lands somewhere +before any REPL interaction has happened; the REPL shows it too when one is +open, above its prompt, which is where whoever is typing there is looking." (when (and text (> (length text) 0)) - (with-current-buffer (get-buffer-create flan-output-buffer) - (let ((at-end (= (point) (point-max)))) + (with-current-buffer (get-buffer-create flan-daemon-buffer) + (let ((at-end (= (point) (point-max))) + (inhibit-read-only t)) (save-excursion (goto-char (point-max)) (insert text)) ;; Follow the tail only for someone who was already at it; a reader ;; scrolled back is reading something. - (when at-end (goto-char (point-max))))))) + (when at-end (goto-char (point-max))))) + (let ((repl (flan--repl-buffer))) + (when repl + (with-current-buffer repl + (flan-repl--insert-output text)))))) ;; The break buffer, which this file shows but does not draw. An autoload ;; rather than a `require': flan-cnr.el reaches the daemon through this file, @@ -1228,13 +1251,6 @@ than being told so." ((null index) (user-error "flan: %s is not on the list" choice)) (t (flan-restart-at index (nth index restarts))))))) -;;;###autoload -(defun flan-show-output () - "Show the running program's output, after collecting anything pending." - (interactive) - (ignore-errors (flan--request '(:op "describe"))) - (display-buffer (get-buffer-create flan-output-buffer))) - (defun flan-describe () "Report what the running program currently defines." (interactive) @@ -1383,28 +1399,67 @@ no longer wrong." ;; the compiler wrote it — `file:line:col: text' — which is what makes ;; `compilation-minor-mode' below able to jump from it, and also what makes a ;; line yanked out of here read the same as one pasted from a terminal. +;; +;; It is the one list for everything the compiler reports. Errors are the +;; log above, appended as they arrive; the allocation sites `flan-check-memory' +;; asks for are one section below them, replaced whole on every ask — a +;; reading of the source has no arrival order worth keeping, where the errors +;; do. The section boundary is `flan--diagnostics-memory-start', a marker +;; that advances past every error inserted at it, so the errors stay above +;; and the memory notes stay below whichever order the two arrive in. + +(defvar flan-diagnostics-mode-map + (let ((map (make-sparse-keymap))) + ;; The bare keys grep-mode and compilation-mode readers reach for. The + ;; minor mode below provides RET, M-g M-n and M-g M-p; these two are the + ;; major-mode half, possible because the buffer is read-only. + (define-key map (kbd "n") #'compilation-next-error) + (define-key map (kbd "p") #'compilation-previous-error) + map) + "Keymap for `flan-diagnostics-mode'.") + +(define-derived-mode flan-diagnostics-mode special-mode "Flan-Diagnostics" + "Every message the compiler handed the editor, one navigable list. +`n' and `p' move between entries, RET goes to the line one names. + +\\{flan-diagnostics-mode-map}" + ;; Every entry names a file, a line and a column, so `next-error' and RET + ;; should go there. The minor mode rather than deriving from + ;; `compilation-mode', because this buffer is not the output of a command + ;; that ran once. + (compilation-minor-mode 1)) + +(defvar-local flan--diagnostics-memory-start nil + "Marker at the start of the memory section, or nil while there is none. +Insertion type t, so an error inserted at it lands above the section and +the marker keeps naming the section's own first character.") (defun flan--diagnostics-buffer () "The diagnostics buffer, made and set up if this is the first message." (or (get-buffer flan-diagnostics-buffer) (with-current-buffer (get-buffer-create flan-diagnostics-buffer) - ;; The same mode the daemon's buffer gets, for the same reason: every - ;; entry names a file, a line and a column, so `next-error' and RET - ;; should go there. A minor mode rather than `compilation-mode', - ;; because this buffer is not the output of a command that ran once. - (compilation-minor-mode 1) + (flan-diagnostics-mode) (current-buffer)))) (defun flan--record-diagnostic (loc msg) "Append MSG, which the daemon reported at LOC, to the diagnostics log. LOC may be nil: a refusal the daemon could not place is still a message -somebody may want to keep, and it is written without one." +somebody may want to keep, and it is written without one. + +The buffer is also shown. A rejection is the moment the list is for, and +it is shown rather than selected — the fix happens in the buffer the error +came from, not here." (when (and (stringp msg) (> (length msg) 0)) (with-current-buffer (flan--diagnostics-buffer) (let ((at-end (= (point) (point-max))) (inhibit-read-only t)) (save-excursion - (goto-char (point-max)) + ;; Above the memory section when there is one: errors are the log, + ;; the memory notes are a standing reading, and the reading stays + ;; at the bottom. + (goto-char (or (and flan--diagnostics-memory-start + (marker-position flan--diagnostics-memory-start)) + (point-max))) (unless (bolp) (insert "\n")) (insert (format-time-string "── %H:%M:%S ──────────────────────\n")) (insert (if (stringp loc) (format "%s: %s\n" loc msg) @@ -1413,7 +1468,53 @@ somebody may want to keep, and it is written without one." ;; `flan--append-output's rule, and the same one: follow the tail only ;; for somebody who was already at it, since a reader scrolled back is ;; reading something. - (when at-end (goto-char (point-max))))))) + (when at-end (goto-char (point-max)))) + (display-buffer (current-buffer))))) + +(defun flan--render-memory-sites (sites) + "Write SITES, the rows of an (:op \"memory\") reply, below the errors. +One section at the end of the diagnostics list, replaced whole every time: +the sites are a reading of the source as it stands, so a second reading +supersedes the first rather than joining it. Each line keeps the +`file:line:col: message' shape, so RET and `n'/`p' work on these exactly as +they do on the errors above, and the kind's face — the same faint pair the +in-buffer underlines use — is what tells the two heaps apart." + (with-current-buffer (flan--diagnostics-buffer) + (let ((inhibit-read-only t)) + (save-excursion + (if (and flan--diagnostics-memory-start + (marker-position flan--diagnostics-memory-start)) + (progn (goto-char flan--diagnostics-memory-start) + (delete-region (point) (point-max))) + (goto-char (point-max)) + (unless (bolp) (insert "\n"))) + (let ((start (point))) + (insert (format-time-string + "── memory, %H:%M:%S ──────────────────\n")) + (if (null sites) + (insert "nothing in this program allocates\n") + (dolist (row sites) + (let ((face (or (flan--memory-face (nth 1 row)) 'shadow))) + ;; Both properties: `face' for a buffer font-lock has not + ;; taken over, `font-lock-face' so refontification under + ;; `compilation-minor-mode' does not strip the colour. + (insert (propertize (format "%s: %s" (nth 0 row) (nth 2 row)) + 'face face 'font-lock-face face) + "\n")))) + ;; After the text, so the marker can advance past errors inserted + ;; at it and still name this section's first character. + (setq flan--diagnostics-memory-start (copy-marker start t))))) + (display-buffer (current-buffer)))) + +(defun flan--repl-note-failure () + "One line at the REPL saying the evaluation failed, when a REPL is open. +The full message is in the diagnostics list, which `flan--record-diagnostic' +has already shown; the prompt gets the pointer and nothing else." + (let ((repl (flan--repl-buffer))) + (when repl + (with-current-buffer repl + (flan-repl--insert-output + (format "1 error — see %s" flan-diagnostics-buffer)))))) ;;;###autoload (defun flan-show-diagnostics () @@ -1423,13 +1524,16 @@ somebody may want to keep, and it is written without one." ;;;###autoload (defun flan-clear-diagnostics () - "Empty the diagnostics log. + "Empty the diagnostics log, the memory section with it. Nothing else empties it — not connecting, not an accepted evaluation, not quitting the program — which is the point of it." (interactive) (with-current-buffer (flan--diagnostics-buffer) (let ((inhibit-read-only t)) - (erase-buffer)))) + (erase-buffer)) + (when flan--diagnostics-memory-start + (set-marker flan--diagnostics-memory-start nil) + (setq flan--diagnostics-memory-start nil)))) (defun flan--show-error (loc msg) "Mark MSG at LOC, if LOC names a file some buffer is visiting. @@ -2012,6 +2116,10 @@ has nothing to sit beside." ;; overlay needs a location and a buffer visiting the file, and the ;; message is worth keeping in either case. (ignore-errors (flan--record-diagnostic loc (or msg "rejected"))) + ;; And said at the REPL, when one is open: whoever is working there + ;; sees that the compile failed without turning to the echo area, and + ;; the line names the buffer the message itself is in. + (ignore-errors (flan--repl-note-failure)) ;; A refusal is not a value. `flan--show-error' clears the buffer it ;; marks, but a rejection the client cannot place — no `:loc', or a file ;; nobody is visiting — marks nothing, and leaving the last value up @@ -2990,7 +3098,11 @@ something is put in it; the block arrives at the first push, which is the line that is marked. The annotations last until you edit the buffer. Asking again while they are -up takes them down." +up takes them down. + +The full list of sites — the ones in files you have open and the ones +elsewhere — goes to the diagnostics buffer as its own section, below +whatever errors are logged there, navigable like them." (interactive) (if (flan--marked-buffers) (progn (mapc #'flan-clear-memory (flan--marked-buffers)) @@ -3003,6 +3115,11 @@ up takes them down." ;; run — but another one may be, and painting over it would stack a ;; second copy with a second `help-echo'. (mapc #'flan-clear-memory (flan--marked-buffers)) + ;; The whole list, into the diagnostics buffer, before the underlines + ;; are drawn: the underlines reach only the files that are open, and + ;; the list is where the rest of the answer is readable — and + ;; navigable, since every line is a location RET can take. + (flan--render-memory-sites (plist-get r :sites)) (dolist (row (plist-get r :sites)) (if (flan--show-memory (nth 0 row) (nth 1 row) (nth 2 row)) (setq here (1+ here)) diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 4aa2bd1..4a4a065 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -456,15 +456,16 @@ already rely on it — so nothing here is a stand-in for the real thing." ;; The session is not poisoned by that: a good form still lands. (flan--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form") - ;; The program's own output arrives on replies and lands in its buffer, so - ;; a long-running program is not writing into a terminal nobody is watching. + ;; The program's own output arrives on replies and lands in the daemon's + ;; buffer — no REPL is open yet, and the log is the fallback that makes a + ;; println never depend on one. (flan--eval "(defn step [] i64 (do (println \"HELLO\") ticks))" "form") (let ((seen nil) (deadline (+ (float-time) 10))) (while (and (not seen) (< (float-time) deadline)) (ignore-errors (flan--request '(:op "describe"))) - (setq seen (with-current-buffer (get-buffer-create flan-output-buffer) + (setq seen (with-current-buffer (get-buffer-create flan-daemon-buffer) (string-match-p "HELLO" (buffer-string))))) - (test-flan--check "the program's output reaches its buffer" seen)) + (test-flan--check "the program's output reaches the daemon's buffer" seen)) ;; ── Which evaluator C-x C-e reaches ────────────────────────────────── ;; @@ -804,9 +805,11 @@ already rely on it — so nothing here is a stand-in for the real thing." (and said (string-match-p "\\_" said) (not (string-match-p "=>" said))))) - ;; The REPL buffer: typed input goes through the same eval-expr request, and - ;; the value lands at the prompt while the program's own output goes to - ;; *flan-output*. Conflating those two is the bug worth testing for. + ;; The REPL buffer: typed input goes through the same eval-expr request. + ;; The value lands at the prompt, the program's own output is inserted + ;; above it — output first, then the value, the way a terminal REPL reads — + ;; and a rejection leaves one line pointing at *flan-diagnostics*, where + ;; the message itself is. (test-flan--check "an incomplete form is not sent" (not (flan-repl--complete-p "(+ 1"))) (test-flan--check "a whole form is sent" (flan-repl--complete-p "(+ 1 2)")) @@ -832,30 +835,89 @@ already rely on it — so nothing here is a stand-in for the real thing." (insert "no-such-thing") (flan-repl-return) (let ((deadline (+ (float-time) 15))) - (while (and (not (string-match-p "unknown name" (buffer-string))) + (while (and (not (string-match-p "1 error" (buffer-string))) (< (float-time) deadline)) (accept-process-output nil 0.05))) - (test-flan--check "the REPL shows an error" - (string-match-p "unknown name" (buffer-string))) - ;; A value and the program's output travel by different routes: the value - ;; is the result of the request, the output rides along with the reply. - ;; Showing them in one place would be convenient and wrong. + ;; A rejection at the prompt is a compiler message like any other: the + ;; message itself goes to the diagnostics list and the prompt gets the + ;; one-line pointer at it. + (test-flan--check "the REPL shows the one-line error summary" + (and (string-match-p "1 error" (buffer-string)) + (string-match-p (regexp-quote + flan-diagnostics-buffer) + (buffer-string)))) + (test-flan--check "and the message itself is in the diagnostics list" + (with-current-buffer (flan--diagnostics-buffer) + (string-match-p "unknown name" (buffer-string)))) + ;; A value and the program's output travel by different routes — the + ;; value is the result of the request, the output rides along with the + ;; reply — and both land here, output above value, so the prompt reads + ;; the way a terminal REPL does. The daemon's buffer mirrors the output. (goto-char (point-max)) (insert "(println \"PRINTED\")") (flan-repl-return) + ;; "^PRINTED$" throughout, because the input echo just inserted contains + ;; the word too: the bare line is the program's output and nothing else + ;; is. (let ((deadline (+ (float-time) 15))) - (while (and (not (with-current-buffer flan-output-buffer - (string-match-p "PRINTED" (buffer-string)))) + (while (and (not (string-match-p "^PRINTED$" (buffer-string))) (< (float-time) deadline)) (ignore-errors (flan--request '(:op "describe"))) (accept-process-output nil 0.05))) - (test-flan--check "printed text goes to the output buffer" - (with-current-buffer flan-output-buffer - (string-match-p "PRINTED" (buffer-string)))) - ;; ...and the prompt got the *value*, which for a call made for its effect - ;; is Unit. The text it printed is not the value and does not belong here. - (test-flan--check "and the prompt got the value, not the text" - (string-match-p "()" (buffer-string)))) + (test-flan--check "printed text lands at the REPL" + (string-match-p "^PRINTED$" (buffer-string))) + ;; ...and the prompt got the *value* as well, which for a call made for + ;; its effect is Unit — after the output it caused, not before it. + (test-flan--check "below it the value, in that order" + (let ((s (buffer-string))) + (and (string-match "^PRINTED$" s) + (string-match-p "()" (substring s (match-end 0)))))) + (test-flan--check "and the daemon's buffer mirrors the output" + (with-current-buffer flan-daemon-buffer + (string-match-p "^PRINTED$" (buffer-string)))) + ;; The two clears. C-c C-o takes down what the last send produced and + ;; nothing else; C-c M-o takes the transcript whole and leaves a prompt. + (flan-repl-clear-output) + (test-flan--check "clear-output removes the last send's output" + (not (string-match-p "^PRINTED$" (buffer-string)))) + (test-flan--check "but not the transcript above it" + (string-match-p "23" (buffer-string))) + (flan-repl-clear) + (test-flan--check "clear empties the transcript to a fresh prompt" + (and (not (string-match-p "23" (buffer-string))) + (string-match-p (regexp-quote flan-repl-prompt) + (buffer-string))))) + + ;; ── One diagnostics list, two sections ───────────────────────────────── + ;; + ;; The memory sites render at the end of the diagnostics buffer as one + ;; section, replaced whole on every ask, and an error that arrives after a + ;; render still lands *above* the section: the errors are the log, the + ;; sites are a standing reading. Driven directly rather than through the + ;; daemon — the op's rows are test_dev.ml's business, the layout is this + ;; file's. + (flan--render-memory-sites '(("f.flan:1:1" "memory/gc" "MEMNOTE-A"))) + (flan--record-diagnostic "f.flan:2:2" "ERR-AFTER") + (with-current-buffer (flan--diagnostics-buffer) + (let ((s (buffer-string))) + (test-flan--check "an error recorded after a render sits above it" + (and (string-match-p "ERR-AFTER" s) + (string-match-p "MEMNOTE-A" s) + (< (string-match "ERR-AFTER" s) + (string-match "MEMNOTE-A" s)))))) + (flan--render-memory-sites '(("f.flan:3:3" "memory/native" "MEMNOTE-B"))) + (with-current-buffer (flan--diagnostics-buffer) + (let ((s (buffer-string))) + (test-flan--check "a second render replaces the section whole" + (and (not (string-match-p "MEMNOTE-A" s)) + (string-match-p "MEMNOTE-B" s))) + (test-flan--check "with the errors still above it" + (< (string-match "ERR-AFTER" s) + (string-match "MEMNOTE-B" s))))) + (flan-clear-diagnostics) + (with-current-buffer (flan--diagnostics-buffer) + (test-flan--check "clearing the list takes both sections" + (= (point-min) (point-max)))) ;; ── The break loop ──────────────────────────────────────────────────── ;;