[nongnu] elpa/gptel 67903a1ac5 04/11: gptel: Generalize gptel directives

[ELPA Syncer]

branch: elpa/gptel
commit 67903a1ac5c85a5c3edcdfd07df5af0700a6c59c
Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com>
Commit: Karthik Chikmagalur <karthikchikmagalur@gmail.com>

    gptel: Generalize gptel directives
    
    * gptel.el (gptel-directives, gptel-request,
    gptel--strip-mode-suffix, gptel--describe-directive,
    gptel--parse-directive, gptel-mode): Generalize the notion of
    gptel's directives to include dynamic system messages and
    templates.  Now entries in `gptel-directives' can be
    - strings, as before: these are interpreted as system messages (no
    change)
    - lists of strings: the head is the system message, and the
    tail is an alternating series of user/llm role messages.
    This can serve as a static template of the intial part of the
    conversation.
    - functions: The function must return a string or list of strings,
    which are interpreted as the above.  This can be used to construct
    system messages and conversations dynamically.
    
    `gptel-request' can now optionally take
    - a list of strings as its :prompt argument, corresponding to
    alternating user/llm role messages.
    - a general gptel directive as its :system argument (i.e. a
    string, list of strings or a function)
    
    * gptel-transient.el (gptel--merge-additional-directive,
    gptel-system-prompt--setup, gptel--format-system-message,
    gptel-system-prompt--format, gptel-menu, gptel-system-prompt,
    gptel--suffix-send, gptel--suffix-system-message): Adjust
    transient features to display the new types of directives
    correctly.  Interactively editing directives that are functions
    and lists of strings is not supported: only the system message
    part (of lists) or the results of calling the directive (when it
    is a function) can be edited.
---
 gptel-transient.el | 209 ++++++++++++++++++++++++++++++-----------------------
 gptel.el           | 125 +++++++++++++++++++++++++-------
 2 files changed, 216 insertions(+), 118 deletions(-)

diff --git a/gptel-transient.el b/gptel-transient.el
index d8a7aa849e..715db77a21 100644
--- a/gptel-transient.el
+++ b/gptel-transient.el
@@ -104,8 +104,11 @@ Or is it the other way around?"
   (if (derived-mode-p 'prog-mode)
       "Refactor" "Rewrite"))
 
