branch: elpa/gptel
commit d020b41d8028f6d1eec2221b296ae7f46fe175b8
Author: Karthik Chikmagalur <karthikchikmaga...@gmail.com>
Commit: Karthik Chikmagalur <karthikchikmaga...@gmail.com>

    gptel: Turn context addition into a transform step
    
    Previously, adding context (from gptel-context) to the query
    payload was a bespoke step, and tied into `gptel-request'.  It was
    carried out by mutating the messages array after buffer parsing.
    
    Now that the `gptel-request' pipeline has been inverted, context
    addition is carried out in the prompt construction buffer, and is
    handled as a regular transform function in
    `gptel-prompt-transform-functions'.  As a result, the context
    addition step can now be asynchronous, since the user might want
    to truncate or augment it depending on its size and content.  By
    default, context addition works by inserting into the prompt
    construction buffer, or by modifying the system message in the
    buffer.
    
    The only exception to this is handling media files in the
    context -- there is no universal buffer-oriented method for doing
    this, so `gptel--wrap-user-prompt' is still used for attaching
    media from `gptel-context--alist'.
    TODO: This will be fixed in the future.
    
    This deprecates some aspects of the gptel-context API, including
    `gptel-context-wrap-function'.
    
    * gptel-context.el (gptel-context-wrap-function): Obsolete.  This
    is no longer used.  Customize `gptel-context-string-function'
    instead or advise `gptel-context--wrap-in-buffer' if that's
    insufficient.
    (gptel-context--wrap): This function serves the same purpose as
    before, but now works by mutating the prompt construction buffer.
    It takes a callback and can be asynchronous.
    (gptel-context--wrap-in-buffer): New function to add the context
    string to the prompt construction buffer, etiher as text or by
    modifying the buffer's system message.
    (gptel-context--wrap-default):  Remove, as this is covered by
    `gptel-context--wrap-in-buffer'.
    
    * gptel.el (gptel--transform-add-context): Augmentor for adding
    context to the request, which calls gptel-context- functions.
    This will be added to `gptel-prompt-transform-functions'
    next.  (Context addition is currently non-functional in gptel.)
    (gptel--realize-query): Move context addition step from here back
    to the transforms/augmentation step.  Handling media files in the
    context is an exception and it still happens here.
    (gptel--wrap-user-prompt-maybe): Remove, no longer needed.
---
 gptel-context.el | 95 +++++++++++++++++++++++++++++++++++++++-----------------
 gptel.el         | 44 +++++++++-----------------
 2 files changed, 81 insertions(+), 58 deletions(-)

diff --git a/gptel-context.el b/gptel-context.el
index 9d64dc1cb6..7f7d06a6a1 100644
--- a/gptel-context.el
+++ b/gptel-context.el
@@ -56,18 +56,25 @@
 This is used in gptel context buffers."
   :group 'gptel)
 
