branch: elpa/gptel
commit 145bca207f1d53af0ea0474b06b527607da48d94
Author: John Wiegley <jo...@newartisans.com>
Commit: Karthik Chikmagalur <karthikchikmaga...@gmail.com>
gptel: Make the abort mechanism more general
`gptel-abort' previously aborted only ongoing Curl and
url-retrieve processes. In preparation for async
augmentors/prompt transforms (such as RAG), allow each async
process type to register its own abort callback in
`gptel--request-alist'.
* gptel-curl.el: (gptel-curl-get-response,
gptel-curl--stream-cleanup, gptel-curl--stream-filter,
gptel-curl--sentinel): Make Curl processes register a callback in
`gptel--request-alist'.
* gptel.el (gptel--request-alist, gptel--inspect-fsm, gptel-abort,
gptel--url-get-response): Make `url-retrieve' processes register
a callback in `gptel--request-alist'. Adjust functions that read
from `gptel--request-alist'.
---
gptel-curl.el | 14 ++++++++++----
gptel.el | 39 ++++++++++++++++++++++-----------------
2 files changed, 32 insertions(+), 21 deletions(-)
diff --git a/gptel-curl.el b/gptel-curl.el
index a59de96a8a..0c94a7ee61 100644
--- a/gptel-curl.el
+++ b/gptel-curl.el
@@ -173,7 +173,13 @@ the response is inserted into the current buffer after
point."
(progn (set-process-sentinel process #'gptel-curl--stream-cleanup)
(set-process-filter process #'gptel-curl--stream-filter))
(set-process-sentinel process #'gptel-curl--sentinel))
- (setf (alist-get process gptel--request-alist) fsm))))
+ (setf (alist-get process gptel--request-alist)
+ (cons fsm
+ #'(lambda ()
+ ;; Clean up Curl process
+ (set-process-sentinel process #'ignore)
+ (delete-process process)
+ (kill-buffer (process-buffer process))))))))
;; ;; Ahead-Of-Time dispatch code for the parsers
;; :parser ; FIXME `cl--generic-*' are internal functions
@@ -219,7 +225,7 @@ PROC-INFO is the plist containing process metadata."
PROCESS and _STATUS are process parameters."
(let ((proc-buf (process-buffer process)))
- (let* ((fsm (alist-get process gptel--request-alist))
+ (let* ((fsm (car (alist-get process gptel--request-alist)))
(info (gptel-fsm-info fsm))
(http-status (plist-get info :http-status)))
(when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging
@@ -291,7 +297,7 @@ Optional RAW disables text properties and transformation."
(gptel--display-tool-results tool-results info))))
(defun gptel-curl--stream-filter (process output)
- (let* ((fsm (alist-get process gptel--request-alist))
+ (let* ((fsm (car (alist-get process gptel--request-alist)))
(proc-info (gptel-fsm-info fsm))
(callback (or (plist-get proc-info :callback)
#'gptel-curl--stream-insert-response)))
@@ -394,7 +400,7 @@ See `gptel-curl--get-response' for its contents.")
PROCESS and _STATUS are process parameters."
(let ((proc-buf (process-buffer process)))
(when-let* (((eq (process-status process) 'exit))
- (fsm (alist-get process gptel--request-alist))
+ (fsm (car (alist-get process gptel--request-alist)))
(proc-info (gptel-fsm-info fsm))
(proc-callback (plist-get proc-info :callback)))
(when gptel-log-level (gptel-curl--log-response proc-buf proc-info))
;logging
diff --git a/gptel.el b/gptel.el
index 3ad6417ccd..f254559aff 100644
--- a/gptel.el
+++ b/gptel.el
@@ -864,7 +864,10 @@ Each entry is of the form
or
(\"path/to/file\").")
-(defvar gptel--request-alist nil "Alist of active gptel requests.")
+(defvar gptel--request-alist nil
+ "Alist of active gptel requests.
+Each entry has the form (PROCESS . (FSM ABORT-CLOSURE))
+If the ABORT-CLOSURE is called, it must abort the PROCESS.")
;;; Utility functions
@@ -1958,7 +1961,7 @@ buffer."
(unless fsm
(setq fsm (or (cdr-safe (cl-find-if
(lambda (proc-list)
- (eq (thread-first (cdr proc-list)
+ (eq (thread-first (cadr proc-list)
(gptel-fsm-info)
(plist-get :buffer))
(current-buffer)))
@@ -2454,28 +2457,24 @@ BUF defaults to the current buffer."
(interactive (list (current-buffer)))
(when-let* ((proc-attrs
(cl-find-if
- (lambda (proc-list)
- (eq (thread-first (cdr proc-list)
+ (lambda (entry)
+ ;; each entry has the form (PROC . (FSM ABORT-FN))
+ (eq (thread-first (cadr entry) ; FSM
(gptel-fsm-info)
(plist-get :buffer))
buf))
gptel--request-alist))
(proc (car proc-attrs))
- (info (gptel-fsm-info (cdr proc-attrs))))
- ;; Run callback with abort signal
+ (fsm (cadr proc-attrs))
+ (info (gptel-fsm-info fsm))
+ (abort-fn (cddr proc-attrs)))
+ ;; Run :callback with abort signal
(with-demoted-errors "Callback error: %S"
(and-let* ((cb (plist-get info :callback))
((functionp cb)))
- (funcall cb 'abort info)))
- (if gptel-use-curl
- (progn ;Clean up Curl process
- (setf (alist-get proc gptel--request-alist nil 'remove) nil)
- (set-process-sentinel proc #'ignore)
- (delete-process proc)
- (kill-buffer (process-buffer proc)))
- (plist-put info :callback #'ignore)
- (let (kill-buffer-query-functions)
- (kill-buffer proc))) ;Can't stop url-retrieve process
+ (funcall cb 'abort info)))
+ (funcall abort-fn)
+ (setf (alist-get proc gptel--request-alist nil 'remove) nil)
(with-current-buffer buf
(when gptel-mode (gptel--update-status " Abort" 'error)))
(message "Stopped gptel request in buffer %S" (buffer-name buf))))
@@ -2882,7 +2881,13 @@ the response is inserted into the current buffer after
point."
(kill-buffer buf)))
nil t nil)))
;; TODO: Add transformer here.
- (setf (alist-get proc-buf gptel--request-alist) fsm))))
+ (setf (alist-get proc-buf gptel--request-alist)
+ (cons fsm
+ #'(lambda ()
+ (plist-put info :callback #'ignore)
+ (let (kill-buffer-query-functions)
+ ;;Can't stop url-retrieve process
+ (kill-buffer proc-buf))))))))
(cl-defgeneric gptel--parse-response (backend response proc-info)
"Response extractor for LLM requests.
