[nongnu] elpa/gptel 88995a6436 007/273: gptel-curl: Add curl module and playback feature.

[ELPA Syncer]

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

    gptel-curl: Add curl module and playback feature.
    
    Conditionally solves #2.
    
    gptel.el (gptel-use-curl, gptel-parse-response, gptel--playback,
    gptel-send, gptel-playback): New user options `gptel-playback',
    `gptel-use-curl`. The former controls whether the response is played
    back in chunks, which is done by the function `gptel--playback'. The
    response returned by `gptel-get-response' and `gptel--curl-get-response'
    is now a plist with the content and status.
    
    gptel-curl.el (gptel--curl-get-args, gptel--curl-get-response,
    gptel--curl-sentinel): Add support for curl when available.  Set it to
    the default. `url-retrieve' is full of fangs that multibyte you.
---
 gptel-curl.el | 141 +++++++++++++++++++++++++++++++++++++++++++++++++++
 gptel.el      | 158 ++++++++++++++++++++++++++++++++++++++--------------------
 2 files changed, 246 insertions(+), 53 deletions(-)

diff --git a/gptel-curl.el b/gptel-curl.el
new file mode 100644
index 0000000000..ffc7112829
--- /dev/null
+++ b/gptel-curl.el
@@ -0,0 +1,141 @@
+;;; gptel-curl.el --- Curl support for GPTel         -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2023  Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur;; <karthikchikmagalur@gmail.com>
+;; Keywords: convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Curl support for GPTel.  Utility functions.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'subr-x))
+(require 'map)
+(require 'json)
+(require 'aio)
+
+(defvar gptel-api-key)
+(defvar gptel--curl-process-alist nil
+  "Alist of active GPTel curl requests.")
+
+(defun gptel--curl-get-args (prompts token)
+  "Produce list of arguments for calling Curl.
+
+PROMPTS is the data to send, TOKEN is a unique identifier."
+  (let* ((args
+          (list "--location" "--silent" "--compressed" "--disable"))
+         (url "https://api.openai.com/v1/chat/completions";)
+         (data (encode-coding-string
+                (json-encode
+                 `(:model "gpt-3.5-turbo"
+                   ;; :temperature 1.0
+                   ;; :top_p 1.0
+                   :messages [,@prompts]))
+                'utf-8))
+         (api-key
+          (cond
+           ((stringp gptel-api-key) gptel-api-key)
+           ((functionp gptel-api-key) (funcall gptel-api-key))))
+         (headers
+          `(("Content-Type" . "application/json")
+            ("Authorization" . ,(concat "Bearer " api-key)))))
+
+    (push (format "-X%s" "POST") args)
+    (push (format "-w(%s . %%{size_header})" token) args)
+    ;; (push (format "--keepalive-time %s" 240) args)
+    (push (format "-m%s" 60) args)
+    (push "-D-" args)
+    (pcase-dolist (`(,key . ,val) headers)
+      (push (format "-H%s: %s" key val) args))
+    (push (format "-d%s" data) args)
+    (nreverse (cons url args))))
+
+(defun gptel--curl-get-response (prompts)
+  "Retrieve response to PROMPTS."
+  (with-current-buffer (generate-new-buffer "*gptel-curl*")
+    (let* ((token (md5 (format "%s%s%s%s"
+                               (random) (emacs-pid) (user-full-name)
+                               (recent-keys))))
+           (args (gptel--curl-get-args prompts token))
+           (process (apply #'start-process "gptel-curl" (current-buffer)
+                           "curl" args))
+           (promise (aio-promise))
+           (cb (lambda (result)
+                 (aio-resolve promise (lambda () result))
+                 (setf (alist-get process
+                                  gptel--curl-process-alist nil 'remove)
+                       nil))))
+      (prog1 promise
+        (set-process-query-on-exit-flag process nil)
+        (setf (alist-get process gptel--curl-process-alist)
+              (list :callback cb :token token))
+        (set-process-sentinel process #'gptel--curl-sentinel)))))
+
+(defun gptel--curl-sentinel (process status)
+  "Process sentinel for GPTel curl requests.
+
+PROCESS and STATUS are process parameters."
+  (let ((proc-buf (process-buffer process)))
+    (if-let* ((ok-p (equal status "finished\n"))
+              (proc-info (alist-get process gptel--curl-process-alist))
+              (proc-token (plist-get proc-info :token))
+              (content (gptel--curl-parse-response proc-buf proc-token)))
+        (funcall (plist-get proc-info :callback) content)
+      ;; Failed
+      (funcall (plist-get proc-info :callback) nil))
+    (kill-buffer proc-buf)))
+
+(defun gptel--curl-parse-response (buf token)
+  "Parse the buffer BUF with curl's response.
+
+TOKEN is used to disambiguate multiple requests in a single
+buffer."
+  (with-current-buffer buf
+    (progn
+      (goto-char (point-max))
+      (search-backward token)
+      (backward-char)
+      (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))))
+          ;; (if (search-backward token nil t)
+          ;;     (search-forward ")" nil t)
+          ;;   (goto-char (point-min)))
+          (goto-char (point-min))
+
+          (if-let* ((http-msg (buffer-substring (line-beginning-position)
+                                                (line-end-position)))
+                    (http-status
+                     (save-match-data
+                       (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" 
http-msg)
+                            (match-string 1 http-msg))))
+                    (json-object-type 'plist)
+                    (response (progn (goto-char header-size)
+                                     (json-read)))
+                    (content (map-nested-elt
+                              response '(:choices 0 :message :content))))
+              (cond
+               ((not (equal http-status "200"))
+                (message "GPTChat request failed with code %s" http-status)
+                (list :content nil :status http-msg))
+               (content
+                (list :content (string-trim content) :status http-msg))
+               (t (message "Could not parse response from ChatGPT.")
+                  (list :content nil :status http-msg))))))))
+
+(provide 'gptel-curl)
+;;; gptel-curl.el ends here
diff --git a/gptel.el b/gptel.el
index c6382e916c..ec77a5b811 100644
--- a/gptel.el
+++ b/gptel.el
@@ -48,8 +48,11 @@
 
 ;;; Code:
 (declare-function markdown-mode "markdown-mode")
+(declare-function gptel--curl-get-response "gptel-curl")
+
 (eval-when-compile
-  (require 'subr-x))
+  (require 'subr-x)
+  (require 'cl-lib))
 
 (require 'aio)
 (require 'json)
@@ -65,6 +68,20 @@ key (more secure)."
           (string :tag "API key")
           (function :tag "Function that retuns the API key")))
 
+(defcustom gptel-playback nil
+  "Whether responses from ChatGPT be played back in chunks.
+
+When set to nil, it is inserted all at once.
+
+'tis a bit silly."
+  :group 'gptel
+  :type 'boolean)
+
+(defcustom gptel-use-curl (and (executable-find "curl") t)
+  "Whether gptel should prefer Curl when available."
+  :group 'gptel
+  :type 'boolean)
+
 (defvar-local gptel--prompt-markers nil)
 (defvar gptel-default-session "*ChatGPT*")
 (defvar gptel-default-mode (if (featurep 'markdown-mode)
@@ -97,34 +114,42 @@ key (more secure)."
                      into prompts
                      do (setq role (if (equal role "user") "assistant" "user"))
                      finally return (nreverse prompts))))
-         (response-buffer (aio-await (gptel-get-response full-prompt)))
-         (json-object-type 'plist))
-    (unwind-protect
-        (when-let* ((content-str (gptel-parse-response response-buffer)))
-          (with-current-buffer gptel-buffer
-            (save-excursion
-              (message "Querying ChatGPT... done.")
-              (goto-char (point-max))
-              (display-buffer (current-buffer)
-                              '((display-buffer-reuse-window
-                                 display-buffer-use-some-window)))
-              (unless (bobp) (insert "\n\n"))
-              ;; (if gptel-playback-response
-              ;;     (aio-await (gptel--playback-print content-str))
-              ;;   (insert content-str))
-              (insert content-str)
-              (push (set-marker (make-marker) (point))
-                    gptel--prompt-markers)
-              (insert "\n\n" gptel-prompt-string)
-              (setf (nth 1 header-line-format)
-                    (propertize " Ready" 'face 'success)))))
-      (kill-buffer response-buffer))))
+         (response (aio-await
+                    (funcall
+                     (if (and gptel-use-curl (require 'gptel-curl nil t))
+                          #'gptel--curl-get-response #'gptel-get-response)
+                     full-prompt)))
+         (content-str (plist-get response :content))
+         (status-str  (plist-get response :status)))
+    (if content-str
+            (with-current-buffer gptel-buffer
+              (save-excursion
+                (message "Querying ChatGPT... done.")
+                (goto-char (point-max))
+                (display-buffer (current-buffer)
+                                '((display-buffer-reuse-window
+                                   display-buffer-use-some-window)))
+                (unless (bobp) (insert "\n\n"))
+                (if gptel-playback
+                    (gptel--playback (current-buffer) content-str (point))
+                  (insert content-str))
+                (push (set-marker (make-marker) (point))
+                      gptel--prompt-markers)
+                (insert "\n\n" gptel-prompt-string)
+                (unless gptel-playback
+                  (setf (nth 1 header-line-format)
+                        (propertize " Ready" 'face 'success)))))
+          (setf (nth 1 header-line-format)
+                (propertize (format " Response Error: %s" status-str)
+                            'face 'error)))))
 
 (aio-defun gptel-get-response (prompts)
   "Fetch response for PROMPTS from ChatGPT.
 
-Return the response buffer."
-  (let* ((api-key
+Return the message received."
+  (let* ((inhibit-message t)
+         (message-log-max nil)
+         (api-key
           (cond
            ((stringp gptel-api-key) gptel-api-key)
            ((functionp gptel-api-key) (funcall gptel-api-key))))
@@ -133,19 +158,34 @@ Return the response buffer."
          `(("Content-Type" . "application/json")
            ("Authorization" . ,(concat "Bearer " api-key))))
         (url-request-data
-         (json-encode
+         (encode-coding-string
+          (json-encode
           `(:model "gpt-3.5-turbo"
             ;; :temperature 1.0
             ;; :top_p 1.0
-            :messages [,@prompts]))))
-    (let ((inhibit-message t)
-          (message-log-max nil))
-      (pcase-let ((`(,_ . ,buffer)
-                   (aio-await
-                    (aio-url-retrieve 
"https://api.openai.com/v1/chat/completions";))))
-        buffer))))
+            :messages [,@prompts]))
+          'utf-8)))
+    (pcase-let ((`(,_ . ,response-buffer)
+                 (aio-await
+                  (aio-url-retrieve 
"https://api.openai.com/v1/chat/completions";))))
+      (prog1
+          (gptel-parse-response response-buffer)
+        (kill-buffer response-buffer)))))
+
+(defun gptel-parse-response (response-buffer)
+  "Parse response in RESPONSE-BUFFER."
+  (when (buffer-live-p response-buffer)
+    (with-current-buffer response-buffer
+      (if-let* ((status (buffer-substring (line-beginning-position) 
(line-end-position)))
+                ((string-match-p "200 OK" status))
+                (response (progn (forward-paragraph)
+                                 (json-read)))
+                (content (map-nested-elt
+                          response '(:choices 0 :message :content))))
+          (list :content (string-trim content)
+                :status status)
+        (list :content nil :status status)))))
 
-;;;###autoload
 (define-minor-mode gptel-mode
   "Minor mode for interacting with ChatGPT."
   :glboal nil
@@ -190,26 +230,38 @@ Ask for API-KEY if `gptel-api-key' is unset."
     (message "Send your query with %s!"
              (substitute-command-keys "\\[gptel-send]"))))
 
-(defun gptel-parse-response (response-buffer)
-  "Parse response in RESPONSE-BUFFER."
-  (when (buffer-live-p response-buffer)
-    (with-current-buffer response-buffer
-      (if-let* ((status (buffer-substring (line-beginning-position) 
(line-end-position)))
-                ((string-match "200 OK" status))
-                (response (progn (forward-paragraph)
-                                 (json-read)))
-                (content (map-nested-elt
-                          response '(:choices 0 :message :content))))
-          (string-trim content)
-        (user-error "Chat failed with status: %S" status)))))
-
-(defvar gptel-playback-response t)
+(defun gptel--playback (buf content-str start-pt)
+  "Playback CONTENT-STR in BUF.
 
-(aio-defun gptel--playback-print (response)
-  (when response
-    (dolist (line (split-string response "\n" nil))
-      (insert line "\n")
-      (aio-await (aio-sleep 0.3)))))
+Begin at START-PT."
+  (let ((handle (gensym "gptel-change-group-handle--"))
+        (playback-timer (gensym "gptel--playback-"))
+        (content-length (length content-str))
+        (idx 0) (pt (make-marker)))
+    (setf (symbol-value handle) (prepare-change-group buf))
+    (activate-change-group (symbol-value handle))
+    (setf (symbol-value playback-timer)
+          (run-at-time
+          0 0.15
+           (lambda ()
+             (with-current-buffer buf
+               (if (>= content-length idx)
+                   (progn
+                     (when (= idx 0) (set-marker pt start-pt))
+                     (goto-char pt)
+                     (insert-before-markers-and-inherit
+                      (cl-subseq
+                       content-str idx
+                       (min content-length (+ idx 16))))
+                     (setq idx (+ idx 16)))
+                 (when start-pt (goto-char (- start-pt 2)))
+                 (setf (nth 1 header-line-format)
+                      (propertize " Ready" 'face 'success))
+                 (force-mode-line-update)
+                 (accept-change-group (symbol-value handle))
+                 (undo-amalgamate-change-group (symbol-value handle))
+                 (cancel-timer (symbol-value playback-timer)))))))
+    nil))
 
 (provide 'gptel)
 ;;; gptel.el ends here