From 7832e7d094b8d9cb49419e2f233a5d900a7377d8 Mon Sep 17 00:00:00 2001 From: Umar Ahmad Date: Sun, 3 May 2026 06:42:44 +0530 Subject: [PATCH] Preserve point and window-start across streaming rerenders Each streaming chunk delete-and-reinserts the in-progress block, which displaces any markers inside that region to its start. `(point-marker)` in the viewport branch and `save-mark-and-excursion`/`save-excursion` (in `agent-shell-ui-update-fragment` and `shell-maker-with-auto-scroll-edit`) all rely on markers, so cursor and viewport jumped to the block header when reading mid-stream. Switch to integer-based save/restore for point and window-start: inside `agent-shell-ui-update-fragment` (covers the viewport flow) and around `shell-maker-with-auto-scroll-edit` in the main shell branch (overrides shell-maker's broken `save-excursion`). --- agent-shell-ui.el | 176 +++++++++++++++++++++++++--------------------- agent-shell.el | 115 ++++++++++++++++-------------- 2 files changed, 157 insertions(+), 134 deletions(-) diff --git a/agent-shell-ui.el b/agent-shell-ui.el index cf09835f..74e3e36a 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -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) diff --git a/agent-shell.el b/agent-shell.el index fca0129e..7a842b98 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -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 @@ -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.