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-connect "flan" nil t)
|
||||||
(autoload 'flan-disconnect "flan" nil t)
|
(autoload 'flan-disconnect "flan" nil t)
|
||||||
(autoload 'flan-describe "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 "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)
|
(autoload 'flan-break "flan" nil t)
|
||||||
;; The two CIDER-shaped buffers. They reach the daemon through an indirection
|
;; 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
|
;; 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-z") #'flan-connect)
|
||||||
(define-key map (kbd "C-c C-q") #'flan-disconnect)
|
(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-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)
|
(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
|
;; 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
|
;; 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
|
;; for it, because the file says which package it belongs to; a prompt has no
|
||||||
;; file and nothing to derive it from.
|
;; file and nothing to derive it from.
|
||||||
;;
|
;;
|
||||||
;; - **A value and the program's output are different things** and arrive by
|
;; - **A value and the program's output are different things**, and both are
|
||||||
;; different routes. The value of the expression appears at the prompt;
|
;; here. The value of the expression appears at the prompt; anything the
|
||||||
;; anything the program printed while evaluating it goes to *flan-output*,
|
;; program printed while evaluating it — riding along on the same reply —
|
||||||
;; riding along on the same reply. Showing them in one place would be
|
;; is inserted above it, output first, then the value, the way a terminal
|
||||||
;; convenient and wrong.
|
;; 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:
|
;;; Code:
|
||||||
|
|
||||||
@ -83,7 +89,10 @@ a buffer-local value is not visible.")
|
|||||||
|
|
||||||
(defvar flan-repl-mode-map
|
(defvar flan-repl-mode-map
|
||||||
(let ((map (make-sparse-keymap)))
|
(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-d") #'flan-describe)
|
||||||
(define-key map (kbd "C-c C-q") #'flan-disconnect)
|
(define-key map (kbd "C-c C-q") #'flan-disconnect)
|
||||||
(define-key map (kbd "<up>") #'flan-repl-previous-input)
|
(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))))
|
(let ((proc (get-buffer-process (current-buffer))))
|
||||||
(comint-output-filter proc (concat text "\n" flan-repl-prompt))))
|
(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)
|
(defun flan-repl--send (_proc text)
|
||||||
"Evaluate TEXT in the running program and show what it was."
|
"Evaluate TEXT in the running program and show what it was."
|
||||||
(let ((code (string-trim text)))
|
(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
|
(let ((reply (condition-case err
|
||||||
(flan--request
|
(flan--request
|
||||||
(list :op "eval-expr" :code code :file "<repl>"))
|
(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))))))
|
:message (error-message-string err))))))
|
||||||
(flan-repl--output
|
(cond
|
||||||
(if (equal (plist-get reply :status) "ok")
|
((equal (plist-get reply :status) "ok")
|
||||||
(or (plist-get reply :value) "")
|
(flan-repl--output (or (plist-get reply :value) "")))
|
||||||
(concat "error: " (or (plist-get reply :message) "rejected")
|
((plist-get reply :client)
|
||||||
(let ((loc (plist-get reply :loc)))
|
(flan-repl--output
|
||||||
(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 ()
|
(defun flan-repl-return ()
|
||||||
"Send the input if it is a whole form, otherwise open a line."
|
"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."
|
"How many installed names to name before falling back to counting them."
|
||||||
:type 'integer)
|
:type 'integer)
|
||||||
|
|
||||||
(defcustom flan-output-buffer "*flan-output*"
|
(defcustom flan-daemon-buffer "*flan*"
|
||||||
"Buffer the running program's own output is appended to."
|
|
||||||
:type 'string)
|
|
||||||
|
|
||||||
(defcustom flan-daemon-buffer "*flan-dev*"
|
|
||||||
"Buffer the daemon's own output goes to.
|
"Buffer the daemon's own output goes to.
|
||||||
This is where a build that failed says so: the daemon compiles the program
|
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
|
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
|
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
|
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)
|
:type 'string)
|
||||||
|
|
||||||
(defcustom flan-diagnostics-buffer "*flan-diagnostics*"
|
(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
|
*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
|
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
|
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)
|
:type 'string)
|
||||||
|
|
||||||
(defcustom flan-reply-timeout 30
|
(defcustom flan-reply-timeout 30
|
||||||
@ -329,17 +333,36 @@ Reconnecting happens before a send, never after one."
|
|||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(flan--no-reply proc))))))
|
(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)
|
(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))
|
(when (and text (> (length text) 0))
|
||||||
(with-current-buffer (get-buffer-create flan-output-buffer)
|
(with-current-buffer (get-buffer-create flan-daemon-buffer)
|
||||||
(let ((at-end (= (point) (point-max))))
|
(let ((at-end (= (point) (point-max)))
|
||||||
|
(inhibit-read-only t))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
(insert text))
|
(insert text))
|
||||||
;; Follow the tail only for someone who was already at it; a reader
|
;; Follow the tail only for someone who was already at it; a reader
|
||||||
;; scrolled back is reading something.
|
;; 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
|
;; 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,
|
;; 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))
|
((null index) (user-error "flan: %s is not on the list" choice))
|
||||||
(t (flan-restart-at index (nth index restarts)))))))
|
(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 ()
|
(defun flan-describe ()
|
||||||
"Report what the running program currently defines."
|
"Report what the running program currently defines."
|
||||||
(interactive)
|
(interactive)
|
||||||
@ -1383,28 +1399,67 @@ no longer wrong."
|
|||||||
;; the compiler wrote it — `file:line:col: text' — which is what makes
|
;; 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
|
;; `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.
|
;; 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 ()
|
(defun flan--diagnostics-buffer ()
|
||||||
"The diagnostics buffer, made and set up if this is the first message."
|
"The diagnostics buffer, made and set up if this is the first message."
|
||||||
(or (get-buffer flan-diagnostics-buffer)
|
(or (get-buffer flan-diagnostics-buffer)
|
||||||
(with-current-buffer (get-buffer-create 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
|
(flan-diagnostics-mode)
|
||||||
;; 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)
|
|
||||||
(current-buffer))))
|
(current-buffer))))
|
||||||
|
|
||||||
(defun flan--record-diagnostic (loc msg)
|
(defun flan--record-diagnostic (loc msg)
|
||||||
"Append MSG, which the daemon reported at LOC, to the diagnostics log.
|
"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
|
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))
|
(when (and (stringp msg) (> (length msg) 0))
|
||||||
(with-current-buffer (flan--diagnostics-buffer)
|
(with-current-buffer (flan--diagnostics-buffer)
|
||||||
(let ((at-end (= (point) (point-max)))
|
(let ((at-end (= (point) (point-max)))
|
||||||
(inhibit-read-only t))
|
(inhibit-read-only t))
|
||||||
(save-excursion
|
(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"))
|
(unless (bolp) (insert "\n"))
|
||||||
(insert (format-time-string "── %H:%M:%S ──────────────────────\n"))
|
(insert (format-time-string "── %H:%M:%S ──────────────────────\n"))
|
||||||
(insert (if (stringp loc) (format "%s: %s\n" loc msg)
|
(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
|
;; `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
|
;; for somebody who was already at it, since a reader scrolled back is
|
||||||
;; reading something.
|
;; 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
|
;;;###autoload
|
||||||
(defun flan-show-diagnostics ()
|
(defun flan-show-diagnostics ()
|
||||||
@ -1423,13 +1524,16 @@ somebody may want to keep, and it is written without one."
|
|||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun flan-clear-diagnostics ()
|
(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
|
Nothing else empties it — not connecting, not an accepted evaluation, not
|
||||||
quitting the program — which is the point of it."
|
quitting the program — which is the point of it."
|
||||||
(interactive)
|
(interactive)
|
||||||
(with-current-buffer (flan--diagnostics-buffer)
|
(with-current-buffer (flan--diagnostics-buffer)
|
||||||
(let ((inhibit-read-only t))
|
(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)
|
(defun flan--show-error (loc msg)
|
||||||
"Mark MSG at LOC, if LOC names a file some buffer is visiting.
|
"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
|
;; overlay needs a location and a buffer visiting the file, and the
|
||||||
;; message is worth keeping in either case.
|
;; message is worth keeping in either case.
|
||||||
(ignore-errors (flan--record-diagnostic loc (or msg "rejected")))
|
(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
|
;; 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
|
;; marks, but a rejection the client cannot place — no `:loc', or a file
|
||||||
;; nobody is visiting — marks nothing, and leaving the last value up
|
;; 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.
|
line that is marked.
|
||||||
|
|
||||||
The annotations last until you edit the buffer. Asking again while they are
|
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)
|
(interactive)
|
||||||
(if (flan--marked-buffers)
|
(if (flan--marked-buffers)
|
||||||
(progn (mapc #'flan-clear-memory (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
|
;; run — but another one may be, and painting over it would stack a
|
||||||
;; second copy with a second `help-echo'.
|
;; second copy with a second `help-echo'.
|
||||||
(mapc #'flan-clear-memory (flan--marked-buffers))
|
(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))
|
(dolist (row (plist-get r :sites))
|
||||||
(if (flan--show-memory (nth 0 row) (nth 1 row) (nth 2 row))
|
(if (flan--show-memory (nth 0 row) (nth 1 row) (nth 2 row))
|
||||||
(setq here (1+ here))
|
(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.
|
;; The session is not poisoned by that: a good form still lands.
|
||||||
(flan--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form")
|
(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
|
;; The program's own output arrives on replies and lands in the daemon's
|
||||||
;; a long-running program is not writing into a terminal nobody is watching.
|
;; 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")
|
(flan--eval "(defn step [] i64 (do (println \"HELLO\") ticks))" "form")
|
||||||
(let ((seen nil) (deadline (+ (float-time) 10)))
|
(let ((seen nil) (deadline (+ (float-time) 10)))
|
||||||
(while (and (not seen) (< (float-time) deadline))
|
(while (and (not seen) (< (float-time) deadline))
|
||||||
(ignore-errors (flan--request '(:op "describe")))
|
(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)))))
|
(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 ──────────────────────────────────
|
;; ── 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)
|
(and said (string-match-p "\\_<ticks\\_>" said)
|
||||||
(not (string-match-p "=>" said)))))
|
(not (string-match-p "=>" said)))))
|
||||||
|
|
||||||
;; The REPL buffer: typed input goes through the same eval-expr request, and
|
;; The REPL buffer: typed input goes through the same eval-expr request.
|
||||||
;; the value lands at the prompt while the program's own output goes to
|
;; The value lands at the prompt, the program's own output is inserted
|
||||||
;; *flan-output*. Conflating those two is the bug worth testing for.
|
;; 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"
|
(test-flan--check "an incomplete form is not sent"
|
||||||
(not (flan-repl--complete-p "(+ 1")))
|
(not (flan-repl--complete-p "(+ 1")))
|
||||||
(test-flan--check "a whole form is sent" (flan-repl--complete-p "(+ 1 2)"))
|
(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")
|
(insert "no-such-thing")
|
||||||
(flan-repl-return)
|
(flan-repl-return)
|
||||||
(let ((deadline (+ (float-time) 15)))
|
(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))
|
(< (float-time) deadline))
|
||||||
(accept-process-output nil 0.05)))
|
(accept-process-output nil 0.05)))
|
||||||
(test-flan--check "the REPL shows an error"
|
;; A rejection at the prompt is a compiler message like any other: the
|
||||||
(string-match-p "unknown name" (buffer-string)))
|
;; message itself goes to the diagnostics list and the prompt gets the
|
||||||
;; A value and the program's output travel by different routes: the value
|
;; one-line pointer at it.
|
||||||
;; is the result of the request, the output rides along with the reply.
|
(test-flan--check "the REPL shows the one-line error summary"
|
||||||
;; Showing them in one place would be convenient and wrong.
|
(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))
|
(goto-char (point-max))
|
||||||
(insert "(println \"PRINTED\")")
|
(insert "(println \"PRINTED\")")
|
||||||
(flan-repl-return)
|
(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)))
|
(let ((deadline (+ (float-time) 15)))
|
||||||
(while (and (not (with-current-buffer flan-output-buffer
|
(while (and (not (string-match-p "^PRINTED$" (buffer-string)))
|
||||||
(string-match-p "PRINTED" (buffer-string))))
|
|
||||||
(< (float-time) deadline))
|
(< (float-time) deadline))
|
||||||
(ignore-errors (flan--request '(:op "describe")))
|
(ignore-errors (flan--request '(:op "describe")))
|
||||||
(accept-process-output nil 0.05)))
|
(accept-process-output nil 0.05)))
|
||||||
(test-flan--check "printed text goes to the output buffer"
|
(test-flan--check "printed text lands at the REPL"
|
||||||
(with-current-buffer flan-output-buffer
|
(string-match-p "^PRINTED$" (buffer-string)))
|
||||||
(string-match-p "PRINTED" (buffer-string))))
|
;; ...and the prompt got the *value* as well, which for a call made for
|
||||||
;; ...and the prompt got the *value*, which for a call made for its effect
|
;; its effect is Unit — after the output it caused, not before it.
|
||||||
;; is Unit. The text it printed is not the value and does not belong here.
|
(test-flan--check "below it the value, in that order"
|
||||||
(test-flan--check "and the prompt got the value, not the text"
|
(let ((s (buffer-string)))
|
||||||
(string-match-p "()" (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 ────────────────────────────────────────────────────
|
;; ── The break loop ────────────────────────────────────────────────────
|
||||||
;;
|
;;
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user