[nongnu] elpa/gptel 7277c0004c 3/5: gptel: Handle aborting requests, better error handling

[ELPA Syncer]

branch: elpa/gptel
commit 7277c0004ce77cf8243d83764bc3983fb960c7fb
Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com>
Commit: Karthik Chikmagalur <karthikchikmagalur@gmail.com>

    gptel: Handle aborting requests, better error handling
    
    * gptel.el (gptel--url-get-response, gptel--request-alist,
    gptel-request): Move `gptel-abort' here, and handle aborting
    url-retrieve errors.  Tweak the gptel-request API further:
    
    - Non-streaming callbacks may be called with the response set to
    `abort' if the request is aborted.  Other behaviors are unchanged.
    
    - Streaming callbacks are called with the response set to the
    string, t (for successful completion), nil (for error) or `abort'.
    
    * gptel-rewrite.el (gptel--rewrite-callback): Adjust for the new
    gptel-request API.
    
    * gptel-curl.el (gptel-curl--sentinel, gptel-curl--stream-filter,
    gptel-curl--stream-cleanup, gptel-abort, gptel-curl-get-response,
    gptel-curl--process-alist):  Rename `gptel-curl--process-alist' to
    `gptel--request-alist', since we now track `url-retrieve' requests
    too.  Implement the tweaked gptel-request API.
---
 gptel-curl.el    | 45 +++++++-------------------
 gptel-rewrite.el |  4 +--
 gptel.el         | 97 ++++++++++++++++++++++++++++++++++++++++++++------------
 3 files changed, 91 insertions(+), 55 deletions(-)

diff --git a/gptel-curl.el b/gptel-curl.el
index 13c7503b20..d3336874fe 100644
--- a/gptel-curl.el
+++ b/gptel-curl.el
@@ -46,9 +46,6 @@
       "-XPOST" "-y300" "-Y1" "-D-"))
   "Arguments always passed to Curl for gptel queries.")
 
-(defvar gptel-curl--process-alist nil
-  "Alist of active GPTel curl requests.")
-
 (defun gptel-curl--get-args (data token)
   "Produce list of arguments for calling Curl.
 
@@ -131,7 +128,7 @@ the response is inserted into the current buffer after 
point."
                   "request Curl command" 'no-json))
     (with-current-buffer (process-buffer process)
       (set-process-query-on-exit-flag process nil)
-      (setf (alist-get process gptel-curl--process-alist)
+      (setf (alist-get process gptel--request-alist)
             (nconc (list :token token
                          :backend backend
                          ;; FIXME `aref' breaks `cl-struct' abstraction 
boundary
@@ -177,34 +174,13 @@ PROC-INFO is the plist containing process metadata."
             (gptel--log (buffer-substring-no-properties p (point))
                         "response body")))))))
 
