config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

gptel-transient.el (41644B)


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