Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
140 changes: 110 additions & 30 deletions agent-shell-chat-mode.el
Original file line number Diff line number Diff line change
Expand Up @@ -164,19 +164,26 @@ so a label following it needs a full pad rather than a single newline."
(seq-find (lambda (overlay) (eq (overlay-get overlay 'category) category))
(overlays-in beg (max end (1+ beg)))))

(defun agent-shell-chat--upsert-overlay (category anchor-beg anchor-end beg end props)
(defun agent-shell-chat--upsert-overlay (category anchor-beg anchor-end beg end props
&optional rear-advance)
"Ensure a CATEGORY overlay spans BEG..END carrying PROPS.

PROPS is an alist of overlay property to value. Reuses an existing
CATEGORY overlay overlapping ANCHOR-BEG..ANCHOR-END (moving it when the
span changed), otherwise creates one."
span changed), otherwise creates one.

With REAR-ADVANCE non-nil the overlay takes in text inserted at its end
and is not `evaporate'd while empty, so it can hold properties over an
input still being typed: relabels do not run per keystroke, so an
overlay that ended at the caret would never grow to cover it."
(let* ((existing (seq-filter (lambda (overlay)
(eq (overlay-get overlay 'category) category))
(overlays-in anchor-beg (max anchor-end (1+ anchor-beg)))))
(overlay (or (car existing)
(let ((created (make-overlay beg end)))
(let ((created (make-overlay beg end nil nil rear-advance)))
(overlay-put created 'category category)
(overlay-put created 'evaporate t)
(unless rear-advance
(overlay-put created 'evaporate t))
created))))
;; Delete stray duplicates: relabels re-create an overlay whenever its
;; span has drifted outside the search range, so more than one can pile up.
Expand All @@ -190,6 +197,35 @@ span changed), otherwise creates one."
props)
overlay))

(defun agent-shell-chat--draft-tail-indent (beg end)
"Return the indent a draft spanning BEG..END needs on its last line.

A `line-prefix' hangs off the character a display row starts from, and a
draft ending in a newline has none there: that row starts at end of
buffer. The caret would sit flush left until the first character landed
to carry the prefix. A string standing at that position indents the row
instead, and gives way (to \"\") the moment there is a character for the
prefix itself.

For example, over a draft of \"one\\n\" returns the body indent, and over
\"one\" returns \"\"."
(if (and (> end beg) (eq (char-before end) ?\n))
agent-shell-chat--body-indent
""))

(defun agent-shell-chat--draft-changed (draft after &rest _)
"Re-indent DRAFT's last line once a change to it has landed.

Runs from DRAFT's own modification hooks, AFTER being non-nil once the
change is in. Kept off the relabel path: relabels are event-driven and
coalesced, so none runs between the newline that empties the last line
and the character that fills it."
(when after
(let ((indent (agent-shell-chat--draft-tail-indent
(overlay-start draft) (overlay-end draft))))
(unless (equal (overlay-get draft 'after-string) indent)
(overlay-put draft 'after-string indent)))))

(defun agent-shell-chat--gc-overlays (categories kept)
"Delete label overlays of CATEGORIES not in KEPT (a list of overlays).
Removes stale labels whose prompt run or marker was deleted (e.g. a live
Expand Down Expand Up @@ -234,10 +270,10 @@ starts): `Me' shows the instant a prompt is submitted, and an empty
prompt does not claim the fresh prompt below as its input.

Blank lines around the prompt collapse to exactly one on each side. The
label rides the one above rather than covering it, so that nothing is
shown at the prompt itself, and the marker travels as a `line-prefix':
a string standing at the prompt holds point and the cursor on the row
above, putting the first line of a multi-line input out of reach of
label rides the one above rather than covering it, and the marker is
`display'ed in place of the prompt text: neither stands as a string of
its own at the prompt, which would hold point and the cursor on the row
above and put the first line of a multi-line input out of reach of
`previous-line'. Updates in place."
(save-excursion
(let ((runs (agent-shell-chat--prompt-runs))
Expand Down Expand Up @@ -357,14 +393,23 @@ above, putting the first line of a multi-line input out of reach of
;; line out of reach of `previous-line'.
(label-nl (and labeled (< start pos) (eq (char-before pos) ?\n)
(1- pos)))
;; The live prompt's marker, shown before the input whether or
;; not text has been typed yet. Keying this off `blank' would
;; drop it the instant the user starts typing. Carried as a
;; `line-prefix', which occupies no buffer position.
(marker (when (and live labeled)
(propertize (concat agent-shell-chat--body-indent
agent-shell-chat--prompt)
'face 'default)))
;; What the run shows in place of the prompt text, as the
;; `display' of the overlay below (so it is part of the row
;; rather than a prefix of it). The live prompt shows the
;; marker its input follows, whether or not anything has been
;; typed yet: keying that off `blank' would drop it the instant
;; the user started typing. A submitted turn shows the bare
;; body indent, lining its first line up with the response
;; below and with the rest of its own lines. An unlabeled run
;; (an empty submission, or the live prompt with the bar on)
;; shows nothing at all.
(marker (cond
((not labeled) "")
(live (propertize (concat agent-shell-chat--body-indent
agent-shell-chat--prompt)
'face 'default))
(t (propertize agent-shell-chat--body-indent
'face 'default))))
;; The label, closed by the newline it rides rather than by the
;; second half of `pad'.
(before (cond ((not labeled) "")
Expand Down Expand Up @@ -394,21 +439,54 @@ above, putting the first line of a multi-line input out of reach of
(push
(agent-shell-chat--upsert-overlay
'agent-shell-chat-me pos run-end (if label-nl pos start) end
;; Hide the covered prompt with a `display' of \"\". Any string
;; shown at this position (a `before-string', or the label when
;; there is no newline above to carry it) keeps `previous-line'
;; from settling on the input's first line, so the marker travels
;; as a `line-prefix' instead, which occupies no position of its
;; own. Empty `line-prefix'/`wrap-prefix' otherwise drop any
;; tinted gutter inherited from the covered text.
;; `display' the covered prompt as the marker (live prompt) or as
;; \"\" (hidden otherwise). The marker replaces prompt text, so it
;; occupies no position of its own and leaves `previous-line' able
;; to settle on a multi-line input's first line, the way a string
;; standing at this position (a `before-string') would not.
;;
;; It is deliberately not a `line-prefix': that is resolved once,
;; at the position a display row starts from, and this row starts
;; on a prompt whose every character is replaced by a `display'.
;; Redisplay paths that resolve it a position later (at the first
;; character of the input, past this overlay) then find nothing
;; and paint the row flush left, which shows as the input jumping
;; sideways for a frame on each keystroke.
;;
;; Empty `line-prefix'/`wrap-prefix' drop any tinted gutter
;; inherited from the covered text.
(list (cons 'before-string (if label-nl "" before))
(cons 'display "")
(cons 'line-prefix (or marker ""))
(cons 'wrap-prefix (or marker ""))))
(cons 'display marker)
(cons 'line-prefix "")
(cons 'wrap-prefix "")))
kept)
;; Indent a submitted turn's input so it aligns with the response
;; body. The live prompt (input flows after the marker) and empty
;; prompts have no input to indent.
;; Indent the live prompt's draft, so the lines below its first (the
;; marker indents that one) line up with it rather than sitting flush
;; left. Rear-advancing and anchored at the input's start: it must
;; already be in place, and grow, as characters arrive, since no
;; relabel runs while typing.
(when (and live labeled)
(push
(agent-shell-chat--upsert-overlay
'agent-shell-chat-me-draft run-end (point-max) run-end (point-max)
(list (cons 'line-prefix agent-shell-chat--body-indent)
(cons 'wrap-prefix agent-shell-chat--body-indent)
;; Indents a last line left empty by a newline, which the
;; prefix above cannot reach. The hooks keep it in step
;; with what is typed.
(cons 'after-string (agent-shell-chat--draft-tail-indent
run-end (point-max)))
(cons 'modification-hooks
(list #'agent-shell-chat--draft-changed))
(cons 'insert-in-front-hooks
(list #'agent-shell-chat--draft-changed))
(cons 'insert-behind-hooks
(list #'agent-shell-chat--draft-changed)))
'rear-advance)
kept))
;; Indent the lines under a submitted turn's first, which the
;; `display' above indents. The live prompt's draft is covered by
;; the overlay above instead, and an empty submission has no input.
(unless (or blank live)
;; End at the input's last real character, not `input-end': the
;; agent label's `before-string' renders in the trailing newline
Expand All @@ -432,7 +510,8 @@ above, putting the first line of a multi-line input out of reach of
(agent-shell-chat--gc-overlays '(agent-shell-chat-me
agent-shell-chat-me-label
agent-shell-chat-me-surplus
agent-shell-chat-me-input)
agent-shell-chat-me-input
agent-shell-chat-me-draft)
kept))))

(defun agent-shell-chat--label-responses ()
Expand Down Expand Up @@ -623,6 +702,7 @@ too."
(remove-overlays (point-min) (point-max) 'category 'agent-shell-chat-me-label)
(remove-overlays (point-min) (point-max) 'category 'agent-shell-chat-me-surplus)
(remove-overlays (point-min) (point-max) 'category 'agent-shell-chat-me-input)
(remove-overlays (point-min) (point-max) 'category 'agent-shell-chat-me-draft)
(remove-overlays (point-min) (point-max) 'category 'agent-shell-chat-agent)
;; The minibuffer hook is global, so it goes once the last shell drops it.
(unless (seq-find (lambda (buffer)
Expand Down
Loading
Loading