gptel-transient: More robust dry-run commands

* gptel.el (gptel--inspect-query): `gptel--inspect-query` now
takes data to display as an argument.  Reduce its function to
displaying a buffer with the data.

* gptel-transient.el (gptel-menu, gptel--suffix-send): Fold
dry-run the option into `gptel--suffix-send` and call it with a
dry-run flag instead of using an alternate pathway for dry-runs.
The "Inspect query" suffixes of `gptel-menu` now perform actual
dry-runs, avoiding issues like #276.
This commit is contained in:
Karthik Chikmagalur 2024-04-04 00:27:07 -07:00
parent 567af4d2ee
commit 4d4b61af94
2 changed files with 67 additions and 70 deletions

View file

@ -336,24 +336,19 @@ Also format its value in the Transient menu."
(lambda ()
"Inspect the query that will be sent as a lisp object."
(interactive)
(let* ((extra (gptel--get-directive
(transient-args
transient-current-command)))
(gptel--system-message
(concat gptel--system-message extra)))
(gptel--sanitize-model)
(gptel--inspect-query))))
(gptel--sanitize-model)
(gptel--inspect-query
(gptel--suffix-send
(cons "I" (transient-args transient-current-command))))))
("J" "Inspect query (JSON)"
(lambda ()
"Inspect the query that will be sent as a JSON object."
(interactive)
(let* ((extra (gptel--get-directive
(transient-args
transient-current-command)))
(gptel--system-message
(concat gptel--system-message extra)))
(gptel--sanitize-model)
(gptel--inspect-query 'json))))]]
(gptel--sanitize-model)
(gptel--inspect-query
(gptel--suffix-send
(cons "I" (transient-args transient-current-command)))
'json)))]]
(interactive)
(gptel--sanitize-model)
(transient-setup 'gptel-menu))
@ -594,6 +589,7 @@ Or in an extended conversation:
(buffer) (position)
(callback) (gptel-buffer-name)
(system-extra (gptel--get-directive args))
(dry-run (and (member "I" args) t))
;; Input redirection: grab prompt from elsewhere?
(prompt
(cond
@ -689,44 +685,47 @@ Or in an extended conversation:
(setq buffer (get-buffer-create gptel-buffer-name))
(with-current-buffer buffer (setq position (point)))))
(gptel-request
prompt
:buffer (or buffer (current-buffer))
:position position
:in-place (and in-place (not output-to-other-buffer-p))
:stream stream
:system (concat gptel--system-message system-extra)
:callback callback)
(prog1 (gptel-request prompt
:buffer (or buffer (current-buffer))
:position position
:in-place (and in-place (not output-to-other-buffer-p))
:stream stream
:system (concat gptel--system-message system-extra)
:callback callback
:dry-run dry-run)
;; NOTE: Possible future race condition here if Emacs ever drops the GIL.
;; The HTTP request callback might modify the buffer before the in-place
;; text is killed below.
(when in-place
;; Kill the latest prompt
(let ((beg
(if (use-region-p)
(region-beginning)
(save-excursion
(text-property-search-backward
'gptel 'response
(when (get-char-property (max (point-min) (1- (point)))
'gptel)
t))
(point))))
(end (if (use-region-p) (region-end) (point))))
(unless output-to-other-buffer-p
;; store the killed text in gptel-history
(gptel--attach-response-history
(list (buffer-substring-no-properties beg end))))
(kill-region beg end)))
;; NOTE: Possible future race condition here if Emacs ever drops the GIL.
;; The HTTP request callback might modify the buffer before the in-place
;; text is killed below.
(when in-place
;; Kill the latest prompt
(let ((beg
(if (use-region-p)
(region-beginning)
(save-excursion
(text-property-search-backward
'gptel 'response
(when (get-char-property (max (point-min) (1- (point)))
'gptel)
t))
(point))))
(end (if (use-region-p) (region-end) (point))))
(unless output-to-other-buffer-p
;; store the killed text in gptel-history
(gptel--attach-response-history
(list (buffer-substring-no-properties beg end))))
(kill-region beg end)))
(when output-to-other-buffer-p
(message (concat "Prompt sent to buffer: "
(propertize gptel-buffer-name 'face 'help-key-binding)))
(display-buffer
buffer '((display-buffer-reuse-window
display-buffer-pop-up-window)
(reusable-frames . visible))))))
(when output-to-other-buffer-p
(message (concat "Prompt sent to buffer: "
(propertize gptel-buffer-name 'face 'help-key-binding)))
(display-buffer
buffer '((display-buffer-reuse-window
display-buffer-pop-up-window)
(reusable-frames . visible)))))))
;; Allow calling from elisp
(put 'gptel--suffix-send 'interactive-only nil)
;; ** Suffix to regenerate response

View file

@ -931,29 +931,27 @@ waiting for the response."
(gptel--update-status " Waiting..." 'warning)))
(declare-function json-pretty-print-buffer "json")
(defun gptel--inspect-query (&optional arg)
"Show the full LLM query to be sent in a new buffer.
(defun gptel--inspect-query (request-data &optional arg)
"Show REQUEST-DATA, the full LLM query to be sent, in a buffer.
This functions as a dry run of `gptel-send'. If prefix ARG is
This functions as a dry run of `gptel-send'. If ARG is
the symbol json, show the encoded JSON query instead of the lisp
structure gptel uses."
(let* ((request-data
(gptel-request nil :stream gptel-stream :dry-run t)))
(with-current-buffer (get-buffer-create "*gptel-query*")
(let ((standard-output (current-buffer))
(inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
(if (eq arg 'json)
(progn (fundamental-mode)
(insert (gptel--json-encode request-data))
(json-pretty-print-buffer))
(lisp-data-mode)
(prin1 request-data)
(pp-buffer))
(goto-char (point-min))
(view-mode 1)
(display-buffer (current-buffer) gptel-display-buffer-action)))))
(with-current-buffer (get-buffer-create "*gptel-query*")
(let ((standard-output (current-buffer))
(inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
(if (eq arg 'json)
(progn (fundamental-mode)
(insert (gptel--json-encode request-data))
(json-pretty-print-buffer))
(lisp-data-mode)
(prin1 request-data)
(pp-buffer))
(goto-char (point-min))
(view-mode 1)
(display-buffer (current-buffer) gptel-display-buffer-action))))
(defun gptel--insert-response (response info)
"Insert the LLM RESPONSE into the gptel buffer.