Skip to content

feat: Support viewport history navigation while streaming #464

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
liaowang11 wants to merge 1 commit into
base: main
Choose a base branch
from
Open

feat: Support viewport history navigation while streaming #464

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
10 changes: 8 additions & 2 deletions agent-shell-viewport.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -510,6 +510,14 @@ Optionally set its PROMPT and RESPONSE."
(goto-char (point-min))
current))

(cl-defun agent-shell-viewport--showing-latest-p (&key viewport-buffer)
"Return non-nil when VIEWPORT-BUFFER is showing the latest interaction."
(when-let* ((viewport-buffer (or viewport-buffer (current-buffer)))
(position (with-current-buffer viewport-buffer
(agent-shell-viewport--position))))
(= (map-elt position :current)
(map-elt position :total))))

(defun agent-shell-viewport-next-item ()
"Go to next item.

Expand Down Expand Up @@ -773,8 +781,6 @@ buffer from the snapshot and switch to edit mode."
(interactive)
(unless (derived-mode-p 'agent-shell-viewport-view-mode)
(error "Not in a viewport buffer"))
(when (agent-shell-viewport--busy-p)
(user-error "Busy... please wait"))
(let ((shell-buffer (agent-shell-viewport--shell-buffer))
(snapshot agent-shell-viewport--compose-snapshot)
(pos (agent-shell-viewport--position :force-refresh t)))
Expand Down
11 changes: 8 additions & 3 deletions agent-shell.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2816,7 +2816,10 @@ variable (see makunbound)"))
(when-let (((map-elt state :buffer))
(viewport-buffer (agent-shell-viewport--buffer
:shell-buffer (map-elt state :buffer)
:existing-only t)))
:existing-only t))
((with-current-buffer viewport-buffer
(and (derived-mode-p 'agent-shell-viewport-view-mode)
(agent-shell-viewport--showing-latest-p)))))
(with-current-buffer viewport-buffer
(agent-shell-ui-delete-fragment :namespace-id (map-elt state :request-count) :block-id block-id :no-undo t)))
(with-current-buffer (map-elt state :buffer)
Expand Down Expand Up @@ -2866,7 +2869,8 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body."
:shell-buffer (map-elt state :buffer)
:existing-only t))
((with-current-buffer viewport-buffer
(derived-mode-p 'agent-shell-viewport-view-mode))))
(and (derived-mode-p 'agent-shell-viewport-view-mode)
(agent-shell-viewport--showing-latest-p)))))
(with-current-buffer viewport-buffer
(let ((inhibit-read-only t)
(auto-scroll (eobp))
Expand Down Expand Up @@ -2977,7 +2981,8 @@ APPEND and CREATE-NEW control update behavior."
:shell-buffer (map-elt state :buffer)
:existing-only t))
((with-current-buffer viewport-buffer
(derived-mode-p 'agent-shell-viewport-view-mode))))
(and (derived-mode-p 'agent-shell-viewport-view-mode)
(agent-shell-viewport--showing-latest-p)))))
(with-current-buffer viewport-buffer
(let ((inhibit-read-only t))
(agent-shell-ui-update-text
Expand Down
191 changes: 191 additions & 0 deletions tests/agent-shell-tests.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2051,6 +2051,197 @@ code block content
(let ((agent-shell-show-context-usage-indicator nil))
(should-not (agent-shell--context-usage-indicator))))))

(ert-deftest agent-shell-viewport-next-page-allows-busy-history-navigation-test ()
"Test `agent-shell-viewport-next-page' allows history navigation while busy."
(let ((shell-buffer (generate-new-buffer " *agent-shell shell*"))
(viewport-buffer (generate-new-buffer " *agent-shell shell* [viewport]"))
(initialized nil)
(updated-header nil))
(unwind-protect
(progn
(with-current-buffer shell-buffer
(insert "older prompt\n\nlatest prompt\n")
(goto-char (point-max)))
(with-current-buffer viewport-buffer
(cl-letf (((symbol-function 'agent-shell-viewport--update-header)
(lambda () nil)))
(agent-shell-viewport-view-mode)))
(with-current-buffer viewport-buffer
(cl-letf (((symbol-function 'agent-shell-viewport--busy-p)
(lambda (&rest _) t))
((symbol-function 'agent-shell-viewport--position)
(lambda (&rest _) '(2 . 2)))
((symbol-function 'comint-previous-prompt)
(lambda (&rest _)
(goto-char (point-min))))
((symbol-function 'shell-maker-next-command-and-response)
(lambda (backwards)
(should backwards)
'("older prompt" . "older response")))
((symbol-function 'agent-shell-viewport--initialize)
(lambda (&rest args)
(setq initialized args)))
((symbol-function 'agent-shell-viewport--update-header)
(lambda ()
(setq updated-header t))))
(should (equal (agent-shell-viewport-next-page :backwards t)
'("older prompt" . "older response")))
(should (equal initialized
'(:prompt "older prompt"
:response "older response")))
(should updated-header))))
(kill-buffer viewport-buffer)
(kill-buffer shell-buffer))))

(ert-deftest agent-shell-viewport-showing-latest-reads-history-position-alist-test ()
"Test `agent-shell-viewport--showing-latest-p' reads history position alists."
(let ((viewport-buffer (generate-new-buffer " *agent-shell shell* [viewport]")))
(unwind-protect
(with-current-buffer viewport-buffer
(cl-letf (((symbol-function 'agent-shell-viewport--update-header)
(lambda () nil)))
(agent-shell-viewport-view-mode))
(cl-letf (((symbol-function 'agent-shell-viewport--position)
(lambda (&rest _)
'((:current . 2) (:total . 2)))))
(should (agent-shell-viewport--showing-latest-p))))
(kill-buffer viewport-buffer))))

(ert-deftest agent-shell--update-text-skips-history-viewport-test ()
"Test `agent-shell--update-text' skips viewport mirroring for older history."
(let ((shell-buffer (generate-new-buffer " *agent-shell shell*"))
(viewport-buffer (generate-new-buffer " *agent-shell shell* [viewport]"))
(viewport-calls 0)
(shell-calls 0)
(original-derived-mode-p (symbol-function 'derived-mode-p)))
(unwind-protect
(progn
(with-current-buffer shell-buffer
(setq-local comint-last-output-start (make-marker))
(setq-local comint-use-prompt-regexp t))
(with-current-buffer viewport-buffer
(cl-letf (((symbol-function 'agent-shell-viewport--update-header)
(lambda () nil)))
(agent-shell-viewport-view-mode)))
(cl-letf (((symbol-function 'agent-shell-viewport--buffer)
(lambda (&rest _) viewport-buffer))
((symbol-function 'agent-shell-viewport--position)
(lambda (&rest _)
'((:current . 1) (:total . 2))))
((symbol-function 'derived-mode-p)
(lambda (&rest modes)
(cond ((eq (current-buffer) shell-buffer)
(memq 'agent-shell-mode modes))
((eq (current-buffer) viewport-buffer)
(memq 'agent-shell-viewport-view-mode modes))
(t
(apply original-derived-mode-p modes)))))
((symbol-function 'agent-shell-ui-update-text)
(lambda (&rest _)
(if (eq (current-buffer) viewport-buffer)
(cl-incf viewport-calls)
(cl-incf shell-calls))
nil)))
(with-current-buffer shell-buffer
(agent-shell--update-text
:state `((:buffer . ,shell-buffer)
(:request-count . 7))
:block-id "chunk"
:text "partial response"
:append t))
(should (= viewport-calls 0))
(should (= shell-calls 1))))
(kill-buffer viewport-buffer)
(kill-buffer shell-buffer))))

(ert-deftest agent-shell--update-fragment-skips-history-viewport-test ()
"Test `agent-shell--update-fragment' skips viewport mirroring for older history."
(let ((shell-buffer (generate-new-buffer " *agent-shell shell*"))
(viewport-buffer (generate-new-buffer " *agent-shell shell* [viewport]"))
(viewport-calls 0)
(shell-calls 0)
(original-derived-mode-p (symbol-function 'derived-mode-p)))
(unwind-protect
(progn
(with-current-buffer shell-buffer
(setq-local comint-last-output-start (make-marker))
(setq-local comint-use-prompt-regexp t))
(with-current-buffer viewport-buffer
(cl-letf (((symbol-function 'agent-shell-viewport--update-header)
(lambda () nil)))
(agent-shell-viewport-view-mode)))
(cl-letf (((symbol-function 'agent-shell-viewport--buffer)
(lambda (&rest _) viewport-buffer))
((symbol-function 'agent-shell-viewport--position)
(lambda (&rest _)
'((:current . 1) (:total . 2))))
((symbol-function 'derived-mode-p)
(lambda (&rest modes)
(cond ((eq (current-buffer) shell-buffer)
(memq 'agent-shell-mode modes))
((eq (current-buffer) viewport-buffer)
(memq 'agent-shell-viewport-view-mode modes))
(t
(apply original-derived-mode-p modes)))))
((symbol-function 'agent-shell-ui-update-fragment)
(lambda (&rest _)
(if (eq (current-buffer) viewport-buffer)
(cl-incf viewport-calls)
(cl-incf shell-calls))
nil)))
(with-current-buffer shell-buffer
(agent-shell--update-fragment
:state `((:buffer . ,shell-buffer)
(:request-count . 7))
:block-id "tool-call"
:body "Running tool"
:append t))
(should (= viewport-calls 0))
(should (= shell-calls 1))))
(kill-buffer viewport-buffer)
(kill-buffer shell-buffer))))

(ert-deftest agent-shell--delete-fragment-skips-history-viewport-test ()
"Test `agent-shell--delete-fragment' skips viewport mirroring for older history."
(let ((shell-buffer (generate-new-buffer " *agent-shell shell*"))
(viewport-buffer (generate-new-buffer " *agent-shell shell* [viewport]"))
(viewport-calls 0)
(shell-calls 0)
(original-derived-mode-p (symbol-function 'derived-mode-p)))
(unwind-protect
(progn
(with-current-buffer viewport-buffer
(cl-letf (((symbol-function 'agent-shell-viewport--update-header)
(lambda () nil)))
(agent-shell-viewport-view-mode)))
(cl-letf (((symbol-function 'agent-shell-viewport--buffer)
(lambda (&rest _) viewport-buffer))
((symbol-function 'agent-shell-viewport--position)
(lambda (&rest _)
'((:current . 1) (:total . 2))))
((symbol-function 'derived-mode-p)
(lambda (&rest modes)
(cond ((eq (current-buffer) shell-buffer)
(memq 'agent-shell-mode modes))
((eq (current-buffer) viewport-buffer)
(memq 'agent-shell-viewport-view-mode modes))
(t
(apply original-derived-mode-p modes)))))
((symbol-function 'agent-shell-ui-delete-fragment)
(lambda (&rest _)
(if (eq (current-buffer) viewport-buffer)
(cl-incf viewport-calls)
(cl-incf shell-calls))
nil)))
(with-current-buffer shell-buffer
(agent-shell--delete-fragment
:state `((:buffer . ,shell-buffer)
(:request-count . 7))
:block-id "tool-call"))
(should (= viewport-calls 0))
(should (= shell-calls 1))))
(kill-buffer viewport-buffer)
(kill-buffer shell-buffer))))
;;; Tests for agent-shell--permission-title

(ert-deftest agent-shell--permission-title-read-shows-filename-test ()
Expand Down