-(defcustom gptel-context-wrap-function #'gptel-context--wrap-default
-  "Function to format the context string sent with the gptel request.
+(defvar gptel-context-wrap-function nil
+  "Function to format the context string sent with the gptel request.")
+(make-obsolete-variable
+ 'gptel-context-wrap-function
+ "Custom functions for wrapping context are no longer supported by gptel.\
+  See `gptel-context--wrap-in-buffer' for details."
+ "0.9.9")
 
-This function receives two argument, the message to wrap with the
-context, and an alist of contexts organized by buffer.  It should
-return a string containing the message and the context, formatted as
-necessary.
+(defcustom gptel-context-string-function #'gptel-context--string
+  "Function to prepare the context string sent with the gptel request.
 
-The message is either the system message or the last user prompt,
-as configured by `gptel-use-context'.
+This function can be synchronous or asynchronous, and receives one or
+two arguments respectively.
 
-The alist of contexts is structured as follows:
+Synchronous: An alist of contexts with buffers or files (the context
+alist).
+Asynchronous: A callback to call with the result, and the context alist.
+
+The context alist is structured as follows:
 
  ((buffer1 . (overlay1 overlay2)
   (\"path/to/file\")
@@ -293,25 +300,57 @@ ADVANCE controls the overlay boundary behavior."
     overlay))
 
 ;;;###autoload
-(defun gptel-context--wrap (message)
-  "Wrap MESSAGE with context string."
-  (funcall gptel-context-wrap-function
-           message (gptel-context--collect)))
-
-(defun gptel-context--wrap-default (message contexts)
-  "Add CONTEXTS to MESSAGE.
-
-MESSAGE is usually either the system message or the user prompt.
-The accumulated context from CONTEXTS is appended or prepended to
-it, respectively."
-  ;; Append context before/after system message.
-  (let ((context-string (gptel-context--string contexts)))
-    (if (> (length context-string) 0)
-        (pcase-exhaustive gptel-use-context
-          ('system (concat message "\n\n" context-string))
-          ('user   (concat context-string "\n\n" message))
-          ('nil    message))
-      message)))
+(defun gptel-context--wrap (callback data-buf)
+  "Add request context to DATA-BUF and run CALLBACK.
+
+DATA-BUF is the buffer where the request prompt is constructed."
+  (if (= (car (func-arity gptel-context-string-function)) 2)
+      (funcall gptel-context-string-function
+               (lambda (c) (with-current-buffer data-buf
+                        (gptel-context--wrap-in-buffer c))
+                 (funcall callback))
+               (gptel-context--collect))
+    (with-current-buffer data-buf
+      (thread-last (gptel-context--collect)
+                   (funcall gptel-context-string-function)
+                   (gptel-context--wrap-in-buffer)))
+    (funcall callback)))
+
+(defun gptel-context--wrap-in-buffer (context-string &optional method)
+  "Inject CONTEXT-STRING to current buffer using METHOD.
+
+METHOD is either system or user, and defaults to `gptel-use-context'.
+This modifies the buffer."
+  (when (length> context-string 0)
+    (pcase (or method gptel-use-context)
+      ('system
+       (if (gptel--model-capable-p 'nosystem)
+           (gptel-context--wrap-in-buffer context-string 'user)
+         (if gptel--system-message
+             (cl-etypecase gptel--system-message
+               (string
+                (setq gptel--system-message
+                      (concat gptel--system-message "\n\n" context-string)))
+               (function
+                (setq gptel--system-message
+                      (gptel--parse-directive gptel--system-message 'raw))
+                (gptel-context--wrap-in-buffer context-string))
+               (list
+                (setq gptel--system-message ;cons a new list to avoid mutation
+                      (cons (concat (car gptel--system-message) "\n\n" 
context-string)
+                            (cdr gptel--system-message)))))
+           (setq gptel--system-message context-string))))
+      ('user
+       (goto-char (point-max))
+       (text-property-search-backward 'gptel nil t)
+       (and gptel-mode
+            (looking-at
+             (concat "[\n[:blank:]]*"
+                     (and-let* ((prefix (gptel-prompt-prefix-string))
+                                ((not (string-empty-p prefix))))
+                       (concat "\\(?:" (regexp-quote prefix) "\\)?"))))
+            (delete-region (match-beginning 0) (match-end 0)))
+       (insert "\n" context-string "\n\n")))))
 
 (defun gptel-context--collect-media (&optional contexts)
   "Collect media CONTEXTS.
diff --git a/gptel.el b/gptel.el
index 09e62b735b..e556e83b95 100644
--- a/gptel.el
+++ b/gptel.el
@@ -1108,6 +1108,11 @@ in any way.")
   "Curl executable to use."
   (if (stringp gptel-use-curl) gptel-use-curl "curl"))
 
+(defun gptel--transform-add-context (callback fsm)
+  (if (and gptel-use-context gptel-context--alist)
+      (gptel-context--wrap callback (plist-get (gptel-fsm-info fsm) :data))
+    (funcall callback)))
+
 ;;;; Model interface
 ;; NOTE: This interface would be simpler to implement as a defstruct.  But then
 ;; users cannot set `gptel-model' to a symbol/string directly, or we'd need
@@ -2513,12 +2518,7 @@ Initiate the request when done."
       (let* ((directive (gptel--parse-directive gptel--system-message 'raw))
              ;; DIRECTIVE contains both the system message and the template 
prompts
              (gptel--system-message
-              ;; Add context chunks to system message if required
-              (unless (gptel--model-capable-p 'nosystem)
-                (if (and gptel-context--alist
-                         (eq gptel-use-context 'system))
-                    (gptel-context--wrap (car directive))
-                  (car directive))))
+              (unless (gptel--model-capable-p 'nosystem) (car directive)))
              ;; TODO(tool) Limit tool use to capable models after documenting 
:capabilities
              ;; (gptel-use-tools (and (gptel--model-capable-p 'tool-use) 
gptel-use-tools))
              (stream (and (plist-get info :stream) gptel-use-curl gptel-stream
@@ -2543,7 +2543,14 @@ Initiate the request when done."
         (setq full-prompt (gptel--parse-buffer ;prompt from buffer or 
explicitly supplied
                            gptel-backend (and gptel--num-messages-to-send
                                               (* 2 
gptel--num-messages-to-send))))
-        (gptel--wrap-user-prompt-maybe full-prompt)
+        ;; Inject media chunks into the first user prompt if required.  Media
+        ;; chunks are always included with the first user message,
+        ;; irrespective of the preference in `gptel-use-context'.  This is
+        ;; because media cannot be included (in general) with system messages.
+        ;; TODO(augment): Find a way to do this in the prompt-buffer?
+        (when (and gptel-context--alist gptel-use-context
+                   gptel-track-media (gptel--model-capable-p 'media))
+          (gptel--wrap-user-prompt gptel-backend full-prompt 'media))
         (unless stream (cl-remf info :stream))
         (plist-put info :backend gptel-backend)
         (when gptel-include-reasoning   ;Required for next-request-only scope
@@ -2761,29 +2768,6 @@ Optional RAW disables text properties and 
transformation."
       (`(tool-result . ,tool-results)
        (gptel--display-tool-results tool-results info)))))
 
-(defun gptel--wrap-user-prompt-maybe (prompts)
-  "Return PROMPTS wrapped with text and media context.
-
-This delegates to backend-specific wrap functions."
-  (prog1 prompts
-    (when gptel-context--alist
-      ;; Inject context chunks into the last user prompt if required.
-      ;; This is also the fallback for when `gptel-use-context' is set to
-      ;; 'system but the model does not support system messages.
-      (when (and gptel-use-context
-                 (or (eq gptel-use-context 'user)
-                     (gptel--model-capable-p 'nosystem))
-                 (> (length prompts) 0)) ;FIXME context should be injected
-                                        ;even when there are no prompts
-        (gptel--wrap-user-prompt gptel-backend prompts))
-      ;; Inject media chunks into the first user prompt if required.  Media
-      ;; chunks are always included with the first user message,
-      ;; irrespective of the preference in `gptel-use-context'.  This is
-      ;; because media cannot be included (in general) with system messages.
-      (when (and gptel-use-context gptel-track-media
-                 (gptel--model-capable-p 'media))
-        (gptel--wrap-user-prompt gptel-backend prompts :media)))))
-
 (defun gptel--create-prompt-buffer (&optional prompt-end)
   "Return a buffer with the conversation prompt to be sent.
 

Reply via email to