Skip to content

Preserve point and window-start across streaming rerenders #566

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Gleek wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Preserve point and window-start across streaming rerenders #566

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
176 changes: 94 additions & 82 deletions agent-shell-ui.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -70,88 +70,100 @@ When EXPANDED is non-nil, body will be expanded by default.
When NO-UNDO is non-nil, disable undo recording for this operation.

For existing blocks, the current expansion state is preserved unless overridden."
(save-mark-and-excursion
(let* ((inhibit-read-only t)
(buffer-undo-list (if no-undo t buffer-undo-list))
(namespace-id (map-elt model :namespace-id))
(qualified-id (format "%s-%s" namespace-id (map-elt model :block-id)))
(new-label-left (map-elt model :label-left))
(new-label-right (map-elt model :label-right))
(new-body (map-elt model :body))
(block-start nil)
(padding-start nil)
(padding-end nil)
(match (save-mark-and-excursion
(goto-char (point-max))
(text-property-search-backward
'agent-shell-ui-state nil
(lambda (_ state)
(equal (map-elt state :qualified-id) qualified-id))
t))))
(when (or new-label-left new-label-right new-body)
(when match
(goto-char (prop-match-beginning match)))
(if (and match (not create-new))
;; Found existing block - delete and regenerate
(let* ((existing-model (agent-shell-ui--read-fragment-at-point))
(state (get-text-property (point) 'agent-shell-ui-state))
(existing-body (map-elt existing-model :body))
(block-end (prop-match-end match))
(final-body (if new-body
(if (and append existing-body)
(concat existing-body new-body)
new-body)
existing-body))
(final-model (list (cons :namespace-id namespace-id)
(cons :block-id (map-elt model :block-id))
(cons :label-left (or new-label-left
(map-elt existing-model :label-left)))
(cons :label-right (or new-label-right
(map-elt existing-model :label-right)))
(cons :body final-body))))
(setq block-start (prop-match-beginning match))

;; Safely replace existing block using narrow-to-region
(save-excursion
(goto-char block-start)
(skip-chars-backward "\n")
(setq padding-start (point)))

;; Replace block
(delete-region block-start block-end)
(goto-char block-start)
(agent-shell-ui--insert-fragment final-model qualified-id
(not (map-elt state :collapsed))
navigation)
(setq padding-end (point)))

;; Not found or create-new - insert new block
(goto-char (point-max))
(setq padding-start (point))
(agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2))
(setq block-start (point))
(agent-shell-ui--insert-fragment model qualified-id expanded navigation)
(agent-shell-ui--insert-read-only "\n\n")
(setq padding-end (point))))
(when on-post-process
(funcall on-post-process))
(when-let ((block-range (agent-shell-ui--block-range :position block-start)))
(list (cons :block block-range)
(cons :body (agent-shell-ui--nearest-range-matching-property
:property 'agent-shell-ui-section :value 'body
:from (map-elt block-range :start)
:to (map-elt block-range :end)))
(cons :label-left (agent-shell-ui--nearest-range-matching-property
:property 'agent-shell-ui-section :value 'label-left
:from (map-elt block-range :start)
:to (map-elt block-range :end)))
(cons :label-right (agent-shell-ui--nearest-range-matching-property
:property 'agent-shell-ui-section :value 'label-right
:from (map-elt block-range :start)
:to (map-elt block-range :end)))
(cons :padding (when (and padding-start padding-end)
(list (cons :start padding-start)
(cons :end padding-end)))))))))
(let* ((inhibit-read-only t)
(buffer-undo-list (if no-undo t buffer-undo-list))
(window (get-buffer-window (current-buffer)))
(saved-point (point))
(saved-mark (mark t))
(saved-mark-active mark-active)
(saved-window-start (and window (window-start window)))
(namespace-id (map-elt model :namespace-id))
(qualified-id (format "%s-%s" namespace-id (map-elt model :block-id)))
(new-label-left (map-elt model :label-left))
(new-label-right (map-elt model :label-right))
(new-body (map-elt model :body))
(block-start nil)
(padding-start nil)
(padding-end nil)
(match (save-mark-and-excursion
(goto-char (point-max))
(text-property-search-backward
'agent-shell-ui-state nil
(lambda (_ state)
(equal (map-elt state :qualified-id) qualified-id))
t))))
(unwind-protect
(progn
(when (or new-label-left new-label-right new-body)
(when match
(goto-char (prop-match-beginning match)))
(if (and match (not create-new))
;; Found existing block - delete and regenerate
(let* ((existing-model (agent-shell-ui--read-fragment-at-point))
(state (get-text-property (point) 'agent-shell-ui-state))
(existing-body (map-elt existing-model :body))
(block-end (prop-match-end match))
(final-body (if new-body
(if (and append existing-body)
(concat existing-body new-body)
new-body)
existing-body))
(final-model (list (cons :namespace-id namespace-id)
(cons :block-id (map-elt model :block-id))
(cons :label-left (or new-label-left
(map-elt existing-model :label-left)))
(cons :label-right (or new-label-right
(map-elt existing-model :label-right)))
(cons :body final-body))))
(setq block-start (prop-match-beginning match))

;; Safely replace existing block using narrow-to-region
(save-excursion
(goto-char block-start)
(skip-chars-backward "\n")
(setq padding-start (point)))

;; Replace block
(delete-region block-start block-end)
(goto-char block-start)
(agent-shell-ui--insert-fragment final-model qualified-id
(not (map-elt state :collapsed))
navigation)
(setq padding-end (point)))

;; Not found or create-new - insert new block
(goto-char (point-max))
(setq padding-start (point))
(agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2))
(setq block-start (point))
(agent-shell-ui--insert-fragment model qualified-id expanded navigation)
(agent-shell-ui--insert-read-only "\n\n")
(setq padding-end (point))))
(when on-post-process
(funcall on-post-process))
(when-let ((block-range (agent-shell-ui--block-range :position block-start)))
(list (cons :block block-range)
(cons :body (agent-shell-ui--nearest-range-matching-property
:property 'agent-shell-ui-section :value 'body
:from (map-elt block-range :start)
:to (map-elt block-range :end)))
(cons :label-left (agent-shell-ui--nearest-range-matching-property
:property 'agent-shell-ui-section :value 'label-left
:from (map-elt block-range :start)
:to (map-elt block-range :end)))
(cons :label-right (agent-shell-ui--nearest-range-matching-property
:property 'agent-shell-ui-section :value 'label-right
:from (map-elt block-range :start)
:to (map-elt block-range :end)))
(cons :padding (when (and padding-start padding-end)
(list (cons :start padding-start)
(cons :end padding-end)))))))
(goto-char saved-point)
(when saved-mark
(set-marker (mark-marker) saved-mark))
(setq mark-active saved-mark-active)
(when window
(set-window-start window saved-window-start t)))))