-(defun gptel--format-system-message (&optional message)
-  "Format the system MESSAGE for display in gptel's transient menus."
+(defun gptel-system-prompt--format (&optional message)
+  "Format the system MESSAGE for display in gptel's transient menus.
+
+Handle formatting for system messages when the active
+`gptel-model' does not support system messages."
   (setq message (or message gptel--system-message))
   (if (gptel--model-capable-p 'nosystem)
       (concat (propertize "[No system message support for model "
@@ -114,14 +117,8 @@ Or is it the other way around?"
                           'face 'warning)
               (propertize "]" 'face 'transient-heading))
     (if message
-        (cl-etypecase message
-          (string (string-replace
-                   "\n" "⮐ "
-                   (truncate-string-to-width
-                    message
-                    (max (- (window-width) 12) 14) nil nil t)))
-          (function (gptel--format-system-message (funcall message)))
-          (list (gptel--format-system-message (car message))))
+        (gptel--describe-directive
+         message (max (- (window-width) 12) 14) "⮐ ")
       "[No system message set]")))
 
 (defvar gptel--crowdsourced-prompts-url
@@ -303,7 +300,7 @@ Also format its value in the Transient menu."
 (transient-define-prefix gptel-menu ()
   "Change parameters of prompt to send to the LLM."
   ;; :incompatible '(("-m" "-n" "-k" "-e"))
-  [:description gptel--format-system-message
+  [:description gptel-system-prompt--format
    [""
     :if (lambda () (not (gptel--model-capable-p 'nosystem)))
     "Instructions"
@@ -421,24 +418,19 @@ Also format its value in the Transient menu."
        ;; are treated as suffixes when invoking `gptel-system-prompt' directly,
        ;; and infixes when going through `gptel-menu'.
        ;; TODO: Raise an issue with Transient.
-       collect (list (key-description (list key))
-                     (concat (capitalize name) " "
-                             (propertize " " 'display '(space :align-to 20))
-                             (propertize
-                              (concat
-                               "("
-                               (string-replace
-                                "\n" " "
-                                (truncate-string-to-width prompt (- width 30) 
nil nil t))
-                               ")")
-                              'face 'shadow))
-                     `(lambda () (interactive)
-                        (message "Directive: %s"
-                         ,(string-replace "\n" "⮐ "
-                           (truncate-string-to-width prompt 100 nil nil t)))
-                        (gptel--set-with-scope 'gptel--system-message ,prompt
-                         gptel--set-buffer-locally))
-                    :transient 'transient--do-return)
+       collect
+       (list (key-description (list key))
+             (concat (capitalize name) " "
+                     (propertize " " 'display '(space :align-to 20))
+                     (propertize
+                      (concat "(" (gptel--describe-directive prompt (- width 
30)) ")")
+                      'face 'shadow))
+             `(lambda () (interactive)
+                (message "Directive: %s"
+                 ,(gptel--describe-directive prompt 100 "⮐ "))
+                (gptel--set-with-scope 'gptel--system-message ',prompt
+                 gptel--set-buffer-locally))
+            :transient 'transient--do-return)
        into prompt-suffixes
        finally return
        (nconc
@@ -471,7 +463,7 @@ You are a poet. Reply only in verse.
 More extensive system messages can be useful for specific tasks.
 
 Customize `gptel-directives' for task-specific prompts."
-  [:description gptel--format-system-message
+  [:description gptel-system-prompt--format
    [(gptel--suffix-system-message)]
    [(gptel--infix-variable-scope)]]
    [:class transient-column
@@ -852,11 +844,10 @@ Or in an extended conversation:
              :position position
              :in-place (and in-place (not output-to-other-buffer-p))
              :stream stream
-             :system (if system-extra
-                         (concat (if gptel--system-message
-                                     (concat gptel--system-message "\n\n"))
-                                 system-extra)
-                       gptel--system-message)
+             :system
+             (if system-extra
+                 (gptel--merge-additional-directive system-extra)
+               gptel--system-message)
              :callback callback
              :dry-run dry-run)
 
@@ -892,6 +883,26 @@ Or in an extended conversation:
                    display-buffer-pop-up-window)
                   (reusable-frames . visible)))))))
 
