diff --git a/NEWS b/NEWS index 4ceda0af..08a61a82 100644 --- a/NEWS +++ b/NEWS @@ -49,6 +49,14 @@ For logistical reasons, the =gptel-request= library will continue to be shipped with =gptel=. +- New user option ~gptel-context~: This variable can be used to specify + additional context sources for gptel queries, usually files or + buffers. It serves the longstanding requests of enabling buffer-local + context specification, as well as context specification in gptel + presets and programmatic gptel use. Each entry is a file path or a + buffer object, but other kinds of specification are possible. See its + documentation for details. + - ~gptel-mcp-connect~ can now start MCP servers synchronously. This is useful for scripting purposes, when MCP tools need to be available before performing other actions. One common use is @@ -58,6 +66,11 @@ context. This setting can be controlled via the user option ~gptel-context-restrict-to-project-files~. +- ~gptel-make-bedrock~ now checks for the ~AWS_BEARER_TOKEN_BEDROCK~ environment + variable parameter and uses it for Bedrock API key based authentication if + present. See + https://docs.aws.amazon.com/bedrock/latest/userguide/api-keys.html. + * 0.9.9 2025-08-02 ** Breaking changes diff --git a/README.org b/README.org index 75322e11..c4ec0b29 100644 --- a/README.org +++ b/README.org @@ -1113,10 +1113,15 @@ Register a backend with :model-region 'apac) #+end_src -The Bedrock backend gets your AWS credentials from the environment variables. It expects to find either -~AWS_ACCESS_KEY_ID~, ~AWS_SECRET_ACCESS_KEY~, ~AWS_SESSION_TOKEN~ (optional), or if present, can use ~AWS_PROFILE~ to get these directly from the ~aws~ cli. - -NOTE: The Bedrock backend needs curl >= 8.5 in order for the sigv4 signing to work properly, +AWS has numerous credential provisions; we follow this order precedence, +- (argument) ~:aws-bearer-token~ +- (env. variable) ~AWS_BEARER_TOKEN_BEDROCK~ +- (argument) ~:aws-profile~ + If this option is specified, the Bedrock-backend uses the shared AWS config and credentials files to obtain credentials based on the AWS Profile selected. If ~:aws-profile~ is set to the keyword ~:static~, the IAM credentials are imported without a profile argument. +- (env. varible) ~AWS_PROFILE~ +- (env. varible) ~AWS_ACCESS_KEY_ID~, ~AWS_SECRET_ACCESS_KEY~ and ~AWS_SESSION_TOKEN~ + +NOTE: Unless ~AWS_BEARER_TOKEN_BEDROCK~ token is used, the Bedrock backend needs curl >= 8.9 in order for the sigv4 signing to work properly, https://github.com/curl/curl/issues/11794 An error will be signalled if ~gptel-curl~ is ~NIL~. @@ -1134,6 +1139,8 @@ The above code makes the backend available to select. If you want it to be the (gptel-make-bedrock "AWS" ;; optionally enable streaming :stream t + ;; optionally specify the aws profile + ;; :profile :region "ap-northeast-1" ;; subset of gptel--bedrock-models :models '(claude-sonnet-4-20250514) diff --git a/gptel-anthropic.el b/gptel-anthropic.el index 79ca0132..72406524 100644 --- a/gptel-anthropic.el +++ b/gptel-anthropic.el @@ -480,34 +480,21 @@ format." into parts-array finally return (vconcat parts-array))) -(cl-defmethod gptel--wrap-user-prompt ((_backend gptel-anthropic) prompts - &optional inject-media) - "Wrap the last user prompt in PROMPTS with the context string. - -If INJECT-MEDIA is non-nil wrap it with base64-encoded media -files in the context." - (if inject-media - ;; Wrap the first user prompt with included media files/contexts - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf (lambda (current) - (vconcat - (gptel--anthropic-parse-multipart media-list) - (cl-typecase current - (string `((:type "text" :text ,current))) - (vector current) - (t current)))) - (plist-get (car prompts) :content))) - ;; Wrap the last user prompt with included text contexts +(cl-defmethod gptel--inject-media ((_backend gptel-anthropic) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) (cl-callf (lambda (current) - (cl-etypecase current - (string (gptel-context--wrap current)) - (vector (if-let* ((wrapped (gptel-context--wrap nil))) - (vconcat `((:type "text" :text ,wrapped)) - current) - current)))) - (plist-get (car (last prompts)) :content)))) - -;; (if-let* ((context-string (gptel-context--string gptel-context--alist))) + (vconcat + (gptel--anthropic-parse-multipart media-list) + (cl-typecase current + (string `((:type "text" :text ,current))) + (vector current) + (t current)))) + (plist-get (car prompts) :content)))) + +;; (if-let* ((context-string (gptel-context--string gptel-context))) ;; (cl-callf (lambda (previous) ;; (cl-typecase previous ;; (string (concat context-string previous)) diff --git a/gptel-bedrock.el b/gptel-bedrock.el index e2973d75..b7161002 100644 --- a/gptel-bedrock.el +++ b/gptel-bedrock.el @@ -136,32 +136,14 @@ Assumes this is a conversation with alternating roles." (list :role (if role "user" "assistant") :content `[(:text ,text)]))) -(cl-defmethod gptel--wrap-user-prompt ((_backend gptel-bedrock) prompts &optional inject-media) - "Inject context into a conversation. - -PROMPTS is list of prompt objects. If INJECT-MEDIA is non-nil -inject the media files from context into the beginning of the -conversation; otherwise inject the context into the last prompt." - (if inject-media - (gptel-bedrock--inject-media-context prompts) - (gptel-bedrock--inject-text-context prompts))) - -(defun gptel-bedrock--inject-media-context (prompts) - "Inject media files from context into a conversation. -Media files will be added at the beginning of the conversation. -PROMPTS should be a non-empty list of prompt objects." +(cl-defmethod gptel--inject-media ((_backend gptel-bedrock) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." (when-let* ((media-list (gptel-context--collect-media))) (cl-callf2 vconcat (gptel-bedrock--parse-multipart media-list) (plist-get (car prompts) :content)))) -(defun gptel-bedrock--inject-text-context (prompts) - "Inject text context into the last prompt object from a conversation. -PROMPTS should be a non-empty list of prompt objects." - (cl-assert prompts nil "Expected a non-empty list of prompts") - (when-let* ((wrapped (gptel-context--wrap nil))) - (cl-callf2 vconcat `[(:text ,wrapped)] - (plist-get (car (last prompts)) :content)))) - (defvar-local gptel-bedrock--stream-cursor nil "Marker to indicate last point parsed.") @@ -499,6 +481,9 @@ conversation." (defun gptel-bedrock--fetch-aws-profile-credentials (profile &optional clear-cache) "Fetch & cache AWS credentials for PROFILE using aws-cli. +If PROFILE is the keyword ':static', then it fetches IAM credentials +from the aws-cli without any profile argument. + Non-nil CLEAR-CACHE will refresh credentials." (let* ((creds-json (let ((cell (or (assoc profile gptel-bedrock--aws-profile-cache #'string=) @@ -506,8 +491,8 @@ Non-nil CLEAR-CACHE will refresh credentials." (or (and (not clear-cache) (cdr cell)) (setf (cdr cell) (with-temp-buffer - (unless (zerop (call-process "aws" nil t nil "configure" "export-credentials" - (format "--profile=%s" profile))) + (unless (zerop (apply #'call-process "aws" nil t nil "configure" "export-credentials" + (unless (eql profile :static) (list (format "--profile=%s" profile))))) (user-error "Failed to get AWS credentials from profile")) (json-parse-string (buffer-string))))))) (expiration (if-let (exp (gethash "Expiration" creds-json)) @@ -522,9 +507,16 @@ Non-nil CLEAR-CACHE will refresh credentials." (gptel-bedrock--fetch-aws-profile-credentials profile t)) (t (user-error "AWS credentials expired for profile: %s" profile))))) -(defun gptel-bedrock--get-credentials () +(defun gptel-bedrock--get-credentials (profile) "Return the AWS credentials to use for the request. +If credentials are not available based on the AWS_ACCESS_KEY_ID +AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN environment variables, +aws configure export-credentials is used to obtain credentials. +PROFILE specifies the AWS profile to use for retrieving +credentials. If PROFILE is unset, AWS_PROFILE environment +variable is used. + Returns a list of 2-3 elements, depending on whether a session token is needed, with this form: (AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN). @@ -533,11 +525,11 @@ Convenient to use with `cl-multiple-value-bind'" (let ((key-id (getenv "AWS_ACCESS_KEY_ID")) (secret-key (getenv "AWS_SECRET_ACCESS_KEY")) (token (getenv "AWS_SESSION_TOKEN")) - (profile (getenv "AWS_PROFILE"))) + (profile (or profile (getenv "AWS_PROFILE")))) (cond - ((and key-id secret-key) (cl-values key-id secret-key token)) ((and profile) (gptel-bedrock--fetch-aws-profile-credentials profile)) - (t (user-error "Missing AWS credentials; currently only environment variables are supported"))))) + ((and key-id secret-key) (cl-values key-id secret-key token)) + (t (user-error "Missing AWS credentials; provide them either via environment variables or specify PROFILE when calling gptel-make-bedrock"))))) (defvar gptel-bedrock--model-ids ;; https://docs.aws.amazon.com/bedrock/latest/userguide/models-supported.html @@ -586,19 +578,25 @@ REGION is one of apac, eu or us." (or (alist-get model gptel-bedrock--model-ids nil nil #'eq) (error "Unknown Bedrock model: %s" model)))) -(defun gptel-bedrock--curl-args (region) - "Generate the curl arguments to get a bedrock request signed for use in REGION." - ;; https://curl.se/docs/manpage.html#--aws-sigv4 - (cl-multiple-value-bind (key-id secret token) (gptel-bedrock--get-credentials) - (nconc - (list - "--user" (format "%s:%s" key-id secret) - "--aws-sigv4" (format "aws:amz:%s:bedrock" region)) - (unless (memq system-type '(windows-nt ms-dos)) - ;; Without this curl swallows the output - (list "--output" "/dev/stdout")) - (when token - (list (format "-Hx-amz-security-token: %s" token)))))) +(defun gptel-bedrock--curl-args (region profile bearer-token) + "Generate the curl arguments to get a bedrock request signed for use in REGION. + +PROFILE specifies the aws profile to use for aws configure +export-credentials. BEARER-TOKEN is the token used for authentication." + (let ((bearer-token (or bearer-token (getenv "AWS_BEARER_TOKEN_BEDROCK"))) + (output-args (unless (memq system-type '(windows-nt ms-dos)) + '("--output" "/dev/stdout")))) + (if bearer-token + (append + (list "-H" (format "Authorization: Bearer %s" bearer-token)) + output-args) + (cl-multiple-value-bind (key-id secret token) (gptel-bedrock--get-credentials profile) + (append + (list "--user" (format "%s:%s" key-id secret) + "--aws-sigv4" (format "aws:amz:%s:bedrock" region)) + output-args + (when token (list "-H" (format "x-amz-security-token: %s" token)))))))) + (defun gptel-bedrock--curl-version () "Check Curl version required for gptel-bedrock." @@ -614,6 +612,7 @@ REGION is one of apac, eu or us." (models gptel--bedrock-models) (model-region nil) stream curl-args request-params + aws-profile aws-bearer-token (protocol "https")) "Register an AWS Bedrock backend for gptel with NAME. @@ -622,14 +621,17 @@ Keyword arguments: REGION - AWS region name (e.g. \"us-east-1\") MODELS - The list of models supported by this backend MODEL-REGION - one of apac, eu, us or nil +AWS-PROFILE - the aws profile to use for aws configure export-credentials +AWS-BEARER-TOKEN - the aws bearer-token for authenticating with AWS CURL-ARGS - additional curl args STREAM - Whether to use streaming responses or not. REQUEST-PARAMS - a plist of additional HTTP request parameters (as plist keys) and values supported by the API." (declare (indent 1)) - (unless (and gptel-use-curl (version<= "8.9" (gptel-bedrock--curl-version))) - (error "Bedrock-backend requires curl >= 8.9, but gptel-use-curl := %s, curl-version := %s" - gptel-use-curl (gptel-bedrock--curl-version))) + (unless (or aws-bearer-token (getenv "AWS_BEARER_TOKEN_BEDROCK")) + (unless (and gptel-use-curl (version<= "8.9" (gptel-bedrock--curl-version))) + (error "Bedrock-backend requires curl >= 8.9, but gptel-use-curl := %s, curl-version := %s" + gptel-use-curl (gptel-bedrock--curl-version)))) (let ((host (format "bedrock-runtime.%s.amazonaws.com" region))) (setf (alist-get name gptel--known-backends nil nil #'equal) (gptel--make-bedrock @@ -637,12 +639,12 @@ parameters (as plist keys) and values supported by the API." :host host :header nil ; x-amz-security-token is set in curl-args if needed :models (gptel--process-models models) - :model-region model-region + :model-region model-region :protocol protocol :endpoint "" ; Url is dynamically constructed based on other args :stream stream :coding-system (and stream 'binary) - :curl-args (lambda () (append curl-args (gptel-bedrock--curl-args region))) + :curl-args (lambda () (append curl-args (gptel-bedrock--curl-args region aws-profile aws-bearer-token))) :request-params request-params :url (lambda () diff --git a/gptel-context.el b/gptel-context.el index 32946734..06e44c95 100644 --- a/gptel-context.el +++ b/gptel-context.el @@ -74,15 +74,15 @@ 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: +Entries in the context alist can have one of these forms: - ((buffer1 . (overlay1 overlay2) - (\"path/to/file\") - (buffer2 . (overlay3 overlay4 overlay5)) - (\"path/to/image/file\" :mime \"image/jpeg\"))) + (buffer1 overlay1 overlay2 ...) ;text overlays in a buffer + (buffer2) ;a buffer object + (\"/path/to/file\") ;a text file + (\"/path/to/file\" :mime \"text/markdown\") ;with explicit mime type + (\"/path/to/image\" :mime \"image/jpeg\") ;media file -Each gptel \"context\" is either a file path or an overlay in a -buffer. Each overlay covers a buffer region containing the +Each overlay covers a buffer region containing the context chunk. This is accessible as, for example: (with-current-buffer buffer1 @@ -147,8 +147,8 @@ context." ;; A region is selected. ((use-region-p) (gptel-context--add-region (current-buffer) - (region-beginning) - (region-end)) + (region-beginning) + (region-end)) (deactivate-mark) (message "Current region added as context.")) ;; If in dired @@ -170,9 +170,9 @@ context." (buffer-file-name) (not (gptel-context--skip-p (buffer-file-name)))) (funcall (if (and arg (< (prefix-numeric-value arg) 0)) - #'gptel-context-remove - #'gptel-context-add-file) - (buffer-file-name))) + #'gptel-context-remove + #'gptel-context-add-file) + (buffer-file-name))) ;; No region is selected, and ARG is positive. ((and arg (> (prefix-numeric-value arg) 0)) (let* ((buffer-name (read-buffer "Choose buffer to add as context: " @@ -210,7 +210,7 @@ context." (defun gptel-context--add-text-file (path) "Add text file at PATH to context." - (cl-pushnew (list path) gptel-context--alist :test #'equal) + (cl-pushnew (list path) gptel-context :test #'equal) (message "File \"%s\" added to context." path) path) @@ -222,7 +222,7 @@ Return PATH if added, nil if ignored." ((gptel--model-mime-capable-p mime))) (prog1 path (cl-pushnew (list path :mime mime) - gptel-context--alist :test #'equal) + gptel-context :test #'equal) (message "File \"%s\" added to context." path)) (message "Ignoring unsupported binary file \"%s\"." path) nil)) @@ -234,7 +234,7 @@ ACTION should be either `add' or `remove'." (pcase-exhaustive action ('add (gptel-context-add-file file)) ('remove - (setf (alist-get file gptel-context--alist nil 'remove #'equal) nil))))) + (setf (alist-get file gptel-context nil 'remove #'equal) nil))))) (defun gptel-context-add-file (path) "Add the file at PATH to the gptel context. @@ -247,7 +247,7 @@ readable as text." (run-at-time 0 nil (lambda () (setq gptel-context--reset-cache nil - gptel-context--project-files nil)))) + gptel-context--project-files nil)))) (cond ((file-directory-p path) (gptel-context--add-directory path 'add)) ((gptel-context--skip-p path) @@ -298,25 +298,27 @@ If CONTEXT is nil, removes the context at point. If selection is active, removes all contexts within selection. If CONTEXT is a directory, recursively removes all files in it." (cond - ((overlayp context) + ((overlayp context) ;Overlay in buffer (delete-overlay context) ;; FIXME: Quadratic cost when clearing a bunch of contexts at once (unless (cl-loop - for ov in (alist-get (current-buffer) gptel-context--alist) + for ov in (alist-get (current-buffer) gptel-context) thereis (overlay-start ov)) - (setf (alist-get (current-buffer) gptel-context--alist nil 'remove) nil))) + (setf (alist-get (current-buffer) gptel-context nil 'remove) nil))) + ((bufferp context) ;Full buffer + (setf (alist-get context gptel-context nil 'remove) nil)) ((stringp context) ;file or directory (if (file-directory-p context) (gptel-context--add-directory context 'remove) - (setf (alist-get context gptel-context--alist nil 'remove #'equal) nil) + (setf (alist-get context gptel-context nil 'remove #'equal) nil) (message "File \"%s\" removed from context." context))) - ((region-active-p) + ((region-active-p) ;Overlays in region (when-let* ((contexts (gptel-context--in-region (current-buffer) (region-beginning) (region-end)))) (cl-loop for ctx in contexts do (delete-overlay ctx)))) - (t + (t ;Anything at point (when-let* ((ctx (gptel-context--at-point))) (delete-overlay ctx))))) @@ -326,15 +328,16 @@ If CONTEXT is a directory, recursively removes all files in it." If VERBOSE is non-nil, ask for confirmation and message afterwards." (interactive (list t)) - (if (null gptel-context--alist) + (if (null gptel-context) (when verbose (message "No gptel context sources to remove.")) (when (or (not verbose) (y-or-n-p "Remove all context? ")) (cl-loop - for (source . ovs) in gptel-context--alist - if (bufferp source) do ;Buffers and buffer regions + for context in gptel-context + for (source . ovs) = (ensure-list context) + if (cl-every #'overlayp ovs) do ;Buffers and buffer regions (mapc #'gptel-context-remove ovs) else do (gptel-context-remove source) ;files or other types - finally do (setq gptel-context--alist nil))) + finally do (setq gptel-context nil))) (when verbose (message "Removed all gptel context sources.")))) ;;; Context wrap @@ -347,7 +350,7 @@ ADVANCE controls the overlay boundary behavior." (overlay-put overlay 'face 'gptel-context-highlight-face) (overlay-put overlay 'gptel-context t) (push overlay (alist-get (current-buffer) - gptel-context--alist)) + gptel-context)) overlay)) ;;;###autoload @@ -358,7 +361,7 @@ 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)) + (gptel-context--wrap-in-buffer c)) (funcall callback)) (gptel-context--collect)) (with-current-buffer data-buf @@ -408,8 +411,8 @@ This modifies the buffer." CONTEXTS, which are typically paths to binary files, are base64-encoded and prepended to the first user prompt." - (cl-loop for context in (or contexts gptel-context--alist) - for (path . props) = context + (cl-loop for context in (or contexts gptel-context) + for (path . props) = (ensure-list context) when (and (stringp path) (plist-get props :mime)) collect (cons :media context))) @@ -423,7 +426,7 @@ the beginning and end." (gptel-context--in-region buffer region-beginning region-end)) (prog1 (with-current-buffer buffer (gptel-context--make-overlay region-beginning region-end advance)) - (message "Region added to context buffer."))) + (message "Region added to context buffer."))) (defun gptel-context--in-region (buffer start end) "Return the list of context overlays in the given region, if any, in BUFFER. @@ -439,67 +442,79 @@ START and END signify the region delimiters." ;;;###autoload (defun gptel-context--collect () - "Get the list of all active context overlays." + "Get the list of all active context sources. + +Ignore overlays, buffers and files that are not live or readable." ;; Get only the non-degenerate overlays, collect them, and update the overlays variable. - (setq gptel-context--alist - (cl-loop for (buf . ovs) in gptel-context--alist - if (buffer-live-p buf) - if (cl-loop for ov in ovs when (overlay-start ov) collect ov) - collect (cons buf it) into elements - end - else if (and (stringp buf) (file-exists-p buf)) - if (plist-get ovs :mime) - collect (cons buf ovs) into elements - else collect (list buf) into elements - finally return elements))) - -(defun gptel-context--insert-buffer-string (buffer contexts) - "Insert at point a context string from all CONTEXTS in BUFFER." - (let ((is-top-snippet t) - (previous-line 1)) - (insert (format "In buffer `%s`:" (buffer-name buffer)) - "\n\n```" (gptel--strip-mode-suffix (buffer-local-value - 'major-mode buffer)) - "\n") - (dolist (context contexts) + (let ((res)) + (dolist (entry gptel-context) + (pcase entry ;Context entry is: + (`(,buf . ,ovs) + (cond + ((buffer-live-p buf) ;Overlay(s) in a buffer + (if-let* ((live-ovs (cl-loop for ov in ovs + when (overlay-start ov) + collect ov))) + (push (cons buf live-ovs) res))) + ((and (stringp buf) (file-readable-p buf)) + (push (cons buf ovs) res)))) ;A file list with (maybe) a mimetype + + ((and (pred stringp) (pred file-readable-p)) ;Just a file, figure out mimetype + (push `(,entry ,@(and (gptel--file-binary-p entry) + (list :mime (mailcap-file-name-to-mime-type entry)))) + res)) + ((pred buffer-live-p) (push (list entry) res)))) ;Just a buffer + (nreverse res))) + +(defun gptel-context--insert-buffer-string (buffer overlays) + "Insert at point a context string from all OVERLAYS in BUFFER. + +If OVERLAYS is nil add the entire buffer text." + (let ((is-top-snippet t) + (previous-line 1)) + (insert (format "In buffer `%s`:" (buffer-name buffer)) + "\n\n```" (gptel--strip-mode-suffix (buffer-local-value + 'major-mode buffer)) + "\n") + (if (not overlays) + (insert-buffer-substring-no-properties buffer) + (dolist (context overlays) (let* ((start (overlay-start context)) - (end (overlay-end context)) - content) + (end (overlay-end context))) (let (lineno column) (with-current-buffer buffer (without-restriction (setq lineno (line-number-at-pos start t) - column (save-excursion (goto-char start) - (current-column)) - content (buffer-substring-no-properties start end)))) + column (save-excursion (goto-char start) (current-column))))) ;; We do not need to insert a line number indicator if we have two regions ;; on the same line, because the previous region should have already put the ;; indicator. (unless (= previous-line lineno) (unless (= lineno 1) - (unless is-top-snippet - (insert "\n")) + (unless is-top-snippet (insert "\n")) (insert (format "... (Line %d)\n" lineno)))) (setq previous-line lineno) (unless (zerop column) (insert " ...")) (if is-top-snippet (setq is-top-snippet nil) (unless (= previous-line lineno) (insert "\n")))) - (insert content))) - (unless (>= (overlay-end (car (last contexts))) (point-max)) - (insert "\n...")) - (insert "\n```"))) + (insert-buffer-substring-no-properties buffer start end))) + (unless (>= (overlay-end (car (last overlays))) (point-max)) + (insert "\n..."))) + (insert "\n```"))) (defun gptel-context--string (context-alist) "Format the aggregated gptel context as annotated markdown fragments. Returns a string. CONTEXT-ALIST is a structure containing -context overlays, see `gptel-context--alist'." +context overlays, see `gptel-context'." (with-temp-buffer - (cl-loop for (buf . ovs) in context-alist + (cl-loop for entry in context-alist + for (buf . ovs) = (ensure-list entry) if (bufferp buf) do (gptel-context--insert-buffer-string buf ovs) - else if (not (plist-get ovs :mime)) + else if (or (not (plist-get ovs :mime)) + (string-match-p "^text/" (plist-get ovs :mime))) do (gptel--insert-file-string buf) end do (insert "\n\n") finally do @@ -509,8 +524,8 @@ context overlays, see `gptel-context--alist'." (goto-char (point-min)) (insert "Request context:\n\n")) finally return - (and (> (buffer-size) 0) - (buffer-string))))) + (and (> (buffer-size) 0) + (buffer-string))))) ;;; Major mode for context inspection buffers (defvar-keymap gptel-context-buffer-mode-map @@ -544,50 +559,59 @@ context overlays, see `gptel-context--alist'." "\\[gptel-context-quit]: cancel, " "\\[quit-window]: quit"))) (save-excursion - (let ((contexts gptel-context--alist)) - (if (length> contexts 0) - (let (beg ov l1 l2) - (pcase-dolist (`(,buf . ,ovs) contexts) - (if (bufferp buf) - ;; It's a buffer with some overlay(s) - (dolist (source-ov ovs) - (with-current-buffer buf - (setq l1 (line-number-at-pos (overlay-start source-ov)) - l2 (line-number-at-pos (overlay-end source-ov)))) - (insert (propertize (format "In buffer %s (lines %d-%d):\n\n" - (buffer-name buf) l1 l2) + (let ((contexts (gptel-context--collect))) + (if (length= contexts 0) + (insert "There are no active gptel contexts.") + (let (beg ov l1 l2) + (pcase-dolist (`(,buf . ,ovs) contexts) + (cond + ((bufferp buf) + (if (not ovs) ;BUF is a full buffer, not specific overlays + (progn + (insert (propertize (format "In buffer %s:\n\n" + (buffer-name buf)) 'face 'bold)) (setq beg (point)) - (insert-buffer-substring - buf (overlay-start source-ov) (overlay-end source-ov)) + (insert-buffer-substring buf) (insert "\n") - (setq ov (make-overlay beg (point))) - (overlay-put ov 'gptel-context source-ov) - (overlay-put ov 'gptel-overlay t) - (overlay-put ov 'evaporate t) - (insert "\n" (make-separator-line) "\n")) - ;; BUF is a file path, not a buffer - (insert (propertize (format "In file %s:\n\n" (file-name-nondirectory buf)) - 'face 'bold)) - (setq beg (point)) - (if-let* ((mime (plist-get ovs :mime))) - ;; BUF is a binary file - (if-let* (((string-match-p (image-file-name-regexp) buf)) - (img (create-image buf))) - (insert-image img "*") ; Can be displayed - (insert - buf " " (propertize "(No preview for binary file)" - 'face '(:inherit shadow :slant italic)))) - (insert-file-contents buf)) - (goto-char (point-max)) - (insert "\n") - (setq ov (make-overlay beg (point))) - (overlay-put ov 'gptel-context buf) - (overlay-put ov 'gptel-overlay t) - (overlay-put ov 'evaporate t) - (insert "\n" (make-separator-line) "\n"))) - (goto-char (point-min))) - (insert "There are no active gptel contexts."))))) + (setq ov (make-overlay beg (point)))) + (dolist (source-ov ovs) ;BUF is a buffer with some overlay(s) + (with-current-buffer buf + (setq l1 (line-number-at-pos (overlay-start source-ov)) + l2 (line-number-at-pos (overlay-end source-ov)))) + (insert (propertize (format "In buffer %s (lines %d-%d):\n\n" + (buffer-name buf) l1 l2) + 'face 'bold)) + (setq beg (point)) + (insert-buffer-substring + buf (overlay-start source-ov) (overlay-end source-ov)) + (insert "\n") + (setq ov (make-overlay beg (point))) + (overlay-put ov 'gptel-context source-ov))) + (overlay-put ov 'gptel-overlay t) + (overlay-put ov 'evaporate t) + (insert "\n" (make-separator-line) "\n")) + (t ;BUF is a file path, not a buffer + (insert (propertize (format "In file %s:\n\n" (file-name-nondirectory buf)) + 'face 'bold)) + (setq beg (point)) + (if-let* ((mime (plist-get ovs :mime)) + ((not (string-match-p "^text/" mime)))) ;BUF is a binary file + (if-let* (((string-match-p (image-file-name-regexp) buf)) + (img (create-image buf))) + (insert-image img "*") ; Can be displayed + (insert + buf " " (propertize "(No preview for binary file)" + 'face '(:inherit shadow :slant italic)))) + (insert-file-contents buf)) + (goto-char (point-max)) + (insert "\n") + (setq ov (make-overlay beg (point))) + (overlay-put ov 'gptel-context buf) + (overlay-put ov 'gptel-overlay t) + (overlay-put ov 'evaporate t) + (insert "\n" (make-separator-line) "\n")))) + (goto-char (point-min))))))) (display-buffer (current-buffer) `((display-buffer-reuse-window display-buffer-reuse-mode-window @@ -702,7 +726,10 @@ If non-nil, indicates backward movement.") (overlay-get ov 'gptel-context))) (overlays-in (point-min) (point-max)))))) (mapc #'gptel-context-remove deletion-marks) - (gptel-context--collect) ;Update contexts and revert buffer (#482) + ;; FIXME(context): This should run in the buffer from which the context + ;; inspection buffer was visited. + ;; Update contexts and revert buffer (#482) + (setq gptel-context (gptel-context--collect)) (revert-buffer)) (gptel-context-quit)) diff --git a/gptel-gemini.el b/gptel-gemini.el index 05abf01d..94c378e1 100644 --- a/gptel-gemini.el +++ b/gptel-gemini.el @@ -358,25 +358,15 @@ format." into parts-array finally return (vconcat parts-array))) -(cl-defmethod gptel--wrap-user-prompt ((_backend gptel-gemini) prompts - &optional inject-media) - "Wrap the last user prompt in PROMPTS with the context string. - -If INJECT-MEDIA is non-nil wrap it with base64-encoded media -files in the context." - (if inject-media - ;; Wrap the first user prompt with included media files/contexts - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf (lambda (current) - (vconcat (gptel--gemini-parse-multipart media-list) - current)) - (plist-get (car prompts) :parts))) - ;; Wrap the last user prompt with included text contexts +(cl-defmethod gptel--inject-media ((_backend gptel-gemini) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) (cl-callf (lambda (current) - (if-let* ((wrapped (gptel-context--wrap nil))) - (vconcat `((:text ,wrapped)) current) - current)) - (plist-get (car (last prompts)) :parts)))) + (vconcat (gptel--gemini-parse-multipart media-list) + current)) + (plist-get (car prompts) :parts)))) (defconst gptel--gemini-models '((gemini-pro-latest diff --git a/gptel-kagi.el b/gptel-kagi.el index c1647654..97a8d9a7 100644 --- a/gptel-kagi.el +++ b/gptel-kagi.el @@ -117,15 +117,6 @@ "")))) prompts))))) -(cl-defmethod gptel--wrap-user-prompt ((_backend gptel-kagi) prompts) - (cond - ((plist-get prompts :url) - (message "Ignoring gptel context for URL summary request.")) - ((plist-get prompts :query) - (cl-callf gptel-context--wrap (plist-get prompts :query))) - ((plist-get prompts :text) - (cl-callf gptel-context--wrap (plist-get prompts :text))))) - ;;;###autoload (cl-defun gptel-make-kagi (name &key curl-args stream key @@ -187,7 +178,7 @@ Example: (prog1 backend (setf (alist-get name gptel--known-backends nil nil #'equal) - backend)))) + backend)))) (provide 'gptel-kagi) ;;; gptel-kagi.el ends here diff --git a/gptel-ollama.el b/gptel-ollama.el index 1c5a07af..75256bf3 100644 --- a/gptel-ollama.el +++ b/gptel-ollama.el @@ -242,22 +242,16 @@ format." `(,@(and text-array (list :content (mapconcat #'identity text-array " "))) ,@(and media-array (list :images (vconcat media-array)))))) -(cl-defmethod gptel--wrap-user-prompt ((_backend gptel-ollama) prompts - &optional inject-media) - "Wrap the last user prompt in PROMPTS with the context string. - -If INJECT-MEDIA is non-nil wrap it with base64-encoded media -files in the context." - (if inject-media - ;; Wrap the first user prompt with included media files/contexts - (when-let* ((media-list (gptel-context--collect-media)) - (media-processed (gptel--ollama-parse-multipart media-list))) - (cl-callf (lambda (images) - (vconcat (plist-get media-processed :images) - images)) - (plist-get (car prompts) :images))) - ;; Wrap the last user prompt with included text contexts - (cl-callf gptel-context--wrap (plist-get (car (last prompts)) :content)))) +(cl-defmethod gptel--inject-media ((_backend gptel-ollama) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media)) + (media-processed (gptel--ollama-parse-multipart media-list))) + (cl-callf (lambda (images) + (vconcat (plist-get media-processed :images) + images)) + (plist-get (car prompts) :images)))) ;;;###autoload (cl-defun gptel-make-ollama diff --git a/gptel-openai.el b/gptel-openai.el index c71d9403..d3eea8e9 100644 --- a/gptel-openai.el +++ b/gptel-openai.el @@ -496,33 +496,19 @@ format." into parts-array finally return (vconcat parts-array))) -;; TODO: Does this need to be a generic function? -(cl-defmethod gptel--wrap-user-prompt ((_backend gptel-openai) prompts - &optional inject-media) - "Wrap the last user prompt in PROMPTS with the context string. - -If INJECT-MEDIA is non-nil wrap it with base64-encoded media -files in the context." - (if inject-media - ;; Wrap the first user prompt with included media files/contexts - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf (lambda (current) - (vconcat - (gptel--openai-parse-multipart media-list) - (cl-typecase current - (string `((:type "text" :text ,current))) - (vector current) - (t current)))) - (plist-get (car prompts) :content))) - ;; Wrap the last user prompt with included text contexts +(cl-defmethod gptel--inject-media ((_backend gptel-openai) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) (cl-callf (lambda (current) - (cl-etypecase current - (string (gptel-context--wrap current)) - (vector (if-let* ((wrapped (gptel-context--wrap nil))) - (vconcat `((:type "text" :text ,wrapped)) - current) - current)))) - (plist-get (car (last prompts)) :content)))) + (vconcat + (gptel--openai-parse-multipart media-list) + (cl-typecase current + (string `((:type "text" :text ,current))) + (vector current) + (t current)))) + (plist-get (car prompts) :content)))) ;;;###autoload (cl-defun gptel-make-openai diff --git a/gptel-request.el b/gptel-request.el index e7e2217a..848377c7 100644 --- a/gptel-request.el +++ b/gptel-request.el @@ -699,13 +699,41 @@ reasoning text will be inserted at the end of that buffer." (const :tag "Include but ignore" ignore) (string :tag "Include in buffer"))) -(defvar gptel-context--alist nil +(defcustom gptel-context nil "List of gptel's context sources. -Each entry is of the form - (buffer . (overlay1 overlay2 ...)) -or - (\"path/to/file\").") +The items in this list (file names or buffers) are included with gptel +queries as additional context. + +Each entry can be a file path (string) or a buffer (object, not buffer +name): + + '(\"~/path/to/file1\" + \"./file2\" + # + ...) + +You can also specify context sources with more detail. Overlay regions +in buffers can be specified as + + (buf ov1 ov2 ...) + +where ov1, ov2 are overlays. In this case the text of the overlay +regions is sent instead of the text of the entire buffer. + +Instead of as a string, file paths can also be specified along with +their MIME-types: + + (\"/path/to/image\" :mime \"image/png\") + +gptel tries to guess file MIME types, but is not always successful. +Additional plist keys (besides :mime) are ignored, but support for more +keys may be implemented in the future. + +Usage of context commands (such as `gptel-add' and `gptel-add-file') +will modify this variable. You can also set this variable +buffer-locally, or let-bind it around calls to gptel queries, or via +gptel presets.") (defvar gptel--request-alist nil "Alist of active gptel requests. @@ -932,7 +960,7 @@ content on this line." (if (stringp gptel-use-curl) gptel-use-curl "curl")) (defun gptel--transform-add-context (callback fsm) - (if (and gptel-use-context gptel-context--alist) + (if (and gptel-use-context gptel-context) (gptel-context--wrap callback (plist-get (gptel-fsm-info fsm) :data)) (funcall callback))) @@ -1486,7 +1514,7 @@ implementation, used by OpenAI-compatible APIs and Ollama." This will be injected into the messages list in the prompt to send to the LLM.") -;; FIXME(fsm) unify this with `gptel--wrap-user-prompt', which is a mess +;; FIXME(fsm) unify this with `gptel--inject-media', which is a mess (cl-defgeneric gptel--inject-prompt (_backend data new-prompt &optional _position) "Append NEW-PROMPT to existing prompts in query DATA. @@ -2009,9 +2037,9 @@ Initiate the request when done." ;; 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 + (when (and gptel-context gptel-use-context gptel-track-media (gptel--model-capable-p 'media)) - (gptel--wrap-user-prompt gptel-backend full-prompt 'media)) + (gptel--inject-media gptel-backend full-prompt)) (unless stream (cl-remf info :stream)) (plist-put info :backend gptel-backend) (when gptel-include-reasoning ;Required for next-request-only scope @@ -2211,7 +2239,7 @@ for inclusion into the user prompt for the gptel request." (push (list :text (buffer-substring-no-properties from-pt end)) parts)) (nreverse parts))) -(cl-defgeneric gptel--wrap-user-prompt (backend _prompts) +(cl-defgeneric gptel--inject-media (backend _prompts) "Wrap the last prompt in PROMPTS with gptel's context. PROMPTS is a structure as returned by `gptel--parse-buffer'. diff --git a/gptel-transient.el b/gptel-transient.el index e05ff7aa..5ff31f71 100644 --- a/gptel-transient.el +++ b/gptel-transient.el @@ -388,15 +388,15 @@ which see." gptel--crowdsourced-prompts)) (defun gptel--describe-infix-context () - (if (null gptel-context--alist) "Context" + (if (null gptel-context) "Context" (pcase-let* - ((contexts (gptel-context--collect)) - (buffer-count (length contexts)) + ((buffer-count (length gptel-context)) (`(,file-count ,ov-count) (if (> buffer-count 0) - (cl-loop for (buf-file . ovs) in contexts + (cl-loop for entry in gptel-context + for (buf-file . ovs) = (ensure-list entry) if (bufferp buf-file) - sum (length ovs) into ov-count + sum (if ovs (length ovs) 1) into ov-count else count (stringp buf-file) into file-count finally return (list file-count ov-count)) (list 0 0)))) @@ -443,8 +443,8 @@ which see." (concat (pth "buffer ") (ptv (substring s 1))))) args)))) (setq context - (and gptel-context--alist - (let ((lc (length gptel-context--alist))) + (and gptel-context + (let ((lc (length gptel-context))) (concat (pth " along with ") (ptv (format "%d" lc)) (pth (concat " context source" (and (/= lc 1) "s"))))))) (cond ((member "m" args) @@ -1357,7 +1357,7 @@ supports. See `gptel-track-media' for more information." (transient-define-suffix gptel--infix-context-remove-all () "Clear gptel's context." - :if (lambda () gptel-context--alist) + :if (lambda () gptel-context) :transient 'transient--do-stay :key "-d" :description "Remove all" @@ -1917,7 +1917,7 @@ whether the action is confirmed/cancelled." "Display all contexts from all buffers & files." :transient 'transient--do-exit :key " C" - :if (lambda () gptel-context--alist) + :if (lambda () gptel-context) :description "Inspect context" (interactive) (gptel-context--buffer-setup)) diff --git a/gptel.el b/gptel.el index 51d7b7a5..1c8eeb4c 100644 --- a/gptel.el +++ b/gptel.el @@ -572,25 +572,26 @@ which see for BEG, END and PRE." 'mouse-face 'highlight 'help-echo "System message for session")) (context - (and gptel-context--alist - (cl-loop for entry in gptel-context--alist - if (bufferp (car entry)) count it into bufs - else count (stringp (car entry)) into files - finally return - (propertize - (buttonize - (concat "[Context: " - (and (> bufs 0) (format "%d buf" bufs)) - (and (> bufs 1) "s") - (and (> bufs 0) (> files 0) ", ") - (and (> files 0) (format "%d file" files)) - (and (> files 1) "s") - "]") - (lambda (&rest _) - (require 'gptel-context) - (gptel-context--buffer-setup))) - 'mouse-face 'highlight - 'help-echo "Active gptel context")))) + (and gptel-context + (cl-loop + for entry in gptel-context + if (bufferp (or (car-safe entry) entry)) count it into bufs + else count (stringp (or (car-safe entry) entry)) into files + finally return + (propertize + (buttonize + (concat "[Context: " + (and (> bufs 0) (format "%d buf" bufs)) + (and (> bufs 1) "s") + (and (> bufs 0) (> files 0) ", ") + (and (> files 0) (format "%d file" files)) + (and (> files 1) "s") + "]") + (lambda (&rest _) + (require 'gptel-context) + (gptel-context--buffer-setup))) + 'mouse-face 'highlight + 'help-echo "Active gptel context")))) (toggle-track-media (lambda (&rest _) (setq-local gptel-track-media