gptel: Handle read-only gptel-buffers

* gptel.el (gptel--insert-response):
* gptel-transient.el (gptel--suffix-send):
* gptel-curl.el (gptel-curl--stream-filter, gptel-curl--stream-insert-response,
gptel-curl--stream-cleanup):
Handle read-only gptel buffers by redirecting the output to a new buffer (that
pops up automatically).  To track this,
- the `:position' argument of the INFO plist, which is a marker, is moved to the
new output buffer.
- the `:buffer' argument of the INFO plist is unmodified, it always points to
the buffer that the request originated from.
This commit is contained in:
Karthik Chikmagalur 2023-05-03 13:42:44 -07:00
parent 075609544a
commit ac754ceb2a
3 changed files with 57 additions and 31 deletions

View file

@ -114,13 +114,14 @@ PROCESS and STATUS are process parameters."
(http-status (plist-get info :http-status))
(http-msg (plist-get info :status)))
(if (equal http-status "200")
(progn
;; Finish handling response
(with-current-buffer gptel-buffer
(with-current-buffer (marker-buffer start-marker)
(pulse-momentary-highlight-region (+ start-marker 2) tracking-marker)
(when gptel-mode
(gptel--update-header-line " Ready" 'success)
(save-excursion (goto-char tracking-marker)
(when gptel-mode (save-excursion (goto-char tracking-marker)
(insert "\n\n" (gptel-prompt-string)))))
(with-current-buffer gptel-buffer
(when gptel-mode (gptel--update-header-line " Ready" 'success))))
;; Or Capture error message
(with-current-buffer proc-buf
(goto-char (point-max))
@ -155,17 +156,16 @@ PROCESS and STATUS are process parameters."
INFO is a mutable plist containing information relevant to this buffer.
See `gptel--url-get-response' for details."
(let ((status-str (plist-get response :status))
(gptel-buffer (plist-get info :buffer))
(start-marker (plist-get info :position))
(tracking-marker (plist-get info :tracking-marker))
(transformer (plist-get info :transformer)))
(when response
(with-current-buffer gptel-buffer
(with-current-buffer (marker-buffer start-marker)
(save-excursion
(unless tracking-marker
(gptel--update-header-line " Typing..." 'success)
(goto-char start-marker)
(unless (plist-get info :in-place)
(unless (or (bobp) (plist-get info :in-place))
(insert "\n\n"))
(setq tracking-marker (set-marker (make-marker) (point)))
(set-marker-insertion-type tracking-marker t)
@ -200,7 +200,20 @@ See `gptel--url-get-response' for details."
(and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
(match-string 1 http-msg)))))
(plist-put proc-info :http-status http-status)
(plist-put proc-info :status (string-trim http-msg)))))
(plist-put proc-info :status (string-trim http-msg))))
;; Handle read-only gptel buffer
(when (with-current-buffer (plist-get proc-info :buffer)
(or buffer-read-only
(get-char-property (plist-get proc-info :position) 'read-only)))
(message "Buffer is read only, displaying reply in buffer \"*ChatGPT response*\"")
(display-buffer
(with-current-buffer (get-buffer-create "*ChatGPT response*")
(goto-char (point-max))
(move-marker (plist-get proc-info :position) (point) (current-buffer))
(current-buffer))
'((display-buffer-reuse-window
display-buffer-pop-up-window)
(reusable-frames . visible)))))
(when-let ((http-msg (plist-get proc-info :status))
(http-status (plist-get proc-info :http-status)))

View file

@ -279,7 +279,7 @@ will get progressively longer!"
(in-place (and (member "-i" args) t))
(output-to-other-buffer-p)
(buffer) (position)
(callback) (buffer-name)
(callback) (gptel-buffer-name)
(prompt
(and (member "-r" args)
(read-string
@ -304,12 +304,12 @@ will get progressively longer!"
(message "ChatGPT response error: %s" (plist-get info :status))
(kill-new resp)
(message "ChatGPT response: copied to kill-ring.")))))
((setq buffer-name
((setq gptel-buffer-name
(cl-some (lambda (s) (and (string-prefix-p "-n" s)
(substring s 2)))
args))
(setq buffer
(gptel buffer-name
(gptel gptel-buffer-name
(condition-case nil
(gptel--api-key)
((error user-error)
@ -332,11 +332,11 @@ will get progressively longer!"
(gptel--update-header-line " Waiting..." 'warning)
(setq position (point)))
(setq output-to-other-buffer-p t))
((setq buffer-name
((setq gptel-buffer-name
(cl-some (lambda (s) (and (string-prefix-p "-e" s)
(substring s 2)))
args))
(setq buffer (get-buffer buffer-name))
(setq buffer (get-buffer gptel-buffer-name))
(setq output-to-other-buffer-p t)
(let ((reduced-prompt
(or prompt
@ -354,7 +354,10 @@ will get progressively longer!"
(point))))))
(with-current-buffer buffer
(goto-char (point-max))
(insert reduced-prompt)
(if (or buffer-read-only
(get-char-property (point) 'read-only))
(setq prompt reduced-prompt)
(insert reduced-prompt))
(setq position (point))
(when gptel-mode
(gptel--update-header-line " Waiting..." 'warning))))))
@ -383,7 +386,7 @@ will get progressively longer!"
:callback callback)
(when output-to-other-buffer-p
(message (concat "Prompt sent to buffer: "
(propertize buffer-name 'face 'help-key-binding)))
(propertize gptel-buffer-name 'face 'help-key-binding)))
(display-buffer
buffer '((display-buffer-reuse-window
display-buffer-pop-up-window)

View file

@ -383,10 +383,7 @@ Model parameters can be let-bound around calls to this function."
#'gptel-curl-get-response #'gptel--url-get-response)
info callback)))
;; TODO: Handle read-only buffers. Should we spawn a new buffer automatically?
;; TODO: Handle multiple requests(#15). (Only one request from one buffer at a time?)
;; TODO: Since we capture a marker for the insertion location, `gptel-buffer' no
;; longer needs to be recorded
;;;###autoload
(defun gptel-send (&optional arg)
"Submit this prompt to ChatGPT.
@ -419,6 +416,20 @@ See `gptel--url-get-response' for details."
(let* ((status-str (plist-get info :status))
(gptel-buffer (plist-get info :buffer))
(start-marker (plist-get info :position)))
;; Handle read-only buffers
(when (with-current-buffer gptel-buffer
(or buffer-read-only
(get-char-property start-marker 'read-only)))
(message "Buffer is read only, displaying reply in buffer \"*ChatGPT response*\"")
(display-buffer
(with-current-buffer (get-buffer-create "*ChatGPT response*")
(goto-char (point-max))
(move-marker start-marker (point) (current-buffer))
(current-buffer))
'((display-buffer-reuse-window
display-buffer-pop-up-window)
(reusable-frames . visible))))
;; Insert response and status message/error message
(with-current-buffer gptel-buffer
(if response
(progn
@ -426,16 +437,15 @@ See `gptel--url-get-response' for details."
response gptel-buffer))
(save-excursion
(put-text-property 0 (length response) 'gptel 'response response)
(message "Querying ChatGPT... done.")
(with-current-buffer (marker-buffer start-marker)
(goto-char start-marker)
(unless (or (bobp) (plist-get info :in-place))
(insert "\n\n"))
(let ((p (point)))
(insert response)
(pulse-momentary-highlight-region p (point)))
(when gptel-mode
(insert "\n\n" (gptel-prompt-string))
(gptel--update-header-line " Ready" 'success))))
(when gptel-mode (insert "\n\n" (gptel-prompt-string))))
(when gptel-mode (gptel--update-header-line " Ready" 'success))))
(gptel--update-header-line
(format " Response Error: %s" status-str) 'error)
(message "ChatGPT response error: (%s) %s"