branch: externals/ellama
commit 2d53906e29bb476a9f4acecfda3d9bb1566814dc
Author: Sergey Kostyaev <[email protected]>
Commit: Sergey Kostyaev <[email protected]>
Refactor request cancellation with context management
Improved request cancellation by introducing request context that tracks
multiple buffers (main and reasoning) involved in a request. Added dedicated
keymap for request mode, enhanced kill buffer handling, and updated response
handler to properly manage request state across buffers. Added comprehensive
tests for cancellation behavior.
---
ellama.el | 402 ++++++++++++++++++++++++++++++++-------------------
tests/test-ellama.el | 188 ++++++++++++++++++++++++
2 files changed, 443 insertions(+), 147 deletions(-)
diff --git a/ellama.el b/ellama.el
index dc46850940..4bfc2dc70a 100644
--- a/ellama.el
+++ b/ellama.el
@@ -499,20 +499,42 @@ It should be a function with single argument generated
text string."
(remove-hook 'after-save-hook 'ellama--save-session)
(ellama--session-deactivate)))
+(defvar ellama-request-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap keyboard-quit]
+ #'ellama--cancel-current-request-and-quit)
+ (define-key map (kbd "C-g")
+ #'ellama--cancel-current-request-and-quit)
+ map)
+ "Keymap for `ellama-request-mode'.")
+
+(defun ellama--cancel-current-request-on-kill ()
+ "Cancel active request on current buffer kill."
+ (unless ellama--ignore-kill-buffer-request-cancel
+ (ellama--cancel-current-request)))
+
(define-minor-mode ellama-request-mode
"Minor mode for `ellama' buffers with active requests to LLM."
:interactive nil
:lighter " ellama:generating"
- :keymap '(([remap keyboard-quit] . ellama--cancel-current-request-and-quit))
+ :keymap ellama-request-mode-map
(if ellama-request-mode
- (add-hook 'kill-buffer-hook 'ellama--cancel-current-request nil t)
- (remove-hook 'kill-buffer-hook 'ellama--cancel-current-request)
+ (add-hook 'kill-buffer-hook
+ 'ellama--cancel-current-request-on-kill nil t)
+ (remove-hook 'kill-buffer-hook
+ 'ellama--cancel-current-request-on-kill)
(ellama--cancel-current-request)))
(defvar-local ellama--change-group nil)
(defvar-local ellama--current-request nil)
+(defvar-local ellama--request-buffers nil)
+
+(defvar-local ellama--request-context nil)
+
+(defvar-local ellama--ignore-kill-buffer-request-cancel nil)
+
(defconst ellama--code-prefix
(rx (minimal-match
(zero-or-more anything) (literal "```") (zero-or-more anything) (+ (or
"\n" "\r")))))
@@ -929,21 +951,80 @@ If EPHEMERAL non nil new session will not be associated
with any file."
(ellama-session-mode +1))
session))
+(defun ellama--make-request-context (buffers)
+ "Create request context for BUFFERS."
+ (list :buffers (cl-remove-if-not #'buffer-live-p buffers)
+ :request nil))
+
+(defun ellama--request-context-buffers (request-context)
+ "Return live buffers from REQUEST-CONTEXT."
+ (cl-remove-if-not #'buffer-live-p
+ (plist-get request-context :buffers)))
+
+(defun ellama--request-context-request (request-context)
+ "Return request object from REQUEST-CONTEXT."
+ (plist-get request-context :request))
+
+(defun ellama--set-current-request (request buffers &optional request-context)
+ "Set REQUEST for BUFFERS and enable `ellama-request-mode'.
+REQUEST-CONTEXT is a request context."
+ (let* ((live-buffers (cl-remove-if-not #'buffer-live-p buffers))
+ (ctx (or request-context
+ (ellama--make-request-context live-buffers))))
+ (setf (plist-get ctx :request) request
+ (plist-get ctx :buffers) live-buffers)
+ (dolist (buffer live-buffers)
+ (with-current-buffer buffer
+ (setq ellama--current-request request)
+ (setq ellama--request-buffers live-buffers)
+ (setq ellama--request-context ctx)
+ (ellama-request-mode +1)))
+ ctx))
+
+(defun ellama--deactivate-current-request (&optional request-context)
+ "Deactivate current request state from REQUEST-CONTEXT."
+ (let* ((ctx (or request-context ellama--request-context))
+ (buffers (if ctx
+ (ellama--request-context-buffers ctx)
+ (list (current-buffer))))
+ (target-buffers nil))
+ (dolist (buffer buffers)
+ (with-current-buffer buffer
+ (when (or (not ctx)
+ (eq ellama--request-context ctx))
+ (setq ellama--current-request nil)
+ (setq ellama--request-buffers nil)
+ (setq ellama--request-context nil)
+ (push buffer target-buffers))))
+ (dolist (buffer target-buffers)
+ (with-current-buffer buffer
+ (ellama-request-mode -1)))))
+
+(defun ellama--kill-buffer-without-request-cancel (buffer)
+ "Kill BUFFER without request cancellation hook."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (setq ellama--ignore-kill-buffer-request-cancel t)
+ (kill-buffer buffer))))
+
(defun ellama--cancel-current-request ()
"Cancel current running request."
(declare-function spinner-stop "ext:spinner")
- (when ellama--current-request
- (llm-cancel-request ellama--current-request)
- (when ellama-spinner-enabled
- (require 'spinner)
- (spinner-stop))
- (setq ellama--current-request nil)))
+ (let* ((request-context ellama--request-context)
+ (request (or ellama--current-request
+ (when request-context
+ (ellama--request-context-request request-context)))))
+ (when request
+ (llm-cancel-request request)
+ (when ellama-spinner-enabled
+ (require 'spinner)
+ (spinner-stop))
+ (ellama--deactivate-current-request request-context))))
(defun ellama--cancel-current-request-and-quit ()
"Cancel the current request and quit."
(interactive)
(ellama--cancel-current-request)
- (ellama-request-mode -1)
(keyboard-quit))
(defun ellama--session-deactivate ()
@@ -1459,12 +1540,13 @@ REASONING-BUFFER is a buffer for reasoning."
'system)))
(defun ellama--error-handler (buffer errcb &optional prompt
- retry-fn)
+ retry-fn request-context)
"Error handler function.
BUFFER is the current ellama buffer.
ERRCB is an error callback.
PROMPT is the active prompt.
-RETRY-FN is called to retry the request."
+RETRY-FN is called to retry the request.
+REQUEST-CONTEXT is request context."
(lambda (err-type msg)
(with-current-buffer buffer
(if (and retry-fn
@@ -1473,14 +1555,15 @@ RETRY-FN is called to retry the request."
(progn
(ellama--append-tool-error-to-prompt prompt msg)
(funcall retry-fn))
- (cancel-change-group ellama--change-group)
- (when ellama-spinner-enabled
- (spinner-stop))
- (funcall errcb msg)
- (setq ellama--current-request nil)
- (ellama-request-mode -1)))))
-
-(defun ellama--response-handler (result-handler reasoning-buffer buffer donecb
errcb provider llm-prompt async filter)
+ (cancel-change-group ellama--change-group)
+ (when ellama-spinner-enabled
+ (spinner-stop))
+ (funcall errcb msg)
+ (ellama--deactivate-current-request request-context)))))
+
+(defun ellama--response-handler (result-handler reasoning-buffer buffer donecb
+ errcb provider llm-prompt async filter
+ &optional request-context)
"Response handler function.
RESULT-HANDLER handles text insertion.
REASONING-BUFFER used for reasoning output.
@@ -1493,77 +1576,93 @@ ASYNC flag is for asyncronous requests.
FILTER is a function that's applied to (partial) response strings before
they're
inserted into the BUFFER."
(lambda (response)
- (let ((text (plist-get response :text))
- (reasoning (plist-get response :reasoning))
- (tool-result (plist-get response :tool-results)))
+ (let ((request-context (or request-context
+ (with-current-buffer buffer
+ ellama--request-context)))
+ (text (plist-get response :text))
+ (reasoning (plist-get response :reasoning))
+ (tool-result (plist-get response :tool-results)))
(funcall result-handler response)
(when (or ellama--current-session
- (not reasoning))
- (when (not tool-result) (kill-buffer reasoning-buffer)))
+ (not reasoning))
+ (when (not tool-result)
+ (ellama--kill-buffer-without-request-cancel reasoning-buffer)))
(if tool-result
- (cl-labels
- ((start-request ()
- (let* ((insert-text
- (ellama--insert
- buffer
- (with-current-buffer buffer
- (if ellama--current-session
- (point-max)
- (point)))
- filter))
- (insert-reasoning
- (ellama--insert reasoning-buffer nil
-
#'ellama--translate-markdown-to-org-filter))
- (handler
- (ellama--handle-partial
- insert-text insert-reasoning reasoning-buffer))
- (cnt 0)
- (skip-handler
- (lambda (request)
- (if (= cnt ellama-response-process-method)
- (progn
- (funcall handler request)
- (setq cnt 0))
- (cl-incf cnt))))
- (error-handler
- (ellama--error-handler
- buffer errcb llm-prompt
- (lambda ()
- (start-request)))))
- (with-current-buffer buffer
- (if async
- (llm-chat-async
- provider
- llm-prompt
- (ellama--response-handler
- handler reasoning-buffer buffer donecb errcb provider
- llm-prompt async filter)
- error-handler
- t)
- (llm-chat-streaming
- provider
- llm-prompt
- (if (integerp ellama-response-process-method)
- skip-handler handler)
- (ellama--response-handler
- handler reasoning-buffer buffer donecb errcb provider
- llm-prompt async filter)
- error-handler
- t))))))
- (start-request))
- (with-current-buffer buffer
- (accept-change-group ellama--change-group)
- (when ellama-spinner-enabled
- (spinner-stop))
- (if (and (listp donecb)
- (functionp (car donecb)))
- (mapc (lambda (fn) (funcall fn text))
- donecb)
- (funcall donecb text))
- (when ellama-session-hide-org-quotes
- (ellama-collapse-org-quotes))
- (setq ellama--current-request nil)
- (ellama-request-mode -1))))))
+ (let ((request-generation 0))
+ (cl-labels
+ ((start-request ()
+ (let* ((generation (cl-incf request-generation))
+ (insert-text
+ (ellama--insert
+ buffer
+ (with-current-buffer buffer
+ (if ellama--current-session
+ (point-max)
+ (point)))
+ filter))
+ (insert-reasoning
+ (ellama--insert
+ reasoning-buffer nil
+ #'ellama--translate-markdown-to-org-filter))
+ (handler
+ (ellama--handle-partial
+ insert-text insert-reasoning reasoning-buffer))
+ (cnt 0)
+ (skip-handler
+ (lambda (request)
+ (if (= cnt ellama-response-process-method)
+ (progn
+ (funcall handler request)
+ (setq cnt 0))
+ (cl-incf cnt))))
+ (error-handler
+ (ellama--error-handler
+ buffer errcb llm-prompt
+ (lambda ()
+ (start-request))
+ request-context))
+ (request
+ (with-current-buffer buffer
+ (if async
+ (llm-chat-async
+ provider
+ llm-prompt
+ (ellama--response-handler
+ handler reasoning-buffer buffer donecb errcb
+ provider llm-prompt async filter
+ request-context)
+ error-handler
+ t)
+ (llm-chat-streaming
+ provider
+ llm-prompt
+ (if (integerp ellama-response-process-method)
+ skip-handler handler)
+ (ellama--response-handler
+ handler reasoning-buffer buffer donecb errcb
+ provider llm-prompt async filter
+ request-context)
+ error-handler
+ t)))))
+ (when (= generation request-generation)
+ (setq request-context
+ (ellama--set-current-request
+ request
+ (list buffer reasoning-buffer)
+ request-context))))))
+ (start-request)))
+ (with-current-buffer buffer
+ (accept-change-group ellama--change-group)
+ (when ellama-spinner-enabled
+ (spinner-stop))
+ (if (and (listp donecb)
+ (functionp (car donecb)))
+ (mapc (lambda (fn) (funcall fn text))
+ donecb)
+ (funcall donecb text))
+ (when ellama-session-hide-org-quotes
+ (ellama-collapse-org-quotes))
+ (ellama--deactivate-current-request request-context))))))
(defun ellama-stream (prompt &rest args)
"Query ellama for PROMPT.
@@ -1648,65 +1747,74 @@ failure (with BUFFER current).
(with-current-buffer reasoning-buffer
(org-mode))
(with-current-buffer buffer
- (ellama-request-mode +1)
- (cl-labels
- ((start-request ()
- (let* ((insert-text
- (ellama--insert buffer point filter))
- (insert-reasoning
- (ellama--insert reasoning-buffer nil
-
#'ellama--translate-markdown-to-org-filter))
- (handler
- (ellama--handle-partial
- insert-text insert-reasoning reasoning-buffer))
- (error-handler
- (ellama--error-handler
- buffer errcb llm-prompt
- #'start-request))
- (request (pcase ellama-response-process-method
- ('async (llm-chat-async
- provider
- llm-prompt
- (ellama--response-handler
- handler reasoning-buffer buffer donecb
errcb provider
- llm-prompt t filter)
- error-handler
- t))
- ('streaming (llm-chat-streaming
- provider
- llm-prompt
- handler
- (ellama--response-handler
- handler reasoning-buffer buffer
donecb errcb
- provider llm-prompt nil filter)
- error-handler
- t))
- ((pred integerp)
- (let* ((cnt 0)
- (skip-handler
- (lambda (request)
- (if (= cnt
ellama-response-process-method)
- (progn
- (funcall handler request)
- (setq cnt 0))
- (cl-incf cnt)))))
- (llm-chat-streaming
- provider
- llm-prompt
- skip-handler
- (ellama--response-handler
- handler reasoning-buffer buffer donecb
errcb provider
- llm-prompt t filter)
- error-handler
- t))))))
- (setq ellama--change-group (prepare-change-group))
- (activate-change-group ellama--change-group)
- (when ellama-spinner-enabled
- (require 'spinner)
- (spinner-start ellama-spinner-type))
- (with-current-buffer buffer
- (setq ellama--current-request request)))))
- (start-request)))))
+ (let ((request-generation 0)
+ (request-context
+ (ellama--make-request-context
+ (list buffer reasoning-buffer))))
+ (cl-labels
+ ((start-request ()
+ (let* ((generation (cl-incf request-generation))
+ (insert-text
+ (ellama--insert buffer point filter))
+ (insert-reasoning
+ (ellama--insert reasoning-buffer nil
+
#'ellama--translate-markdown-to-org-filter))
+ (handler
+ (ellama--handle-partial
+ insert-text insert-reasoning reasoning-buffer))
+ (error-handler
+ (ellama--error-handler
+ buffer errcb llm-prompt
+ #'start-request
+ request-context))
+ (request (pcase ellama-response-process-method
+ ('async (llm-chat-async
+ provider
+ llm-prompt
+ (ellama--response-handler
+ handler reasoning-buffer buffer
donecb errcb provider
+ llm-prompt t filter request-context)
+ error-handler
+ t))
+ ('streaming (llm-chat-streaming
+ provider
+ llm-prompt
+ handler
+ (ellama--response-handler
+ handler reasoning-buffer buffer
donecb errcb
+ provider llm-prompt nil filter
request-context)
+ error-handler
+ t))
+ ((pred integerp)
+ (let* ((cnt 0)
+ (skip-handler
+ (lambda (request)
+ (if (= cnt
ellama-response-process-method)
+ (progn
+ (funcall handler request)
+ (setq cnt 0))
+ (cl-incf cnt)))))
+ (llm-chat-streaming
+ provider
+ llm-prompt
+ skip-handler
+ (ellama--response-handler
+ handler reasoning-buffer buffer donecb
errcb provider
+ llm-prompt t filter request-context)
+ error-handler
+ t))))))
+ (setq ellama--change-group (prepare-change-group))
+ (activate-change-group ellama--change-group)
+ (when ellama-spinner-enabled
+ (require 'spinner)
+ (spinner-start ellama-spinner-type))
+ (when (= generation request-generation)
+ (setq request-context
+ (ellama--set-current-request
+ request
+ (list buffer reasoning-buffer)
+ request-context))))))
+ (start-request))))))
(defun ellama-chain (initial-prompt forms &optional acc)
"Call chain of FORMS on INITIAL-PROMPT.
diff --git a/tests/test-ellama.el b/tests/test-ellama.el
index ab6f9fd23b..91a1f7ee84 100644
--- a/tests/test-ellama.el
+++ b/tests/test-ellama.el
@@ -75,6 +75,155 @@ STYLE controls partial message shape. Default value is
`word-leading'."
(funcall response-callback response-plist)))))
(funcall fn))))
+(ert-deftest test-ellama-request-mode-binds-c-g-to-cancel ()
+ (with-temp-buffer
+ (ellama-request-mode +1)
+ (should (eq (key-binding (kbd "C-g") t)
+ #'ellama--cancel-current-request-and-quit))))
+
+(ert-deftest test-ellama-request-mode-c-g-cancels-current-request ()
+ (let ((cancelled-request nil)
+ (ellama-spinner-enabled nil))
+ (with-temp-buffer
+ (setq-local ellama--current-request 'request)
+ (ellama-request-mode +1)
+ (cl-letf (((symbol-function 'llm-cancel-request)
+ (lambda (request)
+ (setq cancelled-request request))))
+ (let ((cancel-command (key-binding (kbd "C-g") t)))
+ (should (eq cancel-command
+ #'ellama--cancel-current-request-and-quit))
+ (condition-case nil
+ (call-interactively cancel-command)
+ (quit nil))))
+ (should (eq cancelled-request 'request))
+ (should (null ellama--current-request))
+ (should-not ellama-request-mode))))
+
+(ert-deftest test-ellama-request-mode-c-g-cancels-from-reasoning-buffer ()
+ (let ((cancelled-request nil)
+ (ellama-spinner-enabled nil)
+ (reasoning-buffer (generate-new-buffer " *ellama-reasoning-test*")))
+ (unwind-protect
+ (with-temp-buffer
+ (let ((main-buffer (current-buffer)))
+ (ellama--set-current-request
+ 'request
+ (list main-buffer reasoning-buffer))
+ (cl-letf (((symbol-function 'llm-cancel-request)
+ (lambda (request)
+ (setq cancelled-request request))))
+ (with-current-buffer reasoning-buffer
+ (let ((cancel-command (key-binding (kbd "C-g") t)))
+ (should (eq cancel-command
+ #'ellama--cancel-current-request-and-quit))
+ (condition-case nil
+ (call-interactively cancel-command)
+ (quit nil)))))
+ (should (eq cancelled-request 'request))
+ (should-not ellama-request-mode)
+ (with-current-buffer reasoning-buffer
+ (should-not ellama-request-mode))))
+ (when (buffer-live-p reasoning-buffer)
+ (kill-buffer reasoning-buffer)))))
+
+(ert-deftest test-ellama-cancel-does-not-affect-other-request-buffers ()
+ (let* ((cancelled-request nil)
+ (ellama-spinner-enabled nil)
+ (main-a (generate-new-buffer " *ellama-main-a*"))
+ (reasoning-a (generate-new-buffer " *ellama-reasoning-a*"))
+ (main-b (generate-new-buffer " *ellama-main-b*"))
+ (reasoning-b (generate-new-buffer " *ellama-reasoning-b*"))
+ request-context-a
+ request-context-b)
+ (unwind-protect
+ (progn
+ (setq request-context-a
+ (with-current-buffer main-a
+ (ellama--set-current-request
+ 'request-a
+ (list main-a reasoning-a))))
+ (setq request-context-b
+ (with-current-buffer main-b
+ (ellama--set-current-request
+ 'request-b
+ (list main-b reasoning-b))))
+ (cl-letf (((symbol-function 'llm-cancel-request)
+ (lambda (request)
+ (setq cancelled-request request))))
+ (with-current-buffer main-a
+ (let ((cancel-command (key-binding (kbd "C-g") t)))
+ (condition-case nil
+ (call-interactively cancel-command)
+ (quit nil)))))
+ (should (eq cancelled-request 'request-a))
+ (with-current-buffer main-a
+ (should-not ellama-request-mode))
+ (with-current-buffer reasoning-a
+ (should-not ellama-request-mode))
+ (with-current-buffer main-b
+ (should ellama-request-mode)
+ (should (eq ellama--current-request 'request-b)))
+ (with-current-buffer reasoning-b
+ (should ellama-request-mode)
+ (should (eq ellama--current-request 'request-b))))
+ (when (buffer-live-p main-a)
+ (with-current-buffer main-a
+ (ellama--deactivate-current-request request-context-a)))
+ (when (buffer-live-p main-b)
+ (with-current-buffer main-b
+ (ellama--deactivate-current-request request-context-b)))
+ (when (buffer-live-p reasoning-a)
+ (kill-buffer reasoning-a))
+ (when (buffer-live-p reasoning-b)
+ (kill-buffer reasoning-b))
+ (when (buffer-live-p main-a)
+ (kill-buffer main-a))
+ (when (buffer-live-p main-b)
+ (kill-buffer main-b)))))
+
+(ert-deftest test-ellama-response-handler-refresh-request-on-tool-call ()
+ (let* ((main-buffer (generate-new-buffer " *ellama-main-test*"))
+ (reasoning-buffer (generate-new-buffer " *ellama-reasoning-test*"))
+ (ellama-response-process-method 'streaming)
+ (ellama-spinner-enabled nil)
+ request-context)
+ (unwind-protect
+ (progn
+ (with-current-buffer main-buffer
+ (setq request-context
+ (ellama--set-current-request
+ 'request-1
+ (list main-buffer reasoning-buffer)))
+ (cl-letf (((symbol-function 'ellama--insert)
+ (lambda (&rest _args) #'ignore))
+ ((symbol-function 'ellama--handle-partial)
+ (lambda (&rest _args) #'ignore))
+ ((symbol-function 'llm-chat-streaming)
+ (lambda (&rest _args) 'request-2)))
+ (funcall
+ (ellama--response-handler
+ #'ignore
+ reasoning-buffer
+ main-buffer
+ #'ignore
+ #'ignore
+ 'provider
+ 'prompt
+ nil
+ #'identity)
+ '(:tool-results "tool"))))
+ (with-current-buffer main-buffer
+ (should (eq ellama--current-request 'request-2)))
+ (with-current-buffer reasoning-buffer
+ (should (eq ellama--current-request 'request-2))))
+ (when (buffer-live-p main-buffer)
+ (with-current-buffer main-buffer
+ (ellama--deactivate-current-request request-context))
+ (kill-buffer main-buffer))
+ (when (buffer-live-p reasoning-buffer)
+ (kill-buffer reasoning-buffer)))))
+
(ert-deftest test-ellama-ask-about-add-selection-ephemeral ()
(let (captured-ephemeral)
(with-temp-buffer
@@ -666,6 +815,45 @@ detailed comparison to help you decide:
(should (equal done-text "Recovered answer"))
(should (equal (buffer-string) "Recovered answer"))))))
+(ert-deftest test-ellama-stream-retry-tracks-latest-request-for-cancel ()
+ (let* ((call-count 0)
+ (cancelled-request nil)
+ (ellama-response-process-method 'streaming)
+ (ellama-spinner-enabled nil)
+ (_ (unless (get 'ellama-test-tool-call-error-4 'error-conditions)
+ (define-error 'ellama-test-tool-call-error-4
+ "Tool call error used in retry request test"
+ 'llm-tool-call-error))))
+ (with-temp-buffer
+ (cl-letf (((symbol-function 'llm-chat-streaming)
+ (lambda (_provider _prompt _partial-callback
_response-callback
+ error-callback _multi-output)
+ (setq call-count (1+ call-count))
+ (if (= call-count 1)
+ (progn
+ (funcall error-callback
+ 'ellama-test-tool-call-error-4
+ "Temporary tool failure")
+ 'request-1)
+ 'request-2)))
+ ((symbol-function 'llm-cancel-request)
+ (lambda (request)
+ (setq cancelled-request request))))
+ (ellama-stream "retry request tracking test"
+ :provider 'test-provider
+ :buffer (current-buffer)
+ :on-error (lambda (_msg)
+ (ert-fail "Unexpected on-error call"))
+ :on-done (lambda (_text)
+ (ert-fail "Unexpected on-done call")))
+ (should (= call-count 2))
+ (should (eq ellama--current-request 'request-2))
+ (condition-case nil
+ (call-interactively (key-binding (kbd "C-g") t))
+ (quit nil))
+ (should (eq cancelled-request 'request-2))
+ (should-not ellama-request-mode)))))
+
(ert-deftest test-ellama-md-to-org-code-simple ()
(let ((result (ellama--translate-markdown-to-org-filter "Here is your TikZ
code for a blue rectangle:
