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 28ac88cada
commit 040ef0a35d
2 changed files with 67 additions and 70 deletions

View file

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

View file

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