(defun agent-shell-ui--read-fragment-at (position qualified-id)
Expand Down
115 changes: 63 additions & 52 deletions agent-shell.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2970,8 +2970,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body."
(derived-mode-p 'agent-shell-viewport-view-mode))))
(with-current-buffer viewport-buffer
(let ((inhibit-read-only t)
(auto-scroll (shell-maker--should-auto-scroll-p))
(saved-point (point-marker)))
(auto-scroll (shell-maker--should-auto-scroll-p)))
(when-let* ((range (agent-shell-ui-update-fragment
(agent-shell-ui-make-fragment-model
:namespace-id (or namespace-id
Expand Down Expand Up @@ -3009,61 +3008,73 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body."
(let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)
(markdown-overlays-render-images nil))
(markdown-overlays-put))))
(if auto-scroll
(goto-char (point-max))
(goto-char saved-point))))))
(when auto-scroll
(goto-char (point-max)))))))
(with-current-buffer (map-elt state :buffer)
(unless (and (derived-mode-p 'agent-shell-mode)
(equal (current-buffer)
(map-elt state :buffer)))
(error "Editing the wrong buffer: %s" (current-buffer)))
(shell-maker-with-auto-scroll-edit
(when-let* ((range (agent-shell-ui-update-fragment
(agent-shell-ui-make-fragment-model
:namespace-id (or namespace-id
(map-elt state :request-count))
:block-id block-id
:label-left label-left
:label-right label-right
:body body)
:navigation navigation
:append append
:create-new create-new
:expanded expanded
:no-undo t))
(padding-start (map-nested-elt range '(:padding :start)))
(padding-end (map-nested-elt range '(:padding :end)))
(block-start (map-nested-elt range '(:block :start)))
(block-end (map-nested-elt range '(:block :end))))
(save-restriction
;; TODO: Move this to shell-maker?
(let ((inhibit-read-only t))
;; comint relies on field property to
;; derive `comint-next-prompt'.
;; Marking as field to avoid false positives in
;; `agent-shell-next-item' and `agent-shell-previous-item'.
(add-text-properties (or padding-start block-start)
(or padding-end block-end) '(field output)))
;; Apply markdown overlay to body.
(when-let ((body-start (map-nested-elt range '(:body :start)))
(body-end (map-nested-elt range '(:body :end))))
(narrow-to-region body-start body-end)
(let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks))
(markdown-overlays-put))
(widen))
;;
;; Note: For now, we're skipping applying markdown overlays
;; on left labels as they currently carry propertized text
;; for statuses (ie. boxed).
;;
;; Apply markdown overlay to right label.
(when-let ((label-right-start (map-nested-elt range '(:label-right :start)))
(label-right-end (map-nested-elt range '(:label-right :end))))
(narrow-to-region label-right-start label-right-end)
(let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks))
(markdown-overlays-put))
(widen)))
(run-hook-with-args 'agent-shell-section-functions range)))))
(let* ((window (get-buffer-window (current-buffer)))
(auto-scroll (eobp))
(saved-point (point))
(saved-mark (mark t))
(saved-mark-active mark-active)
(saved-window-start (and window (window-start window))))
(shell-maker-with-auto-scroll-edit
(when-let* ((range (agent-shell-ui-update-fragment
(agent-shell-ui-make-fragment-model
:namespace-id (or namespace-id
(map-elt state :request-count))
:block-id block-id
:label-left label-left
:label-right label-right
:body body)
:navigation navigation
:append append
:create-new create-new
:expanded expanded
:no-undo t))
(padding-start (map-nested-elt range '(:padding :start)))
(padding-end (map-nested-elt range '(:padding :end)))
(block-start (map-nested-elt range '(:block :start)))
(block-end (map-nested-elt range '(:block :end))))
(save-restriction
;; TODO: Move this to shell-maker?
(let ((inhibit-read-only t))
;; comint relies on field property to
;; derive `comint-next-prompt'.
;; Marking as field to avoid false positives in
;; `agent-shell-next-item' and `agent-shell-previous-item'.
(add-text-properties (or padding-start block-start)
(or padding-end block-end) '(field output)))
;; Apply markdown overlay to body.
(when-let ((body-start (map-nested-elt range '(:body :start)))
(body-end (map-nested-elt range '(:body :end))))
(narrow-to-region body-start body-end)
(let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks))
(markdown-overlays-put))
(widen))
;;
;; Note: For now, we're skipping applying markdown overlays
;; on left labels as they currently carry propertized text
;; for statuses (ie. boxed).
;;
;; Apply markdown overlay to right label.
(when-let ((label-right-start (map-nested-elt range '(:label-right :start)))
(label-right-end (map-nested-elt range '(:label-right :end))))
(narrow-to-region label-right-start label-right-end)
(let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks))
(markdown-overlays-put))
(widen)))
(run-hook-with-args 'agent-shell-section-functions range)))
(unless auto-scroll
(goto-char saved-point)
(when saved-mark
(set-marker (mark-marker) saved-mark))
(setq mark-active saved-mark-active)
(when window
(set-window-start window saved-window-start t))))))

(cl-defun agent-shell--update-text (&key state namespace-id block-id text append create-new)
"Update plain text entry in the shell buffer.
Expand Down