-(defun gptel-abort (buf)
-  "Stop any active gptel process associated with buffer BUF."
-  (interactive (list (current-buffer)))
-  (unless gptel-use-curl
-    (user-error "Cannot stop a `url-retrieve' request!"))
-  (if-let* ((proc-attrs
-            (cl-find-if
-             (lambda (proc-list)
-               (eq (plist-get (cdr proc-list) :buffer) buf))
-             gptel-curl--process-alist))
-            (proc (car proc-attrs)))
-      (progn
-        (setf (alist-get proc gptel-curl--process-alist nil 'remove) nil)
-        (set-process-sentinel proc #'ignore)
-        (delete-process proc)
-        (kill-buffer (process-buffer proc))
-        (with-current-buffer buf
-          (when gptel-mode (gptel--update-status  " Ready" 'success)))
-        (message "Stopped gptel request in buffer %S" (buffer-name buf)))
-    (message "No gptel request associated with buffer %S" (buffer-name buf))))
-
 ;; TODO: Separate user-messaging from this function
 (defun gptel-curl--stream-cleanup (process _status)
   "Process sentinel for GPTel curl requests.
 
 PROCESS and _STATUS are process parameters."
   (let ((proc-buf (process-buffer process)))
-    (let* ((info (alist-get process gptel-curl--process-alist))
+    (let* ((info (alist-get process gptel--request-alist))
            (gptel-buffer (plist-get info :buffer))
            (backend-name
             (gptel-backend-name
@@ -217,7 +193,8 @@ PROCESS and _STATUS are process parameters."
       (if (member http-status '("200" "100")) ;Finish handling response
           (progn
             ;; Run the callback one last time to signal that the process has 
ended
-            (funcall (plist-get info :callback) t info)
+            (with-demoted-errors "gptel callback error: %S"
+              (funcall (plist-get info :callback) t info))
             (with-current-buffer gptel-buffer
               (if (not tracking-marker)   ;Empty response
                   (when gptel-mode (gptel--update-status " Empty response" 
'success))
@@ -247,7 +224,8 @@ PROCESS and _STATUS are process parameters."
              ((eq response 'json-read-error)
               (message "%s error (%s): Malformed JSON in response." 
backend-name http-msg))
              (t (message "%s error (%s): Could not parse HTTP response." 
backend-name http-msg)))))
-        (funcall (plist-get info :callback) 'error info)
+        (with-demoted-errors "gptel callback error: %S"
+          (funcall (plist-get info :callback) nil info))
         (with-current-buffer gptel-buffer
           (when gptel-mode
             (gptel--update-status
@@ -262,7 +240,7 @@ PROCESS and _STATUS are process parameters."
           (run-hook-with-args 'gptel-post-response-functions
                               (marker-position start-marker)
                               (marker-position (or tracking-marker 
start-marker))))))
-    (setf (alist-get process gptel-curl--process-alist nil 'remove) nil)
+    (setf (alist-get process gptel--request-alist nil 'remove) nil)
     (kill-buffer proc-buf)))
 
 (defun gptel-curl--stream-insert-response (response info)
@@ -300,7 +278,7 @@ See `gptel--url-get-response' for details."
           (run-hooks 'gptel-post-stream-hook))))))
 
 (defun gptel-curl--stream-filter (process output)
-  (let* ((proc-info (alist-get process gptel-curl--process-alist)))
+  (let* ((proc-info (alist-get process gptel--request-alist)))
     (with-current-buffer (process-buffer process)
       ;; Insert output
       (save-excursion
@@ -370,7 +348,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))
-                (proc-info (alist-get process gptel-curl--process-alist))
+                (proc-info (alist-get process gptel--request-alist))
                 (proc-callback (plist-get proc-info :callback)))
       (when gptel-log-level (gptel-curl--log-response proc-buf proc-info)) 
;logging
       (pcase-let ((`(,response ,http-msg ,error)
@@ -378,8 +356,9 @@ PROCESS and _STATUS are process parameters."
                      (gptel-curl--parse-response proc-info))))
         (plist-put proc-info :status http-msg)
         (when error (plist-put proc-info :error error))
-        (funcall proc-callback response proc-info)))
-    (setf (alist-get process gptel-curl--process-alist nil 'remove) nil)
+        (with-demoted-errors "gptel callback error: %S"
+          (funcall proc-callback response proc-info))))
+    (setf (alist-get process gptel--request-alist nil 'remove) nil)
     (kill-buffer proc-buf)))
 
 (defun gptel-curl--parse-response (proc-info)
diff --git a/gptel-rewrite.el b/gptel-rewrite.el
index 697bb0476a..df82c28f44 100644
--- a/gptel-rewrite.el
+++ b/gptel-rewrite.el
@@ -391,12 +391,12 @@ INFO is the async communication channel for the rewrite 
request."
             (add-text-properties (point-min) (point-max) '(face shadow 
font-lock-face shadow))
             (goto-char (point-min)))
           (insert response)
-          (unless (eobp) (with-demoted-errors (delete-char (length response))))
+          (unless (eobp) (ignore-errors (delete-char (length response))))
           (font-lock-ensure)
           (cl-callf concat (overlay-get ov 'gptel-rewrite) response)
           (overlay-put ov 'display (buffer-string))))
       (unless (plist-get info :stream) (gptel--rewrite-callback t info)))
-     ((eq response 'error)              ;finished with error
+     ((null response)                   ;finished with error
       (message (concat "LLM response error: %s. Rewrite/refactor in buffer %s 
canceled.")
                (plist-get info :status) (plist-get info :buffer))
       (when-let* ((proc-buf (cdr-safe (plist-get info :context))))
diff --git a/gptel.el b/gptel.el
index 049b5dda62..1111dd45b5 100644
--- a/gptel.el
+++ b/gptel.el
@@ -1260,8 +1260,8 @@ The request is asynchronous, the function immediately 
returns
 with the data that was sent.
 
 Note: This function is not fully self-contained.  Consider
-let-binding the parameters `gptel-backend' and `gptel-model'
-around calls to it as required.
+let-binding the parameters `gptel-backend', `gptel-model' and
+`gptel-use-context' around calls to it as required.
 
 If PROMPT is
 - a string, it is used to create a full prompt suitable for
@@ -1278,9 +1278,14 @@ Keyword arguments:
 CALLBACK, if supplied, is a function of two arguments, called
 with the RESPONSE (a string) and INFO (a plist):
 
- (callback RESPONSE INFO)
+ (funcall CALLBACK RESPONSE INFO)
 
-RESPONSE is nil if there was no response or an error.
+RESPONSE is
+
+- A string if the request was successful
+- nil if there was no response or an error.
+- The symbol `abort' if the request was aborted, see
+  `gptel-abort'.
 
 The INFO plist has (at least) the following keys:
 :data         - The request data included with the query
@@ -1288,13 +1293,14 @@ The INFO plist has (at least) the following keys:
                 POSITION is specified.
 :buffer       - The buffer current when the request was sent,
                 unless BUFFER is specified.
-:status       - Short string describing the result of the request
+:status       - Short string describing the result of the request, including
+                possible HTTP errors.
 
 Example of a callback that messages the user with the response
 and info:
 
  (lambda (response info)
-  (if response
+  (if (stringp response)
       (let ((posn (marker-position (plist-get info :position)))
             (buf  (buffer-name (plist-get info :buffer))))
         (message \"Response for request from %S at %d: %s\"
@@ -1337,8 +1343,23 @@ the response to determine if delimiters are needed 
between the
 prompt and the response.
 
 STREAM is a boolean that determines if the response should be
-streamed, as in `gptel-stream'. Do not set this if you are
-specifying a custom CALLBACK!
+streamed, as in `gptel-stream'.  The calling convention for
+streaming callbacks is slightly different:
+
+ (funcall CALLBACK RESPONSE INFO)
+
+- CALLBACK will be called with each response text chunk (a
+  string) as it is received.
+
+- When the HTTP request ends successfully, CALLBACK will be
+  called with a RESPONSE argument of t to indicate success.
+
+- If the HTTP request throws an error, CALLBACK will be called
+  with a RESPONSE argument of nil.  You can find the error via
+  (plist-get INFO :status).
+
+- If the request is aborted, CALLBACK will be called with a
+  RESPONSE argument of `abort'.
 
 If DRY-RUN is non-nil, construct and return the full
 query data as usual, but do not send the request.
@@ -1393,6 +1414,35 @@ Model parameters can be let-bound around calls to this 
function."
                info callback))
     request-data))
 
+(defvar gptel--request-alist nil "Alist of active gptel requests.")
+
+(defun gptel-abort (buf)
+  "Stop any active gptel process associated with buffer BUF.
+
+BUF defaults to the current buffer."
+  (interactive (list (current-buffer)))
+  (when-let* ((proc-attrs
+               (cl-find-if (lambda (proc-list)
+                             (eq (plist-get (cdr proc-list) :buffer) buf))
+                           gptel--request-alist))
+              (proc (car proc-attrs))
+              (info (cdr proc-attrs)))
+    ;; Run callback with abort signal
+    (with-demoted-errors "Callback error: %S"
+      (funcall (plist-get info :callback) '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
+    (with-current-buffer buf
+      (when gptel-mode (gptel--update-status  " Abort" 'error)))
+    (message "Stopped gptel request in buffer %S" (buffer-name buf))))
+
 ;; TODO: Handle multiple requests(#15). (Only one request from one buffer at a 
time?)
 ;;;###autoload
 (defun gptel-send (&optional arg)
@@ -1705,18 +1755,25 @@ the response is inserted into the current buffer after 
point."
                              url-request-extra-headers))
                     "request headers"))
       (gptel--log url-request-data "request body"))
-    (url-retrieve (let ((backend-url (gptel-backend-url gptel-backend)))
-                    (if (functionp backend-url)
-                        (funcall backend-url) backend-url))
-                  (lambda (_)
-                    (pcase-let ((`(,response ,http-msg ,error)
-                                 (gptel--url-parse-response backend 
(current-buffer))))
-                      (plist-put info :status http-msg)
-                      (when error (plist-put info :error error))
-                      (funcall (or callback #'gptel--insert-response)
-                               response info)
-                      (kill-buffer)))
-                  nil t nil)))
+    (let ((proc-buf
+          (url-retrieve (let ((backend-url (gptel-backend-url gptel-backend)))
+                          (if (functionp backend-url)
+                              (funcall backend-url) backend-url))
+                        (lambda (_)
+                          (pcase-let ((`(,response ,http-msg ,error)
+                                       (gptel--url-parse-response backend 
(current-buffer)))
+                                      (buf (current-buffer)))
+                            (plist-put info :status http-msg)
+                            (when error (plist-put info :error error))
+                            (with-demoted-errors "gptel callback error: %S"
+                              (funcall (or callback #'gptel--insert-response)
+                                       response info))
+                            (setf (alist-get buf gptel--request-alist nil 
'remove) nil)
+                            (kill-buffer buf)))
+                        nil t nil)))
+      (setf (alist-get proc-buf gptel--request-alist)
+          ;; TODO: Add transformer here.  NOTE: We need info to be mutated 
here.
+          (nconc info (list :callback callback :backend backend))))))
 
 (cl-defgeneric gptel--parse-response (backend response proc-info)
   "Response extractor for LLM requests.