From 4d4b61af94153f26c879c27768e0b80c95eebf58 Mon Sep 17 00:00:00 2001 From: Karthik Chikmagalur Date: Thu, 4 Apr 2024 00:27:07 -0700 Subject: [PATCH] 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. --- gptel-transient.el | 99 +++++++++++++++++++++++----------------------- gptel.el | 38 +++++++++--------- 2 files changed, 67 insertions(+), 70 deletions(-) diff --git a/gptel-transient.el b/gptel-transient.el index ee7f381..08d1cc3 100644 --- a/gptel-transient.el +++ b/gptel-transient.el @@ -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 diff --git a/gptel.el b/gptel.el index 160601d..fc98d9a 100644 --- a/gptel.el +++ b/gptel.el @@ -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.