Two streams and one list: the buffer story consolidated
*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.
This commit is contained in:
parent
6ef0f46bea
commit
e83a50b5c3
@ -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
|
||||
|
||||
@ -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 "<up>") #'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 "<repl>"))
|
||||
(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))))))
|
||||
(cond
|
||||
((equal (plist-get reply :status) "ok")
|
||||
(flan-repl--output (or (plist-get reply :value) "")))
|
||||
((plist-get reply :client)
|
||||
(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 ")") ""))))))))))
|
||||
(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."
|
||||
|
||||
175
emacs/flan.el
175
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))
|
||||
|
||||
@ -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 "\\_<ticks\\_>" 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 ────────────────────────────────────────────────────
|
||||
;;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user