+(defun gptel--merge-additional-directive (additional &optional full)
+  "Merge ADDITIONAL gptel directive with the full system message.
+
+The ADDITIONAL directive is typically specified from `gptel-menu'
+and applies only to the next gptel request, see
+`gptel--infix-add-directive'.
+
+FULL defaults to the active, full system message.  It may be a
+string, a list of prompts or a function, see `gptel-directives'
+for details."
+  (setq full (or full gptel--system-message))
+  (cl-typecase full
+    (string (concat full "\n\n" additional))
+    (list (let ((copy (copy-sequence full)))
+            (setcar copy (concat (car copy) "\n\n" additional))
+            copy))
+    (function (lambda () (gptel--merge-additional-directive
+                     additional (funcall full))))
+    (otherwise additional)))
+
 ;; Allow calling from elisp
 (put 'gptel--suffix-send 'interactive-only nil)
 
@@ -959,61 +970,79 @@ When LOCAL is non-nil, set the system message only in the 
current buffer."
   :key "s"
   (interactive)
   (let ((orig-buf (current-buffer))
-        (msg-start (make-marker)))
-    (with-current-buffer (get-buffer-create "*gptel-system*")
-      (let ((inhibit-read-only t))
-        (erase-buffer)
-        (text-mode)
-        (setq header-line-format
-              (concat
-               "Edit your system message below and press "
-               (propertize "C-c C-c" 'face 'help-key-binding)
-               " when ready, or "
-               (propertize "C-c C-k" 'face 'help-key-binding)
-               " to abort."))
-        (insert
-         "# Example: You are a helpful assistant. Answer as concisely as 
possible.\n"
-         "# Example: Reply only with shell commands and no prose.\n"
-         "# Example: You are a poet. Reply only in verse.\n\n")
-        (add-text-properties
-         (point-min) (1- (point))
-         (list 'read-only t 'face 'font-lock-comment-face))
-        ;; TODO: make-separator-line requires Emacs 28.1+.
-        ;; (insert (propertize (make-separator-line) 'rear-nonsticky t))
-        (set-marker msg-start (point))
-        (save-excursion
-          (insert (or (buffer-local-value 'gptel--system-message orig-buf) ""))
-          (push-mark nil 'nomsg))
-        (activate-mark))
-      (display-buffer (current-buffer)
-                      `((display-buffer-below-selected)
-                        (body-function . ,#'select-window)
-                        (window-height . ,#'fit-window-to-buffer)))
-      (let ((quit-to-menu
-             (lambda ()
-               "Cancel system message update and return to `gptel-menu'"
-               (interactive)
-               (quit-window)
-               (display-buffer
-                orig-buf
-                `((display-buffer-reuse-window
-                   display-buffer-use-some-window)
-                  (body-function . ,#'select-window)))
-               (call-interactively #'gptel-menu))))
-        (use-local-map
-         (make-composed-keymap
-          (define-keymap
-            "C-c C-c" (lambda ()
-                        "Confirm system message and return to `gptel-menu'."
-                        (interactive)
-                        (let ((system-message
-                               (buffer-substring-no-properties msg-start 
(point-max))))
-                          (with-current-buffer orig-buf
-                            (gptel--set-with-scope 'gptel--system-message 
system-message
-                                                   gptel--set-buffer-locally)))
-                        (funcall quit-to-menu))
-            "C-c C-k" quit-to-menu)
-          text-mode-map))))))
+        (msg-start (make-marker))
+        cancel
+        (directive gptel--system-message))
+    (when (functionp gptel--system-message)
+      (setq directive (funcall gptel--system-message)
+            cancel
+            (not (y-or-n-p
+                  "Active directive is a function: Edit its current value 
instead?"))))
+    (if cancel
+        (progn (message "Edit canceled")
+               (call-interactively #'gptel-menu))
+      ;; TODO: Handle editing list-of-strings directives
+      (with-current-buffer (get-buffer-create "*gptel-system*")
+        (let ((inhibit-read-only t))
+          (erase-buffer)
+          (text-mode)
+          (setq header-line-format
+                (concat
+                 "Edit your system message below and press "
+                 (propertize "C-c C-c" 'face 'help-key-binding)
+                 " when ready, or "
+                 (propertize "C-c C-k" 'face 'help-key-binding)
+                 " to abort."))
+          (insert
+           "# Example: You are a helpful assistant. Answer as concisely as 
possible.\n"
+           "# Example: Reply only with shell commands and no prose.\n"
+           "# Example: You are a poet. Reply only in verse.\n\n")
+          (add-text-properties
+           (point-min) (1- (point))
+           (list 'read-only t 'face 'font-lock-comment-face))
+          ;; TODO: make-separator-line requires Emacs 28.1+.
+          ;; (insert (propertize (make-separator-line) 'rear-nonsticky t))
+          (set-marker msg-start (point))
+          (save-excursion
+            ;; If it's a list, insert only the system message part
+            ;; MAYBE: Use `gptel--parse-directive'/`gptel--describe-directive'
+            ;; here?
+            (insert (or (car-safe directive) directive ""))
+            (push-mark nil 'nomsg))
+          (activate-mark))
+        (display-buffer (current-buffer)
+                        `((display-buffer-below-selected)
+                          (body-function . ,#'select-window)
+                          (window-height . ,#'fit-window-to-buffer)))
+        (let ((quit-to-menu
+               (lambda ()
+                 "Cancel system message update and return to `gptel-menu'"
+                 (interactive)
+                 (quit-window)
+                 (display-buffer
+                  orig-buf
+                  `((display-buffer-reuse-window
+                     display-buffer-use-some-window)
+                    (body-function . ,#'select-window)))
+                 (call-interactively #'gptel-menu))))
+          (use-local-map
+           (make-composed-keymap
+            (define-keymap
+              "C-c C-c" (lambda ()
+                          "Confirm system message and return to `gptel-menu'."
+                          (interactive)
+                          (let ((system-message
+                                 (buffer-substring-no-properties msg-start 
(point-max))))
+                            (with-current-buffer orig-buf
+                              (gptel--set-with-scope
+                               'gptel--system-message
+                               (if (cdr-safe directive) ;Handle list of strings
+                                   (prog1 directive (setcar directive 
system-message))
+                                 system-message)
+                               gptel--set-buffer-locally)))
+                          (funcall quit-to-menu))
+              "C-c C-k" quit-to-menu)
+            text-mode-map)))))))
 
 ;; ** Suffix for displaying and removing context
 (declare-function gptel-context--buffer-setup "gptel-context")
diff --git a/gptel.el b/gptel.el
index 76426b56ed..21c097e7b6 100644
--- a/gptel.el
+++ b/gptel.el
@@ -401,21 +401,29 @@ transient menu interface provided by `gptel-menu'."
     (programming . "You are a large language model and a careful programmer. 
Provide code and only code as output without any additional text, prompt or 
note.")
     (writing . "You are a large language model and a writing assistant. 
Respond concisely.")
     (chat . "You are a large language model and a conversation partner. 
Respond concisely."))
-  "System prompts (directives) for the LLM.
-
-These are system instructions sent at the beginning of each
-request to the LLM.
+  "System prompts or directives for the LLM.
+
+A \"directive\" is the system message (also called system prompt
+or system instruction) sent at the beginning of each request to
+the LLM.
+
+A directive can be
+- A string, interpreted as the system message.
+- A list of strings, whose first (possibly nil) element is
+  interpreted as the system message, and the remaining elements
+  as alternating user prompts and LLM responses.  This can be
+  used to template the intial part of a conversation.
+- A function that returns a string or a list of strings,
+  interpreted as the above.  This can be used to dynamically
+  generate a system message and/or conversation template based on
+  the current context.
 
 Each entry in this alist maps a symbol naming the directive to
-the string that is sent.  To set the directive for a chat session
+the directive itself.  To set the directive for a chat session
 interactively call `gptel-send' with a prefix argument."
   :safe #'always
   :type '(alist :key-type symbol :value-type string))
 
-(defvar gptel--system-message (alist-get 'default gptel-directives)
-  "The system message used by gptel.")
-(put 'gptel--system-message 'safe-local-variable #'always)
-
 (defcustom gptel-max-tokens nil
   "Max tokens per response.
 
@@ -978,6 +986,59 @@ MODE-SYM is typically a major-mode symbol."
              mode-sym 'prog-mode 'text-mode 'tex-mode)
             mode-name ""))))
 
+;;;; Directive handling
+
+
+(defvar gptel--system-message (alist-get 'default gptel-directives)
+  "The system message used by gptel.")
+(put 'gptel--system-message 'safe-local-variable #'always)
+
+(defun gptel--describe-directive (directive width &optional replacement)
+  "Find description for DIRECTIVE, truncated  to WIDTH.
+
+DIRECTIVE is a gptel directive, and can be a string, a function
+or a list of strings.  See `gptel-directives'.
+
+The result is a string intended for display.  Newlines are
+replaced with REPLACEMENT."
+  (cl-typecase directive
+    (string
+     (concat
+      (string-replace "\n" (or replacement " ")
+                      (truncate-string-to-width
+                       directive width nil nil t))))
+    (function
+     (concat
+      "λ: "
+      (string-replace
+       "\n" (or replacement " ")
+       (truncate-string-to-width
+        (or (documentation directive)
+            "[Dynamically generated; no preview available]")
+        width nil nil t))))
+    (list (and-let* ((from-template (car directive)))
+            (gptel--describe-directive
+             from-template width)))
+    (t "")))
+
+(defun gptel--parse-directive (directive)
+  "Parse DIRECTIVE into a backend-appropriate form.
+
+DIRECTIVE is a gptel directive: it can be a string, a list or a
+function that returns either, see `gptel-directives'.
+
+Return a cons cell consisting of the system message (a string)
+and a template consisting of alternating user/assistant
+records (a list of strings or nil)."
+  (and directive
+       (cl-etypecase directive
+         (string   (list directive))
+         (function (gptel--parse-directive (funcall directive)))
+         (cons     (cons (car directive)
+                         (gptel--parse-list
+                          gptel-backend (cdr directive)))))))
+
+
 
 ;;; Logging
 
@@ -1091,7 +1152,7 @@ file."
                                 (buttonize
                                  (format "[Prompt: %s]"
                                   (or (car-safe (rassoc gptel--system-message 
gptel-directives))
-                                   (truncate-string-to-width 
gptel--system-message 15 nil nil t)))
+                                   (gptel--describe-directive 
gptel--system-message 15)))
                                  (lambda (&rest _) (gptel-system-prompt)))
                                 'mouse-face 'highlight
                                 'help-echo "System message for session"))
@@ -1198,6 +1259,8 @@ around calls to it as required.
 If PROMPT is
 - a string, it is used to create a full prompt suitable for
   sending to the LLM.
+- A list of strings, it is interpreted as a conversation, i.e. a
+  series of alternating user prompts and LLM responses.
 - nil but region is active, the region contents are used.
 - nil, the current buffer's contents up to (point) are used.
   Previous responses from the LLM are identified as responses.
@@ -1254,9 +1317,11 @@ active.
 CONTEXT is any additional data needed for the callback to run. It
 is included in the INFO argument to the callback.
 
-SYSTEM is the system message (chat directive) sent to the LLM. If
-omitted, the value of `gptel--system-message' for the current
-buffer is used.
+SYSTEM is the system message or extended chat directive sent to
+the LLM.  This can be a string, a list of strings or a function
+that returns either; see `gptel-directives' for more
+information. If SYSTEM is omitted, the value of
+`gptel--system-message' for the current buffer is used.
 
 The following keywords are mainly for internal use:
 
@@ -1275,13 +1340,15 @@ Model parameters can be let-bound around calls to this 
function."
   (declare (indent 1))
   ;; TODO Remove this check in version 1.0
   (gptel--sanitize-model)
-  (let* ((gptel--system-message
-          ;Add context chunks to system message if required
+  (let* ((directive (gptel--parse-directive system))
+         ;; DIRECTIVE contains both the system message and the template prompts
+         (gptel--system-message
+          ;; Add context chunks to system message if required
           (if (and gptel-context--alist
                    (eq gptel-use-context 'system)
                    (not (gptel--model-capable-p 'nosystem)))
-              (gptel-context--wrap system)
-            system))
+              (gptel-context--wrap (car directive))
+            (car directive)))
          (gptel-stream stream)
          (start-marker
           (cond
@@ -1293,17 +1360,19 @@ Model parameters can be let-bound around calls to this 
function."
            ((integerp position)
             (set-marker (make-marker) position buffer))))
          (full-prompt
-          (cond
-           ((null prompt)
-            (gptel--create-prompt start-marker))
-           ((stringp prompt)
-            ;; FIXME Dear reader, welcome to Jank City:
-            (with-temp-buffer
-              (let ((gptel-model (buffer-local-value 'gptel-model buffer))
-                    (gptel-backend (buffer-local-value 'gptel-backend buffer)))
-                (insert prompt)
-                (gptel--create-prompt))))
-           ((consp prompt) prompt)))
+          (nconc
+           (cdr directive)              ;prompt constructed from 
directive/template
+           (cond                        ;prompt from buffer or explicitly 
supplied
+            ((null prompt)
+             (gptel--create-prompt start-marker))
+            ((stringp prompt)
+             ;; FIXME Dear reader, welcome to Jank City:
+             (with-temp-buffer
+               (let ((gptel-model (buffer-local-value 'gptel-model buffer))
+                     (gptel-backend (buffer-local-value 'gptel-backend 
buffer)))
+                 (insert prompt)
+                 (gptel--create-prompt))))
+            ((consp prompt) (gptel--parse-list gptel-backend prompt)))))
          (request-data (gptel--request-data gptel-backend full-prompt))
          (info (list :data request-data
                      :buffer buffer