gptel-transient.el (47661B)
1 ;;; gptel-transient.el --- Transient menu for GPTel -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2023 Karthik Chikmagalur 4 5 ;; Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com> 6 ;; Keywords: convenience 7 8 ;; SPDX-License-Identifier: GPL-3.0-or-later 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; 26 27 ;;; Code: 28 (require 'cl-lib) 29 (require 'gptel) 30 (require 'transient) 31 32 (declare-function ediff-regions-internal "ediff") 33 (declare-function ediff-make-cloned-buffer "ediff-utils") 34 35 36 ;; * Helper functions and vars 37 38 (defvar-local gptel--rewrite-overlays nil 39 "List of active rewrite overlays in the buffer.") 40 41 (defun gptel--rewrite-sanitize-overlays () 42 "Ensure gptel's rewrite overlays in buffer are consistent." 43 (setq gptel--rewrite-overlays 44 (cl-delete-if-not #'overlay-buffer 45 gptel--rewrite-overlays))) 46 47 (defvar gptel--set-buffer-locally nil 48 "Set model parameters from `gptel-menu' buffer-locally. 49 50 Affects the system message too.") 51 52 (defun gptel--set-with-scope (sym value &optional scope) 53 "Set SYMBOL's symbol-value to VALUE with SCOPE. 54 55 If SCOPE is non-nil, set it buffer-locally, else clear any 56 buffer-local value and set its default global value." 57 (if scope 58 (set (make-local-variable sym) value) 59 (kill-local-variable sym) 60 (set sym value))) 61 62 (defun gptel--get-directive (args) 63 "Find the additional directive in the transient ARGS. 64 65 Meant to be called when `gptel-menu' is active." 66 (cl-some (lambda (s) (and (stringp s) (string-prefix-p ":" s) 67 (substring s 1))) 68 args)) 69 70 (defun gptel--instructions-make-overlay (text &optional ov) 71 "Make or move overlay OV with TEXT." 72 (save-excursion 73 ;; Move point to overlay position 74 (cond 75 ((use-region-p) 76 (if (pos-visible-in-window-p (region-beginning)) 77 (goto-char (region-beginning)))) 78 ((gptel--in-response-p) 79 (gptel-beginning-of-response) 80 (skip-chars-forward "\n \t")) 81 (t (text-property-search-backward 'gptel 'response) 82 (skip-chars-forward "\n \t"))) 83 ;; Make overlay 84 (if (and ov (overlayp ov)) 85 (move-overlay ov (point) (point) (current-buffer)) 86 (setq ov (make-overlay (point) (point) nil t))) 87 (overlay-put ov 'before-string nil) 88 ;; (unless (or (bobp) (eq (char-before) "\n")) 89 ;; (overlay-put ov 'before-string (propertize "\n" 'font-lock-face 'shadow))) 90 (overlay-put ov 'category 'gptel) 91 (overlay-put 92 ov 'after-string 93 (concat (propertize (concat "DIRECTIVE: " text) 94 'font-lock-face '(:inherit shadow :weight bold :box t)) 95 "\n")) 96 ov)) 97 98 (defconst gptel--read-with-prefix-help 99 (concat 100 (propertize "(" 'face 'default) 101 (propertize "TAB" 'face 'help-key-binding) 102 (propertize " to expand, " 'face 'default) 103 (propertize "M-n" 'face 'help-key-binding) 104 (propertize "/" 'face 'default) 105 (propertize "M-p" 'face 'help-key-binding) 106 (propertize " for next/previous): " 'face 'default)) 107 "Help string ;TODO: ") 108 109 (defun gptel--read-with-prefix (prefix) 110 "Show string PREFIX in the minibuffer after the minibuffer prompt. 111 112 PREFIX is shown in an overlay. Repeated calls to this function 113 will toggle its visibility state." 114 (unless (minibufferp) 115 (user-error "This command is intended to be used in the minibuffer.")) 116 (let* ((update 117 (lambda (ov s) 118 (overlay-put 119 ov 'after-string 120 (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow) 121 (make-separator-line)))))) 122 (max-width (- (window-width) (minibuffer-prompt-end))) 123 (max (or max-mini-window-height 0.4)) 124 (max-height (- (or (and (natnump max) max) 125 (floor (* max (frame-height)))) 126 5))) 127 (when (and prefix (not (string-empty-p prefix)) (> max-height 1)) 128 (unless visual-line-mode (visual-line-mode 1)) 129 (goto-char (minibuffer-prompt-end)) 130 (pcase-let ((`(,prop . ,ov) 131 (get-char-property-and-overlay 132 (point-min) 'gptel))) 133 (unless ov 134 (setq ov (make-overlay 135 (point-min) (minibuffer-prompt-end) nil t))) 136 (pcase prop 137 ('partial 138 (if (> (length prefix) max-width) 139 (progn 140 (overlay-put ov 'gptel 'prefix) 141 (let ((disp-size 142 (cl-loop for char across prefix 143 for idx upfrom 0 144 with n = 0 with max-length = (* max-height max-width) 145 if (eq char ?\n) do (cl-incf n) 146 if (> n max-height) return idx 147 if (> idx max-length) 148 return idx 149 finally return nil))) 150 (funcall update ov 151 (if disp-size 152 (truncate-string-to-width 153 prefix disp-size nil nil 'ellipsis) 154 prefix)))) 155 (overlay-put ov 'gptel 'hide) 156 (funcall update ov nil))) 157 ('prefix (overlay-put ov 'gptel 'hide) 158 (funcall update ov nil)) 159 (_ (overlay-put ov 'gptel 'partial) 160 (funcall update ov (truncate-string-to-width 161 prefix max-width nil nil 162 'ellipsis)))))))) 163 164 (defun gptel--transient-read-variable (prompt initial-input history) 165 "Read value from minibuffer and interpret the result as a Lisp object. 166 167 PROMPT, INITIAL-INPUT and HISTORY are as in the Transient reader 168 documention." 169 (ignore-errors 170 (read-from-minibuffer prompt initial-input read-expression-map t history))) 171 172 (defsubst gptel--refactor-or-rewrite () 173 "Rewrite should be refactored into refactor. 174 175 Or is it the other way around?" 176 (if (derived-mode-p 'prog-mode) 177 "Refactor" "Rewrite")) 178 179 (defun gptel-system-prompt--format (&optional message) 180 "Format the system MESSAGE for display in gptel's transient menus. 181 182 Handle formatting for system messages when the active 183 `gptel-model' does not support system messages." 184 (setq message (or message gptel--system-message)) 185 (if (gptel--model-capable-p 'nosystem) 186 (concat (propertize "[No system message support for model " 187 'face 'transient-heading) 188 (propertize (gptel--model-name gptel-model) 189 'face 'warning) 190 (propertize "]" 'face 'transient-heading)) 191 (if message 192 (gptel--describe-directive 193 message (max (- (window-width) 12) 14) "⮐ ") 194 "[No system message set]"))) 195 196 (defvar gptel--crowdsourced-prompts-url 197 "https://raw.githubusercontent.com/f/awesome-chatgpt-prompts/main/prompts.csv" 198 "URL for crowdsourced LLM system prompts.") 199 200 (defvar gptel--crowdsourced-prompts 201 (make-hash-table :test #'equal) 202 "Crowdsourced LLM system prompts.") 203 204 (defun gptel--crowdsourced-prompts () 205 "Acquire and read crowdsourced LLM system prompts. 206 207 These are stored in the variable `gptel--crowdsourced-prompts', 208 which see." 209 (when (hash-table-p gptel--crowdsourced-prompts) 210 (when (hash-table-empty-p gptel--crowdsourced-prompts) 211 (unless gptel-crowdsourced-prompts-file 212 (run-at-time 0 nil #'gptel-system-prompt) 213 (user-error "No crowdsourced prompts available")) 214 (unless (and (file-exists-p gptel-crowdsourced-prompts-file) 215 (time-less-p 216 (time-subtract (current-time) (days-to-time 14)) 217 (file-attribute-modification-time 218 (file-attributes gptel-crowdsourced-prompts-file)))) 219 (when (y-or-n-p 220 (concat 221 "Fetch crowdsourced system prompts from " 222 (propertize "https://github.com/f/awesome-chatgpt-prompts" 'face 'link) 223 "?")) 224 ;; Fetch file 225 (message "Fetching prompts...") 226 (let ((dir (file-name-directory gptel-crowdsourced-prompts-file))) 227 (unless (file-exists-p dir) (mkdir dir 'create-parents)) 228 (if (url-copy-file gptel--crowdsourced-prompts-url 229 gptel-crowdsourced-prompts-file 230 'ok-if-already-exists) 231 (message "Fetching prompts... done.") 232 (message "Could not retrieve new prompts."))))) 233 (if (not (file-readable-p gptel-crowdsourced-prompts-file)) 234 (progn (message "No crowdsourced prompts available") 235 (call-interactively #'gptel-system-prompt)) 236 (with-temp-buffer 237 (insert-file-contents gptel-crowdsourced-prompts-file) 238 (goto-char (point-min)) 239 (forward-line 1) 240 (while (not (eobp)) 241 (when-let ((act (read (current-buffer)))) 242 (forward-char) 243 (save-excursion 244 (while (re-search-forward "\"\"" (line-end-position) t) 245 (replace-match "\\\\\""))) 246 (when-let ((prompt (read (current-buffer)))) 247 (puthash act prompt gptel--crowdsourced-prompts))) 248 (forward-line 1))))) 249 gptel--crowdsourced-prompts)) 250 251 252 ;; * Transient classes and methods for gptel 253 254 (defclass gptel-lisp-variable (transient-lisp-variable) 255 ((display-nil :initarg :display-nil) ;String to display if value if nil 256 (display-map :initarg :display-map :initform nil)) ;Display string from alist display-map 257 "Lisp variables that show :display-nil instead of nil.") 258 259 (cl-defmethod transient-format-value ((obj gptel-lisp-variable)) 260 (let ((display-value 261 (with-slots (value display-nil display-map) obj 262 (cond ((null value) display-nil) 263 (display-map (cdr (assoc value display-map))) 264 (t value))))) 265 (propertize 266 (if (stringp display-value) display-value (prin1-to-string display-value)) 267 'face 'transient-value))) 268 269 (cl-defmethod transient-infix-set ((obj gptel-lisp-variable) value) 270 (funcall (oref obj set-value) 271 (oref obj variable) 272 (oset obj value value) 273 gptel--set-buffer-locally)) 274 275 (defclass gptel--switches (gptel-lisp-variable) 276 ((display-if-true :initarg :display-if-true :initform "True") 277 (display-if-false :initarg :display-if-false :initform "False")) 278 "Boolean lisp variable class for gptel-transient.") 279 280 (cl-defmethod transient-infix-read ((obj gptel--switches)) 281 "Cycle through the mutually exclusive switches." 282 (not (oref obj value))) 283 284 (cl-defmethod transient-format-value ((obj gptel--switches)) 285 (with-slots (value display-if-true display-if-false) obj 286 (format 287 (propertize "(%s)" 'face 'transient-delimiter) 288 (concat 289 (propertize display-if-false 290 'face (if value 'transient-inactive-value 'transient-value)) 291 (propertize "|" 'face 'transient-delimiter) 292 (propertize display-if-true 293 'face (if value 'transient-value 'transient-inactive-value)))))) 294 295 (defclass gptel--scope (gptel--switches) 296 ((display-if-true :initarg :display-if-true :initform "for this buffer") 297 (display-if-false :initarg :display-if-false :initform "globally")) 298 "Singleton lisp variable class for `gptel--set-buffer-locally'. 299 300 This is used only for setting this variable via `gptel-menu'.") 301 302 (cl-defmethod transient-infix-set ((obj gptel--scope) value) 303 (funcall (oref obj set-value) 304 (oref obj variable) 305 (oset obj value value))) 306 307 (defclass gptel-provider-variable (transient-lisp-variable) 308 ((model :initarg :model) 309 (model-value :initarg :model-value) 310 (always-read :initform t) 311 (set-value :initarg :set-value :initform #'set)) 312 "Class used for gptel-backends.") 313 314 (cl-defmethod transient-format-value ((obj gptel-provider-variable)) 315 (propertize (concat 316 (gptel-backend-name (oref obj value)) ":" 317 (gptel--model-name 318 (buffer-local-value (oref obj model) transient--original-buffer))) 319 'face 'transient-value)) 320 321 (cl-defmethod transient-infix-set ((obj gptel-provider-variable) value) 322 (pcase-let ((`(,backend-value ,model-value) value)) 323 (funcall (oref obj set-value) 324 (oref obj variable) 325 (oset obj value backend-value) 326 gptel--set-buffer-locally) 327 (funcall (oref obj set-value) 328 (oref obj model) 329 (oset obj model-value model-value) 330 gptel--set-buffer-locally)) 331 (transient-setup)) 332 333 (defclass gptel-option-overlaid (transient-option) 334 ((display-nil :initarg :display-nil) 335 (overlay :initarg :overlay)) 336 "Transient options for overlays displayed in the working buffer.") 337 338 (cl-defmethod transient-format-value ((obj gptel-option-overlaid)) 339 "set up the in-buffer overlay for additional directive, a string. 340 341 Also format its value in the Transient menu." 342 (let ((value (oref obj value)) 343 (ov (oref obj overlay)) 344 (argument (oref obj argument))) 345 ;; Making an overlay 346 (if (or (not value) (string-empty-p value)) 347 (when ov (delete-overlay ov)) 348 (with-current-buffer transient--original-buffer 349 (oset obj overlay (gptel--instructions-make-overlay value ov))) 350 (letrec ((ov-clear-hook 351 (lambda () (when-let* ((ov (oref obj overlay)) 352 ((overlayp ov))) 353 (remove-hook 'transient-exit-hook 354 ov-clear-hook) 355 (delete-overlay ov))))) 356 (add-hook 'transient-exit-hook ov-clear-hook))) 357 ;; Updating transient menu display 358 (if value 359 (propertize (concat argument (truncate-string-to-width value 25 nil nil "...")) 360 'face 'transient-value) 361 (propertize 362 (concat "(" (symbol-name (oref obj display-nil)) ")") 363 'face 'transient-inactive-value)))) 364 365 366 ;; * Transient Prefixes 367 368 (define-obsolete-function-alias 'gptel-send-menu 'gptel-menu "0.3.2") 369 370 ;; BUG: The `:incompatible' spec doesn't work if there's a `:description' below it. 371 ;;;###autoload (autoload 'gptel-menu "gptel-transient" nil t) 372 (transient-define-prefix gptel-menu () 373 "Change parameters of prompt to send to the LLM." 374 ;; :incompatible '(("-m" "-n" "-k" "-e")) 375 [:description gptel-system-prompt--format 376 ["" 377 :if (lambda () (not (gptel--model-capable-p 'nosystem))) 378 "Instructions" 379 ("s" "Set system message" gptel-system-prompt :transient t) 380 (gptel--infix-add-directive)] 381 [:pad-keys t 382 "" 383 "Context" 384 (gptel--infix-context-add-region) 385 (gptel--infix-context-add-buffer) 386 (gptel--infix-context-add-file) 387 (gptel--infix-context-remove-all) 388 (gptel--suffix-context-buffer)]] 389 [["Request Parameters" 390 :pad-keys t 391 (gptel--infix-variable-scope) 392 (gptel--infix-provider) 393 (gptel--infix-max-tokens) 394 (gptel--infix-num-messages-to-send 395 :if (lambda () (or gptel-mode gptel-track-response))) 396 (gptel--infix-temperature :if (lambda () gptel-expert-commands)) 397 (gptel--infix-use-context) 398 (gptel--infix-track-response 399 :if (lambda () (and gptel-expert-commands (not gptel-mode)))) 400 (gptel--infix-track-media 401 :if (lambda () (and gptel-mode (gptel--model-capable-p 'media))))] 402 [" <Prompt from" 403 ("m" "Minibuffer instead" "m") 404 ("y" "Kill-ring instead" "y") 405 "" 406 ("i" "Respond in place" "i")] 407 [" >Response to" 408 ("e" "Echo area" "e") 409 ("g" "gptel session" "g" 410 :class transient-option 411 :prompt "Existing or new gptel session: " 412 :reader 413 (lambda (prompt _ _history) 414 (read-buffer 415 prompt (generate-new-buffer-name 416 (concat "*" (gptel-backend-name gptel-backend) "*")) 417 nil (lambda (buf-name) 418 (if (consp buf-name) (setq buf-name (car buf-name))) 419 (let ((buf (get-buffer buf-name))) 420 (and (buffer-local-value 'gptel-mode buf) 421 (not (eq (current-buffer) buf)))))))) 422 ("b" "Any buffer" "b" 423 :class transient-option 424 :prompt "Output to buffer: " 425 :reader 426 (lambda (prompt _ _history) 427 (read-buffer prompt (buffer-name (other-buffer)) nil))) 428 ("k" "Kill-ring" "k")]] 429 [["Send" 430 (gptel--suffix-send) 431 ("M-RET" "Regenerate" gptel--regenerate :if gptel--in-response-p)] 432 [:description (lambda () 433 (concat 434 (and gptel--rewrite-overlays "Continue ") 435 (gptel--refactor-or-rewrite))) 436 :if (lambda () (or (use-region-p) 437 (and gptel--rewrite-overlays 438 (gptel--rewrite-sanitize-overlays)))) 439 ("r" 440 ;;FIXME: Transient complains if I use `gptel--refactor-or-rewrite' here. It 441 ;;reads this function as a suffix instead of a function that returns the 442 ;;description. 443 (lambda () (if (derived-mode-p 'prog-mode) "Refactor" "Rewrite")) 444 gptel-rewrite)] 445 ["Tweak Response" :if gptel--in-response-p :pad-keys t 446 ("SPC" "Mark" gptel--mark-response) 447 ("P" "Previous variant" gptel--previous-variant 448 :if gptel--at-response-history-p 449 :transient t) 450 ("N" "Next variant" gptel--previous-variant 451 :if gptel--at-response-history-p 452 :transient t) 453 ("E" "Ediff previous" gptel--ediff 454 :if gptel--at-response-history-p)] 455 ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands)) 456 ("I" "Inspect query (Lisp)" 457 (lambda () 458 "Inspect the query that will be sent as a lisp object." 459 (interactive) 460 (gptel--sanitize-model) 461 (gptel--inspect-query 462 (gptel--suffix-send 463 (cons "I" (transient-args transient-current-command)))))) 464 ("J" "Inspect query (JSON)" 465 (lambda () 466 "Inspect the query that will be sent as a JSON object." 467 (interactive) 468 (gptel--sanitize-model) 469 (gptel--inspect-query 470 (gptel--suffix-send 471 (cons "I" (transient-args transient-current-command))) 472 'json)))]] 473 (interactive) 474 (gptel--sanitize-model) 475 (transient-setup 'gptel-menu)) 476 477 ;; ** Prefix for setting the system prompt. 478 479 (defun gptel--setup-directive-menu (sym msg &optional external) 480 "Return a list of transient infix definitions for setting gptel 481 directives. 482 483 SYM is the symbol whose value is set to the selected directive.. 484 MSG is the meaning of symbol, used when messaging. 485 If EXTERNAL is non-nil, include external sources of directives." 486 (cl-loop for (type . prompt) in gptel-directives 487 ;; Avoid clashes with the custom directive key 488 with unused-keys = (delete ?s (number-sequence ?a ?z)) 489 with width = (window-width) 490 for name = (symbol-name type) 491 for key = (seq-find (lambda (k) (member k unused-keys)) name (seq-first unused-keys)) 492 do (setq unused-keys (delete key unused-keys)) 493 ;; The explicit declaration ":transient transient--do-return" here 494 ;; appears to be required for Transient v0.5 and up. Without it, these 495 ;; are treated as suffixes when invoking `gptel-system-prompt' directly, 496 ;; and infixes when going through `gptel-menu'. 497 ;; TODO: Raise an issue with Transient. 498 collect 499 (list (key-description (list key)) 500 (concat (capitalize name) " " 501 (propertize " " 'display '(space :align-to 20)) 502 (propertize 503 (concat "(" (gptel--describe-directive prompt (- width 30)) ")") 504 'face 'shadow)) 505 `(lambda () (interactive) 506 (message "%s: %s" ,msg ,(gptel--describe-directive prompt 100 "⮐ ")) 507 (gptel--set-with-scope ',sym ',prompt gptel--set-buffer-locally)) 508 :transient 'transient--do-return) 509 into prompt-suffixes 510 finally return 511 (nconc 512 prompt-suffixes 513 (list (list "DEL" "None" 514 `(lambda () (interactive) 515 (message "%s unset" ,msg) 516 (gptel--set-with-scope ',sym nil gptel--set-buffer-locally)) 517 :transient 'transient--do-return)) 518 (and external 519 (list (list "SPC" "Pick crowdsourced prompt" 520 'gptel--read-crowdsourced-prompt 521 ;; NOTE: Quitting the completing read when picking a 522 ;; crowdsourced prompt will cause the transient to exit 523 ;; instead of returning to the system prompt menu. 524 :transient 'transient--do-exit)))))) 525 526 ;;;###autoload (autoload 'gptel-system-prompt "gptel-transient" nil t) 527 (transient-define-prefix gptel-system-prompt () 528 "Set the LLM system message for LLM interactions. 529 530 The \"system message\" establishes directives for the chat 531 session and modifies the behavior of the LLM. Some examples of 532 system prompts are: 533 534 You are a helpful assistant. Answer as concisely as possible. 535 Reply only with shell commands and no prose. 536 You are a poet. Reply only in verse. 537 538 More extensive system messages can be useful for specific tasks. 539 540 Customize `gptel-directives' for task-specific prompts." 541 [:description gptel-system-prompt--format 542 [(gptel--suffix-system-message)] 543 [(gptel--infix-variable-scope)]] 544 [:class transient-column 545 :setup-children 546 (lambda (_) (transient-parse-suffixes 547 'gptel-system-prompt 548 (gptel--setup-directive-menu 549 'gptel--system-message "Directive" t))) 550 :pad-keys t]) 551 552 553 ;; * Transient Infixes 554 555 ;; ** Infixes for context aggregation 556 557 (transient-define-infix gptel--infix-use-context () 558 "Describe target destination for context injection. 559 560 gptel will include with the LLM request any additional context 561 added with `gptel-add'. This context can be ignored, included 562 with the system message or included with the user prompt. 563 564 Where in the request this context is included depends on the 565 value of `gptel-use-context', set from here." 566 :description "Include context" 567 :class 'gptel-lisp-variable 568 :variable 'gptel-use-context 569 :format " %k %d %v" 570 :set-value #'gptel--set-with-scope 571 :display-nil "No" 572 :display-map '((nil . "No") 573 (system . "with system message") 574 (user . "with user prompt")) 575 :key "-i" 576 :reader (lambda (prompt &rest _) 577 (let* ((choices '(("No" . nil) 578 ("with system message" . system) 579 ("with user prompt" . user))) 580 (destination (completing-read prompt choices nil t))) 581 (cdr (assoc destination choices))))) 582 583 ;; ** Infixes for model parameters 584 585 (transient-define-infix gptel--infix-variable-scope () 586 "Set gptel's model parameters and system message in this buffer or globally." 587 :argument "scope" 588 :variable 'gptel--set-buffer-locally 589 :class 'gptel--scope 590 :format " %k %d %v" 591 :key "=" 592 :description (propertize "Set" 'face 'transient-inactive-argument)) 593 594 (transient-define-infix gptel--infix-num-messages-to-send () 595 "Number of recent messages to send with each exchange. 596 597 By default, the full conversation history is sent with every new 598 prompt. This retains the full context of the conversation, but 599 can be expensive in token size. Set how many recent messages to 600 include." 601 :description "previous responses" 602 :class 'gptel-lisp-variable 603 :variable 'gptel--num-messages-to-send 604 :set-value #'gptel--set-with-scope 605 :display-nil 'all 606 :format " %k %v %d" 607 :key "-n" 608 :prompt "Number of past messages to include for context (leave empty for all): " 609 :reader 'gptel--transient-read-variable) 610 611 (transient-define-infix gptel--infix-max-tokens () 612 "Max tokens per response. 613 614 This is roughly the number of words in the response. 100-300 is a 615 reasonable range for short answers, 400 or more for longer 616 responses." 617 :description "Response length (tokens)" 618 :class 'gptel-lisp-variable 619 :variable 'gptel-max-tokens 620 :set-value #'gptel--set-with-scope 621 :display-nil 'auto 622 :key "-c" 623 :prompt "Response length in tokens (leave empty: default, 80-200: short, 200-500: long): " 624 :reader 'gptel--transient-read-variable) 625 626 (transient-define-infix gptel--infix-provider () 627 "AI Provider for Chat." 628 :description "GPT Model" 629 :class 'gptel-provider-variable 630 :prompt "Model: " 631 :variable 'gptel-backend 632 :set-value #'gptel--set-with-scope 633 :model 'gptel-model 634 :key "-m" 635 :reader (lambda (prompt &rest _) 636 (cl-loop 637 for (name . backend) in gptel--known-backends 638 nconc (cl-loop for model in (gptel-backend-models backend) 639 collect (list (concat name ":" (gptel--model-name model)) 640 backend model)) 641 into models-alist 642 with completion-extra-properties = 643 `(:annotation-function 644 ,(lambda (comp) 645 (let* ((model (nth 2 (assoc comp models-alist))) 646 (desc (get model :description)) 647 (caps (get model :capabilities)) 648 (context (get model :context-window)) 649 (input-cost (get model :input-cost)) 650 (output-cost (get model :output-cost)) 651 (cutoff (get model :cutoff-date))) 652 (when (or desc caps context input-cost output-cost cutoff) 653 (concat 654 (propertize " " 'display `(space :align-to 40)) 655 (when desc (truncate-string-to-width desc 70 nil ? t t)) 656 " " (propertize " " 'display `(space :align-to 112)) 657 (when caps (truncate-string-to-width (prin1-to-string caps) 21 nil ? t t)) 658 " " (propertize " " 'display `(space :align-to 134)) 659 (when context (format "%5dk" context)) 660 " " (propertize " " 'display `(space :align-to 142)) 661 (when input-cost (format "$%5.2f in" input-cost)) 662 (if (and input-cost output-cost) "," " ") 663 " " (propertize " " 'display `(space :align-to 153)) 664 (when output-cost (format "$%6.2f out" output-cost)) 665 " " (propertize " " 'display `(space :align-to 166)) 666 cutoff))))) 667 finally return 668 (cdr (assoc (completing-read prompt models-alist nil t) 669 models-alist))))) 670 671 (transient-define-infix gptel--infix-temperature () 672 "Temperature of request." 673 :description "Temperature (0 - 2.0)" 674 :class 'gptel-lisp-variable 675 :variable 'gptel-temperature 676 :set-value #'gptel--set-with-scope 677 :key "-t" 678 :prompt "Temperature controls the response randomness (0.0-2.0, leave empty for default): " 679 :reader 'gptel--transient-read-variable) 680 681 (transient-define-infix gptel--infix-track-response () 682 "Distinguish between user messages and LLM responses. 683 684 When creating a prompt to send to the LLM, gptel distinguishes 685 between text entered by the user and past LLM responses. This is 686 required for multi-turn conversations, and is always the case in 687 dedicated chat buffers (in `gptel-mode'). 688 689 In regular buffers, you can toggle this behavior here or by 690 customizing `gptel-track-response'. When response tracking is 691 turned off, all text will be assigned the \"user\" role when 692 querying the LLM." 693 :description "Track LLM responses" 694 :class 'gptel--switches 695 :variable 'gptel-track-response 696 :set-value #'gptel--set-with-scope 697 :display-if-true "Yes" 698 :display-if-false "No" 699 :key "-v") 700 701 (transient-define-infix gptel--infix-track-media () 702 "Send media from \"standalone\" links in the prompt. 703 704 When the active `gptel-model' supports it, gptel can send images 705 or other media from links in the buffer to the LLM. Only 706 \"standalone\" links are considered: these are links on their own 707 line with no surrounding text. 708 709 What link types are sent depends on the mime-types the model 710 supports. See `gptel-track-media' for more information." 711 :description "Send media from links" 712 :class 'gptel--switches 713 :variable 'gptel-track-media 714 :set-value #'gptel--set-with-scope 715 :display-if-true "Yes" 716 :display-if-false "No" 717 :key "-I") 718 719 ;; ** Infixes for adding and removing context 720 721 (declare-function gptel-context--at-point "gptel-context") 722 (declare-function gptel-add "gptel-context") 723 724 (transient-define-suffix gptel--infix-context-add-region () 725 "Add current region to gptel's context." 726 :transient 'transient--do-stay 727 :key "-r" 728 :if (lambda () (or (use-region-p) 729 (and (fboundp 'gptel-context--at-point) 730 (gptel-context--at-point)))) 731 :description 732 (lambda () 733 (if (and (fboundp 'gptel-context--at-point) 734 (gptel-context--at-point)) 735 "Remove context at point" 736 "Add region to context")) 737 (interactive) 738 (gptel-add) 739 (transient-setup)) 740 741 (transient-define-suffix gptel--infix-context-add-buffer () 742 "Add a buffer to gptel's context." 743 :transient 'transient--do-stay 744 :key "-b" 745 :description "Add a buffer to context" 746 (interactive) 747 (gptel-add '(4)) 748 (transient-setup)) 749 750 (declare-function gptel-add-file "gptel-context") 751 (declare-function gptel-context-remove-all "gptel-context") 752 753 (transient-define-suffix gptel--infix-context-add-file () 754 "Add a file to gptel's context." 755 :transient 'transient--do-stay 756 :key "-f" 757 :description "Add a file to context" 758 (interactive) 759 (call-interactively #'gptel-add-file) 760 (transient-setup)) 761 762 (transient-define-suffix gptel--infix-context-remove-all () 763 "Clear gptel's context." 764 :if (lambda () gptel-context--alist) 765 :transient 'transient--do-stay 766 :key "-d" 767 :description "Remove all" 768 (interactive) 769 (when (y-or-n-p "Remove all context? ") 770 (gptel-context-remove-all) 771 (transient-setup))) 772 773 ;; ** Infix for the refactor/rewrite system message 774 775 (transient-define-infix gptel--infix-add-directive () 776 "Additional directive intended for the next query only. 777 778 This is useful to define a quick task on top of a more extensive 779 or detailed system message. 780 781 For example, with code/text selected: 782 783 - Rewrite this function to do X while avoiding Y. 784 - Change the tone of the following paragraph to be more direct. 785 786 Or in an extended conversation: 787 788 - Phrase you next response in ten words or less. 789 - Pretend for now that you're an anthropologist." 790 :class 'gptel-option-overlaid 791 ;; :variable 'gptel--instructions 792 :display-nil 'none 793 :overlay nil 794 :argument ":" 795 :prompt (concat "Add instructions for next request only " 796 gptel--read-with-prefix-help) 797 :reader (lambda (prompt initial history) 798 (let* ((directive 799 (car-safe (gptel--parse-directive gptel--system-message 'raw))) 800 (cycle-prefix (lambda () (interactive) 801 (gptel--read-with-prefix directive))) 802 (minibuffer-local-map 803 (make-composed-keymap 804 (define-keymap "TAB" cycle-prefix "<tab>" cycle-prefix) 805 minibuffer-local-map)) 806 (extra (minibuffer-with-setup-hook cycle-prefix 807 (read-string prompt (or initial " ") history)))) 808 (unless (string-empty-p extra) extra))) 809 :format " %k %d %v" 810 :key "d" 811 :argument ":" 812 :description "Add instruction" 813 :transient t) 814 815 816 ;; * Transient Suffixes 817 818 ;; ** Suffix to send prompt 819 820 (transient-define-suffix gptel--suffix-send (args) 821 "Send ARGS." 822 :key "RET" 823 :description "Send prompt" 824 (interactive (list (transient-args 825 (or transient-current-command 'gptel-menu)))) 826 (let ((stream gptel-stream) 827 (in-place (and (member "i" args) t)) 828 (output-to-other-buffer-p) 829 (backend gptel-backend) 830 (model gptel-model) 831 (backend-name (gptel-backend-name gptel-backend)) 832 (buffer) (position) 833 (callback) (gptel-buffer-name) 834 (system-extra (gptel--get-directive args)) 835 (dry-run (and (member "I" args) t)) 836 ;; Input redirection: grab prompt from elsewhere? 837 (prompt 838 (cond 839 ((member "m" args) 840 (read-string 841 (format "Ask %s: " (gptel-backend-name gptel-backend)) 842 (and (use-region-p) 843 (buffer-substring-no-properties 844 (region-beginning) (region-end))))) 845 ((member "y" args) 846 (unless (car-safe kill-ring) 847 (user-error "`kill-ring' is empty! Nothing to send")) 848 (if current-prefix-arg 849 (read-from-kill-ring "Prompt from kill-ring: ") 850 (current-kill 0)))))) 851 852 ;; Output redirection: Send response elsewhere? 853 (cond 854 ((member "e" args) 855 (setq stream nil) 856 (setq callback 857 (lambda (resp info) 858 (if resp 859 (message "%s response: %s" backend-name resp) 860 (message "%s response error: %s" backend-name (plist-get info :status)))))) 861 ((member "k" args) 862 (setq stream nil) 863 (setq callback 864 (lambda (resp info) 865 (if (not resp) 866 (message "%s response error: %s" backend-name (plist-get info :status)) 867 (kill-new resp) 868 (message "%s response: \"%s\" copied to kill-ring." 869 backend-name 870 (truncate-string-to-width resp 30)))))) 871 ((setq gptel-buffer-name 872 (cl-some (lambda (s) (and (stringp s) (string-prefix-p "g" s) 873 (substring s 1))) 874 args)) 875 (setq output-to-other-buffer-p t) 876 (let ((reduced-prompt ;For inserting into the gptel buffer as 877 ;context, not the prompt used for the 878 ;request itself 879 (or prompt 880 (if (use-region-p) 881 (buffer-substring-no-properties (region-beginning) 882 (region-end)) 883 (buffer-substring-no-properties 884 (save-excursion 885 (text-property-search-backward 886 'gptel 'response 887 (when (get-char-property (max (point-min) (1- (point))) 888 'gptel) 889 t)) 890 (point)) 891 (gptel--at-word-end (point))))))) 892 (cond 893 ((buffer-live-p (get-buffer gptel-buffer-name)) 894 ;; Insert into existing gptel session 895 (progn 896 (setq buffer (get-buffer gptel-buffer-name)) 897 (with-current-buffer buffer 898 (goto-char (point-max)) 899 (unless (or buffer-read-only 900 (get-char-property (point) 'read-only)) 901 (insert reduced-prompt)) 902 (setq position (point)) 903 (when (and gptel-mode (not dry-run)) 904 (gptel--update-status " Waiting..." 'warning))))) 905 ;; Insert into new gptel session 906 (t (setq buffer 907 (gptel gptel-buffer-name 908 (condition-case nil 909 (gptel--get-api-key) 910 ((error user-error) 911 (setq gptel-api-key 912 (read-passwd 913 (format "%s API key: " 914 (gptel-backend-name 915 gptel-backend)))))) 916 reduced-prompt)) 917 ;; Set backend and model in new session from current buffer 918 (with-current-buffer buffer 919 (setq gptel-backend backend) 920 (setq gptel-model model) 921 (unless dry-run 922 (gptel--update-status " Waiting..." 'warning)) 923 (setq position (point))))))) 924 ((setq gptel-buffer-name 925 (cl-some (lambda (s) (and (stringp s) (string-prefix-p "b" s) 926 (substring s 1))) 927 args)) 928 (setq output-to-other-buffer-p t) 929 (setq buffer (get-buffer-create gptel-buffer-name)) 930 (with-current-buffer buffer (setq position (point))))) 931 932 (prog1 (gptel-request prompt 933 :buffer (or buffer (current-buffer)) 934 :position position 935 :in-place (and in-place (not output-to-other-buffer-p)) 936 :stream stream 937 :system 938 (if system-extra 939 (gptel--merge-additional-directive system-extra) 940 gptel--system-message) 941 :callback callback 942 :dry-run dry-run) 943 944 (unless dry-run 945 (gptel--update-status " Waiting..." 'warning)) 946 947 ;; NOTE: Possible future race condition here if Emacs ever drops the GIL. 948 ;; The HTTP request callback might modify the buffer before the in-place 949 ;; text is killed below. 950 (when in-place 951 ;; Kill the latest prompt 952 (let ((beg 953 (if (use-region-p) 954 (region-beginning) 955 (save-excursion 956 (text-property-search-backward 957 'gptel 'response 958 (when (get-char-property (max (point-min) (1- (point))) 959 'gptel) 960 t)) 961 (point)))) 962 (end (if (use-region-p) (region-end) (point)))) 963 (unless output-to-other-buffer-p 964 ;; store the killed text in gptel-history 965 (gptel--attach-response-history 966 (list (buffer-substring-no-properties beg end)))) 967 (kill-region beg end))) 968 969 (when output-to-other-buffer-p 970 (message (concat "Prompt sent to buffer: " 971 (propertize gptel-buffer-name 'face 'help-key-binding))) 972 (display-buffer 973 buffer '((display-buffer-reuse-window 974 display-buffer-pop-up-window) 975 (reusable-frames . visible))))))) 976 977 (defun gptel--merge-additional-directive (additional &optional full) 978 "Merge ADDITIONAL gptel directive with the full system message. 979 980 The ADDITIONAL directive is typically specified from `gptel-menu' 981 and applies only to the next gptel request, see 982 `gptel--infix-add-directive'. 983 984 FULL defaults to the active, full system message. It may be a 985 string, a list of prompts or a function, see `gptel-directives' 986 for details." 987 (setq full (or full gptel--system-message)) 988 (cl-typecase full 989 (string (concat full "\n\n" additional)) 990 (list (let ((copy (copy-sequence full))) 991 (setcar copy (concat (car copy) "\n\n" additional)) 992 copy)) 993 (function (lambda () (gptel--merge-additional-directive 994 additional (funcall full)))) 995 (otherwise additional))) 996 997 ;; Allow calling from elisp 998 (put 'gptel--suffix-send 'interactive-only nil) 999 1000 ;; ** Suffix to regenerate response 1001 1002 (defun gptel--regenerate () 1003 "Regenerate gptel response at point." 1004 (interactive) 1005 (when (gptel--in-response-p) 1006 (pcase-let* ((`(,beg . ,end) (gptel--get-bounds)) 1007 (history (get-char-property (point) 'gptel-history)) 1008 (prev-responses (cons (buffer-substring-no-properties beg end) 1009 history))) 1010 (when gptel-mode ;Remove prefix/suffix 1011 (save-excursion 1012 (goto-char beg) 1013 (when (looking-back (concat "\n+" (regexp-quote (gptel-response-prefix-string))) 1014 (point-min) 'greedy) 1015 (setq beg (match-beginning 0))) 1016 (goto-char end) 1017 (when (looking-at 1018 (concat "\n+" (regexp-quote (gptel-prompt-prefix-string)))) 1019 (setq end (match-end 0))))) 1020 (delete-region beg end) 1021 (gptel--attach-response-history prev-responses) 1022 (call-interactively #'gptel--suffix-send)))) 1023 1024 ;; ** Set system message 1025 (defun gptel--read-crowdsourced-prompt () 1026 "Pick a crowdsourced system prompt for gptel. 1027 1028 This uses the prompts in the variable 1029 `gptel--crowdsourced-prompts', which see." 1030 (interactive) 1031 (if (not (hash-table-empty-p (gptel--crowdsourced-prompts))) 1032 (let ((choice 1033 (completing-read 1034 "Pick and edit prompt: " 1035 (lambda (str pred action) 1036 (if (eq action 'metadata) 1037 `(metadata 1038 (affixation-function . 1039 (lambda (cands) 1040 (mapcar 1041 (lambda (c) 1042 (list c "" 1043 (concat (propertize " " 'display '(space :align-to 22)) 1044 " " (propertize (gethash c gptel--crowdsourced-prompts) 1045 'face 'completions-annotations)))) 1046 cands)))) 1047 (complete-with-action action gptel--crowdsourced-prompts str pred))) 1048 nil t))) 1049 (when-let ((prompt (gethash choice gptel--crowdsourced-prompts))) 1050 (setq gptel--system-message prompt) 1051 (call-interactively #'gptel--suffix-system-message))) 1052 (message "No prompts available."))) 1053 1054 (transient-define-suffix gptel--suffix-system-message (&optional cancel) 1055 "Edit LLM system message. 1056 1057 CANCEL is used to avoid touching dynamic system messages, 1058 generated from functions." 1059 :transient 'transient--do-exit 1060 :description "Set or edit system message" 1061 :format " %k %d" 1062 :key "s" 1063 (interactive 1064 (list (and (functionp gptel--system-message) 1065 (not (y-or-n-p 1066 "Active directive is dynamically generated: Edit its current value instead?"))))) 1067 (if cancel (progn (message "Edit canceled") 1068 (call-interactively #'gptel-menu)) 1069 (gptel--edit-directive 'gptel--system-message))) 1070 1071 ;; MAYBE: Eventually can be simplified with string-edit, after we drop support 1072 ;; for Emacs 28.2. 1073 (defun gptel--edit-directive (sym &optional callback-cmd) 1074 "Edit a gptel directive in a dedicated buffer. 1075 1076 Store the result in SYM, a symbol. If CALLBACK-CMD is specified, 1077 it is run after exiting the edit." 1078 (let ((orig-buf (current-buffer)) 1079 (msg-start (make-marker)) 1080 (directive (symbol-value sym))) 1081 (when (functionp directive) 1082 (setq directive (funcall directive))) 1083 ;; TODO: Handle editing list-of-strings directives 1084 (with-current-buffer (get-buffer-create "*gptel-system*") 1085 (let ((inhibit-read-only t)) 1086 (erase-buffer) 1087 (text-mode) 1088 (setq header-line-format 1089 (concat 1090 "Edit your system message below and press " 1091 (propertize "C-c C-c" 'face 'help-key-binding) 1092 " when ready, or " 1093 (propertize "C-c C-k" 'face 'help-key-binding) 1094 " to abort.")) 1095 (insert 1096 "# Example: You are a helpful assistant. Answer as concisely as possible.\n" 1097 "# Example: Reply only with shell commands and no prose.\n" 1098 "# Example: You are a poet. Reply only in verse.\n\n") 1099 (add-text-properties 1100 (point-min) (1- (point)) 1101 (list 'read-only t 'face 'font-lock-comment-face)) 1102 ;; TODO: make-separator-line requires Emacs 28.1+. 1103 ;; (insert (propertize (make-separator-line) 'rear-nonsticky t)) 1104 (set-marker msg-start (point)) 1105 (save-excursion 1106 ;; If it's a list, insert only the system message part 1107 (insert (car-safe (gptel--parse-directive directive 'raw))) 1108 (push-mark nil 'nomsg)) 1109 (activate-mark)) 1110 (display-buffer (current-buffer) 1111 `((display-buffer-below-selected) 1112 (body-function . ,#'select-window) 1113 (window-height . ,#'fit-window-to-buffer))) 1114 (let ((quit-to-menu 1115 (lambda () 1116 "Cancel system message update and return." 1117 (interactive) 1118 (quit-window) 1119 (display-buffer 1120 orig-buf 1121 `((display-buffer-reuse-window 1122 display-buffer-use-some-window) 1123 (body-function . ,#'select-window))) 1124 (when (commandp callback-cmd) 1125 (call-interactively callback-cmd))))) 1126 (use-local-map 1127 (make-composed-keymap 1128 (define-keymap 1129 "C-c C-c" (lambda () 1130 "Confirm system message and return." 1131 (interactive) 1132 (let ((system-message 1133 (buffer-substring-no-properties msg-start (point-max)))) 1134 (with-current-buffer orig-buf 1135 (gptel--set-with-scope sym 1136 (if (cdr-safe directive) ;Handle list of strings 1137 (prog1 directive (setcar directive system-message)) 1138 system-message) 1139 gptel--set-buffer-locally))) 1140 (funcall quit-to-menu)) 1141 "C-c C-k" quit-to-menu) 1142 text-mode-map)))))) 1143 1144 ;; ** Suffix for displaying and removing context 1145 (declare-function gptel-context--buffer-setup "gptel-context") 1146 (declare-function gptel-context--collect "gptel-context") 1147 1148 (transient-define-suffix gptel--suffix-context-buffer () 1149 "Display all contexts from all buffers & files." 1150 :transient 'transient--do-exit 1151 :key " C" 1152 :if (lambda () gptel-context--alist) 1153 :description 1154 (lambda () 1155 (pcase-let* 1156 ((contexts (and gptel-context--alist (gptel-context--collect))) 1157 (buffer-count (length contexts)) 1158 (`(,file-count ,ov-count) 1159 (if (> buffer-count 0) 1160 (cl-loop for (buf-file . ovs) in contexts 1161 if (bufferp buf-file) 1162 sum (length ovs) into ov-count 1163 else count (stringp buf-file) into file-count 1164 finally return (list file-count ov-count)) 1165 (list 0 0)))) 1166 (concat "Inspect " 1167 (format 1168 (propertize "(%s)" 'face 'transient-delimiter) 1169 (propertize 1170 (concat 1171 (and (> ov-count 0) 1172 (format "%d region%s in %d buffer%s" 1173 ov-count (if (> ov-count 1) "s" "") 1174 (- buffer-count file-count) 1175 (if (> ( - buffer-count file-count) 1) "s" ""))) 1176 (and (> file-count 0) 1177 (propertize 1178 (format "%s%d file%s" 1179 (if (> ov-count 0) ", " "") file-count 1180 (if (> file-count 1) "s" ""))))) 1181 'face (if (zerop (length contexts)) 1182 'transient-inactive-value 1183 'transient-value)))))) 1184 (interactive) 1185 (gptel-context--buffer-setup)) 1186 1187 (provide 'gptel-transient) 1188 ;;; gptel-transient.el ends here 1189 1190 ;; Local Variables: 1191 ;; outline-regexp: "^;; \\*+" 1192 ;; eval: (outline-minor-mode 1) 1193 ;; End: