+++ /dev/null
-;;; gptel-anthropic.el --- Anthropic AI suppport for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for Anthropic's Messages API to gptel
-
-;;; Code:
-(require 'cl-generic)
-(require 'cl-lib)
-(require 'map)
-(require 'gptel)
-
-(defvar json-object-type)
-
-(declare-function prop-match-value "text-property-search")
-(declare-function text-property-search-backward "text-property-search")
-(declare-function json-read "json" ())
-(declare-function gptel-context--wrap "gptel-context")
-(declare-function gptel-context--collect-media "gptel-context")
-
-;;; Anthropic (Messages API)
-(cl-defstruct (gptel-anthropic (:constructor gptel--make-anthropic)
- (:copier nil)
- (:include gptel-backend)))
-
-;; NOTE the crucial difference between
-;; - (push val (plist-get info :key)) and
-;; (plist-put (plist-get info :key) (cons val ...))
-;;
-;; - (setf (plist-get info :key) val) and
-;; (plist-put info :key val)
-;;
-;; in the following function. The first variant conses at the head of info, the
-;; second one at the tail. This means only the second option is viable for
-;; mutating a plist function argument that's passed by reference.
-;; Do NOT change the plist-put to push or setf!
-
-;; NOTE: The stream parser looks complicated only because it handles streaming
-;; tool calls, streaming "thinking" blocks and their interactions. Stream
-;; parsing is simple: if you are studying this code, look instead at a commit
-;; from before tool-use support was added to gptel.
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-anthropic) info)
- "Parse an Anthropic data stream.
-
-Return the text response accumulated since the last call to this
-function. Additionally, mutate state INFO to add tool-use
-information if the stream contains it. Not my best work, I know."
- (let* ((content-strs)
- (pt (point)))
- (condition-case nil
- (while (re-search-forward "^event: " nil t)
- (setq pt (match-beginning 0))
- (if (equal (line-end-position) (point-max))
- (error "Data block incomplete"))
- (cond
- ((looking-at "content_block_delta") ;collect incremental
- (forward-line 1) (forward-char 5) ;text, tool or thinking block
- (when-let* ((delta (plist-get (gptel--json-read) :delta)))
- (if-let* ((content (plist-get delta :text))
- ((not (eq content :null))))
- (push content content-strs) ;collect text
- (if-let* ((partial-json (plist-get delta :partial_json)))
- (plist-put ;collect partial tool input
- info :partial_json
- (cons partial-json (plist-get info :partial_json)))
- (if-let* ((thinking (plist-get delta :thinking)))
- (plist-put info :reasoning
- (concat (plist-get info :reasoning) thinking))
- (if-let* ((signature (plist-get delta :signature)))
- (plist-put info :signature
- (concat (plist-get info :signature) signature))))))))
-
- ((looking-at "content_block_start") ;Is the following block text or tool-use?
- (forward-line 1) (forward-char 5)
- (when-let* ((cblock (plist-get (gptel--json-read) :content_block)))
- (pcase (plist-get cblock :type)
- ("text" (push (plist-get cblock :text) content-strs))
- ("tool_use" (plist-put info :tool-use
- (cons (list :id (plist-get cblock :id)
- :name (plist-get cblock :name))
- (plist-get info :tool-use))))
- ("thinking" (plist-put info :reasoning (plist-get cblock :thinking))
- (plist-put info :reasoning-block 'in)))))
-
- ((looking-at "content_block_stop")
- (cond
- ((plist-get info :partial_json) ;End of tool block
- (condition-case-unless-debug nil ;Combine partial tool inputs
- (let* ((args-json (apply #'concat (nreverse (plist-get info :partial_json))))
- (args-decoded ;Handle blank argument strings
- (if (string-empty-p args-json)
- nil (gptel--json-read-string args-json))))
- ;; Add the input to the tool-call spec
- (plist-put (car (plist-get info :tool-use)) :input args-decoded))
- ;; If there was an error in reading that tool, we ignore it:
- ;; TODO(tool) handle this error better
- (error (pop (plist-get info :tool-use)))) ;TODO: nreverse :tool-use list
- (plist-put info :partial_json nil))
-
- ((eq (plist-get info :reasoning-block) 'in) ;End of reasoning block
- (plist-put info :reasoning-block t)))) ;Signal end of reasoning stream to filter
-
- ((looking-at "message_delta")
- ;; collect stop_reason, usage_tokens and prepare tools
- (forward-line 1) (forward-char 5)
- (when-let* ((tool-use (plist-get info :tool-use))
- (response (gptel--json-read)))
- (let* ((data (plist-get info :data))
- (prompts (plist-get data :messages)))
- (plist-put ; Append a COPY of response text + tool-use to the prompts list
- data :messages
- (vconcat
- prompts
- `((:role "assistant"
- :content ,(vconcat ;Insert any LLM text and thinking text
- (and-let* ((reasoning (plist-get info :partial_reasoning)))
- `((:type "thinking" :thinking ,reasoning
- :signature ,(plist-get info :signature))))
- (and-let* ((strs (plist-get info :partial_text)))
- `((:type "text" :text ,(apply #'concat (nreverse strs)))))
- (mapcar (lambda (tool-call) ;followed by the tool calls
- (append (list :type "tool_use")
- (copy-sequence tool-call)))
- tool-use))))))
- (plist-put info :partial_text nil) ; Clear any captured text
- ;; Then shape the tool-use block by adding args so we can call the functions
- (mapc (lambda (tool-call)
- (plist-put tool-call :args (plist-get tool-call :input))
- (plist-put tool-call :input nil)
- (plist-put tool-call :id (plist-get tool-call :id)))
- tool-use))
- (plist-put info :output-tokens
- (map-nested-elt response '(:usage :output_tokens)))
- (plist-put info :stop-reason
- (map-nested-elt response '(:delta :stop_reason)))))))
- (error (goto-char pt)))
- (let ((response-text (apply #'concat (nreverse content-strs))))
- (unless (string-empty-p response-text)
- (plist-put info :partial_text
- (cons response-text (plist-get info :partial_text))))
- (when (plist-get info :tools)
- (when-let* ((reasoning (plist-get info :reasoning)))
- (plist-put info :partial_reasoning
- (concat (plist-get info :partial_reasoning) reasoning))))
- response-text)))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-anthropic) response info)
- "Parse an Anthropic (non-streaming) RESPONSE and return response text.
-
-Mutate state INFO with response metadata."
- (plist-put info :stop-reason (plist-get response :stop_reason))
- (plist-put info :output-tokens
- (map-nested-elt response '(:usage :output_tokens)))
- (cl-loop
- with content = (plist-get response :content)
- for cblock across content
- for type = (plist-get cblock :type)
- if (equal type "text")
- ;; TODO(tool) can :text be :null?
- collect (plist-get cblock :text) into content-strs
- else if (equal type "tool_use")
- collect cblock into tool-use
- else if (equal type "thinking")
- do
- (plist-put
- info :reasoning
- (concat (plist-get info :reasoning)
- (plist-get cblock :thinking)))
- finally do
- (when tool-use
- ;; First, add the tool call to the prompts list
- (let* ((data (plist-get info :data))
- (prompts (plist-get data :messages)))
- (plist-put
- data :messages
- (vconcat prompts `((:role "assistant" :content ,content)))))
- ;; Then capture the tool call data for running the tool
- (cl-loop
- for call-raw in tool-use
- for call = (copy-sequence call-raw) do
- (plist-put call :args (plist-get call :input))
- (plist-put call :input nil)
- (plist-put call :id (plist-get call :id))
- collect call into calls
- finally do (plist-put info :tool-use calls)))
- finally return
- (and content-strs (apply #'concat content-strs))))
-
-(cl-defmethod gptel--request-data ((backend gptel-anthropic) prompts)
- "JSON encode PROMPTS for sending to ChatGPT."
- (let ((prompts-plist
- `( :model ,(gptel--model-name gptel-model)
- :stream ,(or gptel-stream :json-false)
- :max_tokens ,(or gptel-max-tokens 4096)
- :messages [,@prompts]))
- (cachep (and (or (eq gptel-cache t) (memq 'system gptel-cache))
- (gptel--model-capable-p 'cache))))
- (when gptel--system-message
- ;; gptel--system-message is a string or a list of strings
- (plist-put
- prompts-plist :system
- (cond
- ((consp gptel--system-message) ;multi-part system message
- (vconcat (mapcar (lambda (part)
- (nconc (list :type "text" :text part)
- (and cachep
- (list :cache_control
- '(:type "ephemeral")))))
- gptel--system-message)))
- (cachep `[(:type "text" :text ,gptel--system-message
- :cache_control (:type "ephemeral"))])
- (t gptel--system-message))))
- (when gptel-temperature
- (plist-put prompts-plist :temperature gptel-temperature))
- (when gptel-use-tools
- (when (eq gptel-use-tools 'force)
- (plist-put prompts-plist :tool_choice '(:type "any")))
- (when gptel-tools
- (let ((tools-array (gptel--parse-tools backend gptel-tools)))
- (plist-put prompts-plist :tools tools-array)
- (when (and (or (eq gptel-cache t) (memq 'tool gptel-cache))
- (gptel--model-capable-p 'cache))
- (nconc (aref tools-array (1- (length tools-array)))
- '(:cache_control (:type "ephemeral")))))))
- (when gptel--schema
- (plist-put prompts-plist :tools
- (vconcat
- (list (gptel--parse-schema backend gptel--schema))
- (plist-get prompts-plist :tools)))
- (plist-put prompts-plist :tool_choice
- `(:type "tool" :name ,gptel--ersatz-json-tool)))
- ;; Merge request params with model and backend params.
- (gptel--merge-plists
- prompts-plist
- gptel--request-params
- (gptel-backend-request-params gptel-backend)
- (gptel--model-request-params gptel-model))))
-
-(cl-defmethod gptel--parse-schema ((_backend gptel-anthropic) schema)
- ;; Unlike the other backends, Anthropic generates JSON using a tool call. We
- ;; write the tool here, meant to be added to :tools.
- (list
- :name "response_json"
- :description "Record JSON output according to user prompt"
- :input_schema (gptel--preprocess-schema
- (gptel--dispatch-schema-type schema))))
-
-(cl-defmethod gptel--parse-tools ((_backend gptel-anthropic) tools)
- "Parse TOOLS to the Anthropic API tool definition spec.
-
-TOOLS is a list of `gptel-tool' structs, which see."
- (vconcat
- (mapcar
- (lambda (tool)
- (list :name (gptel-tool-name tool)
- :description (gptel-tool-description tool)
- :input_schema ;NOTE: Anthropic wants "{}" if the function takes no args, not null
- (list :type "object"
- ;; See the generic implementation for an explanation of this
- ;; transformation.
- :properties
- (cl-loop
- for arg in (gptel-tool-args tool)
- for argspec = (copy-sequence arg)
- for name = (plist-get arg :name) ;handled differently
- for newname = (or (and (keywordp name) name)
- (make-symbol (concat ":" name)))
- do ;ARGSPEC is ARG without unrecognized keys
- (cl-remf argspec :name)
- (cl-remf argspec :optional)
- if (equal (plist-get arg :type) "object")
- do (unless (plist-member argspec :required)
- (plist-put argspec :required []))
- append (list newname argspec))
- :required
- (vconcat
- (delq nil (mapcar
- (lambda (arg) (and (not (plist-get arg :optional))
- (plist-get arg :name)))
- (gptel-tool-args tool)))))))
- (ensure-list tools))))
-
-(cl-defmethod gptel--parse-tool-results ((_backend gptel-anthropic) tool-use)
- "Return a prompt containing tool call results in TOOL-USE.
-
-TOOL-USE is a list of plists containing tool names, arguments and call results."
- ;; (declare (side-effect-free t))
- (list
- :role "user"
- :content
- (vconcat
- (mapcar
- (lambda (tool-call)
- (let* ((result (plist-get tool-call :result))
- (formatted
- (list :type "tool_result"
- :tool_use_id (plist-get tool-call :id)
- :content (if (stringp result) result
- (prin1-to-string result)))))
- (prog1 formatted
- (when (plist-get tool-call :error)
- (plist-put formatted :is_error t)))))
- tool-use))))
-
-;; NOTE: No `gptel--inject-prompt' method required for gptel-anthropic, since
-;; this is handled by its defgeneric implementation
-
-;; TODO: Remove these functions (#792)
-(defun gptel--anthropic-format-tool-id (tool-id)
- (unless tool-id
- (setq tool-id (substring
- (md5 (format "%s%s" (random) (float-time)))
- nil 24)))
- (if (or (string-prefix-p "call_" tool-id)
- (string-prefix-p "toolu_" tool-id))
- tool-id
- (format "toolu_%s" tool-id)))
-
-(defun gptel--anthropic-unformat-tool-id (tool-id)
- (or (and (string-match "toolu_\\(.+\\)" tool-id)
- (match-string 1 tool-id))
- tool-id))
-
-(cl-defmethod gptel--parse-list ((backend gptel-anthropic) prompt-list)
- (let ((full-prompt
- (if (consp (car prompt-list))
- (let ((prompts))
- (dolist (entry prompt-list) ; Advanced format, list of lists
- (pcase entry
- (`(prompt . ,msg)
- (push (list :role "user"
- :content `[(:type "text" :text ,(or (car-safe msg) msg))])
- prompts))
- (`(response . ,msg)
- (push (list :role "assistant"
- :content `[(:type "text" :text ,(or (car-safe msg) msg))])
- prompts))
- (`(tool . ,call)
- (unless (plist-get call :id)
- (plist-put call :id (gptel--anthropic-format-tool-id nil)))
- (push (list :role "assistant"
- :content `[( :type "tool_use" :id ,(plist-get call :id)
- :name ,(plist-get call :name)
- :input ,(plist-get call :args))])
- prompts)
- (push (gptel--parse-tool-results backend (list (cdr entry))) prompts))))
- (nreverse prompts))
- (cl-loop for text in prompt-list ; Simple format, list of strings
- for role = t then (not role)
- if text
- collect (list :role (if role "user" "assistant")
- :content `[(:type "text" :text ,text)])))))
- ;; cache messages if required: add cache_control to the last message
- (when (and (or (eq gptel-cache t) (memq 'message gptel-cache))
- (gptel--model-capable-p 'cache))
- (nconc (aref (plist-get (car (last full-prompt)) :content) 0)
- '(:cache_control (:type "ephemeral"))))
- full-prompt))
-
-(cl-defmethod gptel--parse-buffer ((backend gptel-anthropic) &optional max-entries)
- (let ((prompts) (prev-pt (point)))
- (if (or gptel-mode gptel-track-response)
- (while (and (or (not max-entries) (>= max-entries 0))
- (goto-char (previous-single-property-change
- (point) 'gptel nil (point-min)))
- (not (= (point) prev-pt)))
- ;; HACK Until we can find a more robust solution for editing
- ;; responses, ignore prompts containing only whitespace, as the
- ;; Anthropic API can't handle it. See #452, #409, #406, #351 and #321
- ;; We check for blank prompts by skipping whitespace and comparing
- ;; point against the previous.
- (unless (save-excursion (skip-syntax-forward " ") (>= (point) prev-pt))
- (pcase (get-char-property (point) 'gptel)
- ('response
- (when-let* ((content
- (gptel--trim-prefixes
- (buffer-substring-no-properties (point) prev-pt))))
- (when (not (string-blank-p content))
- (push (list :role "assistant" :content content) prompts))))
- (`(tool . ,id)
- (save-excursion
- (condition-case nil
- (let* ((tool-call (read (current-buffer)))
- ;; (id (gptel--anthropic-format-tool-id id))
- (name (plist-get tool-call :name))
- (arguments (plist-get tool-call :args)))
- (unless id (setq id (gptel--anthropic-format-tool-id nil)))
- (plist-put tool-call :id id)
- (plist-put tool-call :result
- (string-trim (buffer-substring-no-properties
- (point) prev-pt)))
- (push (gptel--parse-tool-results backend (list tool-call))
- prompts)
- (push (list :role "assistant"
- :content `[( :type "tool_use" :id ,id :name ,name
- :input ,arguments)])
- prompts))
- ((end-of-file invalid-read-syntax)
- (message (format "Could not parse tool-call %s on line %s"
- id (line-number-at-pos (point))))))))
- ('ignore)
- ('nil ; user role: possibly with media
- (if gptel-track-media
- (when-let* ((content (gptel--anthropic-parse-multipart
- (gptel--parse-media-links major-mode (point) prev-pt))))
- (when (> (length content) 0)
- (push (list :role "user" :content content) prompts)))
- (when-let* ((content (gptel--trim-prefixes
- (buffer-substring-no-properties (point) prev-pt))))
- (push (list :role "user" :content content) prompts))))))
- (setq prev-pt (point))
- (and max-entries (cl-decf max-entries)))
- (when-let* ((content (string-trim (buffer-substring-no-properties
- (point-min) (point-max)))))
- ;; XXX fails if content is empty. The correct error behavior is left to
- ;; a future discussion.
- (push (list :role "user" :content content) prompts)))
- ;; Cache messages if required: add cache_control to the last message
- (if (and (or (eq gptel-cache t) (memq 'message gptel-cache))
- (gptel--model-capable-p 'cache))
- (let ((last-message (plist-get (car (last prompts)) :content)))
- (if (stringp last-message)
- (plist-put
- (car (last prompts)) :content
- `[(:type "text" :text ,last-message
- :cache_control (:type "ephemeral"))])
- (nconc (aref (plist-get (car (last prompts)) :content) 0)
- '(:cache_control (:type "ephemeral"))))))
- prompts))
-
-(defun gptel--anthropic-parse-multipart (parts)
- "Convert a multipart prompt PARTS to the Anthropic API format.
-
-The input is an alist of the form
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\")).
-
-The output is a vector of entries in a backend-appropriate
-format."
- (cl-loop
- for part in parts
- for n upfrom 1
- with last = (length parts)
- with type
- for text = (plist-get part :text)
- for mime = (plist-get part :mime)
- for media = (plist-get part :media)
- if text do
- (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and
- if text
- collect `(:type "text" :text ,text) into parts-array end
- else if media
- do
- (setq type (cond ;Currently supported: Images and PDFs
- ((equal (substring mime 0 5) "image") "image")
- ;; NOTE: Only Claude 3.5 Sonnet supports PDF documents:
- ((equal mime "application/pdf") "document")
- (t (error (concat "(gptel-anthropic) Request aborted: "
- "trying to send unsupported MIME type %s")
- mime))))
- and collect
- `(:type ,type
- :source (:type "base64"
- :media_type ,(plist-get part :mime)
- :data ,(gptel--base64-encode media)))
- into parts-array
- else if (plist-get part :textfile) collect
- `(:type "text"
- :text ,(with-temp-buffer
- (gptel--insert-file-string (plist-get part :textfile))
- (buffer-string)))
- into parts-array
- finally return (vconcat parts-array)))
-
-(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)
- (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))
-;; (vector (vconcat `((:type "text" :text ,previous))
-;; previous))
-;; (t context-string)))
-;; (plist-get (car (last prompts)) :content)))
-
-(defconst gptel--anthropic-models
- '((claude-sonnet-4-5-20250929
- :description "High-performance model with exceptional reasoning and efficiency"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 3
- :output-cost 15
- :cutoff-date "2025-07")
- (claude-haiku-4-5-20251001
- :description "Near-frontier intelligence at blazing speeds with extended thinking"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 1
- :output-cost 5
- :cutoff-date "2025-02")
- (claude-sonnet-4-20250514
- :description "High-performance model with exceptional reasoning and efficiency"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 3
- :output-cost 15
- :cutoff-date "2025-03")
- (claude-opus-4-5-20251101
- :description "Most capable model for complex reasoning and advanced coding"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 5
- :output-cost 25
- :cutoff-date "2025-03")
- (claude-opus-4-1-20250805
- :description "Most capable model for complex reasoning and advanced coding"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 15
- :output-cost 75
- :cutoff-date "2025-03")
- (claude-opus-4-20250514
- :description "Anthropic's previous flagship model"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 15
- :output-cost 75
- :cutoff-date "2025-03")
- (claude-3-7-sonnet-20250219
- :description "Hybrid model capable of standard thinking and extended thinking modes"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 3
- :output-cost 15
- :cutoff-date "2025-02")
- (claude-3-5-sonnet-20241022
- :description "Highest level of intelligence and capability"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 200
- :input-cost 3
- :output-cost 15
- :cutoff-date "2024-04")
- (claude-3-5-sonnet-20240620
- :description "Highest level of intelligence and capability (earlier version)"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 200
- :input-cost 3
- :output-cost 15
- :cutoff-date "2024-04")
- (claude-3-5-haiku-20241022
- :description "Intelligence at blazing speeds"
- :capabilities (tool-use cache)
- :context-window 200
- :input-cost 1.00
- :output-cost 5.00
- :cutoff-date "2024-07")
- (claude-3-opus-20240229
- :description "Top-level performance, intelligence, fluency, and understanding"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 200
- :input-cost 15
- :output-cost 75
- :cutoff-date "2023-08")
- (claude-3-haiku-20240307
- :description "Fast and most compact model for near-instant responsiveness"
- :capabilities (tool-use cache)
- :context-window 200
- :input-cost 0.25
- :output-cost 1.25
- :cutoff-date "2023-08"))
- "List of available Anthropic models and associated properties.
-Keys:
-
-- `:description': a brief description of the model.
-
-- `:capabilities': a list of capabilities supported by the model.
-
-- `:mime-types': a list of supported MIME types for media files.
-
-- `:context-window': the context window size, in thousands of tokens.
-
-- `:input-cost': the input cost, in US dollars per million tokens.
-
-- `:output-cost': the output cost, in US dollars per million tokens.
-
-- `:cutoff-date': the knowledge cutoff date.
-
-- `:request-params': a plist of additional request parameters to
- include when using this model.
-
-Information about the Anthropic models was obtained from the following
-comparison table:
-
-URL `https://docs.anthropic.com/en/docs/about-claude/models#model-comparison-table'")
-
-;;;###autoload
-(cl-defun gptel-make-anthropic
- (name &key curl-args stream key request-params
- (header
- (lambda () (when-let* ((key (gptel--get-api-key)))
- `(("x-api-key" . ,key)
- ("anthropic-version" . "2023-06-01")
- ("anthropic-beta" . "extended-cache-ttl-2025-04-11")))))
- (models gptel--anthropic-models)
- (host "api.anthropic.com")
- (protocol "https")
- (endpoint "/v1/messages"))
- "Register an Anthropic API-compatible backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, \"api.anthropic.com\" by default.
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--anthropic-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(claude-3-haiku-20240307 ;Simple specs
- claude-3-opus-20240229
- (claude-3-5-sonnet-20240620 ;Full spec
- :description \"Balance of intelligence and speed\"
- :capabilities (media tool json)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1/messages\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for."
- (declare (indent 1))
- (let ((backend (gptel--make-anthropic
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :url (if protocol
- (concat protocol "://" host endpoint)
- (concat host endpoint)))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-(provide 'gptel-anthropic)
-;;; gptel-anthropic.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not docstrings)
-;; End:
-
+++ /dev/null
-;;; gptel-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
-;; Generated by the `loaddefs-generate' function.
-
-;; This file is part of GNU Emacs.
-
-;;; Code:
-
-(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
-
-
-\f
-;;; Generated autoloads from gptel.el
-
-(autoload 'gptel-mode "gptel" "\
-Minor mode for interacting with LLMs.
-
-This is a minor mode. If called interactively, toggle the `GPTel mode'
-mode. If the prefix argument is positive, enable the mode, and if it is
-zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the mode
-if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate the variable `gptel-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-(fn &optional ARG)" t)
-(autoload 'gptel-send "gptel" "\
-Submit this prompt to the current LLM backend.
-
-By default, the contents of the buffer up to the cursor position
-are sent. If the region is active, its contents are sent
-instead.
-
-The response from the LLM is inserted below the cursor position
-at the time of sending. To change this behavior or model
-parameters, use prefix arg ARG activate a transient menu with
-more options instead.
-
-This command is asynchronous, you can continue to use Emacs while
-waiting for the response.
-
-(fn &optional ARG)" t)
-(autoload 'gptel "gptel" "\
-Switch to or start a chat session with NAME.
-
-Ask for API-KEY if `gptel-api-key' is unset.
-
-If region is active, use it as the INITIAL prompt. Returns the
-buffer created or switched to.
-
-INTERACTIVEP is t when gptel is called interactively.
-
-(fn NAME &optional _ INITIAL INTERACTIVEP)" t)
-(register-definition-prefixes "gptel" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-anthropic.el
-
-(autoload 'gptel-make-anthropic "gptel-anthropic" "\
-Register an Anthropic API-compatible backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, \"api.anthropic.com\" by default.
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--anthropic-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(claude-3-haiku-20240307 ;Simple specs
- claude-3-opus-20240229
- (claude-3-5-sonnet-20240620 ;Full spec
- :description \"Balance of intelligence and speed\"
- :capabilities (media tool json)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1/messages\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"x-api-key\" \\=\\, key) (\"anthropic-version\" . \"2023-06-01\") (\"anthropic-beta\" . \"extended-cache-ttl-2025-04-11\"))))) (MODELS gptel--anthropic-models) (HOST \"api.anthropic.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/messages\"))")
-(function-put 'gptel-make-anthropic 'lisp-indent-function 1)
-(register-definition-prefixes "gptel-anthropic" '("gptel--anthropic-"))
-
-\f
-;;; Generated autoloads from gptel-bedrock.el
-
-(autoload 'gptel-make-bedrock "gptel-bedrock" "\
-Register an AWS Bedrock backend for gptel with NAME.
-
-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.
-
-(fn NAME &key REGION (MODELS gptel--bedrock-models) (MODEL-REGION nil) STREAM CURL-ARGS REQUEST-PARAMS AWS-PROFILE AWS-BEARER-TOKEN (PROTOCOL \"https\"))")
-(function-put 'gptel-make-bedrock 'lisp-indent-function 1)
-(register-definition-prefixes "gptel-bedrock" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-context.el
-
- (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t)
- (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t)
-(autoload 'gptel-context--wrap "gptel-context" "\
-Add request context to DATA-BUF and run CALLBACK.
-
-DATA-BUF is the buffer where the request prompt is constructed.
-
-(fn CALLBACK DATA-BUF)")
-(autoload 'gptel-context--collect "gptel-context" "\
-Get the list of all active context sources from CONTEXT-ALIST.
-
-CONTEXT-ALIST defaults to the current value of `gptel-context'.
-
-Ignore overlays, buffers and files that are not live or readable.
-
-(fn &optional CONTEXT-ALIST)")
-(register-definition-prefixes "gptel-context" '("gptel-context-"))
-
-\f
-;;; Generated autoloads from gptel-gemini.el
-
-(autoload 'gptel-make-gemini "gptel-gemini" "\
-Register a Gemini backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, defaults to
-\"generativelanguage.googleapis.com\".
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--gemini-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(gemini-2.0-flash-lite ;Simple specs
- gemini-1.5-flash
- (gemini-1.5-pro-latest ;Full spec
- :description
- \"Complex reasoning tasks, problem solving and data extraction\"
- :capabilities (tool json)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\")))
-
-
-STREAM is a boolean to enable streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, \"https\" by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1beta/models\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-(fn NAME &key CURL-ARGS HEADER KEY REQUEST-PARAMS (STREAM nil) (HOST \"generativelanguage.googleapis.com\") (PROTOCOL \"https\") (MODELS gptel--gemini-models) (ENDPOINT \"/v1beta/models\"))")
-(function-put 'gptel-make-gemini 'lisp-indent-function 1)
-(register-definition-prefixes "gptel-gemini" '("gptel--gemini-"))
-
-\f
-;;; Generated autoloads from gptel-gh.el
-
-(autoload 'gptel-make-gh-copilot "gptel-gh" "\
-Register a Github Copilot chat backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, typically \"api.githubcopilot.com\".
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--openai-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(gpt-3.5-turbo ;Simple specs
- gpt-4-turbo
- (gpt-4o-mini ;Full spec
- :description
- \"Affordable and intelligent small model for lightweight tasks\"
- :capabilities (media tool json url)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
-
-Defaults to a list of models supported by GitHub Copilot.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/chat/completions\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that returns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-Defaults to headers required by GitHub Copilot.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-(fn NAME &key CURL-ARGS REQUEST-PARAMS (HEADER (lambda nil (gptel--gh-auth) \\=`((\"openai-intent\" . \"conversation-panel\") (\"authorization\" \\=\\, (concat \"Bearer \" (plist-get (gptel--gh-token gptel-backend) :token))) (\"x-request-id\" \\=\\, (gptel--gh-uuid)) (\"vscode-sessionid\" \\=\\, (or (gptel--gh-sessionid gptel-backend) \"\")) (\"vscode-machineid\" \\=\\, (or (gptel--gh-machineid gptel-backend) \"\")) ,@(when (and gptel-track-media (gptel--model-capable-p \\='media)) \\=`((\"copilot-vision-request\" . \"true\"))) (\"copilot-integration-id\" . \"vscode-chat\")))) (HOST \"api.githubcopilot.com\") (PROTOCOL \"https\") (ENDPOINT \"/chat/completions\") (STREAM t) (MODELS gptel--gh-models))")
-(function-put 'gptel-make-gh-copilot 'lisp-indent-function 1)
-(register-definition-prefixes "gptel-gh" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-integrations.el
-
-(register-definition-prefixes "gptel-integrations" '("gptel-mcp-"))
-
-\f
-;;; Generated autoloads from gptel-kagi.el
-
-(autoload 'gptel-make-kagi "gptel-kagi" "\
-Register a Kagi FastGPT backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is the Kagi host (with port), defaults to \"kagi.com\".
-
-MODELS is a list of available Kagi models: only fastgpt is supported.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false. Kagi does not support a streaming API yet.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/api/v0/fastgpt\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-Example:
--------
-
- (gptel-make-kagi \"Kagi\" :key my-kagi-key)
-
-(fn NAME &key CURL-ARGS STREAM KEY (HOST \"kagi.com\") (HEADER (lambda nil \\=`((\"Authorization\" \\=\\, (concat \"Bot \" (gptel--get-api-key)))))) (MODELS \\='((fastgpt :capabilities (nosystem)) (summarize:cecil :capabilities (nosystem)) (summarize:agnes :capabilities (nosystem)) (summarize:daphne :capabilities (nosystem)) (summarize:muriel :capabilities (nosystem)))) (PROTOCOL \"https\") (ENDPOINT \"/api/v0/\"))")
-(function-put 'gptel-make-kagi 'lisp-indent-function 1)
-
-\f
-;;; Generated autoloads from gptel-ollama.el
-
-(autoload 'gptel-make-ollama "gptel-ollama" "\
-Register an Ollama backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is where Ollama runs (with port), defaults to localhost:11434
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-Currently recognized plist keys are :description, :capabilities
-and :mime-types. An example of a model specification including
-both kinds of specs:
-
-:models
-\\='(mistral:latest ;Simple specs
- openhermes:latest
- (llava:13b ;Full spec
- :description
- \"Llava 1.6: Large Lanuage and Vision Assistant\"
- :capabilities (media)
- :mime-types (\"image/jpeg\" \"image/png\")))
-
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, http by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/api/generate\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key. This is typically not required
-for local models like Ollama.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-Example:
--------
-
- (gptel-make-ollama
- \"Ollama\"
- :host \"localhost:11434\"
- :models \\='(mistral:latest)
- :stream t)
-
-(fn NAME &key CURL-ARGS HEADER KEY MODELS STREAM REQUEST-PARAMS (HOST \"localhost:11434\") (PROTOCOL \"http\") (ENDPOINT \"/api/chat\"))")
-(function-put 'gptel-make-ollama 'lisp-indent-function 1)
-(register-definition-prefixes "gptel-ollama" '("gptel--ollama-"))
-
-\f
-;;; Generated autoloads from gptel-openai.el
-
-(autoload 'gptel-make-openai "gptel-openai" "\
-Register an OpenAI API-compatible backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, typically \"api.openai.com\".
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--openai-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(gpt-3.5-turbo ;Simple specs
- gpt-4-turbo
- (gpt-4o-mini ;Full spec
- :description
- \"Affordable and intelligent small model for lightweight tasks\"
- :capabilities (media tool json url)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1/chat/completions\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that returns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-(fn NAME &key CURL-ARGS MODELS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.openai.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\"))")
-(function-put 'gptel-make-openai 'lisp-indent-function 1)
-(autoload 'gptel-make-azure "gptel-openai" "\
-Register an Azure backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is the API host.
-
-MODELS is a list of available model names, as symbols.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT is the API endpoint for completions.
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-Example:
--------
-
- (gptel-make-azure
- \"Azure-1\"
- :protocol \"https\"
- :host \"RESOURCE_NAME.openai.azure.com\"
- :endpoint
- \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\"
- :stream t
- :models \\='(gpt-3.5-turbo gpt-4))
-
-(fn NAME &key CURL-ARGS HOST (PROTOCOL \"https\") (HEADER (lambda nil \\=`((\"api-key\" \\=\\, (gptel--get-api-key))))) (KEY \\='gptel-api-key) MODELS STREAM ENDPOINT REQUEST-PARAMS)")
-(function-put 'gptel-make-azure 'lisp-indent-function 1)
-(defalias 'gptel-make-gpt4all 'gptel-make-openai "\
-Register a GPT4All backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is where GPT4All runs (with port), typically localhost:4891
-
-MODELS is a list of available model names, as symbols.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/api/v1/completions\"
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
-((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key. This is typically not required for
-local models like GPT4All.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-Example:
--------
-
-(gptel-make-gpt4all
- \"GPT4All\"
- :protocol \"http\"
- :host \"localhost:4891\"
- :models \\='(mistral-7b-openorca.Q4_0.gguf))")
-(register-definition-prefixes "gptel-openai" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-openai-extras.el
-
-(autoload 'gptel-make-privategpt "gptel-openai-extras" "\
-Register an Privategpt API-compatible backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, \"api.privategpt.com\" by default.
-
-MODELS is a list of available model names.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1/messages\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
-((\"Content-Type\" . \"application/json\"))
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-CONTEXT and SOURCES: if true (the default), use available context
-and provide sources used by the model to generate the response.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"localhost:8001\") (PROTOCOL \"http\") (MODELS \\='(private-gpt)) (ENDPOINT \"/v1/chat/completions\") (CONTEXT t) (SOURCES t))")
-(function-put 'gptel-make-privategpt 'lisp-indent-function 1)
-(autoload 'gptel-make-perplexity "gptel-openai-extras" "\
-Register a Perplexity backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, \"api.perplexity.ai\" by default.
-
-MODELS is a list of available model names.
-
-STREAM is a boolean to toggle streaming responses.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions.
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that returns an
-alist.
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters.
-
-(fn NAME &key CURL-ARGS STREAM KEY (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.perplexity.ai\") (PROTOCOL \"https\") (MODELS \\='(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research)) (ENDPOINT \"/chat/completions\") REQUEST-PARAMS)")
-(function-put 'gptel-make-perplexity 'lisp-indent-function 1)
-(autoload 'gptel-make-deepseek "gptel-openai-extras" "\
-Register a DeepSeek backend for gptel with NAME.
-
-For the meanings of the keyword arguments, see `gptel-make-openai'.
-
-(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.deepseek.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((deepseek-reasoner :capabilities (tool reasoning) :context-window 128 :input-cost 0.56 :output-cost 1.68) (deepseek-chat :capabilities (tool) :context-window 128 :input-cost 0.56 :output-cost 1.68))))")
-(function-put 'gptel-make-deepseek 'lisp-indent-function 1)
-(autoload 'gptel-make-xai "gptel-openai-extras" "\
-Register an xAI backend for gptel with NAME.
-
-Keyword arguments:
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-The other keyword arguments are all optional. For their meanings
-see `gptel-make-openai'.
-
-(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \&t-window 131 :input-cost 5 :output-cost 25) (grok-3-mini :description \"Mini Grok 3\" :capabilities (tool-use json reasoning) :context-window 131 :input-cost 0.3 :output-cost 0.5) (grok-3-mini-fast :description \"Faster mini Grok 3\" :capabilities (tool-use json reasoning) :context-window 131072 :input-cost 0.6 :output-cost 4) (grok-2-vision-1212 :description \"Grok 2 Vision\" :capabilities (tool-use json media) :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\") :context-window 32768 :input-cost 2 :output-cost 10))))")
-(function-put 'gptel-make-xai 'lisp-indent-function 1)
-(register-definition-prefixes "gptel-openai-extras" '("gptel--p"))
-
-\f
-;;; Generated autoloads from gptel-org.el
-
-(autoload 'gptel--convert-markdown->org "gptel-org" "\
-Convert string STR from markdown to org markup.
-
-This is a very basic converter that handles only a few markup
-elements.
-
-(fn STR)")
-(autoload 'gptel--stream-convert-markdown->org "gptel-org" "\
-Return a Markdown to Org converter.
-
-This function parses a stream of Markdown text to Org
-continuously when it is called with successive chunks of the
-text stream.
-
-START-MARKER is used to identify the corresponding process when
-cleaning up after.
-
-(fn START-MARKER)")
-(register-definition-prefixes "gptel-org" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-request.el
-
-(autoload 'gptel-curl-get-response "gptel-request" "\
-Fetch response to prompt in state FSM from the LLM using Curl.
-
-FSM is the state machine driving this request.
-
-FSM is the state machine driving this request. Its INFO slot
-contains the data required for setting up the request. INFO is a
-plist with the following keys, among others:
-- :data (the data being sent)
-- :buffer (the gptel buffer)
-- :position (marker at which to insert the response).
-- :callback (optional, the request callback)
-
-Call CALLBACK with the response and INFO afterwards. If omitted
-the response is inserted into the current buffer after point.
-
-(fn FSM)")
-(register-definition-prefixes "gptel-request" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-rewrite.el
-
- (autoload 'gptel-rewrite "gptel-rewrite" nil t)
-(register-definition-prefixes "gptel-rewrite" '("gptel-"))
-
-\f
-;;; Generated autoloads from gptel-transient.el
-
- (autoload 'gptel-menu "gptel-transient" nil t)
- (autoload 'gptel-system-prompt "gptel-transient" nil t)
- (autoload 'gptel-tools "gptel-transient" nil t)
-(register-definition-prefixes "gptel-transient" '("gptel-"))
-\f
-;;; End of scraped data
-
-(provide 'gptel-autoloads)
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; no-native-compile: t
-;; coding: utf-8-emacs-unix
-;; End:
-
-;;; gptel-autoloads.el ends here
+++ /dev/null
-;;; gptel-bedrock.el --- AWS Bedrock support for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2025 Karthik Chikmagalur
-
-;; Keywords: comm, convenience
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for AWS Bedrock to gptel. Documentation for the request data and the
-;; response payloads can be found at these two links:
-;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html
-;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ConverseStream.html
-
-;;; Code:
-(require 'cl-lib)
-(require 'map)
-(require 'gptel)
-(require 'mail-parse)
-
-(declare-function gptel-context--collect-media "gptel-context")
-(declare-function gptel-context--wrap "gptel-context")
-
-(cl-defstruct (gptel-bedrock (:constructor gptel--make-bedrock)
- (:copier nil)
- (:include gptel-backend))
- model-region)
-
-(defconst gptel-bedrock--prompt-type
- ;; For documentation purposes only -- this describes the type of prompt objects that get passed
- ;; around. https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Message.html
- '(plist
- :role (member "user" "assistant")
- :content (array (or (plist :text string)
- (plist :image (:format (member "png" "jpeg" "gif" "webp")
- :source (plist :bytes string))) ; bytes is b64 encoded
- (plist :document (:format (member "pdf" "csv" "doc" "docx" "xls" "xlsx" "html" "txt" "md")
- :name string
- :source (plist :bytes string))) ; bytes is b64 encoded
- (plist :toolUse (plist :input any :name string :toolUseId string))
- (plist :toolResult (plist
- :toolUseId string
- :status (member "success" "error")
- ;; AWS allows more result types in
- ;; ToolResultContentBlock, but we only send text results
- :content (array (plist :text string))))))))
-
-(cl-defmethod gptel--request-data ((backend gptel-bedrock) prompts)
- "Prepare request data for AWS Bedrock BACKEND from PROMPTS."
- ;; First, build the core Bedrock request data structure.
- (let ((base-request-data
- (nconc
- `(:messages [,@prompts] :inferenceConfig (:maxTokens ,(or gptel-max-tokens 500)))
- (when gptel--system-message `(:system [(:text ,gptel--system-message)]))
- (when gptel-temperature `(:temperature ,gptel-temperature))
- (when (and gptel-use-tools gptel-tools)
- `(:toolConfig (:toolChoice ,(if (eq gptel-use-tools 'force) '(:any '()) '(:auto '()))
- :tools ,(gptel--parse-tools backend gptel-tools)))))))
-
- ;; Finally, merge all potential :request-params sources.
- (gptel--merge-plists
- base-request-data ; The core data we just built
- gptel--request-params ; Global/buffer-local gptel--request-params
- (gptel-backend-request-params backend) ; From `gptel-make-bedrock` call
- (gptel--model-request-params gptel-model)))) ; From the model's properties
-
-(cl-defmethod gptel--parse-tools ((_backend gptel-bedrock) tools)
- "Parse TOOLS and return a list of ToolSpecification objects.
-
-TOOLS is a list of `gptel-tool' structs, which see."
- ;; https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ToolSpecification.html
- (let ((default-outputs (cl-call-next-method))) ;; use openai tool-parse
- (cl-map 'vector
- (lambda (tool spec)
- (list :toolSpec
- (list
- :name (gptel-tool-name tool)
- :description (gptel-tool-description tool)
- :inputSchema (list :json (plist-get (plist-get spec :function) :parameters)))))
- (ensure-list tools) default-outputs)))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-bedrock) response info)
- "Parse a Bedrock (non-streaming) RESPONSE and return response text.
-
-Mutate state INFO with response metadata."
- (plist-put info :stop-reason (plist-get response :stopReason))
- (plist-put info :input-tokens
- (map-nested-elt response '(:usage :inputTokens)))
- (plist-put info :output-tokens
- (map-nested-elt response '(:usage :outputTokens)))
-
- (let* ((message (map-nested-elt response '(:output :message)))
- (content-strs (thread-last (plist-get message :content)
- (mapcar (lambda (cblock) (plist-get cblock :text)))
- (delq nil))))
- (gptel-bedrock--record-tool-use message info)
- (and content-strs (apply #'concat content-strs))))
-
-(defun gptel-bedrock--record-tool-use (message info)
- "If MESSAGE has tool use requests, save those to INFO."
- (let* ((content (plist-get message :content))
- (tool-use-blocks (cl-remove-if-not
- (lambda (cblock) (plist-get cblock :toolUse))
- content)))
- (when tool-use-blocks
- (cl-callf vconcat (plist-get (plist-get info :data) :messages) (list message))
-
- (plist-put info :tool-use
- (mapcar (lambda (block)
- (let ((tool-use (plist-get block :toolUse)))
- (list
- :name (plist-get tool-use :name)
- :args (plist-get tool-use :input)
- :id (plist-get tool-use :toolUseId))))
- tool-use-blocks)))))
-
-(cl-defmethod gptel--parse-list ((_backend gptel-bedrock) prompt-strings)
- "Create a list of prompt objects from PROMPT-STRINGS.
-
-Assumes this is a conversation with alternating roles."
- (cl-loop for text in prompt-strings
- for role = t then (not role)
- if text collect
- (list :role (if role "user" "assistant")
- :content `[(:text ,text)])))
-
-(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))))
-
-(defvar-local gptel-bedrock--stream-cursor nil
- "Marker to indicate last point parsed.")
-
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-bedrock) info)
- "Parse an AWS Bedrock streaming response from the ConverseStream API.
-INFO is a plist containing the request context."
- (cl-block fn
- (save-excursion
- ;; Each streaming request uses a fresh buffer, so the cursor starts out null. We keep it unset
- ;; until we have received all the headers
- (when (null gptel-bedrock--stream-cursor)
- (goto-char (point-min))
- (unless (search-forward "\r\n\r\n" nil t) (cl-return-from fn))
- (save-restriction
- (narrow-to-region (point-min) (point)) ; Required by mail-fetch-field
- (let ((content-type (mail-header-parse-content-type
- (mail-fetch-field "Content-Type"))))
- (cl-assert content-type nil "No Content-Type header found")
- (cl-assert (string-equal (car content-type) "application/vnd.amazon.eventstream")
- t "Unexpected Content-Type %S, expected %S")))
- (setq gptel-bedrock--stream-cursor (point-marker))
-
- ;; :accumulated-events contains the events from an in-progress message, from the
- ;; messageStart onwards. With each messageStop it gets cleared
- (plist-put info :accumulated-events nil))
-
- ;; Start of main routine
- (let ((acc-cell (cdr (plist-member info :accumulated-events))) strings prompts)
- (goto-char gptel-bedrock--stream-cursor)
- (while-let ((event (gptel-bedrock--parse-stream-message)))
- (let ((event-type (assoc-default ":event-type" (plist-get event :headers))))
- (when (member event-type '("messageStart" "contentBlockStart" "contentBlockDelta"
- "contentBlockStop"))
- (push event (car acc-cell)))
- (pcase event-type
- ("metadata"
- (plist-put info :input-tokens (map-nested-elt event '(:payload :usage :inputTokens)))
- (plist-put info :output-tokens (map-nested-elt event '(:payload :usage :outputTokens))))
- ("contentBlockDelta"
- (when-let ((delta-text (map-nested-elt event '(:payload :delta :text))))
- (push delta-text strings)))
- ("messageStop"
- (push (gptel-bedrock--assemble-content-blocks (nreverse (car acc-cell))) prompts)
- (setf (car acc-cell) nil)
- (plist-put info :stop-reason (map-nested-elt event '(:payload :stopReason)))
- (plist-put info :message-complete t)))))
- (move-marker gptel-bedrock--stream-cursor (point))
-
- (dolist (message prompts) (gptel-bedrock--record-tool-use message info))
- (apply #'concat (nreverse strings))))))
-
-(defun gptel-bedrock--parse-stream-message ()
- "Parse AWS Bedrock event-stream message starting at current position.
-Point should be at the beginning of an event in the `vnd.amazon.event-stream'
-format. Returns plist with :headers and :payload keys if successful, nil if
-incomplete."
- ;; https://github.com/awslabs/aws-c-event-stream has documentation of this format
- ;; The format consists of three main sections: Prelude, Data, and Message CRC.
- ;; 1. Prelude (12 bytes)
- ;; a. Total Byte Length (4 bytes): Specifies the total length of the message.
- ;; b. Headers Byte Length (4 bytes): Indicates the length of the headers section.
- ;; c. Prelude CRC (4 bytes): A CRC value for validating the integrity of the prelude.
- ;; 2. Data (variable length)
- ;; a. Headers: An array of packed headers. Each header has a specific format documented in
- ;; gptel-bedrock--parse-headers
- ;; b. Payload: The main message content, also of variable length. Length can be computed from
- ;; the prelude fields by subtracting the prelude length, headers length, and message CRC
- ;; length from the total.
- ;; 3. Message CRC (4 bytes): A 4-byte CRC to validate the integrity of the entire message.
-
- ;; (point-max) is the position after the last character, hence the use of >= and not > below
- (when (>= (- (point-max) (point)) 12)
- (let* ((prelude-start (point))
- (prelude-length 12)
- (prelude-end (+ prelude-start prelude-length))
- (prelude (buffer-substring-no-properties prelude-start prelude-end))
- (total-length (gptel-bedrock--bytes-to-int32 (substring prelude 0 4)))
- (headers-length (gptel-bedrock--bytes-to-int32 (substring prelude 4 8)))
- (headers-start prelude-end)
- (headers-end (+ headers-start headers-length))
- headers payload)
- ;; We don't validate either CRC because isn't that what the networking stack is for?
-
- (when (>= (point-max) (+ prelude-start total-length))
- (goto-char headers-start)
- (setq headers (gptel-bedrock--parse-headers (buffer-substring (point) headers-end)))
- (cl-assert (equal (assoc-default ":message-type" headers) "event")
- t "Unknown message type %S; expected %S")
- (cl-assert (equal (assoc-default ":content-type" headers) "application/json")
- t "Unexpected content-type %S is not %S")
-
- (goto-char headers-end)
- (setq payload (gptel--json-read))
- (let* ((message-crc 4)
- (payload-length (- total-length headers-length prelude-length message-crc)))
- (cl-assert (= (- (point) headers-end) payload-length)
- t "Unexpected payload length %d; expected %d."))
-
- (goto-char (+ prelude-start total-length))
- `(:headers ,headers :payload ,payload)))))
-
-(defun gptel-bedrock--parse-headers (headers-data)
- "Parse HEADERS-DATA into alist of (NAME . VALUE).
-Keys are string-valued, lower-cased names."
- ;; Header wire format:
- ;; 1. Header Name Byte Length (1 byte): Specifies the length of the header name.
- ;; 2. Header Name (String) (Variable length): Contains the name of the header.
- ;; 3. Header Value Type (1 byte): Identifies the type of the header value.
- ;; 4. Value String Byte Length (2 bytes): Indicates the length of the value string.
- ;; 5. Value (Variable length): Holds the actual value bytes
- (let ((pos 0) (max (length headers-data)) headers)
- (cl-flet ((pos++ () (prog1 pos (cl-incf pos)))
- (++pos (n) (cl-incf pos n))
- (utf8 (unibyte-string) (decode-coding-string unibyte-string 'utf-8 t)))
- (while (< pos max)
- (let* ((name-len (aref headers-data (pos++)))
- (name (substring headers-data pos (++pos name-len)))
- (type (aref headers-data (pos++)))
- (value-len (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2))))
- (value
- (pcase type
- ;; Header types from https://awslabs.github.io/aws-crt-python/api/eventstream.html
- (0 t)
- (1 :json-false)
- (2 (let ((res (aref headers-data (pos++)))) ; int8
- (if (> res 127) (- res 256) res)))
- (3 (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2)))) ; int16
- (4 (gptel-bedrock--bytes-to-int32 (substring headers-data pos (++pos 4)))) ; int32
- (5 (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8)))) ; int64
- (6 (substring headers-data pos (++pos value-len))) ; raw bytes
- (7 (utf8 (substring headers-data pos (++pos value-len)))) ; utf8 string
- (8 (decode-time ; 64 bit int with seconds since the Unix epoch
- (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8))) t))
- (9 (gptel-bedrock--bytes-to-uuid ; 16 byte UUID
- (substring headers-data pos (++pos 16))))
- (_ (error "Unknown header type: %d" type)))))
- (push (cons (downcase (utf8 name)) value) headers)))
- (cl-assert (= pos max) t "Headers did not parse cleanly. pos=%d header-len=%d")
- headers)))
-
-(defun gptel-bedrock--bytes-to-int16 (bytes)
- "Convert 2-byte string BYTES to big-endian signed integer."
- (let ((b0 (logand (aref bytes 0) 255))
- (b1 (logand (aref bytes 1) 255)))
- (let ((result (+ (ash b0 8) b1)))
- (if (>= b0 #x80) (- result (ash 1 16)) result))))
-
-(defun gptel-bedrock--bytes-to-int32 (bytes)
- "Convert 4-byte string BYTES to big-endian signed integer."
- (let ((b0 (logand (aref bytes 0) 255))
- (b1 (logand (aref bytes 1) 255))
- (b2 (logand (aref bytes 2) 255))
- (b3 (logand (aref bytes 3) 255)))
- (let ((result (+ (ash b0 24) (ash b1 16) (ash b2 8) b3)))
- (if (>= b0 #x80) (- result (ash 1 32)) result))))
-
-(defun gptel-bedrock--bytes-to-int64 (bytes)
- "Convert 8-byte string BYTES to big-endian signed integer."
- (let ((b0 (logand (aref bytes 0) 255))
- (b1 (logand (aref bytes 1) 255))
- (b2 (logand (aref bytes 2) 255))
- (b3 (logand (aref bytes 3) 255))
- (b4 (logand (aref bytes 4) 255))
- (b5 (logand (aref bytes 5) 255))
- (b6 (logand (aref bytes 6) 255))
- (b7 (logand (aref bytes 7) 255)))
- (let ((result-u63 (+ (ash (logand b0 #x7f) 56) (ash b1 48)
- (ash b2 40) (ash b3 32) (ash b4 24) (ash b5 16) (ash b6 8) b7)))
- (if (>= b0 #x80)
- (- result-u63 (ash 1 63))
- result-u63))))
-
-(defun gptel-bedrock--bytes-to-uuid (bytes)
- "Convert a 16-byte unibyte BYTES to a 36 character UUID string."
- (unless (and (stringp bytes) (= (length bytes) 16))
- (error "Input must be a 16-byte unibyte string"))
- (let ((hex (mapconcat (lambda (i) (format "%02x" (aref bytes i))) (number-sequence 0 15) "")))
- (format "%s-%s-%s-%s-%s"
- (substring hex 0 8)
- (substring hex 8 12)
- (substring hex 12 16)
- (substring hex 16 20)
- (substring hex 20 32))))
-
-(defun gptel-bedrock--assemble-content-blocks (events)
- "Build a completed prompt object contained from EVENTS.
-EVENTS should be a list of messageStart, contentBlockStart,
-contentBlockDelta, and contentBlockStop stream messages as
-returned by `gptel-bedrock--parse-stream-message', in the order
-received."
- (let ((blocks (make-hash-table :test #'eql))
- role contents)
- (dolist (event events)
- (let* ((headers (plist-get event :headers))
- (payload (plist-get event :payload))
- (event-type (assoc-default ":event-type" headers)))
- (pcase event-type
- ("messageStart" (setq role (plist-get payload :role)))
- ("contentBlockStart"
- (puthash (plist-get payload :contentBlockIndex) (list event) blocks))
- ("contentBlockDelta"
- (push event (gethash (plist-get payload :contentBlockIndex) blocks)))
- ("contentBlockStop"
- (let* ((block-index (plist-get payload :contentBlockIndex))
- (block-events (nreverse (gethash block-index blocks)))
- (start (car block-events))
- (deltas (cdr block-events)))
- (when-let ((tool-use (map-nested-elt start '(:payload :start :toolUse))))
- (let ((id (plist-get tool-use :toolUseId))
- (name (plist-get tool-use :name))
- (input (gptel--json-read-string
- (mapconcat
- (lambda (delta) (map-nested-elt delta '(:payload :delta :toolUse :input)))
- deltas))))
- (push
- (list :toolUse (list :input input :name name :toolUseId id))
- contents)))
- (when-let ((texts (delq nil (mapcar (lambda (d) (map-nested-elt d '(:payload :delta :text))) deltas))))
- (push (list :text (apply #'concat texts)) contents))
- ;; Currently we discard any reasoning content but this would be the spot to handle it
- ))
- (_ (error "Unexpected event-type %S" event-type)))))
- (list :role role :content (vconcat (nreverse contents)))))
-
-(cl-defmethod gptel--parse-buffer ((_backend gptel-bedrock) &optional max-entries)
- "Parse current buffer and return a list of prompt objects for Bedrock.
-
-MAX-ENTRIES is the maximum number of prompts to include."
- (unless max-entries (setq max-entries most-positive-fixnum))
- (let ((prompts nil) (prev-pt (point))
- (include-media (and gptel-track-media (gptel--model-capable-p 'media))))
- (cl-flet ((capture-prompt (role beg end)
- (let* ((content (if include-media
- (gptel-bedrock--parse-multipart
- (gptel--parse-media-links major-mode beg end))
- `[(:text ,(gptel--trim-prefixes
- (buffer-substring-no-properties beg end)))]))
- (prompt (list :role role :content content)))
- (push prompt prompts))))
-
- (if (or gptel-mode gptel-track-response)
- (while (and (> max-entries 0)
- (/= prev-pt (point-min))
- (goto-char (previous-single-property-change
- (point) 'gptel nil (point-min))))
- (capture-prompt (pcase (get-char-property (point) 'gptel)
- ('response "assistant")
- ('nil "user"))
- (point) prev-pt)
- (setq prev-pt (point))
- (cl-decf max-entries))
- (capture-prompt "user" (point-min) (point-max)))
- prompts)))
-
-(defconst gptel-bedrock--image-formats
- '(("image/jpg" . "jpeg")
- ("image/jpeg" . "jpeg")
- ("image/png" . "png")
- ("image/gif" . "gif")
- ("image/webp" . "webp"))
- "Map of mime type to image formats as used in AWS's ImageBlock.")
-
-(defconst gptel-bedrock--doc-formats
- '(("application/pdf" . "pdf")
- ("text/csv" . "csv")
- ("application/msword" . "doc")
- ("application/vnd.openxmlformats-officedocument.wordprocessingml.document" . "docx")
- ("application/vnd.ms-excel" . "xls")
- ("application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" . "xlsx")
- ("text/html" . "html")
- ("text/plain" . "txt")
- ("text/markdown" . "md"))
- "Map of mime type to document formats as used in AWS's DocumentBlock.")
-
-(defun gptel-bedrock--parse-multipart (parts)
- "Convert a multipart prompt PARTS to the AWS Bedrock API format.
-
-The input is a list of text and media plists of the form:
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\")).
-
-The output is a vector of entries in Bedrock API format."
- (thread-last parts
- (cl-maplist
- (lambda (tail)
- (let* ((part (car tail))
- (text (plist-get part :text))
- (mime (plist-get part :mime))
- (media (plist-get part :media))
- (textfile (plist-get part :textfile))
- format)
- (cond
- (text (when (or (eq part (car parts)) (null (cdr tail)))
- (setq text (gptel--trim-prefixes text)))
- (unless (string-empty-p text)
- `(:text ,text)))
- (media
- (cond
- ((setq format (assoc mime gptel-bedrock--image-formats))
- `(:image (:format ,(cdr format) :source (:bytes ,(gptel--base64-encode media)))))
- ((setq format (assoc mime gptel-bedrock--doc-formats))
- `(:document (:format ,(cdr format)
- :name ,(file-name-nondirectory media)
- :source (:bytes ,(gptel--base64-encode media)))))
- (t (error "Unsupported MIME type %s for AWS Bedrock" mime))))
- (textfile `(:text ,(with-temp-buffer
- (gptel--insert-file-string textfile)
- (buffer-string))))))))
- (delq nil)
- (vconcat)))
-
-;; gptel--inject-prompt not needed since the default implementation works here
-
-(cl-defmethod gptel--parse-tool-results ((_backend gptel-bedrock) tool-use-requests)
- "Return a backend-appropriate prompt containing tool call results.
-
-TOOL-USE-REQUESTS is a list of request plists that have been
-completed. Returns a single prompt object to inject into the
-conversation."
- (list
- :role "user"
- :content
- (vconcat
- (mapcar
- (lambda (tool-call)
- `(:toolResult (:toolUseId ,(plist-get tool-call :id)
- :status "success"
- :content [(:text ,(plist-get tool-call :result))])))
- tool-use-requests))))
-
-(defvar gptel-bedrock--aws-profile-cache nil
- "Cache for AWS profile credentials in the form of (PROFILE . CREDS).")
-
-(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=)
- (car (push (cons profile nil) gptel-bedrock--aws-profile-cache)))))
- (or (and (not clear-cache) (cdr cell))
- (setf (cdr cell)
- (with-temp-buffer
- (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))
- (date-to-time exp))))
- (cond
- ((time-less-p (current-time) expiration)
- (let ((access-key (gethash "AccessKeyId" creds-json))
- (secret-key (gethash "SecretAccessKey" creds-json))
- (session-token (gethash "SessionToken" creds-json)))
- (cl-values access-key secret-key session-token)))
- ((not clear-cache)
- (gptel-bedrock--fetch-aws-profile-credentials profile t))
- (t (user-error "AWS credentials expired for profile: %s" profile)))))
-
-(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).
-
-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 (or profile (getenv "AWS_PROFILE"))))
- (cond
- ((and profile) (gptel-bedrock--fetch-aws-profile-credentials profile))
- ((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
- '((claude-sonnet-4-5-20250929 . "anthropic.claude-sonnet-4-5-20250929-v1:0")
- (claude-haiku-4-5-20251001 . "anthropic.claude-haiku-4-5-20251001-v1:0")
- (claude-opus-4-5-20251101 . "anthropic.claude-opus-4-5-20251101-v1:0")
- (claude-opus-4-1-20250805 . "anthropic.claude-opus-4-1-20250805-v1:0")
- (claude-sonnet-4-20250514 . "anthropic.claude-sonnet-4-20250514-v1:0")
- (claude-opus-4-20250514 . "anthropic.claude-opus-4-20250514-v1:0")
- (claude-3-7-sonnet-20250219 . "anthropic.claude-3-7-sonnet-20250219-v1:0")
- (claude-3-5-sonnet-20241022 . "anthropic.claude-3-5-sonnet-20241022-v2:0")
- (claude-3-5-sonnet-20240620 . "anthropic.claude-3-5-sonnet-20240620-v1:0")
- (claude-3-5-haiku-20241022 . "anthropic.claude-3-5-haiku-20241022-v1:0")
- (claude-3-opus-20240229 . "anthropic.claude-3-opus-20240229-v1:0")
- (claude-3-haiku-20240307 . "anthropic.claude-3-haiku-20240307-v1:0")
- (nova-2-lite-v1 . "amazon.nova-2-lite-v1:0")
- (mistral-7b . "mistral.mistral-7b-instruct-v0:2")
- (mistral-8x7b . "mistral.mixtral-8x7b-instruct-v0:1")
- (mistral-large-2402 . "mistral.mistral-large-2402-v1:0")
- (mistral-large-2407 . "mistral.mistral-large-2407-v1:0")
- (mistral-small-2402 . "mistral.mistral-small-2402-v1:0")
- (llama-3-8b . "meta.llama3-8b-instruct-v1:0")
- (llama-3-70b . "meta.llama3-70b-instruct-v1:0")
- (llama-3-1-8b . "meta.llama3-1-8b-instruct-v1:0")
- (llama-3-1-70b . "meta.llama3-1-70b-instruct-v1:0")
- (llama-3-1-405b . "meta.llama3-1-405b-instruct-v1:0")
- (llama-3-2-1b . "meta.llama3-2-1b-instruct-v1:0")
- (llama-3-2-3b . "meta.llama3-2-3b-instruct-v1:0")
- (llama-3-2-11b . "meta.llama3-2-11b-instruct-v1:0")
- (llama-3-2-90b . "meta.llama3-2-90b-instruct-v1:0")
- (llama-3-3-70b . "meta.llama3-3-70b-instruct-v1:0"))
- "Map of model name to bedrock id.
-
-IDs can be added or replaced by calling
-\(push (model-name . \"model-id\") gptel-bedrock--model-ids).")
-
-(defvar gptel--bedrock-models
- (mapcar #'car gptel-bedrock--model-ids)
- "List of available AWS Bedrock models and associated properties.")
-
-(defun gptel-bedrock--get-model-id (model &optional region)
- "Return the Bedrock model ID for MODEL.
-
-REGION is one of global, apac, eu or us."
- (concat
- (when region
- (or (member region '(global apac eu us))
- (error "Unknown Bedrock region %s" region))
- (concat (symbol-name region) "."))
- (or (alist-get model gptel-bedrock--model-ids nil nil #'eq)
- (error "Unknown Bedrock model: %s" model))))
-
-(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."
- (let* ((output (shell-command-to-string "curl --version"))
- (version (and (string-match "^curl \\([0-9.]+\\)" output)
- (match-string 1 output))))
- version))
-
-;;;###autoload
-(cl-defun gptel-make-bedrock
- (name &key
- region
- (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.
-
-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 (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
- :name name
- :host host
- :header nil ; x-amz-security-token is set in curl-args if needed
- :models (gptel--process-models models)
- :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 aws-profile aws-bearer-token)))
- :request-params request-params
- :url
- (lambda ()
- (concat protocol "://" host
- "/model/" (gptel-bedrock--get-model-id gptel-model model-region)
- "/" (if stream "converse-stream" "converse")))))))
-
-(provide 'gptel-bedrock)
-;;; gptel-bedrock.el ends here
+++ /dev/null
-;;; gptel-context.el --- Context aggregator for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: daedsidog <contactNOSPAMdaedsidog.com>
-;; Keywords: convenience, buffers
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; The context allows you to conveniently create contexts which can be fed
-;; to gptel.
-
-;;; Code:
-
-(require 'gptel-request)
-(require 'cl-lib)
-(require 'project)
-
-(declare-function gptel-menu "gptel-transient")
-(declare-function dired-get-marked-files "dired")
-(declare-function ibuffer-get-marked-buffers "ibuffer")
-(declare-function ibuffer-current-buffer "ibuffer")
-(declare-function image-file-name-regexp "image-file")
-(declare-function create-image "image")
-
-(defface gptel-context-highlight-face
- '((((background dark) (min-colors 88)) :background "gray4" :extend t)
- (((background light) (min-colors 88)) :background "alice blue" :extend t)
- (t :inherit mode-line))
- "Face used to highlight gptel contexts in buffers."
- :group 'gptel)
-
-(defface gptel-context-deletion-face
- '((((class color) (min-colors 257) (background light))
- :background "#ffeeee" :extend t)
- (((class color) (min-colors 88) (background light))
- :background "#ffdddd" :extend t)
- (((class color) (min-colors 88) (background dark))
- :background "#553333" :extend t)
- (((class color)) :foreground "red" :extend t))
- "Face used to highlight gptel contexts to be deleted.
-
-This is used in gptel context buffers."
- :group 'gptel)
-
-(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")
-
-(defcustom gptel-context-string-function #'gptel-context--string
- "Function to prepare the context string sent with the gptel request.
-
-This function can be synchronous or asynchronous, and receives one or
-two arguments respectively.
-
-Synchronous: An alist of contexts with buffers or files (the context
-alist).
-Asynchronous: A callback to call with the result, and the context alist.
-
-Entries in the context alist can have one of these forms:
-
- (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 overlay covers a buffer region containing the
-context chunk. This is accessible as, for example:
-
- (with-current-buffer buffer1
- (buffer-substring (overlay-start overlay1)
- (overlay-end overlay1)))"
- :group 'gptel
- :type 'function)
-
-(defcustom gptel-context-restrict-to-project-files t
- "Restrict files eligible to be added to the context to project files.
-
-When set to t, files in a VCS that are not project files (such as files
-listed in `.gitignore' in a Git repository) will not be added to the
-context."
- :group 'gptel
- :type 'boolean)
-
-(defvar gptel-context--project-files nil
- "Cached alist of project files per project.")
-
-(defvar gptel-context--reset-cache nil
- "Whether a project files cache-buster has been scheduled.")
-
-;;; Commands
-
-(defun gptel-context-add-current-kill (&optional arg)
- "Add current kill to gptel, accumulating if ARG is non-nil."
- (interactive "P")
- (let ((kill (current-kill 0)))
- (with-current-buffer (get-buffer-create " *gptel-kill-ring-context*")
- (if (not arg)
- (kill-region (point-min) (point-max))
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n----\n")))
- (insert kill)
- (gptel-context--add-region (current-buffer)
- (point-min) (point-max))
- (message "*current-kill* has been added as context."))))
-
-(defun gptel-context-add (&optional arg confirm)
- "Add context to gptel in a DWIM fashion.
-
-- If a region is selected, add the selected region to the
- context. If there is already a gptel context at point, remove it
- instead.
-
-- If in Dired, add marked files or file at point to the context. If
- the selection includes directories, add all their files recursively,
- prompting the user for confirmation if called interactively or
- CONFIRM is non-nil. With negative prefix ARG, remove all files from
- the context instead.
-
-- If in IBuffer, add marked buffers or buffer at point to the context.
- With negative prefix ARG, remove buffers from the context instead.
-
-- Otherwise add the current buffer to the context. With positive
- prefix ARG, prompt for a buffer name and add it to the context.
-
-- With negative prefix ARG, remove all gptel contexts from the current
- buffer, prompting the user for confirmation if called interactively
- or CONFIRM is non-nil."
- (interactive "P\np")
- (cond
- ;; A region is selected.
- ((use-region-p)
- (gptel-context--add-region (current-buffer)
- (region-beginning)
- (region-end))
- (deactivate-mark)
- (message "Current region added as context."))
- ;; If in dired
- ((derived-mode-p 'dired-mode)
- (let* ((files (dired-get-marked-files))
- (dirs (cl-remove-if-not #'file-directory-p files))
- (remove-p (< (prefix-numeric-value arg) 0))
- (action-fn (if remove-p
- #'gptel-context-remove
- #'gptel-context-add-file)))
- (when (or remove-p (null dirs) (null confirm)
- (y-or-n-p (format "Recursively add files from %d director%s? "
- (length dirs)
- (if (= (length dirs) 1) "y" "ies"))))
- (mapc action-fn files))))
- ;; If in ibuffer
- ((derived-mode-p 'ibuffer-mode)
- (let* ((buffers (or (ibuffer-get-marked-buffers)
- (list (ibuffer-current-buffer))))
- (remove-p (< (prefix-numeric-value arg) 0))
- (action-fn (if remove-p
- #'gptel-context-remove
- #'gptel-context--add-buffer)))
- (mapc action-fn buffers)))
- ;; If in an image buffer
- ((and (derived-mode-p 'image-mode)
- (gptel--model-capable-p 'media)
- (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)))
- ;; 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: "
- (current-buffer) t))
- (start (with-current-buffer buffer-name (point-min)))
- (end (with-current-buffer buffer-name (point-max))))
- (gptel-context--add-region
- (get-buffer buffer-name) start end t)
- (message "Buffer '%s' added as context." buffer-name)))
- ;; No region is selected, and ARG is negative.
- ((and arg (< (prefix-numeric-value arg) 0))
- (when (or (null confirm)
- (y-or-n-p "Remove all contexts from this buffer? "))
- (let ((removed-contexts 0))
- (cl-loop for cov in
- (gptel-context--in-region (current-buffer) (point-min) (point-max))
- do (progn
- (cl-incf removed-contexts)
- (gptel-context-remove cov)))
- (message (format "%d context%s removed from current buffer."
- removed-contexts
- (if (= removed-contexts 1) "" "s"))))))
- (t ; Default behavior
- (if (gptel-context--at-point)
- (progn
- (gptel-context-remove
- (car (gptel-context--in-region (current-buffer)
- (max (point-min) (1- (point)))
- (point))))
- (message "Context under point has been removed."))
- (gptel-context--add-buffer (current-buffer))))))
-
-;;;###autoload (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t)
-(defalias 'gptel-add #'gptel-context-add)
-
-(defun gptel-context--add-buffer (buffer)
- "Add BUFFER to context."
- (with-current-buffer buffer
- (gptel-context--add-region (current-buffer) (point-min) (point-max) t))
- (message "Buffer \"%s\" added to context." (buffer-name buffer)))
-
-(defun gptel-context--add-text-file (path)
- "Add text file at PATH to context."
- (cl-pushnew (list path) gptel-context :test #'equal)
- (message "File \"%s\" added to context." path)
- path)
-
-(defun gptel-context--add-binary-file (path)
- "Add binary file at PATH to context if supported.
-Return PATH if added, nil if ignored."
- (if-let* (((gptel--model-capable-p 'media))
- (mime (mailcap-file-name-to-mime-type path))
- ((gptel--model-mime-capable-p mime)))
- (prog1 path
- (cl-pushnew (list path :mime mime)
- gptel-context :test #'equal)
- (message "File \"%s\" added to context." path))
- (message "Ignoring unsupported binary file \"%s\"." path)
- nil))
-
-(defun gptel-context--add-directory (path action)
- "Process all files in directory at PATH according to ACTION.
-ACTION should be either `add' or `remove'."
- (dolist (file (directory-files-recursively path "."))
- (pcase-exhaustive action
- ('add
- (unless gptel-context--reset-cache
- (setq gptel-context--reset-cache t)
- (run-at-time
- 0 nil
- (lambda () (setq gptel-context--reset-cache nil
- gptel-context--project-files nil))))
- (if (gptel-context--skip-p file)
- ;; Don't message about .git, as this creates thousands of messages
- (unless (string-match-p "\\.git/" file)
- (gptel-context--message-skipped file))
- (gptel-context-add-file file)))
- ('remove
- (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.
-
-If PATH is a directory, recursively add all files in it. PATH should be
-readable as text."
- (interactive "fChoose file to add to context: ")
- (cond ((file-directory-p path)
- (gptel-context--add-directory path 'add))
- ((gptel--file-binary-p path)
- (gptel-context--add-binary-file path))
- (t (gptel-context--add-text-file path))))
-
-;;;###autoload (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t)
-(defalias 'gptel-add-file #'gptel-context-add-file)
-
-;;; project-related functions
-(defun gptel-context--get-project-files (dir)
- "Return a list of files in the project DIR, or nil if no project is found."
- (when-let* ((project (project-current nil dir)))
- (with-memoization (alist-get dir gptel-context--project-files
- nil nil #'equal)
- (project-files project))))
-
-(defun gptel-context--skip-p (file)
- "Return non-nil if FILE should not be added to the context."
- (when (and gptel-context-restrict-to-project-files
- (not (file-remote-p file)))
- (and-let* ((file-dir (or (file-name-directory file) default-directory))
- (project (project-current nil file-dir)))
- (not (member (expand-file-name file)
- (gptel-context--get-project-files (project-root project)))))))
-
-(defun gptel-context--message-skipped (file)
- "Message that FILE is skipped because it is not a project file."
- (let* ((type (if (file-directory-p file) "directory" "file"))
- (reminder (format "To include it, unset `%S'."
- 'gptel-context-restrict-to-project-files)))
- (if-let* ((root (cl-some (lambda (dir) (and (file-in-directory-p file dir) dir))
- (map-keys gptel-context--project-files)))
- (rel-file (file-relative-name file root)))
- (message "Skipping %s \"%s\" in project \"%s\". %s"
- type rel-file root reminder)
- (message "Skipping %s \"%s\". %s" type file reminder))))
-
-;;; Remove context
-(defun gptel-context-remove (&optional context)
- "Remove the CONTEXT overlay from the contexts list.
-
-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) ;Overlay in buffer
- (when-let* ((buf (overlay-buffer context)))
- (delete-overlay context)
- ;; FIXME: Quadratic cost when clearing a bunch of contexts at once
- (unless
- (cl-loop
- for ov in
- (plist-get (alist-get buf gptel-context) :overlays)
- thereis (overlay-start ov))
- (setf (alist-get buf gptel-context nil 'remove) nil))))
- ((bufferp context) ;Full buffer
- (setf (alist-get context gptel-context nil 'remove) nil)
- (when (buffer-live-p context)
- (with-current-buffer context
- (without-restriction
- (remove-overlays nil nil 'gptel-context t)))))
- ((stringp context) ;file or directory
- (if (file-directory-p context)
- (gptel-context--add-directory context 'remove)
- (setf (alist-get context gptel-context nil 'remove #'equal) nil)
- (message "File \"%s\" removed from context." context)))
- ((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 ;Anything at point
- (when-let* ((ctx (gptel-context--at-point)))
- (delete-overlay ctx)))))
-
-(defun gptel-context-remove-all (&optional verbose)
- "Remove all gptel context.
-
-If VERBOSE is non-nil, ask for confirmation and message
-afterwards."
- (interactive (list t))
- (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 context in gptel-context
- for (source . spec) = (ensure-list context)
- if (bufferp source) do ;Buffers and buffer regions
- (mapc #'gptel-context-remove (plist-get spec :overlays))
- else do (gptel-context-remove source) ;files or other types
- finally do (setq gptel-context nil))
- (when verbose (message "Removed all gptel context sources.")))))
-
-;;; Context wrap
-(defun gptel-context--make-overlay (start end &optional advance)
- "Highlight the region from START to END.
-
-ADVANCE controls the overlay boundary behavior."
- (let ((overlay (make-overlay start end nil (not advance) advance))
- (buf-entry (alist-get (current-buffer) gptel-context)))
- (overlay-put overlay 'evaporate t)
- (overlay-put overlay 'face 'gptel-context-highlight-face)
- (overlay-put overlay 'gptel-context t)
- (setf (alist-get (current-buffer) gptel-context)
- (plist-put buf-entry :overlays
- (cons overlay (plist-get buf-entry :overlays))))
- overlay))
-
-;;;###autoload
-(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 context-string "\n\n" gptel--system-message)))
- (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 context-string "\n\n" (car gptel--system-message))
- (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.
-
-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)
- for (path . props) = (ensure-list context)
- when (and (stringp path) (plist-get props :mime))
- collect (cons :media context)))
-
-(cl-defun gptel-context--add-region (buffer region-beginning region-end &optional advance)
- "Add region delimited by REGION-BEGINNING, REGION-END in BUFFER as context.
-
-If ADVANCE is non-nil, the context overlay envelopes changes at
-the beginning and end."
- ;; Remove existing contexts in the same region, if any.
- (mapc #'gptel-context-remove
- (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.")))
-
-(defun gptel-context--in-region (buffer start end)
- "Return the list of context overlays in the given region, if any, in BUFFER.
-START and END signify the region delimiters."
- (with-current-buffer buffer
- (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context))
- (overlays-in start end))))
-
-(defun gptel-context--at-point ()
- "Return the context overlay at point, if any."
- (cl-find-if (lambda (ov) (overlay-get ov 'gptel-context))
- (overlays-at (point))))
-
-;;;###autoload
-(defun gptel-context--collect (&optional context-alist)
- "Get the list of all active context sources from CONTEXT-ALIST.
-
-CONTEXT-ALIST defaults to the current value of `gptel-context'.
-
-Ignore overlays, buffers and files that are not live or readable."
- ;; Get only the non-degenerate overlays, collect them, and update the overlays variable.
- (let ((res))
- (dolist (entry (or context-alist gptel-context))
- (pcase entry ;Context entry is:
- (`(,buf . ,data)
- (cond
- ((buffer-live-p buf)
- ;; (<buf> :overlays ... :lines ... :bounds ...)
- (when-let* ((ovs (plist-get data :overlays))) ;Clear dead overlays
- (plist-put data :overlays (cl-remove-if-not #'overlay-start ovs)))
- (push (cons buf data) res))
- ((and (stringp buf) (file-readable-p buf))
- ;; ("/file/path" :mime ... :bounds ... :line ...)
- (push (cons buf data) res))))
-
- ((and (pred stringp) (pred file-readable-p)) ;Just a file, figure out mimetype
- (if (file-directory-p entry)
- (progn
- (unless gptel-context--reset-cache
- (setq gptel-context--reset-cache t)
- (run-at-time
- 0 nil
- (lambda () (setq gptel-context--reset-cache nil
- gptel-context--project-files nil))))
- (dolist (f (directory-files-recursively entry "."))
- (unless (gptel-context--skip-p f)
- (push `(,f ,@(and (gptel--file-binary-p f)
- (list :mime (mailcap-file-name-to-mime-type entry))))
- res))))
- (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
- res))
-
-(defun gptel-context--collect-regions (buffer context-data)
- "Collect BUFFER regions from CONTEXT-DATA specification.
-
-CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds.
-Returns a sorted list of (START . END) position pairs."
- (let (regions)
- (with-current-buffer buffer
- (without-restriction
- ;; Collect overlays
- (dolist (ov (plist-get context-data :overlays))
- (when (overlay-start ov)
- (push (cons (overlay-start ov) (overlay-end ov))
- regions)))
- ;; Collect bounds (already in position format)
- (when-let* ((bounds (plist-get context-data :bounds)))
- (if (consp (car bounds))
- (setq regions (nconc regions bounds)) ;((start1 . end1) (start2 . end2) ...)
- (push bounds regions))) ;(start1 . end1)
- ;; Collect lines (convert line numbers to positions)
- (when-let* ((line-bounds (plist-get context-data :lines)))
- ;; Convert singleton (start1 . end1) to ((start1 . end1))
- (unless (consp (car line-bounds)) (setq line-bounds (list line-bounds)))
- (dolist (pair line-bounds)
- (push (cons (progn (goto-char (point-min))
- (forward-line (1- (car pair)))
- (point))
- (progn (goto-char (point-min))
- (forward-line (cdr pair))
- (point)))
- regions)))))
- ;; TODO: Update sort for Emacs 28+ calling convention
- ;; Sort by start position.
- (sort regions (lambda (a b) (< (car a) (car b))))))
-
-(defun gptel-context--insert-buffer-string (buffer context-data &optional header)
- "Insert at point a context string from CONTEXT-DATA in BUFFER.
-
-CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds to
-include specific overlays, line ranges or position bounds instead of the
-entire buffer. See `gptel-context'.
-
-HEADER is an optional header to insert before the contents."
- (let ((is-top-snippet t)
- (previous-line 1)
- (regions (gptel-context--collect-regions buffer context-data)))
-
- ;; Insert header
- (insert (or header (format "In buffer `%s`:\n\n```"(buffer-name buffer)))
- (gptel--strip-mode-suffix (buffer-local-value
- 'major-mode buffer))
- "\n")
- (if (not regions)
- (insert-buffer-substring-no-properties buffer)
- (dolist (region regions)
- (let ((start (car region)) (end (cdr region)))
- (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)))))
- ;; 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"))
- (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-buffer-substring-no-properties buffer start end)))
- (unless (>= (cdr (car (last regions))) (point-max))
- (insert "\n...")))
- (insert "\n```")))
-
-(defun gptel-context--insert-file-string (path &optional spec)
- "Insert at point the contents of file at PATH as context.
-
-SPEC is a plist specifying :lines or position :bounds to include instead
-of the entire file. See `gptel-context' for details."
- (if (not (and spec (or (plist-member spec :lines)
- (plist-member spec :bounds))))
- ;; Insert whole file
- (gptel--insert-file-string path)
- ;; Insert only regions from lines and/or bounds
- (let* ((visiting-buf (find-buffer-visiting ;Reuse buffer
- path (lambda (b) (not (buffer-modified-p b)))))
- (file-buf (or visiting-buf ;temp buf to dump file contents
- (gptel--temp-buffer " *gptel-file-context*"))))
- (unless visiting-buf
- (with-current-buffer file-buf (insert-file-contents path)))
- (gptel-context--insert-buffer-string
- file-buf spec (format "In file `%s`:\n\n```\n"
- (abbreviate-file-name path)))
- (unless visiting-buf (kill-buffer file-buf)))))
-
-(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'."
- (with-temp-buffer
- (cl-loop for entry in context-alist
- for (source . spec) = (ensure-list entry)
- if (bufferp source)
- do (gptel-context--insert-buffer-string source spec)
- else if (or (not (plist-get spec :mime))
- (string-match-p "^text/" (plist-get spec :mime)))
- do (gptel-context--insert-file-string source spec) end
- do (insert "\n\n")
- finally do
- (skip-chars-backward "\n\t\r ")
- (delete-region (point) (point-max))
- (unless (bobp)
- (goto-char (point-min))
- (insert "Request context:\n\n"))
- finally return
- (and (> (buffer-size) 0)
- (buffer-string)))))
-
-;;; Major mode for context inspection buffers
-(defvar-keymap gptel-context-buffer-mode-map
- "C-c C-c" #'gptel-context-confirm
- "C-c C-k" #'gptel-context-quit
- "RET" #'gptel-context-visit
- "n" #'gptel-context-next
- "p" #'gptel-context-previous
- "d" #'gptel-context-flag-deletion)
-
-(define-derived-mode gptel-context-buffer-mode special-mode "gptel-context"
- "Major-mode for inspecting context used by gptel."
- :group 'gptel
- (add-hook 'post-command-hook #'gptel-context--post-command
- nil t)
- (setq-local revert-buffer-function #'gptel-context--buffer-setup))
-
-;; FIXME(targeted-context): This does not handle :bounds and :lines. Reuse
-;; `gptel-context--insert-buffer-string'?
-(defun gptel-context--buffer-setup (&optional _ignore-auto _noconfirm context-alist)
- "Set up the gptel context buffer.
-
-CONTEXT-ALIST is the alist of contexts to use to populate the buffer."
- (with-current-buffer (get-buffer-create "*gptel-context*")
- (gptel-context-buffer-mode)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (setq header-line-format
- (substitute-command-keys
- (concat
- "\\[gptel-context-flag-deletion]: Mark/unmark deletion, "
- "\\[gptel-context-next]/\\[gptel-context-previous]: next/previous, "
- "\\[gptel-context-visit]: visit, "
- "\\[gptel-context-confirm]: apply, "
- "\\[gptel-context-quit]: cancel, "
- "\\[quit-window]: quit")))
- (save-excursion
- (let ((contexts (gptel-context--collect context-alist)))
- (if (length= contexts 0)
- (insert "There are no active gptel contexts.")
- (let (beg ov l1 l2)
- (pcase-dolist (`(,buf . ,spec) contexts)
- (cond
- ((bufferp buf)
- (if (not spec) ;BUF is a full buffer, not specific ranges
- (progn
- (insert (propertize (format "In buffer %s:\n\n"
- (buffer-name buf))
- 'face 'bold))
- (setq beg (point))
- (insert-buffer-substring buf)
- (insert "\n")
- (setq ov (make-overlay beg (point))))
- (dolist (source-ov (plist-get spec :overlays)) ;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 spec :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
- display-buffer-below-selected)
- (body-function . ,#'select-window)
- (window-height . ,#'fit-window-to-buffer)))))
-
-(defvar gptel-context--buffer-reverse nil
- "Last direction of cursor movement in gptel context buffer.
-
-If non-nil, indicates backward movement.")
-
-(defalias 'gptel-context--post-command
- (let ((highlight-overlay))
- (lambda ()
- ;; Only update if point moved outside the current region.
- (unless (memq highlight-overlay (overlays-at (point)))
- (let ((context-overlay
- (cl-loop for ov in (overlays-at (point))
- thereis (and (overlay-get ov 'gptel-overlay) ov))))
- (when highlight-overlay
- (overlay-put highlight-overlay 'face nil))
- (when context-overlay
- (overlay-put context-overlay 'face 'highlight))
- (setq highlight-overlay context-overlay))))))
-
-(defun gptel-context-visit ()
- "Display the location of this gptel context chunk in its original buffer."
- (interactive)
- (let ((ov-here (car (overlays-at (point)))))
- (if-let* ((source (overlay-get ov-here 'gptel-context))
- (buf (if (overlayp source)
- (overlay-buffer source)
- (find-file-noselect source)))
- (offset (- (point) (overlay-start ov-here))))
- (with-selected-window (display-buffer buf)
- (goto-char (if (overlayp source)
- (overlay-start source)
- (point-min)))
- (forward-char offset)
- (recenter))
- (message "No source location for this gptel context chunk."))))
-
-(defun gptel-context-next ()
- "Move to next gptel context chunk."
- (interactive)
- (let ((ov-here (car (overlays-at (point))))
- (next-start (next-overlay-change (point))))
- (when (and (/= (point-max) next-start) ov-here)
- ;; We were inside the overlay, so we want the next overlay change, which
- ;; would be the start of the next overlay.
- (setq next-start (next-overlay-change next-start)))
- (when (/= next-start (point-max))
- (setq gptel-context--buffer-reverse nil)
- (goto-char next-start)
- (recenter (floor (window-height) 4)))))
-
-(defun gptel-context-previous ()
- "Move to previous gptel context chunk."
- (interactive)
- (let ((ov-here (car (overlays-at (point)))))
- (when ov-here (goto-char (overlay-start ov-here)))
- (let ((previous-context-pos (previous-overlay-change
- (previous-overlay-change (point)))))
- ;; Prevent point from jumping to the start of the buffer.
- (unless (= previous-context-pos (point-min))
- (goto-char previous-context-pos)
- (recenter (floor (window-height) 4))
- (setq gptel-context--buffer-reverse t)))))
-
-(defun gptel-context-flag-deletion ()
- "Mark gptel context chunk at point for removal."
- (interactive)
- (let* ((overlays (if (use-region-p)
- (overlays-in (region-beginning) (region-end))
- (overlays-at (point))))
- (deletion-ov)
- (marked-ovs (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context-deletion-mark))
- overlays)))
- (if marked-ovs
- (mapc #'delete-overlay marked-ovs)
- (save-excursion
- (dolist (ov overlays)
- (when (overlay-get ov 'gptel-context)
- (goto-char (overlay-start ov))
- (setq deletion-ov (make-overlay (overlay-start ov) (overlay-end ov)))
- (overlay-put deletion-ov 'gptel-context (overlay-get ov 'gptel-context))
- (overlay-put deletion-ov 'priority -80)
- (overlay-put deletion-ov 'face 'gptel-context-deletion-face)
- (overlay-put deletion-ov 'gptel-context-deletion-mark t)))))
- (if (use-region-p)
- (deactivate-mark)
- (if gptel-context--buffer-reverse
- (gptel-context-previous)
- (gptel-context-next)))))
-
-(defun gptel-context-quit ()
- "Cancel pending operations and return to gptel's menu."
- (interactive)
- (quit-window)
- (call-interactively #'gptel-menu))
-
-(defun gptel-context-confirm ()
- "Confirm pending operations and return to gptel's menu."
- (interactive)
- ;; Delete all the context overlays that have been marked for deletion.
- (when-let* ((deletion-marks
- (delq nil (mapcar
- (lambda (ov)
- (and
- (overlay-get ov 'gptel-context-deletion-mark)
- (overlay-get ov 'gptel-context)))
- (overlays-in (point-min) (point-max))))))
- (mapc #'gptel-context-remove deletion-marks)
- (revert-buffer))
- ;; 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 (nreverse (gptel-context--collect)))
- (gptel-context-quit))
-
-(provide 'gptel-context)
-;;; gptel-context.el ends here.
+++ /dev/null
-;;; gptel-gemini.el --- Gemini suppport for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for the Gemini API to gptel
-
-;;; Code:
-(require 'gptel)
-(require 'cl-generic)
-(require 'map)
-(eval-when-compile (require 'cl-lib))
-
-(declare-function prop-match-value "text-property-search")
-(declare-function text-property-search-backward "text-property-search")
-(declare-function json-read "json")
-(declare-function gptel-context--wrap "gptel-context")
-(declare-function gptel-context--collect-media "gptel-context")
-(defvar json-object-type)
-
-;;; Gemini
-(cl-defstruct
- (gptel-gemini (:constructor gptel--make-gemini)
- (:copier nil)
- (:include gptel-backend)))
-
-;; TODO: Using alt=sse in the query url generates an OpenAI style streaming
-;; response, with more immediate updates. Maybe we should switch to that and
-;; rewrite the stream parser?
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-gemini) info)
- "Parse a Gemini data stream.
-
-Return the text response accumulated since the last call to this
-function. Additionally, mutate state INFO to add tool-use
-information if the stream contains it."
- (let* ((content-strs))
- (condition-case nil
- (while (prog1 (search-forward "{" nil t) ; while-let is Emacs 29.1+ only
- (backward-char 1))
- (save-match-data
- (when-let* ((response (gptel--json-read))
- (text (gptel--parse-response
- (plist-get info :backend)
- response info 'include)))
- (push text content-strs))))
- (error
- (goto-char (match-beginning 0))))
- (apply #'concat (nreverse content-strs))))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-gemini) response info
- &optional include-text)
- "Parse an Gemini (non-streaming) RESPONSE and return response text.
-
-Mutate state INFO with response metadata.
-
-If INCLUDE-TEXT is non-nil, include response text in the prompts
-list."
- (let* ((cand0 (map-nested-elt response '(:candidates 0)))
- (parts (map-nested-elt cand0 '(:content :parts))))
- (plist-put info :stop-reason (plist-get cand0 :finishReason))
- (plist-put info :output-tokens
- (map-nested-elt
- response '(:usageMetadata :candidatesTokenCount)))
- (cl-loop
- for part across parts
- for tx = (plist-get part :text)
- if (and tx (not (eq tx :null)))
- if (plist-get part :thought)
- do (unless (plist-get info :reasoning-block)
- (plist-put info :reasoning-block 'in))
- (plist-put info :reasoning (concat (plist-get info :reasoning) tx))
- else do
- (if (eq (plist-get info :reasoning-block) 'in)
- (plist-put info :reasoning-block t))
- and collect tx into content-strs end
- else if (plist-get part :functionCall)
- collect (copy-sequence it) into tool-use
- finally do ;Add text and tool-calls to prompts list
- (when (or tool-use include-text)
- (let* ((data (plist-get info :data))
- (prompts (plist-get data :contents))
- (last-prompt (aref prompts (1- (length prompts)))))
- (if (equal (plist-get last-prompt :role) "model")
- ;; When streaming, the last prompt may already have the role
- ;; "model" from prior calls to this function. Append to its parts
- ;; instead of adding a new model role then.
- (plist-put last-prompt :parts
- (vconcat (plist-get last-prompt :parts) parts))
- (plist-put ;otherwise create a new "model" role
- data :contents
- (vconcat prompts `((:role "model" :parts ,parts)))))))
- (when tool-use ;Capture tool call data for running tools
- (plist-put info :tool-use
- (nconc (plist-get info :tool-use) tool-use)))
- finally return
- (and content-strs (apply #'concat content-strs)))))
-
-(cl-defmethod gptel--request-data ((backend gptel-gemini) prompts)
- "JSON encode PROMPTS for sending to Gemini."
- (let ((prompts-plist
- (list :contents (vconcat prompts)
- :safetySettings [(:category "HARM_CATEGORY_HARASSMENT"
- :threshold "BLOCK_NONE")
- (:category "HARM_CATEGORY_SEXUALLY_EXPLICIT"
- :threshold "BLOCK_NONE")
- (:category "HARM_CATEGORY_DANGEROUS_CONTENT"
- :threshold "BLOCK_NONE")
- (:category "HARM_CATEGORY_HATE_SPEECH"
- :threshold "BLOCK_NONE")]))
- params)
- (if gptel--system-message
- (plist-put prompts-plist :systemInstruction
- `(:parts [(:text ,gptel--system-message)])))
- (when gptel-use-tools
- (when (eq gptel-use-tools 'force)
- (plist-put prompts-plist :toolConfig
- '(:functionCallingConfig (:mode "ANY"))))
- (when gptel-tools
- (plist-put prompts-plist :tools
- (gptel--parse-tools backend gptel-tools))))
- (when gptel-temperature
- (setq params
- (plist-put params
- :temperature (max gptel-temperature 1.0))))
- (when gptel-max-tokens
- (setq params
- (plist-put params
- :maxOutputTokens gptel-max-tokens)))
- (when gptel-include-reasoning
- (setq params
- (plist-put params :thinkingConfig '(:includeThoughts t))))
- (when gptel--schema
- (setq params (nconc params (gptel--gemini-filter-schema
- (gptel--parse-schema backend gptel--schema)))))
- (when params
- (plist-put prompts-plist
- :generationConfig params))
- ;; Merge request params with model and backend params.
- (gptel--merge-plists
- prompts-plist
- gptel--request-params
- (gptel-backend-request-params gptel-backend)
- (gptel--model-request-params gptel-model))))
-
-(cl-defmethod gptel--parse-schema ((_backend gptel-gemini) schema)
- (list :responseMimeType "application/json"
- :responseSchema (gptel--preprocess-schema
- (gptel--dispatch-schema-type schema))))
-
-(defun gptel--gemini-filter-schema (schema)
- "Destructively filter unsupported attributes from SCHEMA.
-
-Gemini's API does not support `additionalProperties'."
- (cl-remf schema :additionalProperties)
- (when (plistp schema)
- (cl-loop for (key val) on schema by #'cddr
- do (cond
- ;; Recursively modify schemas within vectors (anyOf/allOf)
- ((memq key '(:anyOf :allOf))
- (dotimes (i (length val))
- (aset val i (gptel--gemini-filter-schema (aref val i)))))
- ;; Recursively modify plist values, which may contain sub-schemas
- ((plistp val)
- (when (cl-remf val :additionalProperties)
- (cl-remf (plist-get schema key) :additionalProperties))
- (gptel--gemini-filter-schema val))
- ;; Default: do nothing to other key-value pairs yet.
- (t nil))))
- schema)
-
-(cl-defmethod gptel--parse-tools ((_backend gptel-gemini) tools)
- "Parse TOOLS to the Gemini API tool definition spec.
-
-TOOLS is a list of `gptel-tool' structs, which see."
- (cl-loop
- for tool in (ensure-list tools)
- collect
- (list
- :name (gptel-tool-name tool)
- :description (gptel-tool-description tool)
- :parameters
- (if (not (gptel-tool-args tool))
- :null ;NOTE: Gemini wants :null if the function takes no args
- (list :type "object"
- ;; See the generic implementation for an explanation of this
- ;; transformation.
- :properties
- (cl-loop
- for arg in (gptel-tool-args tool)
- for argspec = (copy-sequence arg)
- for name = (plist-get arg :name) ;handled differently
- for newname = (or (and (keywordp name) name)
- (make-symbol (concat ":" name)))
- do ;ARGSPEC is ARG without unrecognized keys
- (cl-remf argspec :name)
- (cl-remf argspec :optional)
- if (equal (plist-get arg :type) "object")
- do (unless (plist-member argspec :required)
- (plist-put argspec :required []))
- if (equal (plist-get arg :type) "string")
- do (cl-remf argspec :format)
- append (list newname (gptel--gemini-filter-schema argspec)))
- :required
- (vconcat
- (delq nil (mapcar
- (lambda (arg) (and (not (plist-get arg :optional))
- (plist-get arg :name)))
- (gptel-tool-args tool)))))))
- into tool-specs
- finally return `[(:functionDeclarations ,(vconcat tool-specs))]))
-
-(cl-defmethod gptel--parse-tool-results ((_backend gptel-gemini) tool-use)
- "Return a prompt containing tool call results in TOOL-USE."
- (list
- :role "user"
- :parts
- (vconcat
- (mapcar
- (lambda (tool-call)
- (let ((result (plist-get tool-call :result))
- (name (plist-get tool-call :name)))
- `(:functionResponse
- (:name ,name :response
- (:name ,name :content ,result)))))
- tool-use))))
-
-(cl-defmethod gptel--inject-prompt ((_backend gptel-gemini) data new-prompt &optional _position)
- "Append NEW-PROMPT to existing prompts in query DATA.
-
-See generic implementation for full documentation."
- (let ((prompts (plist-get data :contents)))
- (plist-put data :contents (vconcat prompts (list new-prompt)))))
-
-(cl-defmethod gptel--parse-list ((backend gptel-gemini) prompt-list)
- (if (consp (car prompt-list))
- (let ((full-prompt)) ; Advanced format, list of lists
- (dolist (entry prompt-list)
- (pcase entry
- (`(prompt . ,msg)
- (push (list :role "user"
- :parts `[(:text ,(or (car-safe msg) msg))])
- full-prompt))
- (`(response . ,msg)
- (push (list :role "model"
- :parts `[(:text ,(or (car-safe msg) msg))])
- full-prompt))
- (`(tool . ,call)
- (push (list :role "model"
- :parts (vector `(:functionCall ( :name ,(plist-get call :name)
- :args ,(plist-get call :args)))))
- full-prompt)
- (push (gptel--parse-tool-results backend (list (cdr entry))) full-prompt))))
- (nreverse full-prompt))
- (cl-loop for text in prompt-list ; Simple format, list of strings
- for role = t then (not role)
- if text
- if role
- collect (list :role "user" :parts `[(:text ,text)]) into prompts
- else collect (list :role "model" :parts `[(:text ,text)]) into prompts
- finally return prompts)))
-
-(cl-defmethod gptel--parse-buffer ((backend gptel-gemini) &optional max-entries)
- (let ((prompts) (prev-pt (point)))
- (if (or gptel-mode gptel-track-response)
- (while (and (or (not max-entries) (>= max-entries 0))
- (goto-char (previous-single-property-change
- (point) 'gptel nil (point-min)))
- (not (= (point) prev-pt)))
- (pcase (get-char-property (point) 'gptel)
- ('response
- (when-let* ((content (gptel--trim-prefixes
- (buffer-substring-no-properties (point) prev-pt))))
- (push (list :role "model" :parts `[(:text ,content)]) prompts)))
- (`(tool . ,_id)
- (save-excursion
- (condition-case nil
- (let* ((tool-call (read (current-buffer)))
- (name (plist-get tool-call :name))
- (arguments (plist-get tool-call :args)))
- (plist-put tool-call :result
- (string-trim (buffer-substring-no-properties
- (point) prev-pt)))
- (push (gptel--parse-tool-results backend (list tool-call))
- prompts)
- (push (list :role "model"
- :parts
- (vector `(:functionCall ( :name ,name
- :args ,arguments))))
- prompts))
- ((end-of-file invalid-read-syntax)
- (message (format "Could not parse tool-call on line %s"
- (line-number-at-pos (point))))))))
- ('ignore)
- ('nil
- (if gptel-track-media
- (when-let* ((content (gptel--gemini-parse-multipart
- (gptel--parse-media-links major-mode (point) prev-pt))))
- (when (> (length content) 0)
- (push (list :role "user" :parts content) prompts)))
- (when-let* ((content (gptel--trim-prefixes
- (buffer-substring-no-properties
- (point) prev-pt))))
- (push (list :role "user" :parts `[(:text ,content)]) prompts)))))
- (setq prev-pt (point))
- (and max-entries (cl-decf max-entries)))
- (let ((content (string-trim (buffer-substring-no-properties
- (point-min) (point-max)))))
- (push (list :role "user" :parts `[(:text ,content)]) prompts)))
- prompts))
-
-(defun gptel--gemini-parse-multipart (parts)
- "Convert a multipart prompt PARTS to the Gemini API format.
-
-The input is an alist of the form
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\")).
-
-The output is a vector of entries in a backend-appropriate
-format."
- (cl-loop
- for part in parts
- for n upfrom 1
- with last = (length parts)
- for text = (plist-get part :text)
- for media = (plist-get part :media)
- if text do
- (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and
- if text
- collect (list :text text) into parts-array end
- else if media
- collect
- `(:inline_data
- (:mime_type ,(plist-get part :mime)
- :data ,(gptel--base64-encode media)))
- into parts-array
- else if (plist-get part :textfile)
- collect
- (list :text (with-temp-buffer
- (gptel--insert-file-string (plist-get part :textfile))
- (buffer-string)))
- into parts-array
- finally return (vconcat parts-array)))
-
-(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)
- (vconcat (gptel--gemini-parse-multipart media-list)
- current))
- (plist-get (car prompts) :parts))))
-
-(defconst gptel--gemini-models
- '((gemini-pro-latest
- :description "Most powerful Gemini thinking model, always points to latest version"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 1048 ; 65536 output token limit
- :input-cost 1.25 ; 2.50 for >200k tokens
- :output-cost 10.00 ; 15 for >200k tokens
- :cutoff-date "2025-01")
- (gemini-flash-latest
- :description "Best price / performance, always points to latest version"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 1048 ; 65536 output token limit
- :input-cost 0.3
- :output-cost 2.50
- :cutoff-date "2025-01")
- (gemini-flash-lite-latest
- :description "Fastest, cheapest Gemini model, always points to latest version"
- :capabilities (tool-use json media)
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain"
- "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg"
- "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm"
- "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4"
- "video/webm" "video/wmv" "video/3gpp")
- :context-window 1048 ; 64000 output token limit
- :input-cost 0.10
- :output-cost 0.40
- :cutoff-date "2025-01")
- (gemini-3-pro-preview
- :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 1048 ; 65536 output token limit
- :input-cost 2.0 ; 4.0 for >200k tokens
- :output-cost 12.00 ; 18.0 for >200k tokens
- :cutoff-date "2025-01")
- (gemini-3-flash-preview
- :description "Most intelligent Gemini model built for speed"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 1048 ; 65536 output token limit
- :input-cost 0.50
- :output-cost 3.00
- :cutoff-date "2025-01")
- (gemini-2.5-pro
- :description "Most powerful Gemini thinking model with state-of-the-art performance"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 1048 ; 65536 output token limit
- :input-cost 1.25 ; 2.50 for >200k tokens
- :output-cost 10.00 ; 15 for >200k tokens
- :cutoff-date "2025-01")
- (gemini-2.5-pro-preview-06-05
- :description "Most powerful thinking model with state-of-the-art performance"
- :capabilities (tool-use json media)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html")
- :context-window 1048 ; 65536 output token limit
- :input-cost 1.25 ; 2.50 for >200k tokens
- :output-cost 10.00 ; 15 for >200k tokens
- :cutoff-date "2025-01")
- (gemini-2.5-flash
- :description "Best in terms of price-performance, with well-rounded capabilities"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 1048 ; 65536 output token limit
- :input-cost 0.3
- :output-cost 2.50
- :cutoff-date "2025-01")
- (gemini-2.5-flash-preview-09-2025
- :description "DEPRECATED: Please use gemini-2.5-flash instead"
- :capabilities (tool-use json media)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html")
- :context-window 1048 ; 65536 output token limit
- :input-cost 0.15
- :output-cost 0.60 ; 3.50 for thinking
- :cutoff-date "2025-01")
- (gemini-2.5-flash-lite
- :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks"
- :capabilities (tool-use json media)
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain"
- "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg"
- "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm"
- "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4"
- "video/webm" "video/wmv" "video/3gpp")
- :context-window 1048 ; 64000 output token limit
- :input-cost 0.10
- :output-cost 0.40
- :cutoff-date "2025-01")
- (gemini-2.5-flash-lite-preview-09-2025
- :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain"
- "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg"
- "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm"
- "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4"
- "video/webm" "video/wmv" "video/3gpp")
- :context-window 1048 ; 65536 output token limit
- :input-cost 0.10
- :output-cost 0.40
- :cutoff-date "2025-01")
- (gemini-2.0-flash
- :description "Next gen, high speed, multimodal for a diverse variety of tasks"
- :capabilities (tool-use json media)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html")
- :context-window 1000
- :input-cost 0.10
- :output-cost 0.40
- :cutoff-date "2024-08")
- (gemini-2.0-flash-exp
- :description "Next generation features, superior speed, native tool use"
- :capabilities (tool-use json media)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html")
- :context-window 1000
- :input-cost 0.00
- :output-cost 0.00)
- (gemini-2.0-flash-thinking-exp
- :description "DEPRECATED: Please use gemini-2.0-flash-thinking-exp-01-21 instead"
- :capabilities (tool-use media)
- :context-window 32
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "text/plain" "text/csv" "text/html")
- :input-cost 0.00
- :output-cost 0.00))
- "List of available Gemini models and associated properties.
-Keys:
-
-- `:description': a brief description of the model.
-
-- `:capabilities': a list of capabilities supported by the model.
-
-- `:mime-types': a list of supported MIME types for media files.
-
-- `:context-window': the context window size, in thousands of tokens.
-
-- `:input-cost': the input cost, in US dollars per million tokens.
-
-- `:output-cost': the output cost, in US dollars per million tokens.
-
-- `:cutoff-date': the knowledge cutoff date.
-
-- `:request-params': a plist of additional request parameters to
- include when using this model.
-
-Information about the Gemini models was obtained from the following
-source:
-
-- <https://ai.google.dev/pricing>
-- <https://ai.google.dev/gemini-api/docs/models>")
-
-;;;###autoload
-(cl-defun gptel-make-gemini
- (name &key curl-args header key request-params
- (stream nil)
- (host "generativelanguage.googleapis.com")
- (protocol "https")
- (models gptel--gemini-models)
- (endpoint "/v1beta/models"))
-
- "Register a Gemini backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, defaults to
-\"generativelanguage.googleapis.com\".
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--gemini-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(gemini-2.0-flash-lite ;Simple specs
- gemini-1.5-flash
- (gemini-1.5-pro-latest ;Full spec
- :description
- \"Complex reasoning tasks, problem solving and data extraction\"
- :capabilities (tool json)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\")))
-
-
-STREAM is a boolean to enable streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, \"https\" by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1beta/models\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for."
- (declare (indent 1))
- (let ((backend (gptel--make-gemini
- :curl-args curl-args
- :name name
- :host host
- :header header
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :key key
- :url (lambda ()
- (let ((method
- (if (and stream gptel-use-curl gptel-stream)
- "streamGenerateContent"
- "generateContent")))
- (format "%s://%s%s/%s:%s?key=%s"
- protocol
- host
- endpoint
- gptel-model
- method
- (gptel--get-api-key)))))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-(provide 'gptel-gemini)
-;;; gptel-gemini.el ends here
+++ /dev/null
-;;; gptel-gh.el --- Github Copilot AI suppport for gptel -*- lexical-binding: t; -*-
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for Github Copilot API to gptel
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl-lib))
-(require 'map)
-(require 'gptel)
-(require 'browse-url)
-
-;;; Github Copilot
-(defconst gptel--gh-models
- '((gpt-4o
- :description
- "Advanced model for complex tasks; cheaper & faster than GPT-Turbo"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 128 :input-cost 0 :output-cost 0 :cutoff-date "2023-10")
- (gpt-4.1
- :description "Flagship model for complex tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 128
- :input-cost 0
- :output-cost 0
- :cutoff-date "2024-05")
- (gpt-41-copilot
- :description "Flagship model for complex tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 200
- :input-cost 0
- :output-cost 0
- :cutoff-date "2024-05")
- (gpt-5
- :description "Flagship model for coding, reasoning, and agentic tasks across domains"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 264
- :input-cost 1
- :output-cost 1
- :cutoff-date "2024-09")
- (gpt-5.1-codex-max
- :description "Flagship model for coding, reasoning, and agentic tasks across domains"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 1
- :output-cost 1
- :cutoff-date "2024-09")
- (gpt-5-mini
- :description "Faster, more cost-efficient version of GPT-5"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 264
- :input-cost 0
- :output-cost 0
- :cutoff-date "2024-09")
- (gpt-5.1
- :description "The best model for coding and agentic tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 1
- :output-cost 1
- :cutoff-date "2024-09")
- (gpt-5.2
- :description "The best model for coding and agentic tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 1.75
- :output-cost 14
- :cutoff-date "2025-08")
- (claude-sonnet-4
- :description "High-performance model with exceptional reasoning and efficiency"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 216
- :input-cost 1
- :output-cost 1
- :cutoff-date "2025-03")
- (claude-sonnet-4.5
- :description "High-performance model with exceptional reasoning and efficiency"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 144
- :input-cost 1
- :output-cost 1
- :cutoff-date "2025-07")
- (claude-haiku-4.5
- :description "Near-frontier intelligence at blazing speeds with extended thinking"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 144
- :input-cost 0.33
- :output-cost 0.33
- :cutoff-date "2025-02")
- (claude-opus-41
- :description "Most capable model for complex reasoning and advanced coding"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 80
- :input-cost 10
- :output-cost 10
- :cutoff-date "2025-03")
- (claude-opus-4.5
- :description "Most capable model for complex reasoning and advanced coding"
- :capabilities (media tool-use cache)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
- :context-window 144
- :input-cost 3
- :output-cost 3
- :cutoff-date "2025-05")
- (gemini-2.5-pro
- :description "Next gen, high speed, multimodal for a diverse variety of tasks"
- :capabilities (tool-use json media)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html")
- :context-window 128
- :input-cost 1
- :output-cost 1
- :cutoff-date "2024-08")
- (gemini-3-flash-preview
- :description "Most intelligent Gemini model built for speed"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 128
- :input-cost 0.33
- :output-cost 0.33
- :cutoff-date "2025-01")
- (gemini-3-pro-preview
- :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding"
- :capabilities (tool-use json media audio video)
- :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
- "application/pdf" "text/plain" "text/csv" "text/html"
- "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
- "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
- :context-window 128
- :input-cost 1
- :output-cost 1
- :cutoff-date "2025-01")
- (grok-code-fast-1
- :description "Fast reasoning model for agentic coding"
- :capabilities '(tool-use json reasoning)
- :context-window 128
- :input-cost 0.2
- :output-cost 1.5)))
-
-(cl-defstruct (gptel--gh (:include gptel-openai)
- (:copier nil)
- (:constructor gptel--make-gh))
- token github-token sessionid machineid)
-
-(defcustom gptel-gh-github-token-file (expand-file-name ".cache/copilot-chat/github-token"
- user-emacs-directory)
- "File where the GitHub token is stored."
- :type 'string
- :group 'gptel)
-
-(defcustom gptel-gh-token-file (expand-file-name ".cache/copilot-chat/token"
- user-emacs-directory)
- "File where the chat token is cached."
- :type 'string
- :group 'gptel)
-
-(defconst gptel--gh-auth-common-headers
- `(("editor-plugin-version" . "gptel/*")
- ("editor-version" . ,(concat "emacs/" emacs-version))))
-
-(defconst gptel--gh-client-id "Iv1.b507a08c87ecfe98")
-
-;; https://en.wikipedia.org/wiki/Universally_unique_identifier#Version_4_(random)
-(defun gptel--gh-uuid ()
- "Generate a UUID v4-1."
- (format "%04x%04x-%04x-4%03x-8%03x-%04x%04x%04x"
- (random #x10000) (random #x10000)
- (random #x10000)
- (random #x1000)
- (random #x1000)
- (random #x10000) (random #x10000) (random #x10000)))
-
-(defun gptel--gh-machine-id ()
- "Generate a machine ID."
- (let ((hex-chars "0123456789abcdef")
- (length 65)
- hex)
- (dotimes (_ length)
- (setq hex (nconc hex (list (aref hex-chars (random 16))))))
- (apply #'string hex)))
-
-(defun gptel--gh-restore (file)
- "Restore saved object from FILE."
- (when (file-exists-p file)
- ;; We set the coding system to `utf-8-auto-dos' when reading so that
- ;; files with CR EOL can still be read properly
- (let ((coding-system-for-read 'utf-8-auto-dos))
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally file)
- (goto-char (point-min))
- (read (current-buffer))))))
-
-(defun gptel--gh-save (file obj)
- "Save OBJ to FILE."
- (let ((print-length nil)
- (print-level nil)
- (coding-system-for-write 'utf-8-unix))
- (make-directory (file-name-directory file) t)
- (write-region (prin1-to-string obj) nil file nil :silent)
- obj))
-
-(defun gptel-gh-login ()
- "Login to GitHub Copilot API.
-
-This will prompt you to authorize in a browser and store the token.
-
-In SSH sessions, the URL and code will be displayed for manual entry
-instead of attempting to open a browser automatically."
- (interactive)
- ;; Determine which GitHub backend to use
- (let ((gh-backend
- (cond
- ;; If current backend is GitHub, use it
- ((and (boundp 'gptel-backend)
- gptel-backend
- (gptel--gh-p gptel-backend))
- gptel-backend)
- ;; Otherwise, find any GitHub backend
- ((cl-find-if (lambda (b) (gptel--gh-p b))
- (mapcar #'cdr gptel--known-backends)))
- ;; No GitHub backend found
- (t (user-error "No GitHub Copilot backend found. \
-Please set one up with `gptel-make-gh-copilot' first"))))
- ;; Detect SSH sessions
- (in-ssh-session (or (getenv "SSH_CLIENT")
- (getenv "SSH_CONNECTION")
- (getenv "SSH_TTY"))))
- (pcase-let (((map :device_code :user_code :verification_uri)
- (gptel--url-retrieve
- "https://github.com/login/device/code"
- :method 'post
- :headers gptel--gh-auth-common-headers
- :data `( :client_id ,gptel--gh-client-id
- :scope "read:user"))))
- (gui-set-selection 'CLIPBOARD user_code)
- (if in-ssh-session
- ;; SSH session: display URL and code, don't auto-open browser
- (progn
- (message "GitHub Device Code: %s (copied to clipboard)" user_code)
- (read-from-minibuffer
- (format "Code %s is copied. Visit https://github.com/login/device \
-in your local browser, enter the code, and authorize. Press ENTER after authorizing. "
- user_code)))
- ;; Local session: auto-open browser
- (read-from-minibuffer
- (format "Your one-time code %s is copied. \
-Press ENTER to open GitHub in your browser. \
-If your browser does not open automatically, browse to %s."
- user_code verification_uri))
- (browse-url verification_uri)
- (read-from-minibuffer "Press ENTER after authorizing. "))
- ;; Use gh-backend for token storage
- (thread-last
- (plist-get
- (gptel--url-retrieve
- "https://github.com/login/oauth/access_token"
- :method 'post
- :headers gptel--gh-auth-common-headers
- :data `( :client_id ,gptel--gh-client-id
- :device_code ,device_code
- :grant_type "urn:ietf:params:oauth:grant-type:device_code"))
- :access_token)
- (gptel--gh-save gptel-gh-github-token-file)
- (setf (gptel--gh-github-token gh-backend))))
- ;; Check gh-backend for success
- (if (and (gptel--gh-github-token gh-backend)
- (not (string-empty-p
- (gptel--gh-github-token gh-backend))))
- (message "Successfully logged in to GitHub Copilot.")
- (user-error "Error: You might not have access to GitHub Copilot Chat!"))))
-
-(defun gptel--gh-renew-token ()
- "Renew session token."
- (let ((token
- (gptel--url-retrieve
- "https://api.github.com/copilot_internal/v2/token"
- :method 'get
- :headers `(("authorization"
- . ,(format "token %s" (gptel--gh-github-token gptel-backend)))
- ,@gptel--gh-auth-common-headers))))
- (if (not (plist-get token :token))
- (progn
- (setf (gptel--gh-github-token gptel-backend) nil)
- (user-error "Error: You might not have access to GitHub Copilot Chat!"))
- (thread-last
- (gptel--gh-save gptel-gh-token-file token)
- (setf (gptel--gh-token gptel-backend))))))
-
-(defun gptel--gh-auth ()
- "Authenticate with GitHub Copilot API.
-
-We first need github authorization (github token).
-Then we need a session token."
- (unless (gptel--gh-github-token gptel-backend)
- (let ((token (gptel--gh-restore gptel-gh-github-token-file)))
- (if token
- (setf (gptel--gh-github-token gptel-backend) token)
- (gptel-gh-login))))
-
- (when (null (gptel--gh-token gptel-backend))
- ;; try to load token from `gptel-gh-token-file'
- (setf (gptel--gh-token gptel-backend)
- (gptel--gh-restore gptel-gh-token-file)))
-
- (pcase-let (((map :token :expires_at)
- (gptel--gh-token gptel-backend)))
- (when (or (null token)
- (and expires_at
- (> (round (float-time (current-time)))
- expires_at)))
- (gptel--gh-renew-token))))
-
-;;;###autoload
-(cl-defun gptel-make-gh-copilot
- (name &key curl-args request-params
- (header (lambda ()
- (gptel--gh-auth)
- `(("openai-intent" . "conversation-panel")
- ("authorization" . ,(concat "Bearer "
- (plist-get (gptel--gh-token gptel-backend) :token)))
- ("x-request-id" . ,(gptel--gh-uuid))
- ("vscode-sessionid" . ,(or (gptel--gh-sessionid gptel-backend) ""))
- ("vscode-machineid" . ,(or (gptel--gh-machineid gptel-backend) ""))
- ,@(when (and gptel-track-media
- (gptel--model-capable-p 'media))
- `(("copilot-vision-request" . "true")))
- ("copilot-integration-id" . "vscode-chat"))))
- (host "api.githubcopilot.com")
- (protocol "https")
- (endpoint "/chat/completions")
- (stream t)
- (models gptel--gh-models))
- "Register a Github Copilot chat backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, typically \"api.githubcopilot.com\".
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--openai-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(gpt-3.5-turbo ;Simple specs
- gpt-4-turbo
- (gpt-4o-mini ;Full spec
- :description
- \"Affordable and intelligent small model for lightweight tasks\"
- :capabilities (media tool json url)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
-
-Defaults to a list of models supported by GitHub Copilot.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/chat/completions\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that returns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-Defaults to headers required by GitHub Copilot.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for."
- (declare (indent 1))
- (let ((backend (gptel--make-gh
- :name name
- :host host
- :header header
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :curl-args curl-args
- :url (concat protocol "://" host endpoint)
- :machineid (gptel--gh-machine-id))))
- (setf (alist-get name gptel--known-backends nil nil #'equal) backend)
- backend))
-
-(provide 'gptel-gh)
-;;; gptel-gh.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not docstrings)
-;; End:
+++ /dev/null
-;;; gptel-transient.el --- Integrations for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords: convenience
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Integrations with related packages for gptel. To use these, run
-;;
-;; (require 'gptel-integrations)
-;;
-;; For MCP integration:
-;; - Run M-x `gptel-mcp-connect' and M-x `gptel-mcp-disconnect', OR
-;; - Use gptel's tools menu, M-x `gptel-tools', OR
-;; - Access tools from `gptel-menu'
-
-;;; Code:
-(require 'gptel)
-(require 'cl-lib)
-(eval-when-compile (require 'transient))
-
-;;;; MCP integration - requires the mcp package
-(declare-function mcp-hub-get-all-tool "mcp-hub")
-(declare-function mcp-hub-get-servers "mcp-hub")
-(declare-function mcp-hub-start-all-server "mcp-hub")
-(declare-function mcp-stop-server "mcp")
-(declare-function mcp-hub "mcp-hub")
-(declare-function mcp--status "mcp-hub")
-(declare-function mcp--tools "mcp-hub")
-(declare-function mcp-make-text-tool "mcp-hub")
-(defvar mcp-hub-servers)
-(defvar mcp-server-connections)
-
-(defun gptel-mcp-connect (&optional servers server-callback interactive)
- "Add gptel tools from MCP servers using the mcp package.
-
-MCP servers are started if required. SERVERS is a list of server
-names (strings) to connect to. If nil, all known servers are
-considered.
-
-If INTERACTIVE is non-nil (or called interactively), guide the user
-through setting up mcp, and query for servers to retrieve tools from.
-
-Call SERVER-CALLBACK after starting MCP servers. If SERVER-CALLBACK is
-not a function and non-nil, start SERVERS synchronously."
- (interactive (list nil nil t))
- (if (locate-library "mcp-hub")
- (unless (require 'mcp-hub nil t)
- (user-error "Could not load `mcp-hub'! Please install\
- or configure the mcp package"))
- (user-error "Could not find mcp! Please install or configure the mcp package"))
- (if (null mcp-hub-servers)
- (user-error "No MCP servers available! Please configure `mcp-hub-servers'")
- (setq servers
- (if servers
- (mapcar (lambda (s) (assoc s mcp-hub-servers)) servers)
- mcp-hub-servers))
- (let ((unregistered-servers ;Available servers minus servers already registered with gptel
- (cl-loop for server in servers
- with registered-names =
- (cl-loop for (cat . _tools) in gptel--known-tools
- if (string-prefix-p "mcp-" cat)
- collect (substring cat 4))
- unless (member (car server) registered-names)
- collect server)))
- (if unregistered-servers
- (let* ((servers
- (if interactive
- (let ((picks
- (completing-read-multiple
- "Add tools from MCP servers (separate with \",\"): "
- (cons '("ALL") unregistered-servers) nil t)))
- (if (member "ALL" picks)
- unregistered-servers
- (mapcar (lambda (s) (assoc s mcp-hub-servers)) picks)))
- unregistered-servers))
- (server-active-p
- (lambda (server)
- (when-let* ((server (gethash (car server) mcp-server-connections)))
- (equal (mcp--status server) 'connected))))
- (inactive-servers (cl-remove-if server-active-p servers))
- (add-all-tools
- (lambda (&optional server-names)
- "Register and add tools from servers. Report failures."
- (let ((tools (gptel-mcp--get-tools
- (or server-names (mapcar #'car inactive-servers))))
- (now-active (cl-remove-if-not server-active-p mcp-hub-servers)))
- (mapc (lambda (tool) (apply #'gptel-make-tool tool)) tools)
- (gptel-mcp--activate-tools tools)
- (if-let* ((failed (cl-set-difference inactive-servers now-active
- :test #'equal)))
- (progn
- (message "Inactive-before: %S, Now-Active: %S" inactive-servers now-active)
- (message (substitute-command-keys
- "%d/%d server%s failed to start: %s. Run \\[mcp-hub] to investigate.")
- (length failed) (length inactive-servers)
- (if (= (length failed) 1) "" "s")
- (mapconcat #'car failed ", ")))
- (let ((added (or server-names (mapcar #'car now-active))))
- (message "Added %d tools from %d MCP server%s: %s"
- (length tools) (length added)
- (if (= (length added) 1) "" "s")
- (mapconcat #'identity added ", "))))
- (when (functionp server-callback) (funcall server-callback))))))
-
- (if inactive-servers ;start servers
- (let ((syncp (and server-callback (not (functionp server-callback)) t)))
- (mcp-hub-start-all-server
- add-all-tools (mapcar #'car inactive-servers) syncp))
- (funcall add-all-tools (mapcar #'car servers))))
- (when interactive (message "All MCP tools are already available to gptel!"))
- (when (functionp server-callback) (funcall server-callback))))))
-
-(defun gptel-mcp-disconnect (&optional servers interactive)
- "Unregister gptel tools provided by MCP servers using the mcp package.
-
-SERVERS is a list of server names (strings) to disconnect from.
-
-If INTERACTIVE is non-nil, query the user about which tools to remove."
- (interactive (list nil t))
- (if-let* ((names-alist
- (cl-loop
- for (category . _tools) in gptel--known-tools
- if (and (string-match "^mcp-\\(.*\\)" category)
- (or (null servers) ;Consider all if nil
- (member (match-string 1 category) servers)))
- collect (cons (match-string 1 category) category))))
- (let ((remove-fn (lambda (cat-names)
- (setq gptel-tools ;Remove from gptel-tools
- (cl-delete-if (lambda (tool) (member (gptel-tool-category tool)
- cat-names))
- gptel-tools))
- (mapc (lambda (category) ;Remove from registry
- (setf (alist-get category gptel--known-tools
- nil t #'equal)
- nil))
- cat-names))))
- (if interactive
- (when-let* ((server-names
- (completing-read-multiple
- "Remove MCP server tools for (separate with \",\"): "
- (cons '("ALL" . nil) names-alist)
- nil t)))
- (when (member "ALL" server-names)
- (setq server-names (mapcar #'car names-alist)))
- (funcall remove-fn ;remove selected tool categories
- (mapcar (lambda (s) (cdr (assoc s names-alist))) server-names))
- (if (y-or-n-p
- (format "Removed MCP tools from %d server%s. Also shut down MCP servers?"
- (length server-names)
- (if (= (length server-names) 1) "" "s")))
- (progn (mapc #'mcp-stop-server server-names)
- (message "Shut down MCP servers: %S" server-names))
- (message "Removed MCP tools for: %S" server-names)))
- (funcall remove-fn (mapcar #'cdr names-alist))))
- ;; No MCP tools, ask to shut down servers
- (if (cl-loop
- for v being the hash-values of mcp-server-connections
- never v)
- (when interactive (message "No MCP servers active!"))
- (when (or (not interactive)
- (y-or-n-p "No MCP tools in gptel! Shut down all MCP servers? "))
- (dolist (server mcp-hub-servers)
- (when (gethash (car server) mcp-server-connections)
- (mcp-stop-server (car server))))))))
-
-(defun gptel-mcp--get-tools (&optional server-names)
- "Return tools from running MCP servers.
-
-SERVER-NAMES is a list of server names to add tools from. Add tools
-from all connected servers if it is nil."
- (unless server-names
- (setq server-names (hash-table-keys mcp-server-connections)))
- (let ((servers (mapcar (lambda (n) (gethash n mcp-server-connections))
- server-names)))
- (cl-mapcan
- (lambda (name server)
- (when (and server (equal (mcp--status server) 'connected))
- (when-let* ((tools (mcp--tools server))
- (tool-names (mapcar #'(lambda (tool) (plist-get tool :name)) tools)))
- (mapcar (lambda (tool-name)
- (plist-put (mcp-make-text-tool name tool-name t)
- :category (format "mcp-%s" name)))
- tool-names))))
- server-names servers)))
-
-(defun gptel-mcp--activate-tools (&optional tools)
- "Activate TOOLS or all MCP tools in current gptel session."
- (unless tools (setq tools (gptel-mcp--get-tools)))
- (dolist (tool tools)
- (cl-pushnew (gptel-get-tool (list (plist-get tool :category)
- (plist-get tool :name)))
- gptel-tools)))
-
-(with-eval-after-load 'gptel-transient
- (transient-define-suffix gptel--suffix-mcp-connect ()
- "Register tools provided by MCP servers."
- :key "M+"
- :description "Add MCP server tools"
- :transient t
- (interactive)
- ;; gptel-tools stores its state in its scope slot. Retain the scope but
- ;; update it with the newly selected tools. Then set up gptel-tools.
- (condition-case err
- (gptel-mcp-connect
- nil (lambda () (when-let* ((transient--prefix)
- ((eq (oref transient--prefix command)
- 'gptel-tools)))
- (let ((state (transient-scope 'gptel-tools)))
- (plist-put state :tools
- (delete-dups
- (nconc (mapcar (lambda (tool)
- (list (gptel-tool-category tool)
- (gptel-tool-name tool)))
- gptel-tools)
- (plist-get state :tools))))
- (transient-setup 'gptel-tools nil nil :scope state))))
- t)
- (user-error (message "%s" (cadr err)))))
-
- (transient-define-suffix gptel--suffix-mcp-disconnect ()
- "Remove tools provided by MCP servers from gptel."
- :key "M-"
- :description (lambda () (if (cl-some (lambda (cat) (string-match-p "^mcp-" cat))
- (map-keys gptel--known-tools))
- "Remove MCP server tools"
- "Shut down MCP servers"))
- :transient t
- :inapt-if
- (lambda () (or (not (boundp 'mcp-hub-servers))
- (null mcp-hub-servers)
- (cl-loop
- for v being the hash-values of mcp-server-connections
- never v)))
- (interactive)
- (call-interactively #'gptel-mcp-disconnect)
- ;; gptel-tools stores its state in its scope slot. Retain the scope but
- ;; remove tools from it that no longer exist, then set up gptel-tools
- (cl-loop with state = (transient-scope 'gptel-tools)
- with tools = (plist-get state :tools)
- for tool-spec in tools
- if (map-nested-elt gptel--known-tools tool-spec)
- collect tool-spec into valid-tools
- finally do (plist-put state :tools valid-tools)
- (transient-setup 'gptel-tools nil nil :scope state)))
-
- (transient-remove-suffix 'gptel-tools '(0 2))
- (transient-append-suffix 'gptel-tools '(0 -1)
- [""
- (gptel--suffix-mcp-connect)
- (gptel--suffix-mcp-disconnect)]))
-
-(provide 'gptel-integrations)
-;;; gptel-integrations.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not noruntime)
-;; End:
+++ /dev/null
-;;; gptel-kagi.el --- Kagi support for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords: hypermedia
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for the Kagi FastGPT LLM API to gptel
-
-;;; Code:
-(require 'gptel)
-(require 'cl-generic)
-(eval-when-compile
- (require 'cl-lib))
-
-(declare-function gptel-context--wrap "gptel-context")
-
-;;; Kagi
-(cl-defstruct (gptel-kagi (:constructor gptel--make-kagi)
- (:copier nil)
- (:include gptel-backend)))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-kagi) response info)
- (let* ((data (plist-get response :data))
- (output (plist-get data :output))
- (references (plist-get data :references)))
- (if (eq references :null) (setq references nil))
- (if (eq output :null) (setq output nil))
- (when references
- (setq references
- (cl-loop with linker =
- (pcase (buffer-local-value 'major-mode
- (plist-get info :buffer))
- ('org-mode
- (lambda (text url)
- (format "[[%s][%s]]" url text)))
- ('markdown-mode
- (lambda (text url)
- (format "[%s](%s)" text url)))
- (_ (lambda (text url)
- (buttonize
- text (lambda (data) (browse-url data))
- url))))
- for ref across references
- for title = (plist-get ref :title)
- for snippet = (plist-get ref :snippet)
- for url = (plist-get ref :url)
- for n upfrom 1
- collect
- (concat (format "[%d] " n)
- (funcall linker title url) ": "
- (replace-regexp-in-string
- "</?b>" "*" snippet))
- into ref-strings
- finally return
- (concat "\n\n" (mapconcat #'identity ref-strings "\n")))))
- (concat output references)))
-
-;; TODO: Add support for model/backend-specific request-params and
-;; gptel--request-params
-(cl-defmethod gptel--request-data ((_backend gptel-kagi) prompts)
- "JSON encode PROMPTS for Kagi."
- (pcase-exhaustive (gptel--model-name gptel-model)
- ("fastgpt"
- `(,@prompts :web_search t :cache t))
- ((and model (guard (string-prefix-p "summarize" model)))
- `(,@prompts :engine ,(substring model 10)))))
-
-(cl-defmethod gptel--parse-buffer ((_backend gptel-kagi) &optional _max-entries)
- (let ((url (or (thing-at-point 'url)
- (get-text-property (point) 'shr-url)
- (get-text-property (point) 'image-url)))
- ;; (filename (thing-at-point 'existing-filename)) ;no file upload support yet
- (prop (text-property-search-backward
- 'gptel 'response
- (when (get-char-property (max (point-min) (1- (point)))
- 'gptel)
- t))))
- (if (and url (string-prefix-p "summarize" (gptel--model-name gptel-model)))
- (list :url url)
- (if (and (or gptel-mode gptel-track-response)
- (prop-match-p prop)
- (prop-match-value prop))
- (user-error "No user prompt found!")
- (let ((prompts
- (if (or gptel-mode gptel-track-response)
- (or (gptel--trim-prefixes
- (buffer-substring-no-properties (prop-match-beginning prop)
- (prop-match-end prop)))
- "")
- (string-trim (buffer-substring-no-properties (point-min) (point-max))))))
- (pcase-exhaustive (gptel--model-name gptel-model)
- ("fastgpt" (setq prompts (list :query (if (prop-match-p prop) prompts ""))))
- ((and model (guard (string-prefix-p "summarize" model)))
- ;; If the entire contents of the prompt looks like a url, send the url
- ;; Else send the text of the region
- (setq prompts
- (if-let* (((prop-match-p prop))
- (engine (substring model 10)))
- ;; It's a region of text
- (list :text prompts)
- ""))))
- prompts)))))
-
-;;;###autoload
-(cl-defun gptel-make-kagi
- (name &key curl-args stream key
- (host "kagi.com")
- (header (lambda () `(("Authorization" . ,(concat "Bot " (gptel--get-api-key))))))
- (models '((fastgpt :capabilities (nosystem))
- (summarize:cecil :capabilities (nosystem))
- (summarize:agnes :capabilities (nosystem))
- (summarize:daphne :capabilities (nosystem))
- (summarize:muriel :capabilities (nosystem))))
- (protocol "https")
- (endpoint "/api/v0/"))
- "Register a Kagi FastGPT backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is the Kagi host (with port), defaults to \"kagi.com\".
-
-MODELS is a list of available Kagi models: only fastgpt is supported.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false. Kagi does not support a streaming API yet.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/api/v0/fastgpt\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-Example:
--------
-
- (gptel-make-kagi \"Kagi\" :key my-kagi-key)"
- (declare (indent 1))
- stream ;Silence byte-compiler
- (let ((backend (gptel--make-kagi
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :url
- (lambda ()
- (concat protocol "://" host endpoint
- (if (equal gptel-model 'fastgpt)
- "fastgpt" "summarize"))))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-(provide 'gptel-kagi)
-;;; gptel-kagi.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not docstrings)
-;; End:
+++ /dev/null
-;;; gptel-ollama.el --- Ollama support for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords: hypermedia
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for the Ollama LLM API to gptel
-
-;;; Code:
-(require 'gptel)
-(require 'cl-generic)
-
-(declare-function json-read "json" ())
-(declare-function gptel-context--wrap "gptel-context")
-(declare-function gptel-context--collect-media "gptel-context")
-(defvar json-object-type)
-
-;;; Ollama
-(cl-defstruct (gptel-ollama (:constructor gptel--make-ollama)
- (:copier nil)
- (:include gptel-backend)))
-
-;; FIXME(fsm) Remove this variable
-(defvar-local gptel--ollama-token-count 0
- "Token count for ollama conversations.
-
-This variable holds the total token count for conversations with
-Ollama models.
-
-Intended for internal use only.")
-
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-ollama) info)
- "Parse response stream for the Ollama API."
- (when (and (bobp) (re-search-forward "^{" nil t))
- (forward-line 0))
- (let* ((content-strs) (content) (pt (point)))
- (condition-case nil
- (while (setq content (gptel--json-read))
- (setq pt (point))
- (let ((done (map-elt content :done))
- (reasoning (map-nested-elt content '(:message :thinking)))
- (response (map-nested-elt content '(:message :content)))
- (tool-calls (map-nested-elt content '(:message :tool_calls))))
- (when (and response (not (eq response :null)))
- (push response content-strs))
- (when (and tool-calls (not (eq tool-calls :null)))
- (gptel--inject-prompt
- (plist-get info :backend) (plist-get info :data)
- `(:role "assistant" :content :null :tool_calls ,(vconcat tool-calls)))
- (cl-loop
- for tool-call across tool-calls ;replace ":arguments" with ":args"
- for call-spec = (copy-sequence (plist-get tool-call :function))
- do (plist-put call-spec :args
- (plist-get call-spec :arguments))
- (plist-put call-spec :arguments nil)
- collect call-spec into tool-use
- finally (plist-put info :tool-use tool-use)))
- (if (and reasoning (not (eq reasoning :null)))
- (plist-put info :reasoning
- (concat (plist-get info :reasoning) reasoning))
- (if (eq 'in (plist-get info :reasoning-block))
- (plist-put info :reasoning-block t)
- (plist-put info :reasoning-block nil)))
- (unless (eq done :json-false)
- (with-current-buffer (plist-get info :buffer)
- (cl-incf gptel--ollama-token-count
- (+ (or (map-elt content :prompt_eval_count) 0)
- (or (map-elt content :eval_count) 0))))
- (goto-char (point-max)))))
- (error (goto-char pt)))
- (apply #'concat (nreverse content-strs))))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-ollama) response info)
- "Parse a one-shot RESPONSE from the Ollama API and return text.
-
-Store response metadata in state INFO."
- (plist-put info :stop-reason (plist-get response :done_reason))
- (plist-put info :output-tokens (plist-get response :eval_count))
- (let* ((message (plist-get response :message))
- (reasoning (plist-get message :thinking))
- (content (plist-get message :content)))
- (when reasoning
- (plist-put info :reasoning reasoning))
- (when-let* ((tool-calls (plist-get message :tool_calls)))
- ;; First add the tool call to the prompts list
- (let* ((data (plist-get info :data))
- (prompts (plist-get data :messages)))
- (plist-put data :messages (vconcat prompts `(,message))))
- ;; Then capture the tool call data for running the tool
- (cl-loop
- for tool-call across tool-calls ;replace ":arguments" with ":args"
- for call-spec = (copy-sequence (plist-get tool-call :function))
- do (plist-put call-spec :args
- (plist-get call-spec :arguments))
- (plist-put call-spec :arguments nil)
- collect call-spec into tool-use
- finally (plist-put info :tool-use tool-use)))
- (when (and content (not (or (eq content :null) (string-empty-p content))))
- content)))
-
-(cl-defmethod gptel--request-data ((backend gptel-ollama) prompts)
- "JSON encode PROMPTS for sending to Ollama."
- (when gptel--system-message
- (push (list :role "system"
- :content gptel--system-message)
- prompts))
- (let* ((prompts-plist
- (gptel--merge-plists
- `(:model ,(gptel--model-name gptel-model)
- :messages [,@prompts]
- :stream ,(or gptel-stream :json-false)
- ,@(and gptel--schema
- `(:format ,(gptel--preprocess-schema
- (gptel--dispatch-schema-type gptel--schema)))))
- gptel--request-params
- (gptel-backend-request-params gptel-backend)
- (gptel--model-request-params gptel-model)))
- ;; the initial options (if any) from request params
- (options-plist (plist-get prompts-plist :options)))
-
- (when (and gptel-use-tools gptel-tools)
- ;; TODO(tool): Find out how to force tool use for Ollama
- (plist-put prompts-plist :tools
- (gptel--parse-tools backend gptel-tools)))
- ;; if the temperature and max-tokens aren't set as
- ;; backend/model-specific, use the global settings
- (when (and gptel-temperature (not (plist-get options-plist :temperature)))
- (setq options-plist
- (plist-put options-plist :temperature gptel-temperature)))
- (when (and gptel-max-tokens (not (plist-get options-plist :num_predict)))
- (setq options-plist
- (plist-put options-plist :num_predict gptel-max-tokens)))
- (plist-put prompts-plist :options options-plist)))
-
-;; NOTE: No `gptel--parse-tools' method required for gptel-ollama, since this is
-;; handled by its defgeneric implementation
-
-(cl-defmethod gptel--parse-tool-results ((_backend gptel-ollama) tool-use)
- "Return a prompt containing tool call results in TOOL-USE."
- (mapcar (lambda (tool-call)
- (list :role "tool" :content (plist-get tool-call :result)))
- tool-use))
-
-;; NOTE: No `gptel--inject-prompt' method required for gptel-ollama, since this is
-;; handled by its defgeneric implementation
-
-(cl-defmethod gptel--parse-list ((backend gptel-ollama) prompt-list)
- (if (consp (car prompt-list))
- (let ((full-prompt)) ; Advanced format, list of lists
- (dolist (entry prompt-list)
- (pcase entry
- (`(prompt . ,msg)
- (push (list :role "user" :content (or (car-safe msg) msg))
- full-prompt))
- (`(response . ,msg)
- (push (list :role "assistant" :content (or (car-safe msg) msg))
- full-prompt))
- (`(tool . ,call)
- (push (list :role "assistant"
- :content ""
- :tool_calls `[(:function (:name ,(plist-get call :name)
- :arguments ,(plist-get call :args)))])
- full-prompt)
- (push (car (gptel--parse-tool-results backend (list (cdr entry))))
- full-prompt))))
- (nreverse full-prompt))
- (cl-loop for text in prompt-list ; Simple format, list of strings
- for role = t then (not role)
- if text collect
- (list :role (if role "user" "assistant") :content text))))
-
-(cl-defmethod gptel--parse-buffer ((backend gptel-ollama) &optional max-entries)
- (let ((prompts) (prev-pt (point)))
- (if (or gptel-mode gptel-track-response)
- (while (and (or (not max-entries) (>= max-entries 0))
- (goto-char (previous-single-property-change
- (point) 'gptel nil (point-min)))
- (not (= (point) prev-pt)))
- (pcase (get-char-property (point) 'gptel)
- ('response
- (when-let* ((content (gptel--trim-prefixes
- (buffer-substring-no-properties (point) prev-pt))))
- (push (list :role "assistant" :content content) prompts)))
- (`(tool . ,_id)
- (save-excursion
- (condition-case nil
- (let* ((tool-call (read (current-buffer)))
- (name (plist-get tool-call :name))
- (arguments (plist-get tool-call :args)))
- (plist-put tool-call :result
- (string-trim (buffer-substring-no-properties
- (point) prev-pt)))
- (push (car (gptel--parse-tool-results backend (list tool-call)))
- prompts)
- (push (list :role "assistant"
- :content ""
- :tool_calls `[(:function (:name ,name :arguments ,arguments))])
- prompts))
- ((end-of-file invalid-read-syntax)
- (message (format "Could not parse tool-call on line %s"
- (line-number-at-pos (point))))))))
- ('ignore)
- ('nil
- (if gptel-track-media
- (when-let* ((content (gptel--ollama-parse-multipart
- (gptel--parse-media-links major-mode (point) prev-pt))))
- (when (> (length content) 0)
- (push (append '(:role "user") content) prompts)))
- (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties
- (point) prev-pt))))
- (push (list :role "user" :content content) prompts)))))
- (setq prev-pt (point))
- (and max-entries (cl-decf max-entries)))
- (let ((content (string-trim (buffer-substring-no-properties
- (point-min) (point-max)))))
- (push (list :role "user" :content content) prompts)))
- prompts))
-
-(defun gptel--ollama-parse-multipart (parts)
- "Convert a multipart prompt PARTS to the Ollama API format.
-
-The input is an alist of the form
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\")).
-
-The output is a vector of entries in a backend-appropriate
-format."
- (cl-loop
- for part in parts
- for n upfrom 1
- with last = (length parts)
- for text = (plist-get part :text)
- for media = (plist-get part :media)
- if text do
- (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and
- if text
- collect text into text-array end
- else if media
- collect (gptel--base64-encode media) into media-array
- else if (plist-get part :textfile)
- collect
- (with-temp-buffer
- (gptel--insert-file-string (plist-get part :textfile))
- (buffer-string))
- into text-array
- finally return
- `(,@(and text-array (list :content (mapconcat #'identity text-array " ")))
- ,@(and media-array (list :images (vconcat media-array))))))
-
-(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
- (name &key curl-args header key models stream request-params
- (host "localhost:11434")
- (protocol "http")
- (endpoint "/api/chat"))
- "Register an Ollama backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is where Ollama runs (with port), defaults to localhost:11434
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-Currently recognized plist keys are :description, :capabilities
-and :mime-types. An example of a model specification including
-both kinds of specs:
-
-:models
-\\='(mistral:latest ;Simple specs
- openhermes:latest
- (llava:13b ;Full spec
- :description
- \"Llava 1.6: Large Lanuage and Vision Assistant\"
- :capabilities (media)
- :mime-types (\"image/jpeg\" \"image/png\")))
-
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, http by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/api/generate\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key. This is typically not required
-for local models like Ollama.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-Example:
--------
-
- (gptel-make-ollama
- \"Ollama\"
- :host \"localhost:11434\"
- :models \\='(mistral:latest)
- :stream t)"
- (declare (indent 1))
- (let ((backend (gptel--make-ollama
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :url (if protocol
- (concat protocol "://" host endpoint)
- (concat host endpoint)))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-(provide 'gptel-ollama)
-;;; gptel-ollama.el ends here
-
-
+++ /dev/null
-;;; gptel-openai-extras.el --- Extensions to the OpenAI API -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Authors: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com> and pirminj
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for Privategpt's Messages API and
-;; Perplexity's Citations feature to gptel
-
-;;; Code:
-(require 'cl-generic)
-(eval-when-compile
- (require 'cl-lib))
-(require 'map)
-(require 'gptel)
-
-(defvar json-object-type)
-
-(declare-function prop-match-value "text-property-search")
-(declare-function text-property-search-backward "text-property-search")
-(declare-function json-read "json" ())
-
-
-
-;;; Privategpt (Messages API)
-(cl-defstruct (gptel-privategpt (:constructor gptel--make-privategpt)
- (:copier nil)
- (:include gptel-openai))
- context sources)
-
-(defun gptel--privategpt-parse-sources (response)
- (cl-loop with source-alist
- for source across (map-nested-elt response '(:choices 0 :sources))
- for name = (map-nested-elt source '(:document :doc_metadata :file_name))
- for page = (map-nested-elt source '(:document :doc_metadata :page_label))
- do (push page (alist-get name source-alist nil nil #'equal))
- finally return
- (cl-loop for (file-name . file-pages) in source-alist
- for pages = (delete-dups (delq nil file-pages))
- if pages
- collect (format "- %s (page %s)" file-name (mapconcat #'identity pages ", "))
- into source-items
- else collect (format "- %s" file-name) into source-items
- finally return (mapconcat #'identity (cons "\n\nSources:" source-items) "\n"))))
-
-;; FIXME(tool) add tool use
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-privategpt) info)
- (let* ((content-strs))
- (condition-case nil
- (while (re-search-forward "^data:" nil t)
- (save-match-data
- (if (looking-at " *\\[DONE\\]")
- (when-let* ((sources-string (plist-get info :sources)))
- (push sources-string content-strs))
- (let ((response (gptel--json-read)))
- (unless (or (plist-get info :sources)
- (not (gptel-privategpt-sources (plist-get info :backend))))
- (plist-put info :sources (gptel--privategpt-parse-sources response)))
- (let* ((delta (map-nested-elt response '(:choices 0 :delta)))
- (content (plist-get delta :content)))
- (push content content-strs))))))
- (error
- (goto-char (match-beginning 0))))
- (apply #'concat (nreverse content-strs))))
-
-;; FIXME(tool) add tool use
-(cl-defmethod gptel--parse-response ((_backend gptel-privategpt) response info)
- (let ((response-string (map-nested-elt response '(:choices 0 :message :content)))
- (sources-string (and (gptel-privategpt-sources (plist-get info :backend))
- (gptel--privategpt-parse-sources response))))
- (concat response-string sources-string)))
-
-(cl-defmethod gptel--request-data ((_backend gptel-privategpt) prompts)
- "JSON encode PROMPTS for sending to ChatGPT."
- (let ((prompts-plist
- `(:model ,(gptel--model-name gptel-model)
- :messages [,@prompts]
- :use_context ,(or (gptel-privategpt-context gptel-backend) :json-false)
- :include_sources ,(or (gptel-privategpt-sources gptel-backend) :json-false)
- :stream ,(or gptel-stream :json-false))))
- (when (and gptel--system-message
- (not (gptel--model-capable-p 'nosystem)))
- (plist-put prompts-plist :system gptel--system-message))
- (when gptel-temperature
- (plist-put prompts-plist :temperature gptel-temperature))
- (when gptel-max-tokens
- (plist-put prompts-plist :max_tokens gptel-max-tokens))
- ;; Merge request params with model and backend params.
- (gptel--merge-plists
- prompts-plist
- (gptel-backend-request-params gptel-backend)
- (gptel--model-request-params gptel-model))))
-
-
-;;;###autoload
-(cl-defun gptel-make-privategpt
- (name &key curl-args stream key request-params
- (header
- (lambda () (when-let* ((key (gptel--get-api-key)))
- `(("Authorization" . ,(concat "Bearer " key))))))
- (host "localhost:8001")
- (protocol "http")
- (models '(private-gpt))
- (endpoint "/v1/chat/completions")
- (context t) (sources t))
- "Register an Privategpt API-compatible backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, \"api.privategpt.com\" by default.
-
-MODELS is a list of available model names.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1/messages\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
-((\"Content-Type\" . \"application/json\"))
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-CONTEXT and SOURCES: if true (the default), use available context
-and provide sources used by the model to generate the response.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for."
- (declare (indent 1))
- (let ((backend (gptel--make-privategpt
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models models
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :url (if protocol
- (concat protocol "://" host endpoint)
- (concat host endpoint))
- :context context
- :sources sources)))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-
-;;; Perplexity
-(cl-defstruct (gptel-perplexity (:constructor gptel--make-perplexity)
- (:copier nil)
- (:include gptel-openai)))
-
-(defsubst gptel--perplexity-parse-citations (citations)
- (let ((counter 0))
- (concat "\n\nCitations:\n"
- (mapconcat (lambda (url)
- (setq counter (1+ counter))
- (format "[%d] %s" counter url))
- citations "\n"))))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-perplexity) response _info)
- "Parse Perplexity response RESPONSE."
- (let ((response-string (map-nested-elt response '(:choices 0 :message :content)))
- (citations-string (when-let* ((citations (map-elt response :citations)))
- (gptel--perplexity-parse-citations citations))))
- (concat response-string citations-string)))
-
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-perplexity) info)
- "Parse a Perplexity API data stream with INFO.
-
-If available, collect citations at the end and include them with
-the response."
- (let ((resp (cl-call-next-method)))
- (unless (plist-get info :citations)
- (save-excursion
- (goto-char (point-max))
- (when (search-backward (plist-get info :token)
- (line-beginning-position) t)
- (forward-line 0)
- (when (re-search-backward "^data: " nil t)
- (goto-char (match-end 0))
- (ignore-errors
- (when-let* ((chunk (gptel--json-read))
- (citations (map-elt chunk :citations)))
- (plist-put info :citations t)
- (setq resp (concat resp (gptel--perplexity-parse-citations
- citations)))))))))
- resp))
-
-;;;###autoload
-(cl-defun gptel-make-perplexity
- (name &key curl-args stream key
- (header
- (lambda () (when-let* ((key (gptel--get-api-key)))
- `(("Authorization" . ,(concat "Bearer " key))))))
- (host "api.perplexity.ai")
- (protocol "https")
- ;; https://docs.perplexity.ai/guides/model-cards
- (models '(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research))
- (endpoint "/chat/completions")
- request-params)
- "Register a Perplexity backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, \"api.perplexity.ai\" by default.
-
-MODELS is a list of available model names.
-
-STREAM is a boolean to toggle streaming responses.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions.
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that returns an
-alist.
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters."
- (declare (indent 1))
- (let ((backend (gptel--make-perplexity
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models models
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :url (if protocol
- (concat protocol "://" host endpoint)
- (concat host endpoint)))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-;;; Deepseek
-(cl-defstruct (gptel-deepseek (:include gptel-openai)
- (:copier nil)
- (:constructor gptel--make-deepseek)))
-
-(cl-defmethod gptel--parse-buffer :around ((_backend gptel-deepseek) _max-entries)
- "Merge successive prompts in the prompts list that have the same role.
-
-The Deepseek API requires strictly alternating roles (user/assistant) in messages."
- (let* ((prompts (cl-call-next-method))
- (index prompts))
- (prog1 prompts
- (while index
- (let ((p1 (car index))
- (p2 (cadr index))
- (rest (cdr index)))
- (when (and p2 (equal (plist-get p1 :role)
- (plist-get p2 :role)))
- (setf (plist-get p1 :content)
- (concat (plist-get p1 :content) "\n"
- (plist-get p2 :content)))
- (setcdr index (cdr rest)))
- (setq index (cdr index)))))))
-
-;;;###autoload
-(cl-defun gptel-make-deepseek
- (name &key curl-args stream key request-params
- (header (lambda () (when-let* ((key (gptel--get-api-key)))
- `(("Authorization" . ,(concat "Bearer " key))))))
- (host "api.deepseek.com")
- (protocol "https")
- (endpoint "/v1/chat/completions")
- (models '((deepseek-reasoner
- :capabilities (tool reasoning)
- :context-window 128
- :input-cost 0.56
- :output-cost 1.68)
- (deepseek-chat
- :capabilities (tool)
- :context-window 128
- :input-cost 0.56
- :output-cost 1.68))))
- "Register a DeepSeek backend for gptel with NAME.
-
-For the meanings of the keyword arguments, see `gptel-make-openai'."
- (declare (indent 1))
- (let ((backend (gptel--make-deepseek
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :curl-args curl-args
- :url (concat protocol "://" host endpoint))))
- (setf (alist-get name gptel--known-backends nil nil #'equal) backend)
- backend))
-
-;;; xAI
-;;;###autoload
-(cl-defun gptel-make-xai
- (name &key curl-args stream key request-params
- (header (lambda () (when-let* ((key (gptel--get-api-key)))
- `(("Authorization" . ,(concat "Bearer " key))))))
- (host "api.x.ai")
- (protocol "https")
- (endpoint "/v1/chat/completions")
- (models
- '((grok-4
- :description "Grok Flagship model"
- :capabilities (tool-use json reasoning)
- :context-window 256
- :input-cost 3
- :output-cost 15)
-
- (grok-code-fast-1
- :description "Fast reasoning model for agentic coding"
- :capabilities (tool-use json reasoning)
- :context-window 256
- :input-cost 0.2
- :output-cost 1.5)
-
- (grok-3
- :description "Grok 3"
- :capabilities (tool-use json reasoning)
- :context-window 131
- :input-cost 3
- :output-cost 15)
-
- (grok-3-fast
- :description "Faster Grok 3"
- :capabilities (tool-use json reasoning)
- :context-window 131
- :input-cost 5
- :output-cost 25)
-
- (grok-3-mini
- :description "Mini Grok 3"
- :capabilities (tool-use json reasoning)
- :context-window 131
- :input-cost 0.3
- :output-cost 0.5)
-
- (grok-3-mini-fast
- :description "Faster mini Grok 3"
- :capabilities (tool-use json reasoning)
- :context-window 131072
- :input-cost 0.6
- :output-cost 4)
-
- (grok-2-vision-1212
- :description "Grok 2 Vision"
- :capabilities (tool-use json media)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 32768
- :input-cost 2
- :output-cost 10))))
- "Register an xAI backend for gptel with NAME.
-
-Keyword arguments:
-
-KEY is a variable whose value is the API key, or function that
-returns the key.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-The other keyword arguments are all optional. For their meanings
-see `gptel-make-openai'."
- (declare (indent 1))
- (let ((backend (gptel--make-deepseek
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :curl-args curl-args
- :url (concat protocol "://" host endpoint))))
- (setf (alist-get name gptel--known-backends nil nil #'equal) backend)
- backend))
-
-
-(provide 'gptel-openai-extras)
-;;; gptel-openai-extras.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not docstrings)
-;; End:
+++ /dev/null
-;;; gptel-openai.el --- ChatGPT suppport for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file adds support for the ChatGPT API to gptel
-
-;;; Code:
-(require 'cl-generic)
-(eval-when-compile
- (require 'cl-lib))
-(require 'map)
-
-(defvar gptel-model)
-(defvar gptel-stream)
-(defvar gptel-use-curl)
-(defvar gptel-backend)
-(defvar gptel-temperature)
-(defvar gptel-max-tokens)
-(defvar gptel--system-message)
-(defvar json-object-type)
-(defvar gptel-mode)
-(defvar gptel-track-response)
-(defvar gptel-track-media)
-(defvar gptel-use-tools)
-(defvar gptel-tools)
-(defvar gptel--schema)
-(defvar gptel--request-params)
-(declare-function gptel-context--collect-media "gptel-context")
-(declare-function gptel--base64-encode "gptel")
-(declare-function gptel--trim-prefixes "gptel")
-(declare-function gptel--parse-media-links "gptel")
-(declare-function gptel--model-capable-p "gptel")
-(declare-function gptel--model-name "gptel")
-(declare-function gptel--get-api-key "gptel")
-(declare-function gptel--insert-file-string "gptel")
-(declare-function prop-match-value "text-property-search")
-(declare-function text-property-search-backward "text-property-search")
-(declare-function json-read "json")
-(declare-function gptel-prompt-prefix-string "gptel")
-(declare-function gptel-response-prefix-string "gptel")
-(declare-function gptel--merge-plists "gptel")
-(declare-function gptel--model-request-params "gptel")
-(declare-function gptel-context--wrap "gptel-context")
-(declare-function gptel--inject-prompt "gptel")
-(declare-function gptel--parse-tools "gptel")
-(declare-function gptel--parse-schema "gptel")
-(declare-function gptel--preprocess-schema "gptel")
-(declare-function gptel--dispatch-schema-type "gptel")
-
-;; JSON conversion semantics used by gptel
-;; empty object "{}" => empty list '() == nil
-;; null => :null
-;; false => :json-false
-
-;; TODO(tool) Except when reading JSON from a string, where null => nil
-
-(defmacro gptel--json-read ()
- (if (fboundp 'json-parse-buffer)
- `(json-parse-buffer
- :object-type 'plist
- :null-object :null
- :false-object :json-false)
- (require 'json)
- (defvar json-object-type)
- (defvar json-null)
- (declare-function json-read "json" ())
- `(let ((json-object-type 'plist)
- (json-null :null))
- (json-read))))
-
-(defmacro gptel--json-read-string (str)
- (if (fboundp 'json-parse-string)
- `(json-parse-string ,str
- :object-type 'plist
- :null-object nil
- :false-object :json-false)
- (require 'json)
- (defvar json-object-type)
- (declare-function json-read-from-string "json" ())
- `(let ((json-object-type 'plist))
- (json-read-from-string ,str))))
-
-(defmacro gptel--json-encode (object)
- (if (fboundp 'json-serialize)
- `(json-serialize ,object
- :null-object :null
- :false-object :json-false)
- (require 'json)
- (defvar json-false)
- (defvar json-null)
- (declare-function json-encode "json" (object))
- `(let ((json-false :json-false)
- (json-null :null))
- (json-encode ,object))))
-
-(defun gptel--process-models (models)
- "Convert items in MODELS to symbols with appropriate properties."
- (let ((models-processed))
- (dolist (model models)
- (cl-etypecase model
- (string (push (intern model) models-processed))
- (symbol (push model models-processed))
- (cons
- (cl-destructuring-bind (name . props) model
- (setf (symbol-plist name)
- ;; MAYBE: Merging existing symbol plists is safer, but makes it
- ;; difficult to reset a symbol plist, since removing keys from
- ;; it (as opposed to setting them to nil) is more work.
- ;;
- ;; (map-merge 'plist (symbol-plist name) props)
- props)
- (push name models-processed)))))
- (nreverse models-processed)))
-
-;;; Common backend struct for LLM support
-(defvar gptel--known-backends nil
- "Alist of LLM backends known to gptel.
-
-This is an alist mapping user-provided names to backend structs,
-see `gptel-backend'.
-
-You can have more than one backend pointing to the same resource
-with differing settings.")
-
-(defun gptel-get-backend (name)
- "Return gptel backend with NAME.
-
-Throw an error if there is no match."
- (or (alist-get name gptel--known-backends nil nil #'equal)
- (user-error "Backend %s is not known to be defined"
- name)))
-
-(gv-define-setter gptel-get-backend (val name)
- `(setf (alist-get ,name gptel--known-backends
- nil t #'equal)
- ,val))
-
-(cl-defstruct
- (gptel-backend (:constructor gptel--make-backend)
- (:copier gptel--copy-backend))
- name host header protocol stream
- endpoint key models url request-params
- curl-args
- (coding-system nil :documentation "Can be set to `binary' if the backend expects non UTF-8 output."))
-
-;;; OpenAI (ChatGPT)
-(cl-defstruct (gptel-openai (:constructor gptel--make-openai)
- (:copier nil)
- (:include gptel-backend)))
-
-;; How the following function works:
-;;
-;; The OpenAI API returns a stream of data chunks. Each data chunk has a
-;; component that can be parsed as JSON. Besides metadata, each chunk has
-;; either some text or part of a tool call.
-;;
-;; If we find text, we collect it in a list, concat them at the end and return
-;; it.
-;;
-;; If we find part of a tool call, we begin collecting the pieces in
-;; INFO -> :tool-use.
-;;
-;; Tool call arguments are themselves JSON encoded strings can be spread across
-;; chunks. We collect them in INFO -> :partial_json. The end of a tool call
-;; chunk is marked by the beginning of another, or by the end of the stream. In
-;; either case we flaten the :partial_json we have thus far, add it to the tool
-;; call spec in :tool-use and reset it.
-;;
-;; If we find reasoning text, collect it in INFO -> :reasoning, to be consumed
-;; by the stream filter (and eventually the callback). We also collect it in
-;; INFO -> :reasoning-chunks, in case we need to send it back along with tool
-;; call results.
-;;
-;; Finally we append any tool calls and accumulated reasoning text (from
-;; :reasoning-chunks) to the (INFO -> :data -> :messages) list of prompts.
-
-(cl-defmethod gptel-curl--parse-stream ((_backend gptel-openai) info)
- "Parse an OpenAI API data stream.
-
-Return the text response accumulated since the last call to this
-function. Additionally, mutate state INFO to add tool-use
-information if the stream contains it."
- (let* ((content-strs))
- (condition-case nil
- (while (re-search-forward "^data:" nil t)
- (save-match-data
- (if (looking-at " *\\[DONE\\]")
- ;; The stream has ended, so we do the following thing (if we found tool calls)
- ;; - pack tool calls into the messages prompts list to send (INFO -> :data -> :messages)
- ;; - collect tool calls (formatted differently) into (INFO -> :tool-use)
- ;; - Clear any reasoning content chunks we've captured
- (progn
- (when-let* ((tool-use (plist-get info :tool-use))
- (args (apply #'concat (nreverse (plist-get info :partial_json))))
- (func (plist-get (car tool-use) :function)))
- (plist-put func :arguments args) ;Update arguments for last recorded tool
- (gptel--inject-prompt
- (plist-get info :backend) (plist-get info :data)
- `( :role "assistant" :content :null :tool_calls ,(vconcat tool-use) ; :refusal :null
- ;; Return reasoning if available
- ,@(and-let* ((chunks (nreverse (plist-get info :reasoning-chunks)))
- (reasoning-field (pop chunks))) ;chunks is (:reasoning.* "chunk1" "chunk2" ...)
- (list reasoning-field (apply #'concat chunks)))))
- (cl-loop
- for tool-call in tool-use ; Construct the call specs for running the function calls
- for spec = (plist-get tool-call :function)
- collect (list :id (plist-get tool-call :id)
- :name (plist-get spec :name)
- :args (ignore-errors (gptel--json-read-string
- (plist-get spec :arguments))))
- into call-specs
- finally (plist-put info :tool-use call-specs)))
- (when (plist-member info :reasoning-chunks) (plist-put info :reasoning-chunks nil)))
- (when-let* ((response (gptel--json-read))
- (delta (map-nested-elt response '(:choices 0 :delta))))
- (if-let* ((content (plist-get delta :content))
- ((not (or (eq content :null) (string-empty-p content)))))
- (push content content-strs)
- ;; No text content, so look for tool calls
- (when-let* ((tool-call (map-nested-elt delta '(:tool_calls 0)))
- (func (plist-get tool-call :function)))
- (if (and-let* ((func-name (plist-get func :name)) ((not (eq func-name :null))))
- ;; TEMP: This check is for litellm compatibility, should be removed
- (not (equal func-name "null"))) ; new tool block begins
- (progn
- (when-let* ((partial (plist-get info :partial_json)))
- (let* ((prev-tool-call (car (plist-get info :tool-use)))
- (prev-func (plist-get prev-tool-call :function)))
- (plist-put prev-func :arguments ;update args for old tool block
- (apply #'concat (nreverse (plist-get info :partial_json)))))
- (plist-put info :partial_json nil)) ;clear out finished chain of partial args
- ;; Start new chain of partial argument strings
- (plist-put info :partial_json (list (plist-get func :arguments)))
- ;; NOTE: Do NOT use `push' for this, it prepends and we lose the reference
- (plist-put info :tool-use (cons tool-call (plist-get info :tool-use))))
- ;; old tool block continues, so continue collecting arguments in :partial_json
- (push (plist-get func :arguments) (plist-get info :partial_json)))))
- ;; Check for reasoning blocks, currently only used by Openrouter
- (unless (eq (plist-get info :reasoning-block) 'done)
- (if-let* ((reasoning-plist ;reasoning-plist is (:reasoning.* "chunk" ...) or nil
- (or (plist-member delta :reasoning) ;for Openrouter and co
- (plist-member delta :reasoning_content))) ;for Deepseek, Llama.cpp
- (reasoning-chunk (cadr reasoning-plist))
- ((not (or (eq reasoning-chunk :null) (string-empty-p reasoning-chunk)))))
- (progn (plist-put info :reasoning ;For stream filter consumption
- (concat (plist-get info :reasoning) reasoning-chunk))
- (plist-put info :reasoning-chunks ;To include with tool call results, if any
- (cons reasoning-chunk (or (plist-get info :reasoning-chunks)
- (list (car reasoning-plist))))))
- ;; Done with reasoning if we get non-empty content
- (if-let* (((plist-member info :reasoning)) ;Is this a reasoning model?
- (c (plist-get delta :content)) ;Started receiving text content?
- ((not (or (eq c :null) (string-blank-p c)))))
- (plist-put info :reasoning-block t)))))))) ;Signal end of reasoning block
- (error (goto-char (match-beginning 0))))
- (apply #'concat (nreverse content-strs))))
-
-(cl-defmethod gptel--parse-response ((_backend gptel-openai) response info)
- "Parse an OpenAI (non-streaming) RESPONSE and return response text.
-
-Mutate state INFO with response metadata."
- (let* ((choice0 (map-nested-elt response '(:choices 0)))
- (message (plist-get choice0 :message))
- (content (plist-get message :content)))
- (plist-put info :stop-reason
- (plist-get choice0 :finish_reason))
- (plist-put info :output-tokens
- (map-nested-elt response '(:usage :completion_tokens)))
- ;; OpenAI returns either non-blank text content or a tool call, not both.
- ;; However OpenAI-compatible APIs like llama.cpp can include both (#819), so
- ;; we check for both tool calls and responses independently.
- (when-let* ((tool-calls (plist-get message :tool_calls))
- ((not (eq tool-calls :null))))
- (gptel--inject-prompt ; First add the tool call to the prompts list
- (plist-get info :backend) (plist-get info :data) message)
- (cl-loop ;Then capture the tool call data for running the tool
- for tool-call across tool-calls ;replace ":arguments" with ":args"
- for call-spec = (copy-sequence (plist-get tool-call :function))
- do (ignore-errors (plist-put call-spec :args
- (gptel--json-read-string
- (plist-get call-spec :arguments))))
- (plist-put call-spec :arguments nil)
- (plist-put call-spec :id (plist-get tool-call :id))
- collect call-spec into tool-use
- finally (plist-put info :tool-use tool-use)))
- (when-let* ((reasoning (or (plist-get message :reasoning) ;for Openrouter and co
- (plist-get message :reasoning_content))) ;for Deepseek, Llama.cpp
- ((and (stringp reasoning) (not (string-empty-p reasoning)))))
- (plist-put info :reasoning reasoning))
- (when (and content (not (or (eq content :null) (string-empty-p content))))
- content)))
-
-(cl-defmethod gptel--request-data ((backend gptel-openai) prompts)
- "JSON encode PROMPTS for sending to ChatGPT."
- (when gptel--system-message
- (push (list :role "system"
- :content gptel--system-message)
- prompts))
- (let ((prompts-plist
- `(:model ,(gptel--model-name gptel-model)
- :messages [,@prompts]
- :stream ,(or gptel-stream :json-false)))
- (reasoning-model-p ; TODO: Embed this capability in the model's properties
- (memq gptel-model '(o1 o1-preview o1-mini o3-mini o3 o4-mini
- gpt-5 gpt-5-mini gpt-5-nano gpt-5.1 gpt-5.2))))
- (when (and gptel-temperature (not reasoning-model-p))
- (plist-put prompts-plist :temperature gptel-temperature))
- (when gptel-use-tools
- (when (eq gptel-use-tools 'force)
- (plist-put prompts-plist :tool_choice "required"))
- (when gptel-tools
- (plist-put prompts-plist :tools
- (gptel--parse-tools backend gptel-tools))
- (unless reasoning-model-p
- (plist-put prompts-plist :parallel_tool_calls t))))
- (when gptel-max-tokens
- ;; HACK: The OpenAI API has deprecated max_tokens, but we still need it
- ;; for OpenAI-compatible APIs like GPT4All (#485)
- (plist-put prompts-plist
- (if reasoning-model-p :max_completion_tokens :max_tokens)
- gptel-max-tokens))
- (when gptel--schema
- (plist-put prompts-plist
- :response_format (gptel--parse-schema backend gptel--schema)))
- ;; Merge request params with model and backend params.
- (gptel--merge-plists
- prompts-plist
- gptel--request-params
- (gptel-backend-request-params gptel-backend)
- (gptel--model-request-params gptel-model))))
-
-(cl-defmethod gptel--parse-schema ((_backend gptel-openai) schema)
- (list :type "json_schema"
- :json_schema
- (list :name (md5 (format "%s" (random)))
- :schema (gptel--preprocess-schema
- (gptel--dispatch-schema-type schema))
- :strict t)))
-
-;; NOTE: No `gptel--parse-tools' method required for gptel-openai, since this is
-;; handled by its defgeneric implementation
-
-(cl-defmethod gptel--parse-tool-results ((_backend gptel-openai) tool-use)
- "Return a prompt containing tool call results in TOOL-USE."
- ;; (declare (side-effect-free t))
- (mapcar
- (lambda (tool-call)
- (list
- :role "tool"
- :tool_call_id (plist-get tool-call :id)
- :content (plist-get tool-call :result)))
- tool-use))
-
-;; TODO: Remove these functions (#792)
-(defun gptel--openai-format-tool-id (tool-id)
- "Format TOOL-ID for OpenAI.
-
-If the ID has the format used by a different backend, use as-is."
- (unless tool-id
- (setq tool-id (substring
- (md5 (format "%s%s" (random) (float-time)))
- nil 24)))
- (if (or (string-prefix-p "toolu_" tool-id) ;#747
- (string-prefix-p "call_" tool-id))
- tool-id
- (format "call_%s" tool-id)))
-
-(defun gptel--openai-unformat-tool-id (tool-id)
- (or (and (string-match "call_\\(.+\\)" tool-id)
- (match-string 1 tool-id))
- tool-id))
-
-;; NOTE: No `gptel--inject-prompt' method required for gptel-openai, since this
-;; is handled by its defgeneric implementation
-
-(cl-defmethod gptel--parse-list ((backend gptel-openai) prompt-list)
- (if (consp (car prompt-list))
- (let ((full-prompt)) ; Advanced format, list of lists
- (dolist (entry prompt-list)
- (pcase entry
- (`(prompt . ,msg)
- (push (list :role "user" :content (or (car-safe msg) msg)) full-prompt))
- (`(response . ,msg)
- (push (list :role "assistant" :content (or (car-safe msg) msg)) full-prompt))
- (`(tool . ,call)
- (unless (plist-get call :id)
- (plist-put call :id (gptel--openai-format-tool-id nil)))
- (push
- (list
- :role "assistant"
- :tool_calls
- (vector
- (list :type "function"
- :id (plist-get call :id)
- :function `( :name ,(plist-get call :name)
- :arguments ,(decode-coding-string
- (gptel--json-encode (plist-get call :args))
- 'utf-8 t)))))
- full-prompt)
- (push (car (gptel--parse-tool-results backend (list (cdr entry)))) full-prompt))))
- (nreverse full-prompt))
- (cl-loop for text in prompt-list ; Simple format, list of strings
- for role = t then (not role)
- if text collect
- (list :role (if role "user" "assistant") :content text))))
-
-(cl-defmethod gptel--parse-buffer ((backend gptel-openai) &optional max-entries)
- (let ((prompts) (prev-pt (point)))
- (if (or gptel-mode gptel-track-response)
- (while (and (or (not max-entries) (>= max-entries 0))
- (/= prev-pt (point-min))
- (goto-char (previous-single-property-change
- (point) 'gptel nil (point-min))))
- (pcase (get-char-property (point) 'gptel)
- ('response
- (when-let* ((content (gptel--trim-prefixes
- (buffer-substring-no-properties (point) prev-pt))))
- (push (list :role "assistant" :content content) prompts)))
- (`(tool . ,id)
- (save-excursion
- (condition-case nil
- (let* ((tool-call (read (current-buffer)))
- (name (plist-get tool-call :name))
- (arguments (decode-coding-string
- (gptel--json-encode (plist-get tool-call :args))
- 'utf-8 t)))
- (setq id (gptel--openai-format-tool-id id))
- (plist-put tool-call :id id)
- (plist-put tool-call :result
- (string-trim (buffer-substring-no-properties
- (point) prev-pt)))
- (push (car (gptel--parse-tool-results backend (list tool-call)))
- prompts)
- (push (list :role "assistant"
- :tool_calls
- (vector (list :type "function"
- :id id
- :function `( :name ,name
- :arguments ,arguments))))
- prompts))
- ((end-of-file invalid-read-syntax)
- (message (format "Could not parse tool-call %s on line %s"
- id (line-number-at-pos (point))))))))
- ('ignore)
- ('nil
- (and max-entries (cl-decf max-entries))
- (if gptel-track-media
- (when-let* ((content (gptel--openai-parse-multipart
- (gptel--parse-media-links major-mode
- (point) prev-pt))))
- (when (> (length content) 0)
- (push (list :role "user" :content content) prompts)))
- (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties
- (point) prev-pt))))
- (push (list :role "user" :content content) prompts)))))
- (setq prev-pt (point)))
- (let ((content (string-trim (buffer-substring-no-properties
- (point-min) (point-max)))))
- (push (list :role "user" :content content) prompts)))
- prompts))
-
-;; TODO This could be a generic function
-(defun gptel--openai-parse-multipart (parts)
- "Convert a multipart prompt PARTS to the OpenAI API format.
-
-The input is an alist of the form
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\")).
-
-The output is a vector of entries in a backend-appropriate
-format."
- (cl-loop
- for part in parts
- for n upfrom 1
- with last = (length parts)
- for text = (plist-get part :text)
- for media = (plist-get part :media)
- if text do
- (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text)))
- and if text
- collect `(:type "text" :text ,text) into parts-array end
- else if media collect
- `(:type "image_url"
- :image_url (:url ,(concat "data:" (plist-get part :mime)
- ";base64," (gptel--base64-encode media))))
- into parts-array
- else if (plist-get part :textfile) collect
- `(:type "text"
- :text ,(with-temp-buffer
- (gptel--insert-file-string (plist-get part :textfile))
- (buffer-string)))
- into parts-array end and
- if (plist-get part :url)
- collect
- `(:type "image_url"
- :image_url (:url ,(plist-get part :url)))
- into parts-array
- finally return (vconcat parts-array)))
-
-(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)
- (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
- (name &key curl-args models stream key request-params
- (header
- (lambda () (when-let* ((key (gptel--get-api-key)))
- `(("Authorization" . ,(concat "Bearer " key))))))
- (host "api.openai.com")
- (protocol "https")
- (endpoint "/v1/chat/completions"))
- "Register an OpenAI API-compatible backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST (optional) is the API host, typically \"api.openai.com\".
-
-MODELS is a list of available model names, as symbols.
-Additionally, you can specify supported LLM capabilities like
-vision or tool-use by appending a plist to the model with more
-information, in the form
-
- (model-name . plist)
-
-For a list of currently recognized plist keys, see
-`gptel--openai-models'. An example of a model specification
-including both kinds of specs:
-
-:models
-\\='(gpt-3.5-turbo ;Simple specs
- gpt-4-turbo
- (gpt-4o-mini ;Full spec
- :description
- \"Affordable and intelligent small model for lightweight tasks\"
- :capabilities (media tool json url)
- :mime-types
- (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/v1/chat/completions\".
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that returns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for."
- (declare (indent 1))
- (let ((backend (gptel--make-openai
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :url (if protocol
- (concat protocol "://" host endpoint)
- (concat host endpoint)))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-;;; Azure
-;;;###autoload
-(cl-defun gptel-make-azure
- (name &key curl-args host
- (protocol "https")
- (header (lambda () `(("api-key" . ,(gptel--get-api-key)))))
- (key 'gptel-api-key)
- models stream endpoint request-params)
- "Register an Azure backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is the API host.
-
-MODELS is a list of available model names, as symbols.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL (optional) specifies the protocol, https by default.
-
-ENDPOINT is the API endpoint for completions.
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
- ((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-Example:
--------
-
- (gptel-make-azure
- \"Azure-1\"
- :protocol \"https\"
- :host \"RESOURCE_NAME.openai.azure.com\"
- :endpoint
- \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\"
- :stream t
- :models \\='(gpt-3.5-turbo gpt-4))"
- (declare (indent 1))
- (let ((backend (gptel--make-openai
- :curl-args curl-args
- :name name
- :host host
- :header header
- :key key
- :models (gptel--process-models models)
- :protocol protocol
- :endpoint endpoint
- :stream stream
- :request-params request-params
- :url (if protocol
- (concat protocol "://" host endpoint)
- (concat host endpoint)))))
- (prog1 backend
- (setf (alist-get name gptel--known-backends
- nil nil #'equal)
- backend))))
-
-;; GPT4All
-;;;###autoload
-(defalias 'gptel-make-gpt4all 'gptel-make-openai
- "Register a GPT4All backend for gptel with NAME.
-
-Keyword arguments:
-
-CURL-ARGS (optional) is a list of additional Curl arguments.
-
-HOST is where GPT4All runs (with port), typically localhost:4891
-
-MODELS is a list of available model names, as symbols.
-
-STREAM is a boolean to toggle streaming responses, defaults to
-false.
-
-PROTOCOL specifies the protocol, https by default.
-
-ENDPOINT (optional) is the API endpoint for completions, defaults to
-\"/api/v1/completions\"
-
-HEADER (optional) is for additional headers to send with each
-request. It should be an alist or a function that retuns an
-alist, like:
-((\"Content-Type\" . \"application/json\"))
-
-KEY (optional) is a variable whose value is the API key, or
-function that returns the key. This is typically not required for
-local models like GPT4All.
-
-REQUEST-PARAMS (optional) is a plist of additional HTTP request
-parameters (as plist keys) and values supported by the API. Use
-these to set parameters that gptel does not provide user options
-for.
-
-Example:
--------
-
-(gptel-make-gpt4all
- \"GPT4All\"
- :protocol \"http\"
- :host \"localhost:4891\"
- :models \\='(mistral-7b-openorca.Q4_0.gguf))")
-
-(provide 'gptel-openai)
-;;; gptel-openai.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not docstrings)
-;; End:
+++ /dev/null
-;;; gptel-org.el --- Org functions for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2024 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-(eval-when-compile (require 'gptel))
-(require 'cl-lib)
-(require 'org-element)
-(require 'outline)
-(require 'mailcap) ;FIXME Avoid this somehow
-
-;; Functions used for saving/restoring gptel state in Org buffers
-(defvar gptel--num-messages-to-send)
-(defvar org-entry-property-inherited-from)
-(defvar gptel-backend)
-(defvar gptel--known-backends)
-(defvar gptel--system-message)
-(defvar gptel-model)
-(defvar gptel-temperature)
-(defvar gptel-max-tokens)
-(defvar gptel--link-type-cache)
-
-(defvar org-link-angle-re)
-(defvar org-link-bracket-re)
-(declare-function mailcap-file-name-to-mime-type "mailcap")
-(declare-function gptel--model-capable-p "gptel")
-(declare-function gptel--model-mime-capable-p "gptel")
-(declare-function gptel--model-name "gptel")
-(declare-function gptel--to-string "gptel")
-(declare-function gptel--to-number "gptel")
-(declare-function gptel--intern "gptel")
-(declare-function gptel--get-buffer-bounds "gptel")
-(declare-function gptel-backend-name "gptel")
-(declare-function gptel--parse-buffer "gptel")
-(declare-function gptel--parse-directive "gptel")
-(declare-function gptel--restore-props "gptel")
-(declare-function gptel--with-buffer-copy "gptel")
-(declare-function gptel--file-binary-p "gptel")
-(declare-function org-entry-get "org")
-(declare-function org-entry-put "org")
-(declare-function org-with-wide-buffer "org-macs")
-(declare-function org-set-property "org")
-(declare-function org-property-values "org")
-(declare-function org-open-line "org")
-(declare-function org-at-heading-p "org")
-(declare-function org-get-heading "org")
-(declare-function org-at-heading-p "org")
-
-;; Bundle `org-element-lineage-map' if it's not available (for Org 9.67 or older)
-(eval-and-compile
- (if (fboundp 'org-element-lineage-map)
- (progn (declare-function org-element-lineage-map "org-element-ast")
- (defalias 'gptel-org--element-lineage-map 'org-element-lineage-map))
- (defun gptel-org--element-lineage-map (datum fun &optional types with-self first-match)
- "Map FUN across ancestors of DATUM, from closest to furthest.
-
-DATUM is an object or element. For TYPES, WITH-SELF and
-FIRST-MATCH see `org-element-lineage-map'.
-
-This function is provided for compatibility with older versions
-of Org."
- (declare (indent 2))
- (setq fun (if (functionp fun) fun `(lambda (node) ,fun)))
- (let ((up (if with-self datum (org-element-parent datum)))
- acc rtn)
- (catch :--first-match
- (while up
- (when (or (not types) (org-element-type-p up types))
- (setq rtn (funcall fun up))
- (if (and first-match rtn)
- (throw :--first-match rtn)
- (when rtn (push rtn acc))))
- (setq up (org-element-parent up)))
- (nreverse acc)))))
- (if (fboundp 'org-element-begin)
- (progn (declare-function org-element-begin "org-element")
- (declare-function org-element-end "org-element")
- (declare-function org-element-parent "org-element")
- (defalias 'gptel-org--element-begin 'org-element-begin)
- (defalias 'gptel-org--element-end 'org-element-end)
- (defalias 'gptel-org--element-parent 'org-element-parent))
- (defsubst gptel-org--element-begin (node)
- "Get `:begin' property of NODE."
- (org-element-property :begin node))
- (defsubst gptel-org--element-end (node)
- "Get `:end' property of NODE."
- (org-element-property :end node))
- (defsubst gptel-org--element-parent (node)
- "Return `:parent' property of NODE."
- (org-element-property :parent node))))
-
-\f
-;;; User options
-(defcustom gptel-org-branching-context nil
- "Use the lineage of the current heading as the context for gptel in Org buffers.
-
-This makes each same level heading a separate conversation
-branch.
-
-By default, gptel uses a linear context: all the text up to the
-cursor is sent to the LLM. Enabling this option makes the
-context the hierarchical lineage of the current Org heading. In
-this example:
-
------
-Top level text
-
-* Heading 1
-heading 1 text
-
-* Heading 2
-heading 2 text
-
-** Heading 2.1
-heading 2.1 text
-** Heading 2.2
-heading 2.2 text
------
-
-With the cursor at the end of the buffer, the text sent to the
-LLM will be limited to
-
------
-Top level text
-
-* Heading 2
-heading 2 text
-
-** Heading 2.2
-heading 2.2 text
------
-
-This makes it feasible to have multiple conversation branches."
- :type 'boolean
- :group 'gptel)
-
-(defcustom gptel-org-ignore-elements '(property-drawer)
- "Types of Org elements to be stripped from the prompt before sending.
-
-By default gptel will remove Org property drawers from the
-prompt. For the full list of available elements, please see
-`org-element-all-elements'.
-
-Please note: Removing property-drawer elements is fast, but
-adding elements to this list can significantly slow down
-`gptel-send'."
- :group 'gptel
- :type '(repeat symbol))
-
-(defcustom gptel-org-validate-link #'always
- "Validate links to be sent as context with gptel queries.
-
-When `gptel-track-media' is enabled, this option determines if a
-supported link will be followed and its source included with gptel
-queries from Org buffers. Currently only \"file\" and \"attachment\"
-link types are supported (along with web URLs if the model supports
-them).
-
-It should be a function that accepts an Org link object and return
-non-nil if the link should be followed.
-
-By default, all links are considered valid.
-
-Set this to `gptel-org--link-standalone-p' to only follow links placed
-on a line by themselves, separated from surrounding text."
- :group 'gptel
- :type '(choice
- (const :tag "All links" always)
- (const :tag "Standalone links" gptel-org--link-standalone-p)
- (function :tag "Function")))
-
-(defconst gptel-org--link-regex
- (concat "\\(?:" org-link-bracket-re "\\|" org-link-angle-re "\\)")
- "Link regex for `gptel-mode' in Org mode.")
-
-\f
-;;; Setting context and creating queries
-(defun gptel-org--get-topic-start ()
- "If a conversation topic is set, return it."
- (when (org-entry-get (point) "GPTEL_TOPIC" 'inherit)
- (marker-position org-entry-property-inherited-from)))
-
-(defun gptel-org-set-topic (topic)
- "Set a TOPIC and limit this conversation to the current heading.
-
-This limits the context sent to the LLM to the text between the current
-heading (i.e. the heading with the topic set) and the cursor position."
- (interactive
- (list
- (progn
- (or (derived-mode-p 'org-mode)
- (user-error "Support for multiple topics per buffer is only implemented for `org-mode'"))
- (completing-read "Set topic as: "
- (org-property-values "GPTEL_TOPIC")
- nil nil (downcase
- (truncate-string-to-width
- (substring-no-properties
- (replace-regexp-in-string
- "\\s-+" "-"
- (org-entry-get nil "ITEM")))
- 50))))))
- (when (stringp topic) (org-set-property "GPTEL_TOPIC" topic)))
-
-;; NOTE: This can be converted to a cl-defmethod for
-;; `gptel--create-prompt-buffer' (conceptually cleaner), but will cause
-;; load-order issues in gptel.el and might be harder to debug.
-(defun gptel-org--create-prompt-buffer (&optional prompt-end)
- "Return a buffer with the conversation prompt to be sent.
-
-If the region is active limit the prompt text to the region contents.
-Otherwise the prompt text is constructed from the contents of the
-current buffer up to point, or PROMPT-END if provided. Its contents
-depend on the value of `gptel-org-branching-context', which see."
- (when (use-region-p)
- (narrow-to-region (region-beginning) (region-end))
- (setq prompt-end (point-max)))
- (goto-char (or prompt-end (setq prompt-end (point))))
- (let ((topic-start (gptel-org--get-topic-start)))
- (when topic-start
- ;; narrow to GPTEL_TOPIC property scope
- (narrow-to-region topic-start prompt-end))
- (if (and gptel-org-branching-context
- (or (fboundp 'org-element-lineage-map)
- (prog1 nil
- (display-warning
- '(gptel org)
- "Using `gptel-org-branching-context' requires Org version 9.7 or higher, it will be ignored."))))
- ;; Create prompt from direct ancestors of point
- (save-excursion
- (let* ((org-buf (current-buffer))
- ;; Collect all heading start positions in the lineage
- (full-bounds (gptel-org--element-lineage-map
- (org-element-at-point) #'gptel-org--element-begin
- '(headline) 'with-self) )
- ;; lineage-map returns the full lineage in the unnarrowed
- ;; buffer. Remove heading start positions before (point-min)
- ;; that are invalid due to narrowing, and add (point-min) if
- ;; it's not already included in the lineage
- (start-bounds
- (nconc (cl-delete-if (lambda (p) (< p (point-min)))
- full-bounds)
- (unless (save-excursion (goto-char (point-min))
- (looking-at-p outline-regexp))
- (list (point-min)))))
- (end-bounds
- (cl-loop
- ;; (car start-bounds) is the begining of the current element,
- ;; not relevant
- for pos in (cdr start-bounds)
- do (goto-char pos) (outline-next-heading)
- collect (point) into ends
- finally return (cons prompt-end ends))))
- (gptel--with-buffer-copy org-buf nil nil
- (cl-loop for start in start-bounds
- for end in end-bounds
- do (insert-buffer-substring org-buf start end)
- (goto-char (point-min)))
- (goto-char (point-max))
- (gptel-org--unescape-tool-results)
- (gptel-org--strip-block-headers)
- (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy
- (buffer-local-value 'gptel-org-ignore-elements
- org-buf)))
- (gptel-org--strip-elements))
- (setq org-complex-heading-regexp ;For org-element-context to run
- (buffer-local-value 'org-complex-heading-regexp org-buf))
- (current-buffer))))
- ;; Create prompt the usual way
- (let ((org-buf (current-buffer))
- (beg (point-min)))
- (gptel--with-buffer-copy org-buf beg prompt-end
- (gptel-org--unescape-tool-results)
- (gptel-org--strip-block-headers)
- (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy
- (buffer-local-value 'gptel-org-ignore-elements
- org-buf)))
- (gptel-org--strip-elements))
- (setq org-complex-heading-regexp ;For org-element-context to run
- (buffer-local-value 'org-complex-heading-regexp org-buf))
- (current-buffer))))))
-
-(defun gptel-org--strip-elements ()
- "Remove all elements in `gptel-org-ignore-elements' from the prompt."
- (let ((major-mode 'org-mode) element-markers)
- (if (equal '(property-drawer) gptel-org-ignore-elements)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-property-drawer-re nil t)
- ;; ;; Slower but accurate
- ;; (let ((drawer (org-element-at-point)))
- ;; (when (org-element-type-p drawer 'property-drawer)
- ;; (delete-region (org-element-begin drawer) (org-element-end drawer))))
-
- ;; Fast but inexact, can have false positives
- (delete-region (match-beginning 0) (match-end 0))))
- ;; NOTE: Parsing the buffer is extremely slow. Avoid this path unless
- ;; required.
- ;; NOTE: `org-element-map' takes a third KEEP-DEFERRED argument in newer
- ;; Org versions
- (org-element-map (org-element-parse-buffer 'element nil)
- gptel-org-ignore-elements
- (lambda (node)
- (push (list (gptel-org--element-begin node)
- (gptel-org--element-end node))
- element-markers)))
- (dolist (bounds element-markers)
- (apply #'delete-region bounds)))))
-
-(defun gptel-org--strip-block-headers ()
- "Remove all gptel-specific block headers and footers.
-Every line that matches will be removed entirely.
-
-This removal is necessary to avoid auto-mimicry by LLMs."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (rx line-start (literal "#+")
- (or (literal "begin") (literal "end"))
- (or (literal "_tool") (literal "_reasoning")))
- nil t)
- (delete-region (match-beginning 0)
- (min (point-max) (1+ (line-end-position)))))))
-
-(defun gptel-org--unescape-tool-results ()
- "Undo escapes done to keep results from escaping blocks.
-Scans backward for gptel tool text property, then unescapes the block
-contents."
- (save-excursion
- (goto-char (point-max))
- (let ((prev-pt (point)))
- (while (> prev-pt (point-min))
- (goto-char
- (previous-single-char-property-change (point) 'gptel))
- (let ((prop (get-text-property (point) 'gptel))
- (backward-progress (point)))
- (when (eq (car-safe prop) 'tool)
- ;; User edits to clean up can potentially insert a tool-call header
- ;; that is propertized. Tool call headers should not be
- ;; propertized.
- (when (looking-at-p "[[:space:]]*#\\+begin_tool")
- (goto-char (match-end 0)))
- ;; TODO this code is able to put the point behind prev-pt, which
- ;; makes the region inverted. The `max' catches this, but really
- ;; `read' and `looking-at' are the culprits. Badly formed tool
- ;; blocks can lead to this being necessary.
- (org-unescape-code-in-region
- (min prev-pt (point)) prev-pt))
- (goto-char (setq prev-pt backward-progress)))))))
-
-(defun gptel-org--link-standalone-p (object)
- "Check if link OBJECT is on a line by itself."
- (when-let* ((par (gptel-org--element-parent object))
- ((eq (org-element-type par) 'paragraph)))
- (and (= (gptel-org--element-begin object)
- (save-excursion
- (goto-char (org-element-property :contents-begin par))
- (skip-chars-forward "\t ")
- (point))) ;account for leading space before object
- (<= (- (org-element-property :contents-end par)
- (org-element-property :end object))
- 1))))
-
-(defsubst gptel-org--validate-link (link)
- "Validate an Org LINK as sendable under the current gptel settings.
-
-Return a form (validp link-type path . REST), where REST is a list
-explaining why sending the link is not supported by gptel. Only the
-first nil value in REST is guaranteed to be correct."
- (let ((mime))
- (if-let* ((link-type (org-element-property :type link))
- (resource-type
- (or (and (member link-type '("attachment" "file")) 'file)
- (and (gptel--model-capable-p 'url)
- (member link-type '("http" "https" "ftp")) 'url)))
- (path (org-element-property :path link))
- (user-check (funcall gptel-org-validate-link link))
- (readablep (or (eq resource-type 'url) (file-remote-p path)
- (file-readable-p path)))
- (mime-valid
- (if (or (eq resource-type 'url)
- (cdr (with-memoization
- (alist-get (expand-file-name path)
- gptel--link-type-cache
- nil nil #'string=)
- (cons t (gptel--file-binary-p path)))))
- (gptel--model-mime-capable-p
- (setq mime (mailcap-file-name-to-mime-type path)))
- t)))
- (list t link-type path resource-type user-check readablep mime-valid mime)
- (list nil link-type path resource-type user-check readablep mime-valid mime))))
-
-(cl-defmethod gptel--parse-media-links ((_mode (eql 'org-mode)) beg end)
- "Parse text and actionable links between BEG and END.
-
-Return a list of the form
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\"))
-for inclusion into the user prompt for the gptel request."
- (let ((parts) (from-pt))
- (save-excursion
- (setq from-pt (goto-char beg))
- (while (re-search-forward gptel-org--link-regex end t)
- (let* ((link (org-element-context))
- (link-status (gptel-org--validate-link link)))
- (cl-destructuring-bind
- (valid type path resource-type user-check readablep mime-valid mime)
- link-status
- (cond
- ((and valid (member type '("file" "attachment")))
- ;; Text file or supported binary file: collect text up to link
- (when-let* ((text (buffer-substring-no-properties
- from-pt (gptel-org--element-begin link))))
- (unless (string-blank-p text) (push (list :text text) parts)))
- ;; collect link
- (push (if mime (list :media path :mime mime) (list :textfile path))
- parts)
- (setq from-pt (point)))
- ((and valid (member type '("http" "https" "ftp")))
- ;; Collect text up to this image, and collect this image url
- (when-let* ((text (buffer-substring-no-properties
- from-pt (gptel-org--element-begin link))))
- (unless (string-blank-p text) (push (list :text text) parts)))
- (push (list :url (org-element-property :raw-link link) :mime mime) parts)
- (setq from-pt (point)))
- ((not resource-type)
- (message "Link source not followed for unsupported link type \"%s\"." type))
- ((not user-check)
- (message (if (eq gptel-org-validate-link 'gptel--link-standalone-p)
- "Ignoring non-standalone link \"%s\"."
- "Link %s failed to validate, see `gptel-org-validate-link'.")
- path))
- ((not readablep)
- (message "Ignoring inaccessible file \"%s\"." path))
- ((and (not mime-valid) (eq resource-type 'file))
- (message "Ignoring unsupported binary file \"%s\"." path))))))
- (unless (= from-pt end)
- (push (list :text (buffer-substring-no-properties from-pt end)) parts)))
- (nreverse parts)))
-
-(defun gptel-org--annotate-links (beg end)
- "Annotate Org links whose sources will be sent with `gptel-send'.
-
-Search between BEG and END."
- (when gptel-track-media
- (save-excursion
- (goto-char beg) (forward-line -1)
- (let ((link-ovs (cl-loop for o in (overlays-in (point) end)
- if (overlay-get o 'gptel-track-media)
- collect o into os finally return os)))
- (while (re-search-forward gptel-org--link-regex end t)
- (unless (gptel--in-response-p (1- (point)))
- (let* ((link (org-element-context))
- (from (org-element-begin link))
- (to (org-element-end link))
- (link-status (gptel-org--validate-link link))
- (ov (cl-loop for o in (overlays-in from to)
- if (overlay-get o 'gptel-track-media)
- return o)))
- (if ov ; Ensure overlay over each link
- (progn (move-overlay ov from to)
- (setq link-ovs (delq ov link-ovs)))
- (setq ov (make-overlay from to nil t))
- (overlay-put ov 'gptel-track-media t)
- (overlay-put ov 'evaporate t)
- (overlay-put ov 'priority -80))
- ;; Check if link will be sent, and annotate accordingly
- (gptel--annotate-link ov link-status))))
- (and link-ovs (mapc #'delete-overlay link-ovs))))
- `(jit-lock-bounds ,beg . ,end)))
-
-(defun gptel-org--send-with-props (send-fun &rest args)
- "Conditionally modify SEND-FUN's calling environment.
-
-If in an Org buffer under a heading containing a stored gptel
-configuration, use that for requests instead. This includes the
-system message, model and provider (backend), among other
-parameters.
-
-ARGS are the original function call arguments."
- (if (derived-mode-p 'org-mode)
- (pcase-let ((`(,gptel--system-message ,gptel-backend ,gptel-model
- ,gptel-temperature ,gptel-max-tokens
- ,gptel--num-messages-to-send ,gptel-tools)
- (seq-mapn (lambda (a b) (or a b))
- (gptel-org--entry-properties)
- (list gptel--system-message gptel-backend gptel-model
- gptel-temperature gptel-max-tokens
- gptel--num-messages-to-send gptel-tools))))
- (apply send-fun args))
- (apply send-fun args)))
-
-(advice-add 'gptel-send :around #'gptel-org--send-with-props)
-(advice-add 'gptel--suffix-send :around #'gptel-org--send-with-props)
-
-;; ;; NOTE: Basic uses in org-mode are covered by advising gptel-send and
-;; ;; gptel--suffix-send. For custom commands it might be necessary to advise
-;; ;; gptel-request instead.
-;; (advice-add 'gptel-request :around #'gptel-org--send-with-props)
-
-\f
-;;; Saving and restoring state
-(defun gptel-org--entry-properties (&optional pt)
- "Find gptel configuration properties stored at PT."
- (pcase-let
- ((`(,system ,backend ,model ,temperature ,tokens ,num ,tools)
- (mapcar
- (lambda (prop) (org-entry-get (or pt (point)) prop 'selective))
- '("GPTEL_SYSTEM" "GPTEL_BACKEND" "GPTEL_MODEL"
- "GPTEL_TEMPERATURE" "GPTEL_MAX_TOKENS"
- "GPTEL_NUM_MESSAGES_TO_SEND" "GPTEL_TOOLS"))))
- (when system
- (setq system (string-replace "\\n" "\n" system)))
- (when backend
- (setq backend (alist-get backend gptel--known-backends
- nil nil #'equal)))
- (when model (setq model (gptel--intern model)))
- (when temperature
- (setq temperature (gptel--to-number temperature)))
- (when tokens (setq tokens (gptel--to-number tokens)))
- (when num (setq num (gptel--to-number num)))
- (when tools
- (setq tools (cl-loop
- for tname in (split-string tools)
- for tool = (with-demoted-errors "gptel: %S"
- (gptel-get-tool tname))
- if tool collect tool else do
- (display-warning
- '(gptel org tools)
- (format "Tool %s not found, ignoring" tname)))))
- (list system backend model temperature tokens num tools)))
-
-(defun gptel-org--restore-state ()
- "Restore gptel state for Org buffers when turning on `gptel-mode'."
- (save-restriction
- (let ((modified (buffer-modified-p)))
- (widen)
- (condition-case status
- (progn
- (when-let* ((bounds (org-entry-get (point-min) "GPTEL_BOUNDS")))
- (gptel--restore-props (read bounds)))
- (pcase-let ((`(,system ,backend ,model ,temperature ,tokens ,num ,tools)
- (gptel-org--entry-properties (point-min))))
- (when system (setq-local gptel--system-message system))
- (if backend (setq-local gptel-backend backend)
- (message
- (substitute-command-keys
- (concat
- "Could not activate gptel backend \"%s\"! "
- "Switch backends with \\[universal-argument] \\[gptel-send]"
- " before using gptel."))
- backend))
- (when model (setq-local gptel-model model))
- (when temperature (setq-local gptel-temperature temperature))
- (when tokens (setq-local gptel-max-tokens tokens))
- (when num (setq-local gptel--num-messages-to-send num))
- (when tools (setq-local gptel-tools tools))))
- (:success (message "gptel chat restored."))
- (error (message "Could not restore gptel state, sorry! Error: %s" status)))
- (set-buffer-modified-p modified))))
-
-(defun gptel-org-set-properties (pt &optional msg)
- "Store the active gptel configuration under the current heading.
-
-The active gptel configuration includes the current system
-message, language model and provider (backend), and additional
-settings when applicable.
-
-PT is the cursor position by default. If MSG is
-non-nil (default), display a message afterwards."
- (interactive (list (point) t))
- (org-entry-put pt "GPTEL_MODEL" (gptel--model-name gptel-model))
- (org-entry-put pt "GPTEL_BACKEND" (gptel-backend-name gptel-backend))
- (org-entry-put pt "GPTEL_SYSTEM" ;TODO: Handle nil case correctly
- (and-let* ((msg (car-safe
- (gptel--parse-directive
- gptel--system-message))))
- (string-replace "\n" "\\n" msg)))
- (if gptel-tools
- (org-entry-put
- pt "GPTEL_TOOLS" (mapconcat #'gptel-tool-name gptel-tools " "))
- (org-entry-delete pt "GPTEL_TOOLS"))
- (if (equal (default-value 'gptel-temperature) gptel-temperature)
- (org-entry-delete pt "GPTEL_TEMPERATURE")
- (org-entry-put pt "GPTEL_TEMPERATURE"
- (number-to-string gptel-temperature)))
- (if (natnump gptel--num-messages-to-send)
- (org-entry-put pt "GPTEL_NUM_MESSAGES_TO_SEND"
- (number-to-string gptel--num-messages-to-send))
- (org-entry-delete pt "GPTEL_NUM_MESSAGES_TO_SEND"))
- (if gptel-max-tokens
- (org-entry-put
- pt "GPTEL_MAX_TOKENS" (number-to-string gptel-max-tokens))
- (org-entry-delete pt "GPTEL_MAX_TOKENS"))
- (when msg
- (message "Added gptel configuration to current headline.")))
-
-(defun gptel-org--save-state ()
- "Write the gptel state to the Org buffer as Org properties."
- (org-with-wide-buffer
- (goto-char (point-min))
- (when (org-at-heading-p)
- (org-open-line 1))
- (gptel-org-set-properties (point-min))
- ;; Save response boundaries
- (letrec ((write-bounds
- (lambda (attempts)
- (when-let* ((bounds (gptel--get-buffer-bounds))
- ;; first value of ((prop . ((beg end val)...))...)
- (offset (caadar bounds))
- (offset-marker (set-marker (make-marker) offset)))
- (org-entry-put (point-min) "GPTEL_BOUNDS"
- (prin1-to-string (gptel--get-buffer-bounds)))
- (when (and (not (= (marker-position offset-marker) offset))
- (> attempts 0))
- (funcall write-bounds (1- attempts)))))))
- (funcall write-bounds 6))))
-
-\f
-;;; Transforming responses
-;;;###autoload
-(defun gptel--convert-markdown->org (str)
- "Convert string STR from markdown to org markup.
-
-This is a very basic converter that handles only a few markup
-elements."
- (with-temp-buffer
- (insert str)
- (goto-char (point-min))
- (while (re-search-forward "`+\\|\\*\\{1,2\\}\\|_\\|^#+" nil t)
- (pcase (match-string 0)
- ;; Handle backticks
- ((and (guard (eq (char-before) ?`)) ticks)
- (gptel--replace-source-marker (length ticks))
- (save-match-data
- (catch 'block-end
- (while (search-forward ticks nil t)
- (unless (or (eq (char-before (match-beginning 0)) ?`)
- (eq (char-after) ?`))
- (gptel--replace-source-marker (length ticks) 'end)
- (throw 'block-end nil))))))
- ;; Handle headings
- ((and (guard (eq (char-before) ?#)) heading)
- (cond
- ((looking-at "[[:space:]]") ;Handle headings
- (delete-region (line-beginning-position) (point))
- (insert (make-string (length heading) ?*)))
- ((looking-at "\\+begin_src") ;Overeager LLM switched to using Org src blocks
- (save-match-data (re-search-forward "^#\\+end_src" nil t)))))
- ;; Handle emphasis
- ("**" (cond
- ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)")
- ;; (delete-char 1))
- ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}"
- (max (- (point) 3) (point-min)))
- (delete-char -1))))
- ("*"
- (cond
- ((save-match-data
- (and (or (= (point) 2)
- (looking-back "\\(?:[[:space:]]\\|\s\\)\\(?:_\\|\\*\\)"
- (max (- (point) 2) (point-min))))
- (not (looking-at "[[:space:]]\\|\s"))))
- ;; Possible beginning of emphasis
- (and
- (save-excursion
- (when (and (re-search-forward (regexp-quote (match-string 0))
- (line-end-position) t)
- (looking-at "[[:space:][:punct:]]\\|\s")
- (not (looking-back "\\(?:[[:space]]\\|\s\\)\\(?:_\\|\\*\\)"
- (max (- (point) 2) (point-min)))))
- (delete-char -1) (insert "/") t))
- (progn (delete-char -1) (insert "/"))))
- ((save-excursion
- (ignore-errors (backward-char 2))
- (or (and (bobp) (looking-at "\\*[[:space:]]"))
- (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]")))
- ;; Bullet point, replace with hyphen
- (delete-char -1) (insert "-"))))))
- (buffer-string)))
-
-(defun gptel--replace-source-marker (num-ticks &optional end)
- "Replace markdown style backticks with Org equivalents.
-
-NUM-TICKS is the number of backticks being replaced. If END is
-true these are \"ending\" backticks.
-
-This is intended for use in the markdown to org stream converter."
- (let ((from (match-beginning 0)))
- (delete-region from (point))
- (if (and (= num-ticks 3)
- (save-excursion (beginning-of-line)
- (skip-chars-forward " \t")
- (eq (point) from)))
- (insert (if end "#+end_src" "#+begin_src "))
- (insert "="))))
-
-;;;###autoload
-(defun gptel--stream-convert-markdown->org (start-marker)
- "Return a Markdown to Org converter.
-
-This function parses a stream of Markdown text to Org
-continuously when it is called with successive chunks of the
-text stream.
-
-START-MARKER is used to identify the corresponding process when
-cleaning up after."
- (letrec ((in-src-block nil) ;explicit nil to address BUG #183
- (in-org-src-block nil)
- (temp-buf ; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1
- (gptel--temp-buffer " *gptel-temp*"))
- (start-pt (make-marker))
- (ticks-total 0) ;MAYBE should we let-bind case-fold-search here?
- (cleanup-fn
- (lambda (beg _)
- (when (and (equal beg (marker-position start-marker))
- (eq (current-buffer) (marker-buffer start-marker)))
- (when (buffer-live-p (get-buffer temp-buf))
- (set-marker start-pt nil)
- (kill-buffer temp-buf))
- (remove-hook 'gptel-post-response-functions cleanup-fn)))))
- (add-hook 'gptel-post-response-functions cleanup-fn)
- (lambda (str)
- (let ((noop-p) (ticks 0))
- (with-current-buffer (get-buffer temp-buf)
- (save-excursion (goto-char (point-max)) (insert str))
- (when (marker-position start-pt) (goto-char start-pt))
- (when in-src-block (setq ticks ticks-total))
- (save-excursion
- (while (re-search-forward "`\\|\\*\\{1,2\\}\\|_\\|^#+" nil t)
- (pcase (match-string 0)
- ("`"
- ;; Count number of consecutive backticks
- (backward-char)
- (while (and (char-after) (eq (char-after) ?`))
- (forward-char)
- (if in-src-block (cl-decf ticks) (cl-incf ticks)))
- ;; Set the verbatim state of the parser
- (if (and (eobp)
- ;; Special case heuristic: If the response ends with
- ;; ^``` we don't wait for more input.
- ;; FIXME: This can have false positives.
- (not (save-excursion (beginning-of-line)
- (looking-at "^```$"))))
- ;; End of input => there could be more backticks coming,
- ;; so we wait for more input
- (progn (setq noop-p t) (set-marker start-pt (match-beginning 0)))
- ;; We reached a character other than a backtick
- (cond
- ;; Ticks balanced, end src block
- ((= ticks 0)
- (progn (setq in-src-block nil)
- (gptel--replace-source-marker ticks-total 'end)))
- ;; Positive number of ticks, start an src block
- ((and (> ticks 0) (not in-src-block))
- (setq ticks-total ticks
- in-src-block t)
- (gptel--replace-source-marker ticks-total))
- ;; Negative number of ticks or in a src block already,
- ;; reset ticks
- (t (setq ticks ticks-total)))))
- ;; Handle headings and misguided #+begin_src text
- ((and (guard (and (eq (char-before) ?#) (or (not in-src-block) in-org-src-block)))
- heading)
- (if in-org-src-block
- ;; If we are inside an Org-style src block, look for #+end_src
- (cond
- ((< (- (point-max) (point)) 8) ;not enough information to close Org src block
- (setq noop-p t) (set-marker start-pt (match-beginning 0)))
- ((looking-at "\\+end_src") ;Close Org src block
- (setq in-src-block nil in-org-src-block nil)))
- ;; Otherwise check for Markdown headings, or for #+begin_src
- (cond
- ((eobp) ; Not enough information about the heading yet
- (setq noop-p t) (set-marker start-pt (match-beginning 0)))
- ((looking-at "[[:space:]]") ; Convert markdown heading to Org heading
- (delete-region (line-beginning-position) (point))
- (insert (make-string (length heading) ?*)))
- ((< (- (point-max) (point)) 11) ;Not enough information to check if Org src block
- (setq noop-p t) (set-marker start-pt (match-beginning 0)))
- ((looking-at "\\+begin_src ") ;Overeager LLM switched to using Org src blocks
- (setq in-src-block t in-org-src-block t)))))
- ;; Handle other chars: emphasis, bold and bullet items
- ((and "**" (guard (not in-src-block)))
- (cond
- ;; TODO Not sure why this branch was needed
- ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)") (delete-char 1))
-
- ;; Looking back at "w**" or " **"
- ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}"
- (max (- (point) 3) (point-min)))
- (delete-char -1))))
- ((and "*" (guard (not in-src-block)))
- (if (eobp)
- ;; Not enough information about the "*" yet
- (progn (setq noop-p t) (set-marker start-pt (match-beginning 0)))
- ;; "*" is either emphasis or a bullet point
- (save-match-data
- (save-excursion
- (ignore-errors (backward-char 2))
- (cond
- ((and ; At bob, underscore/asterisk followed by word
- (or (and (bobp) (looking-at "\\(?:_\\|\\*\\)\\([^[:space:][:punct:]]\\|$\\)"))
- (looking-at ; word followed by underscore/asterisk
- "[^[:space:]\n]\\(?:_\\|\\*\\)\\(?:[[:space:][:punct:]]\\|$\\)")
- (looking-at ; underscore/asterisk followed by word
- "\\(?:[[:space:]]\\)\\(?:_\\|\\*\\)\\([^[:space:]]\\|$\\)"))
- (not (looking-at "[[:punct:]]\\(?:_\\|\\*\\)[[:punct:]]")))
- ;; Emphasis, replace with slashes
- (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "/"))
- ((or (and (bobp) (looking-at "\\*[[:space:]]"))
- (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]"))
- ;; Bullet point, replace with hyphen
- (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "-"))))))))))
- (if noop-p
- (buffer-substring (point) start-pt)
- (prog1 (buffer-substring (point) (point-max))
- (set-marker start-pt (point-max)))))))))
-
-(provide 'gptel-org)
-;;; gptel-org.el ends here
-
-;; Silence warnings about `org-element-type-p' and `org-element-parent', see #294.
-;; Local Variables:
-;; byte-compile-warnings: (not unresolved)
-;; End:
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "gptel" "20260123.739"
- "Interact with ChatGPT or other LLMs."
- '((emacs "27.1")
- (transient "0.7.4")
- (compat "30.1.0.0"))
- :url "https://github.com/karthink/gptel"
- :commit "96199593c107767ffe0b59ab2a1f996c112e4fdf"
- :revdesc "96199593c107"
- :keywords '("convenience" "tools")
- :authors '(("Karthik Chikmagalur" . "karthik.chikmagalurNOSPAMgmail.com"))
- :maintainers '(("Karthik Chikmagalur" . "karthik.chikmagalurNOSPAMgmail.com")))
+++ /dev/null
-;;; gptel-request.el --- LLM request library for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur;; <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords: convenience
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; LLM querying library used by gptel. This file provides the basic data
-;; structures (models, backends) and prompt construction functions used by
-;; gptel, along with the `gptel-request' API.
-;;
-;; This is everything required to use `gptel-request' to write custom commands,
-;; UIs or packages that use gptel to implement custom workflows. To use gptel's
-;; LLM querying API, you can
-;;
-;; (require 'gptel-request)
-;;
-;; and make calls to `gptel-request'.
-;;
-;; Note that this file does not provide any of the UI components used by gptel
-;; (chat buffers, tool use prompts, transient menus), nor does it provide the
-;; default response callbacks used by `gptel-request'. You will need to provide
-;; your own callback to `gptel-request' to act on the LLM response, or require
-;; the larger `gptel' feature.
-
-;;; Code:
-
-(require 'gptel-openai)
-(eval-when-compile
- (require 'subr-x))
-(require 'compat nil t)
-(require 'cl-lib)
-(require 'url)
-(require 'text-property-search)
-(require 'cl-generic)
-(require 'map)
-(require 'mailcap) ;FIXME Avoid this somehow
-
-(declare-function json-read "json" ())
-(defvar json-object-type)
-
-(declare-function gptel--stream-convert-markdown->org "gptel-org")
-(declare-function gptel--convert-markdown->org "gptel-org")
-(declare-function gptel-org--create-prompt-buffer "gptel-org")
-(declare-function gptel-context--wrap "gptel-context")
-(declare-function gptel--transform-apply-preset "gptel")
-(declare-function gptel--insert-response "gptel")
-(declare-function gptel-curl--stream-insert-response "gptel")
-
-\f
-;;; User options
-(defgroup gptel nil
- "Interact with LLMs from anywhere in Emacs."
- :group 'hypermedia)
-
-(defcustom gptel-proxy ""
- "Path to a proxy to use for gptel interactions.
-Passed to curl via --proxy arg, for example \"proxy.yourorg.com:80\"
-Leave it empty if you don't use a proxy."
- :type 'string)
-
-(defcustom gptel-api-key #'gptel-api-key-from-auth-source
- "An API key (string) for the default LLM backend.
-
-OpenAI by default.
-
-Can also be a function of no arguments that returns an API
-key (more secure) for the active backend."
- :type '(choice
- (string :tag "API key")
- (function :tag "Function that returns the API key")))
-
-(defcustom gptel-stream t
- "Stream responses from the LLM as they are received.
-
-This option is ignored unless
-- the LLM backend supports streaming, and
-- Curl is in use (see `gptel-use-curl')
-
-When set to nil, Emacs waits for the full response and inserts it
-all at once. This wait is asynchronous.
-
-\='tis a bit silly."
- :type 'boolean)
-
-(defcustom gptel-use-curl (and (executable-find "curl") t)
- "Whether gptel should prefer Curl when available.
-
-Can be set to t, nil, or a string path to the curl executable."
- :type '(choice
- (const :tag "Do not use Curl" nil)
- (const :tag "Use Curl" t)
- (string :tag "Specify path to the Curl executable")))
-
-(defcustom gptel-org-convert-response t
- "Whether gptel should convert Markdown responses to Org markup.
-
-This only affects requests originating from Org mode buffers."
- :type 'boolean)
-
-(defcustom gptel-curl-file-size-threshold
- (if (memq system-type '(windows-nt ms-dos)) #x6ffe 130000)
- "Size threshold for using file input with Curl.
-
-Specifies the size threshold for when to use a temporary file to pass data to
-Curl in gptel queries. If the size of the data to be sent exceeds this
-threshold, the data is written to a temporary file and passed to Curl using the
-`--data-binary' option with a file reference. Otherwise, the data is passed
-directly as a command-line argument.
-
-The value is an integer representing the number of bytes.
-
-Adjusting this value may be necessary depending on the environment
-and the typical size of the data being sent in gptel queries.
-A larger value may improve performance by avoiding the overhead of creating
-temporary files for small data payloads, while a smaller value may be needed
-if the command-line argument size is limited by the operating system.
-
-The default of #x8000 for windows comes from Microsoft documentation
-located here:
-https://learn.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-createprocessa
-
-It is set to (#x8000 - #x1000 - 2) to account for other (non-data) Curl
-command line arguments."
- :type 'natnum)
-
-(define-obsolete-variable-alias 'gptel-prompt-filter-hook
- 'gptel-prompt-transform-functions "0.9.9")
-
-(defcustom gptel-prompt-transform-functions
- '(gptel--transform-apply-preset gptel--transform-add-context)
- "Handlers to augment or transform a query before sending it.
-
-This hook is called in a temporary buffer containing the text to
-be sent, with the cursor at the end of the prompt. You can use
-it to modify the buffer or buffer-local variables as required.
-
-Since these functions modify the prompt construction buffer, the order
-in which they run is significant! In particular, you may want to add
-your function before (the default) or after
-`gptel--transform-add-context', which adds gptel's context (other
-buffers, files etc) to this buffer.
-
-Example: A typical use case might be to search for occurrences of $(cmd)
-and replace it with the output of the shell command cmd, making it easy
-to send the output of shell commands to the LLM.
-
-Transform functions can be synchronous or asynchronous.
-
-Synchronous hook functions must accept zero or one argument: the INFO
-plist for the current request.
-
-Asynchronous hook functions must accept two arguments: a callback to
-call after the transformation is complete, and the INFO plist for the
-current request.
-
-Note that while this set of handlers can certainly be set with a global
-value to be applied to all queries in all buffers, it meant to be set
-locally for a specific buffer, or chat topic, or only the context of a
-certain task."
- :type 'hook)
-
-(defcustom gptel-post-request-hook nil
- "Hook run after sending a gptel request.
-
-This runs (possibly) before any response is received."
- :type 'hook)
-
-;; TODO(v1.0): Remove this.
-(defvar gptel-response-filter-functions nil)
-(make-obsolete-variable
- 'gptel-response-filter-functions
- "Response filtering is no longer supported in gptel. To toggle
-markdown to Org conversion, see `gptel-org-convert-response'. To
-filter LLM response text, either use `gptel-request' with a
-custom callback, or use `gptel-post-response-functions'."
- "0.9.7")
-
-;; TODO: Handle `prog-mode' using the `comment-start' variable
-(defcustom gptel-prompt-prefix-alist
- '((markdown-mode . "### ")
- (org-mode . "*** ")
- (text-mode . "### "))
- "String used as a prefix to the query being sent to the LLM.
-
-This is meant for the user to distinguish between queries and
-responses, and is removed from the query before it is sent.
-
-This is an alist mapping major modes to the prefix strings. This
-is only inserted in dedicated gptel buffers."
- :type '(alist :key-type symbol :value-type string))
-
-(defcustom gptel-response-prefix-alist
- '((markdown-mode . "")
- (org-mode . "")
- (text-mode . ""))
- "String inserted before the response from the LLM.
-
-This is meant for the user to distinguish between queries and
-responses.
-
-This is an alist mapping major modes to the reply prefix strings. This
-is only inserted in dedicated gptel buffers before the AI's response."
- :type '(alist :key-type symbol :value-type string))
-
-(defcustom gptel-response-separator "\n\n"
- "String inserted before responses.
-
-Also inserted before and after non-consecutive tool calls."
- :type 'string)
-
-;; Model and interaction parameters
-(defcustom gptel-directives
- '((default . "You are a large language model living in Emacs and a helpful assistant. Respond concisely.")
- (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 or directives for the LLM.
-
-Each entry in this alist maps a symbol naming the directive to
-the directive itself. By default, gptel uses the directive with
-the key \\+`default'.
-
-To set the directive for a chat session interactively call
-`gptel-send' with a prefix argument, or call `gptel-menu'.
-
-A \"directive\" is typically the system message (also called
-system prompt or system instruction) sent at the beginning of
-each request to the LLM. It is used to set general instructions,
-expectations and the overall tone.
-
-gptel's idea of the directive is more general. A directive in
-`gptel-directives' 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 (possibly nil) alternating user prompts and LLM responses.
- This can be used to template the initial 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. See the definition of
- `gptel--rewrite-directive-default' for an example."
- :safe #'always
- :type '(alist :key-type symbol :value-type string))
-
-(defcustom gptel-max-tokens nil
- "Max tokens per response.
-
-This is roughly the number of words in the response. 100-300 is a
-reasonable range for short answers, 400 or more for longer
-responses.
-
-To set the target token count for a chat session interactively
-call `gptel-send' with a prefix argument."
- :safe #'always
- :type '(choice (natnum :tag "Specify Token count")
- (const :tag "Default" nil)))
-
-(defcustom gptel-temperature 1.0
- "\"Temperature\" of the LLM response.
-
-This is a number between 0.0 and 2.0 that controls the randomness
-of the response, with 2.0 being the most random.
-
-To set the temperature for a chat session interactively call
-`gptel-send' with a prefix argument."
- :safe (lambda (v) (or (null v) (numberp v)))
- :type '(choice (number :tag "Temperature value")
- (const :tag "Use default" nil)))
-
-(defcustom gptel-cache nil
- "Whether the LLM should cache request content.
-
-Some LLM backends can cache content sent to it by gptel, so that
-only the newly included part of the text needs to be processed on
-subsequent conversation turns. This results in faster and
-significantly cheaper processing.
-
-NOTE: Manual or client-configurable caching is currently
-supported only by the Anthropic API and thus the
-`gptel-anthropic' backend. This variable has no effect on the
-behavior of other backends.
-
-This variable controls which parts of the query will be cached,
-and can be the symbols t or nil to cache everything or nothing
-respectively. It can also be a list of symbols:
-
-- message: Cache conversation messages
-- system: Cache the system message
-- tool: Cache tool definitions
-
-Examples:
-
-Setting it to (message system) will cache the system message and
-the conversation text.
-
-Setting it to (message system tool) will cache everything and is
-the same as t."
- :type '(choice
- (const :tag "Cache everything" t)
- (const :tag "Do not cache" nil)
- (repeat symbol))
- :group 'gptel)
-
-(defvar gptel--known-backends)
-
-(defconst gptel--openai-models
- '((gpt-4o
- :description "Advanced model for complex tasks; cheaper & faster than GPT-Turbo"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 128
- :input-cost 2.50
- :output-cost 10
- :cutoff-date "2023-10")
- (gpt-4o-mini
- :description "Cheap model for fast tasks; cheaper & more capable than GPT-3.5 Turbo"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 128
- :input-cost 0.15
- :output-cost 0.60
- :cutoff-date "2023-10")
- (gpt-4.1
- :description "Flagship model for complex tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 1024
- :input-cost 2.0
- :output-cost 8.0
- :cutoff-date "2024-05")
- (gpt-4.5-preview
- :description "DEPRECATED: Use gpt-4.1 instead"
- :capabilities (media tool-use url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 128
- :input-cost 75
- :output-cost 150
- :cutoff-date "2023-10")
- (gpt-4.1-mini
- :description "Balance between intelligence, speed and cost"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 1024
- :input-cost 0.4
- :output-cost 1.6)
- (gpt-4.1-nano
- :description "Fastest, most cost-effective GPT-4.1 model"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 1024
- :input-cost 0.10
- :output-cost 0.40
- :cutoff-date "2024-05")
- (gpt-4-turbo
- :description "Previous high-intelligence model"
- :capabilities (media tool-use url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 128
- :input-cost 10
- :output-cost 30
- :cutoff-date "2023-11")
- (gpt-4
- :description "GPT-4 snapshot from June 2023 with improved function calling support"
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :capabilities (media url)
- :context-window 8.192
- :input-cost 30
- :output-cost 60
- :cutoff-date "2023-11")
- (gpt-5
- :description "Flagship model for coding, reasoning, and agentic tasks across domains"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 1.25
- :output-cost 10
- :cutoff-date "2024-09")
- (gpt-5-mini
- :description "Faster, more cost-efficient version of GPT-5"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 0.25
- :output-cost 2.0
- :cutoff-date "2024-09")
- (gpt-5-nano
- :description "Fastest, cheapest version of GPT-5"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 0.05
- :output-cost 0.40
- :cutoff-date "2024-09")
- (gpt-5.1
- :description "The best model for coding and agentic tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 1.25
- :output-cost 10
- :cutoff-date "2024-09")
- (gpt-5.2
- :description "The best model for coding and agentic tasks"
- :capabilities (media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 400
- :input-cost 1.75
- :output-cost 14
- :cutoff-date "2025-08")
- (o1
- :description "Reasoning model designed to solve hard problems across domains"
- :capabilities (media reasoning)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 200
- :input-cost 15
- :output-cost 60
- :cutoff-date "2023-10")
- (o1-mini
- :description "Faster and cheaper reasoning model good at coding, math, and science"
- :context-window 128
- :input-cost 3
- :output-cost 12
- :cutoff-date "2023-10"
- :capabilities (nosystem reasoning))
- (o3
- :description "Well-rounded and powerful model across domains"
- :capabilities (reasoning media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 200
- :input-cost 2
- :output-cost 8
- :cutoff-date "2024-05")
- (o3-mini
- :description "High intelligence at the same cost and latency targets of o1-mini"
- :context-window 200
- :input-cost 1.10
- :output-cost 4.40
- :cutoff-date "2023-10"
- :capabilities (reasoning tool-use json))
- (o4-mini
- :description "Fast, effective reasoning with efficient performance in coding and visual tasks"
- :capabilities (reasoning media tool-use json url)
- :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
- :context-window 200
- :input-cost 1.10
- :output-cost 4.40
- :cutoff-date "2024-05")
- (gpt-3.5-turbo
- :description "More expensive & less capable than GPT-4o-mini; use that instead"
- :capabilities (tool-use)
- :context-window 16.358
- :input-cost 0.50
- :output-cost 1.50
- :cutoff-date "2021-09")
- (gpt-3.5-turbo-16k
- :description "More expensive & less capable than GPT-4o-mini; use that instead"
- :capabilities (tool-use)
- :context-window 16.385
- :input-cost 3
- :output-cost 4
- :cutoff-date "2021-09"))
- "List of available OpenAI models and associated properties.
-Keys:
-
-- `:description': a brief description of the model.
-
-- `:capabilities': a list of capabilities supported by the model.
-
-- `:mime-types': a list of supported MIME types for media files.
-
-- `:context-window': the context window size, in thousands of tokens.
-
-- `:input-cost': the input cost, in US dollars per million tokens.
-
-- `:output-cost': the output cost, in US dollars per million tokens.
-
-- `:cutoff-date': the knowledge cutoff date.
-
-- `:request-params': a plist of additional request parameters to
- include when using this model.
-
-Information about the OpenAI models was obtained from the following
-sources:
-
-- <https://platform.openai.com/docs/pricing>
-- <https://platform.openai.com/docs/models>")
-
-(defcustom gptel-model 'gpt-4o-mini
- (concat
- "Model for chat.
-
-The name of the model, as a symbol. This is the name as expected
-by the LLM provider's API.
-
-To set the model for a chat session interactively call
-`gptel-send' with a prefix argument.")
- :safe #'always
- :type `(choice
- (symbol :tag "Specify model name")
- ,@(mapcar (lambda (model)
- (list 'const :tag (symbol-name (car model))
- (car model)))
- gptel--openai-models)))
-
-(defvar gptel--openai
- (gptel-make-openai
- "ChatGPT"
- :key 'gptel-api-key
- :stream t
- :models gptel--openai-models))
-
-(defcustom gptel-backend gptel--openai
- "LLM backend to use.
-
-This is the default \"backend\", an object of type
-`gptel-backend' containing connection, authentication and model
-information.
-
-A backend for ChatGPT is pre-defined by gptel. Backends for
-other LLM providers (local or remote) may be constructed using
-one of the available backend creation functions:
-- `gptel-make-openai'
-- `gptel-make-azure'
-- `gptel-make-ollama'
-- `gptel-make-gpt4all'
-- `gptel-make-gemini'
-See their documentation for more information and the package
-README for examples."
- :safe #'always
- :type `(choice
- (const :tag "ChatGPT" ,gptel--openai)
- (restricted-sexp :match-alternatives (gptel-backend-p 'nil)
- :tag "Other backend")))
-
-(defvar gptel-expert-commands nil
- "Whether experimental gptel options should be enabled.
-
-This opens up advanced options in `gptel-menu'.")
-
-(defvar gptel--num-messages-to-send nil)
-(put 'gptel--num-messages-to-send 'safe-local-variable #'always)
-
-(defcustom gptel-log-level nil
- "Logging level for gptel.
-
-This is one of nil or the symbols info and debug:
-
-nil: Don't log responses
-info: Log request and response bodies
-debug: Log request/response bodies, headers and all other
- connection settings.
-
-When non-nil, information is logged to `gptel--log-buffer-name',
-which see."
- :type '(choice
- (const :tag "No logging" nil)
- (const :tag "Limited" info)
- (const :tag "Full" debug)))
-
-(defcustom gptel-track-response t
- "Distinguish between user messages and LLM responses.
-
-When creating a prompt to send to the LLM, gptel distinguishes
-between text entered by the user and past LLM responses. This
-distinction is necessary for back-and-forth conversation with an
-LLM.
-
-In regular Emacs buffers you can turn this behavior off by
-setting `gptel-track-response' to nil. All text, including
-past LLM responses, is then treated as user input when sending
-queries.
-
-This variable has no effect in dedicated chat buffers (buffers
-with `gptel-mode' enabled), where user prompts and responses are
-always handled separately."
- :type 'boolean)
-
-(defcustom gptel-track-media nil
- "Whether supported media in chat buffers should be sent.
-
-When this is non-nil, gptel will send text, images or other media from
-links in chat buffers to the LLM.
-
-Sending images or other binary media from links requires the
-active `gptel-model' to support it. See `gptel-make-openai',
-`gptel-make-anthropic', `gptel-make-ollama' or `gptel-make-gemini' for
-details on how to specify media support for models.
-
-This option has no effect in non-chat buffers. To include
-media (including images) more generally, use `gptel-add' or
-`gptel-add-file'."
- :type 'boolean)
-
-(defcustom gptel-use-context 'system
- "Where in the request to inject gptel's additional context.
-
-gptel always includes the active region or the buffer up to the
-cursor in the request to the LLM. Additionally, you can add
-other buffers or their regions to the context with
-`gptel-add-context', or from gptel's menu. This data will be
-sent with every request.
-
-This option controls whether and where this additional context is
-included in the request.
-
-Currently supported options are:
-
- nil - Do not use the context.
- system - Include the context with the system message.
- user - Include the context with the user prompt."
- :group 'gptel
- :type '(choice
- (const :tag "Don't include context" nil)
- (const :tag "With system message" system)
- (const :tag "With user prompt" user)))
-
-(defcustom gptel-include-reasoning t
- "How to handle LLM reasoning or \"thinking\" text blocks.
-
-Some LLMs include in their response a \"thinking\" section. This
-text improves the quality of the LLM's final output, but may not
-be interesting to you by itself.
-
-Supported options are the symbols
-
- t - Include with the response, the default
- nil - Do not include
- ignore - Include with the response but ignore on subsequent
- conversation turns
-
-It can also be a string naming a buffer, in which case the
-reasoning text will be inserted at the end of that buffer."
- :group 'gptel
- :type '(choice
- (const :tag "Include with response" t)
- (const :tag "Don't include" nil)
- (const :tag "Include but ignore" ignore)
- (string :tag "Include in buffer")))
-
-(define-obsolete-variable-alias 'gptel-context--alist 'gptel-context
- "0.9.9.3")
-
-(defcustom gptel-context nil
- "List of gptel's context sources.
-
-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\"
- #<buffer *scratch*>
- ...)
-
-The above covers the most common cases. You can also specify context
-sources in a more targeted way, with entries of the form
-
- (<buffer> . spec)
- (\"/path/to/file\" . spec)
-
-where spec is a plist declaring specific parts of the buffer/file to
-include instead of the entire text.
-
-For buffers, you can specify regions to include using buffer spans and
-line number ranges as conses, and overlays as a list:
-
- (<buffer> :bounds ((start1 . end1) (start2 . end2) ...)
- :lines ((from1 . to1) (from2 . end2) ...)
- :overlays (ov1 ov2 ...))
-
-For files, spec can include buffer spans and line number ranges, as well as
-the MIME type of the file:
-
- (\"/path/to/file\" :bounds ((start1 . end1) (start2 . end2) ...)
- :lines ((from1 . to1) (from2 . end2) ...)
- :mime \"image/png\")
-
-gptel tries to guess file MIME types, but is not always successful, so
-it is recommended to provide it with non-text files.
-
-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 with the :context key."
- :type '(repeat string))
-
-(defcustom gptel-markdown-validate-link #'always
- "Validate links to be sent as context with gptel queries.
-
-When `gptel-track-media' is enabled, this option determines if a
-supported link will be followed and its source included with gptel
-queries from Markdown buffers. Currently only links to files are
-supported (along with web URLs if the model supports them).
-
-It should be a function that accepts a Markdown link and return non-nil
-if the link should be followed. See `markdown-link-at-pos' for the
-structure of a Markdown link object.
-
-By default, all links are considered valid.
-
-Set this to `gptel--link-standalone-p' to only follow links placed on a
-line by themselves, separated from surrounding text."
- :type '(choice
- (const :tag "All links" always)
- (const :tag "Standalone links" gptel--link-standalone-p)
- (function :tag "Function"))
- :group 'gptel)
-
-(defvar gptel--request-alist nil
- "Alist of active gptel requests.
-Each entry has the form (PROCESS . (FSM ABORT-CLOSURE))
-If the ABORT-CLOSURE is called, it must abort the PROCESS.")
-
-(defvar gptel--request-params nil
- "Extra parameters sent with each gptel request.
-
-These parameters are combined with model-specific and backend-specific
-:request-params before sending a request, which see. Warning: values
-incompatible with the active backend can break gptel. Do not use this
-variable unless you know what you're doing!")
-
-(defconst gptel--ersatz-json-tool "response_json"
- "Name of ersatz tool used to force JSON output.
-
-Some APIs, like Anthropic, use a tool to produce structured JSON output.")
-
-(defcustom gptel-curl-extra-args nil
- "Extra arguments to pass to Curl when sending queries.
-
-This should be a list of strings, each one a Curl command line
-argument. Note that these should not conflict with the options
-in `gptel-curl--common-args', which gptel requires for correct
-functioning.
-
-If you want to specify extra arguments only when using a specific
-gptel backend, use the `:curl-args' slot of the backend instead.
-See `gptel-backend'."
- :group 'gptel
- :type '(repeat string))
-
-(defconst gptel-curl--common-args
- (if (memq system-type '(windows-nt ms-dos))
- '("--disable" "--location" "--silent" "-XPOST"
- "-y7200" "-Y1" "-D-")
- '("--disable" "--location" "--silent" "--compressed"
- "-XPOST" "-y7200" "-Y1" "-D-"))
- "Arguments always passed to Curl for gptel queries.")
-
-(defvar gptel--link-type-cache nil
- "Cache of checks for binary files.
-
-Each alist entry maps an absolute file path to a cons cell of the
-form (t . binaryp), where binaryp is non-nil if the file is
-binary-encoded.")
-
-;; The following is derived from:
-;;
-;; (concat "\\(?:" markdown-regex-link-inline "\\|" markdown-regex-angle-uri "\\)")
-;;
-;; Since we want this known at compile time, when markdown-mode is not
-;; guaranteed to be available, we have to hardcode it.
-(defconst gptel-markdown--link-regex
- "\\(?:\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)\\|\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^] \n\r<>,;()]+\\)\\(>\\)\\)"
- "Link regex for `gptel-mode' in Markdown mode.")
-
-\f
-;;; Utility functions
-
-(defun gptel-api-key-from-auth-source (&optional host user)
- "Lookup api key in the auth source.
-By default, the LLM host for the active backend is used as HOST,
-and \"apikey\" as USER."
- (if-let* ((secret
- (plist-get
- (car (auth-source-search
- :host (or host (gptel-backend-host gptel-backend))
- :user (or user "apikey")
- :require '(:secret)))
- :secret)))
- (if (functionp secret)
- (encode-coding-string (funcall secret) 'utf-8)
- secret)
- (user-error "No `gptel-api-key' found in the auth source")))
-
-;; FIXME Should we utf-8 encode the api-key here?
-(defun gptel--get-api-key (&optional key)
- "Get api key from KEY, or from `gptel-api-key'."
- (when-let* ((key-sym (or key (gptel-backend-key gptel-backend))))
- (cl-typecase key-sym
- (function (string-trim-right (funcall key-sym) "[\n\r]+"))
- (string (string-trim-right key-sym "[\n\r]+"))
- (symbol (if-let* ((val (symbol-value key-sym)))
- (gptel--get-api-key val)
- (error "`gptel-api-key' is not valid")))
- (t (error "`gptel-api-key' is not valid")))))
-
-(defsubst gptel--to-number (val)
- "Ensure VAL is a number."
- (cond
- ((numberp val) val)
- ((stringp val) (string-to-number val))
- ((error "%S cannot be converted to a number" val))))
-
-(defsubst gptel--to-string (s)
- "Convert S to a string, if possible."
- (cl-typecase s
- (symbol (symbol-name s))
- (string s)
- (otherwise (prin1-to-string s))))
-
-(defsubst gptel--intern (s)
- "Intern S, if possible."
- (cl-etypecase s
- (symbol s)
- (string (intern s))))
-
-(defun gptel--merge-plists (&rest plists)
- "Merge PLISTS, altering the first one.
-
-Later plists in the sequence take precedence over earlier ones."
- (let (;; (rtn (copy-sequence (pop plists)))
- (rtn (pop plists))
- p v ls)
- (while plists
- (setq ls (pop plists))
- (while ls
- (setq p (pop ls) v (pop ls))
- (setq rtn (plist-put rtn p v))))
- rtn))
-
-(defun gptel--file-binary-p (path)
- "Check if file at PATH is readable and binary."
- ;; HACK Image files with ICC color profiles are characterized as ASCII
- ;; (#1223), so until we find a better solution we just match these files by
- ;; extension.
- (or (string-match-p "\\.\\(jpe?g\\|png\\|gif\\|webp\\)\\'" path)
- (condition-case nil
- (with-temp-buffer
- (insert-file-contents path nil 1 512 'replace)
- (memq buffer-file-coding-system
- '(no-conversion no-conversion-multibyte)))
- (file-missing (message "File \"%s\" is not readable." path)
- nil))))
-
-(defun gptel--insert-file-string (path)
- "Insert at point the contents of the file at PATH as context."
- (insert (format "In file `%s`:" (abbreviate-file-name path))
- "\n\n```\n")
- (let ((pm (point-marker)))
- (set-marker-insertion-type pm t)
- (insert-file-contents path)
- (goto-char pm))
- (insert "\n```\n"))
-
-(defun gptel--strip-mode-suffix (mode-sym)
- "Remove the -mode suffix from MODE-SYM.
-
-MODE-SYM is typically a major-mode symbol."
- (or (alist-get mode-sym gptel--mode-description-alist)
- (let ((mode-name (thread-last
- (symbol-name mode-sym)
- (string-remove-suffix "-mode")
- (string-remove-suffix "-ts"))))
- ;; NOTE: The advertised calling convention of provided-mode-derived-p
- ;; has changed in Emacs 30, this needs to be updated eventually
- (if (provided-mode-derived-p
- mode-sym 'prog-mode 'text-mode 'tex-mode)
- mode-name ""))))
-
-(defvar url-http-end-of-headers)
-(defvar url-http-response-status)
-(cl-defun gptel--url-retrieve (url &key method data headers)
- "Retrieve URL synchronously with METHOD, DATA and HEADERS."
- (declare (indent 1))
- (let ((url-request-method (if (eq method 'post) "POST" "GET"))
- (url-request-data (when (eq method 'post) (encode-coding-string (gptel--json-encode data) 'utf-8)))
- (url-mime-accept-string "application/json")
- (url-request-extra-headers
- `(("content-type" . "application/json")
- ,@headers)))
- (with-current-buffer (url-retrieve-synchronously url 'silent)
- (goto-char url-http-end-of-headers)
- (gptel--json-read))))
-
-(defsubst gptel-prompt-prefix-string ()
- "Prefix before user prompts in `gptel-mode'."
- (declare (side-effect-free t))
- (or (alist-get major-mode gptel-prompt-prefix-alist) ""))
-
-(defsubst gptel-response-prefix-string ()
- "Prefix before LLM responses in `gptel-mode'."
- (declare (side-effect-free t))
- (or (alist-get major-mode gptel-response-prefix-alist) ""))
-
-(defmacro gptel--at-word-end (&rest body)
- "Execute BODY at end of the current word or punctuation."
- `(save-excursion
- (skip-syntax-forward "w.")
- ,(macroexp-progn body)))
-
-(defmacro gptel--temp-buffer (buf)
- "Generate a temp buffer BUF.
-
-Compatibility macro for Emacs 27.1."
- (if (< emacs-major-version 28)
- `(generate-new-buffer ,buf)
- `(generate-new-buffer ,buf t)))
-
-;; This is defined in gptel, but we define it here as well as it's required by
-;; `gptel--with-buffer-copy'.
-(defvar gptel-mode nil)
-
-(defmacro gptel--with-buffer-copy (buf start end &rest body)
- "Copy gptel's local variables from BUF to a temp buffer and run BODY.
-
-If positions START and END are provided, insert that part of BUF first."
- (declare (indent 3))
- `(gptel--with-buffer-copy-internal ,buf ,start ,end (lambda () ,@body)))
-
-(defun gptel--with-buffer-copy-internal (buf start end body-thunk)
- "Prepare a temp buffer for a gptel request.
-
-For BUF, START, END and BODY-THUNK see `gptel--with-buffer-copy'."
- (let ((temp-buffer (gptel--temp-buffer " *gptel-prompt*")))
- (with-current-buffer temp-buffer
- (dolist (sym '( gptel-backend gptel--system-message gptel-model
- gptel-mode gptel-track-response gptel-track-media
- gptel-use-tools gptel-tools gptel-use-curl gptel--schema
- gptel-use-context gptel-context gptel--num-messages-to-send
- gptel-stream gptel-include-reasoning gptel--request-params
- gptel-temperature gptel-max-tokens gptel-cache))
- (set (make-local-variable sym) (buffer-local-value sym buf)))
- (when (and start end) (insert-buffer-substring buf start end))
- (setq major-mode (buffer-local-value 'major-mode buf))
- (funcall body-thunk))))
-
-(defsubst gptel--trim-prefixes (s)
- "Remove prompt/response prefixes from string S.
-
-Return nil if string collapses to empty string."
- (let* ((trimmed (string-trim-left
- s (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
- (regexp-quote
- (gptel-prompt-prefix-string)))))
- (trimmed (string-trim-right
- trimmed (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
- (regexp-quote
- (gptel-response-prefix-string))))))
- (unless (string-empty-p trimmed)
- trimmed)))
-
-(defun gptel--link-standalone-p (link)
- "Return non-nil if Markdown LINK is isolated.
-
-This means the extent from the link beginning to end is the only
-non-whitespace content on its line."
- (let ((beg (car link)) (end (cadr link)))
- (save-excursion
- (and (= beg (progn (goto-char beg) (beginning-of-line)
- (skip-chars-forward "\t ")
- (point)))
- (= end (progn (goto-char end) (end-of-line)
- (skip-chars-backward "\t ")
- (point)))))))
-
-(defsubst gptel--curl-path ()
- "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)
- (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
-;; another map from these symbols to the actual model structs.
-
-(defsubst gptel--model-name (model)
- "Get name of gptel MODEL."
- (gptel--to-string model))
-
-(defsubst gptel--model-capabilities (model)
- "Get MODEL capabilities."
- (get model :capabilities))
-
-(defsubst gptel--model-mimes (model)
- "Get supported mime-types for MODEL."
- (get model :mime-types))
-
-(defsubst gptel--model-capable-p (cap &optional model)
- "Return non-nil if MODEL supports capability CAP."
- (memq cap (gptel--model-capabilities
- (or model gptel-model))))
-
-;; TODO Handle model mime specifications like "image/*"
-(defsubst gptel--model-mime-capable-p (mime &optional model)
- "Return non nil if MODEL can understand MIME type."
- (car-safe (member mime (gptel--model-mimes
- (or model gptel-model)))))
-
-(defsubst gptel--model-request-params (model)
- "Get model-specific request parameters for MODEL."
- (get model :request-params))
-
-;;;; File handling
-(defun gptel--base64-encode (file)
- "Encode FILE as a base64 string.
-
-FILE is assumed to exist and be a regular file."
- (with-temp-buffer
- (insert-file-contents-literally file)
- (base64-encode-region (point-min) (point-max)
- :no-line-break)
- (buffer-string)))
-
-;;;; Directive handling
-
-(defvar gptel--system-message
- (or (alist-get 'default gptel-directives)
- "You are a large language model living in Emacs and a helpful assistant. Respond concisely.")
- "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
- (string-replace
- "\n" (or replacement " ")
- (substring directive 0 (min width (length directive)))))
- (function
- (concat
- "λ: "
- (string-replace
- "\n" (or replacement " ")
- (truncate-string-to-width
- (or (and-let* ((doc (documentation directive)))
- (substring doc nil (string-match-p "\n" doc)))
- "[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 &optional raw)
- "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/LLM
-records (a list of strings or nil).
-
-If RAW is non-nil, the user/LLM records are not processed and are
-returned as a list of strings."
- (and directive
- (cl-etypecase directive
- (string (list directive))
- (function (gptel--parse-directive (funcall directive) raw))
- (cons (if raw directive
- (cons (car directive)
- ;; FIXME(augment) do this elsewhere
- (gptel--parse-list
- gptel-backend (cdr directive))))))))
-
-\f
-;;; Logging
-
-(defconst gptel--log-buffer-name "*gptel-log*"
- "Log buffer for gptel.")
-
-(declare-function json-pretty-print "json")
-
-(defun gptel--log (data &optional type no-json)
- "Log DATA to `gptel--log-buffer-name'.
-
-TYPE is a label for data being logged. DATA is assumed to be
-Valid JSON unless NO-JSON is t."
- (with-current-buffer (get-buffer-create gptel--log-buffer-name)
- (let ((p (goto-char (point-max))))
- (unless (bobp) (insert "\n"))
- (insert (format "{\"gptel\": \"%s\", " (or type "none"))
- (format-time-string "\"timestamp\": \"%Y-%m-%d %H:%M:%S\"}\n")
- data)
- (unless no-json (ignore-errors (json-pretty-print p (point)))))))
-
-\f
-;;; Structured output
-(defvar gptel--schema nil
- "Response output schema for backends that support it.")
-
-(cl-defgeneric gptel--parse-schema (_backend _schema)
- "Parse JSON schema in a backend-appropriate way.")
-
-(defun gptel--dispatch-schema-type (schema)
- "Convert SCHEMA to a valid elisp representation.
-
-SCHEMA can be specified in several ways:
-- As a plist readable by `gptel--json-encode'
- Ex: (:type object :properties (:key1 (:type number :description \"...\")
- :key2 (:type string)))
-
-- As a serialized JSON string, which will be passed as-is.
-
-- In shorthand form #1, a single-line comma-separated string with object
- keys and (optionally) types:
- Ex: \"key1, key2 number\"
- Ex: \"key1 string, key2 int\"
- The default type is string, and types can be shortened (integer -> int) as
- long as they match a JSON schema type uniquely.
-
-- In shorthand form #2, a multi-line string with keys, (optionally) types and
- (optionally) descriptions
- Ex: \"key1: description 1 here
- key2 integer: description 2 here\"
-
-- Shorthand forms can be placed inside [ and ] to specify an array of
- objects:
- Ex: \"[key1, key2 number]\"
- Ex: \"[key1: description 1 here
- key2 int: description 2 here]\""
- (when (stringp schema) ;Two possibilities: serialized JSON, or shorthand form
- (let (wrap-in-array) ;Flag to wrap the object type in an array
- (with-temp-buffer ;Parser for (possibly) shorthand forms
- (insert schema)
- (goto-char (point-min)) (skip-chars-forward " \n\r\t")
- (if (= (char-after) ?{)
- (setq schema (gptel--json-read)) ;Assume serialized JSON schema, we're done
- (when (= (char-after) ?\[) ;Shorthand: assume array top-level type
- (save-excursion
- (goto-char (point-max)) (skip-chars-backward " \n\r\t") (delete-char -1))
- (delete-char 1) ;Delete array markers [ and ]
- (setq wrap-in-array t))
- (let ( props types descriptions ;Nested object and array types are disallowed in shorthand
- (all-types '("number" "string" "integer" "boolean" "null")))
- (if (= (point-max) (line-end-position)) ; Single or multi-line?
- ;; Single line format (type optional): "key1 type, key2, ..."
- (while (re-search-forward ",?\\([^ ,]+\\) *\\([^ ,]*\\]?\\)" nil t)
- (push (match-string 1) props)
- (push (if (string-empty-p (match-string 2))
- "string" (car (all-completions (match-string 2) all-types)))
- types)
- (push nil descriptions))
- ;; Multi-line format (type, description optional):
- ;; "key1 type: description1 \n key2: description2..."
- (while (re-search-forward "\\([^ :]+\\) *\\([^ :]*\\):?"
- (line-end-position) t)
- (push (match-string 1) props)
- (push (if (string-empty-p (match-string 2))
- "string" (car (all-completions (match-string 2) all-types)))
- types)
- (skip-chars-forward " \t")
- (push (if (eolp) nil (buffer-substring-no-properties
- (point) (line-end-position)))
- descriptions)
- (forward-line 1)))
- (let ((object
- (list :type "object"
- :properties
- (cl-mapcan
- (lambda (prop type desc)
- `(,(intern (concat ":" prop))
- (:type ,type ,@(when desc
- (list :description (string-trim desc))))))
- (nreverse props) (nreverse types) (nreverse descriptions)))))
- (setq schema
- (if wrap-in-array (list :type "array" :items object) object))))))))
- ;; The OpenAI and Anthropic APIs don't allow arrays at the root of the schema.
- ;; Work around this by wrapping it in an object with the field "items".
- ;; TODO(schema): Find some way to strip this extra layer from the response.
- (if (member (plist-get schema :type) '("array" array))
- (list :type "object"
- :properties (list :items schema)
- :required ["items"]
- :additionalProperties :json-false)
- schema))
-
-(defun gptel--preprocess-schema (spec)
- "Set additionalProperties for objects in SPEC destructively.
-
-Convert symbol :types to strings."
- ;; NOTE: Do not use `sequencep' here, as that covers strings too and breaks
- ;; things.
- (when (or (listp spec) (vectorp spec))
- (cond
- ((vectorp spec)
- (cl-loop for element across spec
- for idx upfrom 0
- do (aset spec idx (gptel--preprocess-schema element))))
- ((keywordp (car spec))
- (let ((tail spec))
- (while tail
- (when (eq (car tail) :type)
- (when (symbolp (cadr tail)) ;Convert symbol :type to string
- (setcar (cdr tail) (symbol-name (cadr tail))))
- (when (equal (cadr tail) "object") ;Add additional object fields
- (plist-put tail :additionalProperties :json-false)
- (let ((vprops (vconcat
- (cl-loop
- for prop in (plist-get tail :properties) by #'cddr
- collect (substring (symbol-name prop) 1)))))
- (plist-put tail :required vprops)
- (plist-put tail :propertyOrdering vprops))))
- (when (or (listp (cadr tail)) (vectorp (cadr tail)))
- (gptel--preprocess-schema (cadr tail)))
- (setq tail (cddr tail)))))
- ((listp spec) (dolist (element spec)
- (when (listp element)
- (gptel--preprocess-schema element))))))
- spec)
-
-\f
-;;; Tool use
-
-(defcustom gptel-use-tools t
- "Whether gptel should use tools.
-
-Tools are capabilities provided by you to the LLM as functions an
-LLM can choose to call. gptel runs the function call on your
-machine.
-
-If set to t, any tools selected in variable `gptel-tools' will be made
-available to the LLM. This is the default. It has no effect if no
-tools are selected.
-
-If set to force, gptel will try to force the LLM to call one or
-more of the provided tools. Support for this feature depends on
-the backend/API, and gptel will fall back to the default behavior
-when forcing tool use is unsupported.
-
-If nil, tool use is turned off."
- :type '(choice
- (const :tag "Enable" t)
- (const :tag "Force tool use" force)
- (const :tag "Turn Off" nil)))
-
-(defcustom gptel-confirm-tool-calls 'auto
- "Whether tool calls should wait for the user to run them.
-
-If set to t or nil, tool calls always or never seek confirmation
-from the user before running.
-
-If set to the symbol auto (the default), a tool call will seek
-confirmation only when the corresponding tool spec has a non-nil
-:confirm slot. See `gptel-make-tool'."
- :type '(choice
- (const :tag "Tool decides" auto)
- (const :tag "Always" t)
- (const :tag "Never" nil)))
-
-(defcustom gptel-include-tool-results 'auto
- "Whether tool call results should be included in the buffer.
-
-If set to t or nil, results of tool calls are always or never
-included in the LLM response, respectively.
-
-If set to the symbol auto (the default), a tool call result is
-included only when the corresponding tool spec has a non-nil
-:include slot. See `gptel-make-tool'."
- :type '(choice
- (const :tag "Tool decides" auto)
- (const :tag "Always" t)
- (const :tag "Never" nil)))
-
-(defcustom gptel-tools nil
- "A list of tools to include with gptel requests.
-
-Each tool should be a `gptel-tool' struct, which see. To specify
-a tool, use `gptel-make-tool', which see."
- :group 'gptel
- :type '(repeat gptel-tool))
-
-(cl-defstruct (gptel-tool (:constructor nil)
- (:constructor gptel--make-tool-internal
- (&key function name description args
- async category confirm include
- &allow-other-keys))
- (:copier gptel--copy-tool))
- "Struct to specify tools for LLMs to run.
-
-A tool is a function specification sent to the LLM along with
-a (plain language) task. If the LLM decides to use the tool to
-accomplish the task, gptel will run the tool and (optionally)
-feed the LLM the results. You can add tools via
-`gptel-make-tool', which see."
- (function nil :type function :documentation "Function that runs the tool")
- (name nil :type string :documentation "Tool name, snake_case recommended")
- (description nil :type string :documentation "What the tool does, intended for the LLM")
- (args nil :type list :documentation "List of plists specifying function arguments")
- (async nil :type boolean :documentation "Whether the function runs asynchronously")
- (category nil :type string :documentation "Use to group tools by purpose")
- (confirm nil :type boolean :documentation "Seek confirmation before running tool?")
- (include nil :type boolean :documentation "Include tool results in buffer?"))
-
-(defun gptel--preprocess-tool-args (spec)
- "Convert symbol :type values in tool SPEC to strings destructively."
- ;; NOTE: Do not use `sequencep' here, as that covers strings too and breaks
- ;; things.
- (when (or (listp spec) (vectorp spec))
- (cond
- ((vectorp spec)
- (cl-loop for element across spec
- for idx upfrom 0
- do (aset spec idx (gptel--preprocess-tool-args element))))
- ((keywordp (car spec))
- (let ((tail spec))
- (while tail
- (when (and (eq (car tail) :type) (symbolp (cadr tail)))
- (setcar (cdr tail) (symbol-name (cadr tail))))
- ;; TODO: Handle :enum ("provided" "as" "list") here, convert to
- ;; :enum ["provided" "as" "array"]
- (when (or (listp (cadr tail)) (vectorp (cadr tail)))
- (gptel--preprocess-tool-args (cadr tail)))
- (setq tail (cddr tail)))))
- ((listp spec) (dolist (element spec)
- (when (listp element)
- (gptel--preprocess-tool-args element))))))
- spec)
-
-(defun gptel--make-tool (&rest spec)
- "Construct a gptel-tool according to SPEC."
- (gptel--preprocess-tool-args (plist-get spec :args))
- (apply #'gptel--make-tool-internal spec))
-
-(defvar gptel--known-tools nil
- "Alist of gptel tools arranged by category.
-
-A \"tool\" is a function spec (definition and description)
-provided by gptel to an LLM. See `gptel-tool'. Each tool is
-assigned a category when it is created, with a category of
-\"misc\" if none is specified.
-
-This is a two-level alist mapping categories and tool names to
-the tool itself. It is used as a global register of available
-tools and in gptel's UI, see variable `gptel-tools'.
-
-In this example structure, cat-tool and the rest are cl-structs
-of type `gptel-tool':
-
- CATEGORY TOOL NAME TOOL
- ((\"filesystem\" . ((\"read_file\" . cat-tool)
- (\"list_directory\" . ls-tool)))
- (\"emacs\" . ((\"read_buffer\" . buffer-substring-tool)
- (\"send_message\" . message-tool))))
-
-This variable is for internal use only, to define a tool use
-`gptel-make-tool'.")
-
-(defun gptel-get-tool (path)
- "Find tool in gptel's tool registry at PATH.
-
-PATH can be specified
-- as a string representing the tool name, like \"search_db\",
-- or as a list representing a category and tool name,
- like \\='(\"emacs\" \"read_buffer\").
-In both cases, the first matching gptel-tool is returned.
-
-- as a string representing a category, like \"filesystem\".
-In this case a list of all gptel-tools with this category is
-returned."
- (or (cl-etypecase path
- (cons (let ((tc (map-nested-elt gptel--known-tools path)))
- (if (consp tc) (map-values tc) tc)))
- (string (if-let* ((category (assoc path gptel--known-tools)))
- (map-values (cdr category))
- (cl-loop for (_ . tools) in gptel--known-tools
- if (assoc path tools)
- return (cdr it)))))
- (error "No tool matches for %S" path)))
-
-(defun gptel-make-tool (&rest slots)
- "Make a gptel tool for LLM use.
-
-The following keyword arguments are available, of which the first
-four SLOTS are required.
-
-NAME: The name of the tool, recommended to be in Javascript style snake_case.
-
-FUNCTION: The function itself (lambda or symbol) that runs the tool.
-
-DESCRIPTION: A verbose description of what the tool does, how to
-call it and what it returns.
-
-ARGS: A list of plists specifying the arguments, or nil for a function that
-takes no arguments. Each plist in ARGS requires the following keys:
-- argument :name and :description, as strings.
-- argument :type, as a symbol. Allowed types are those understood by the JSON
- schema: string, number, integer, boolean, array, object or null
-
-The following plist keys are conditional/optional:
-- :optional, boolean indicating if argument is optional
-- :enum for enumerated types, whose value is a vector of strings representing
- allowed values. Note that :type is still required for enums.
-- :items, if the :type is array. Its value must be a plist including at least
- the item's :type.
-- :properties, if the type is object. Its value must be a plist that can be
- serialized into a JSON object specification by `json-serialize'.
-
-ASYNC: boolean indicating if the elisp function is asynchronous.
-If ASYNC is t, the function should take a callback as its first
-argument, along with the arguments specified in ARGS, and run the
-callback with the tool call result when it's ready. The callback
-itself is an implementation detail and must not be included in
-ARGS.
-
-The following keys are optional
-
-CATEGORY: A string indicating a category for the tool. This is
-used only for grouping in gptel's UI. Defaults to \"misc\".
-
-CONFIRM: Whether the tool call should wait for the user to run it. If
-true, the user will be prompted with the proposed tool call, which can
-be examined, accepted, deferred or canceled. It can also be a function
-that receives the same arguments as FUNCTION and returns true if the
-user should be prompted.
-
-INCLUDE: Whether the tool results should be included as part of
-the LLM output. This is useful for logging and as context for
-subsequent requests in the same buffer. This is primarily useful
-in chat buffers.
-
-Here is an example definition:
-
- (gptel-make-tool
- :function (lambda (location unit)
- (url-retrieve-synchronously \"api.weather.com/...\"
- location unit))
- :name \"get_weather\"
- :description \"Get the current weather in a given location\"
- :args (list \\='(:name \"location\"
- :type string
- :description \"The city and state, e.g. San Francisco, CA\")
- \\='(:name \"unit\"
- :type string
- :enum [\"celsius\" \"farenheit\"]
- :description
- \"The unit of temperature, either \\='celsius\\=' or \\='fahrenheit\\='\"
- :optional t)))
-
-If the tool is asynchronous, the function is modified to take a
-callback as its first argument, which it runs with the result:
-
- (lambda (callback location unit)
- (url-retrieve \"api.weather.com/...\"
- (lambda (_)
- (let ((result (parse-this-buffer)))
- (funcall callback result)))))"
- (let* ((tool (apply #'gptel--make-tool slots))
- (category (or (gptel-tool-category tool) "misc")))
- (setf (alist-get
- (gptel-tool-name tool)
- (alist-get category gptel--known-tools nil nil #'equal)
- nil nil #'equal)
- tool)))
-
-(cl-defgeneric gptel--parse-tools (_backend tools)
- "Parse TOOLS and return a list of prompts.
-
-TOOLS is a list of `gptel-tool' structs, which see.
-
-_BACKEND is the LLM backend in use. This is the default
-implementation, used by OpenAI-compatible APIs and Ollama."
- (vconcat
- (mapcar
- (lambda (tool)
- (list
- :type "function"
- :function
- (append
- (list
- :name (gptel-tool-name tool)
- :description (gptel-tool-description tool))
- (if (gptel-tool-args tool)
- (list
- :parameters
- (list :type "object"
- ;; gptel's tool args spec is close to the JSON schema, except
- ;; that we use (:name "argname" ...)
- ;; instead of (:argname (...)), and
- ;; (:optional t) for each arg instead of (:required [...])
- ;; for all args at once. Handle this difference by
- ;; modifying a copy of the gptel tool arg spec.
- :properties
- (cl-loop
- for arg in (gptel-tool-args tool)
- for argspec = (copy-sequence arg)
- for name = (plist-get arg :name) ;handled differently
- for newname = (or (and (keywordp name) name)
- (make-symbol (concat ":" name)))
- do ;ARGSPEC is ARG without unrecognized keys
- (cl-remf argspec :name)
- (cl-remf argspec :optional)
- if (equal (plist-get arg :type) "object")
- do (unless (plist-member argspec :required)
- (plist-put argspec :required []))
- (plist-put argspec :additionalProperties :json-false)
- append (list newname argspec))
- :required
- (vconcat
- (delq nil (mapcar
- (lambda (arg) (and (not (plist-get arg :optional))
- (plist-get arg :name)))
- (gptel-tool-args tool))))
- :additionalProperties :json-false))
- (list :parameters (list :type "object" :properties nil))))))
- (ensure-list tools))))
-
-(cl-defgeneric gptel--parse-tool-results (backend results)
- "Return a BACKEND appropriate prompt containing tool call RESULTS.
-
-This will be injected into the messages list in the prompt to
-send to the LLM.")
-
-;; 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.
-
-NEW-PROMPT can be a single message or a list of messages.
-
-Not implemented: if POSITION is
-- a non-negative number, insert it at that position in PROMPTS.
-- a negative number, insert it there counting from the end.
-
-This generic implementation handles the Anthropic,
-OpenAI-compatible and Ollama message formats."
- ;; ;TODO(fsm): implement _POSITION
- (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many?
- (setq new-prompt (list new-prompt)))
- (let ((prompts (plist-get data :messages)))
- (plist-put data :messages (vconcat prompts new-prompt))))
-
-\f
-;;; State machine for driving requests
-(defvar gptel-request--transitions
- `((INIT . ((t . WAIT)))
- (WAIT . ((t . TYPE)))
- (TYPE . ((,#'gptel--error-p . ERRS)
- (,#'gptel--tool-use-p . TOOL)
- (t . DONE)))
- (TOOL . ((,#'gptel--error-p . ERRS)
- (,#'gptel--tool-result-p . WAIT)
- (t . DONE))))
- "Alist specifying gptel's default state transition table for requests.
-
-Each entry is a list whose car is a request state (any symbol)
-and whose cdr is an alist listing possible next states. Each key
-is either a predicate function or t. When `gptel--fsm-next' is
-called, the predicates are called in the order they appear here
-to find the next state. Each predicate is called with the state
-machine's INFO, see `gptel-fsm'. A predicate of t is
-considered a success and acts as a default.")
-
-(defvar gptel-request--handlers
- `((WAIT ,#'gptel--handle-wait)
- (TOOL ,#'gptel--handle-tool-use)
- (DONE ,#'gptel--handle-post)
- (ERRS ,#'gptel--handle-post)
- (ABRT ,#'gptel--handle-post))
- "Alist specifying handlers for gptel's default state transitions.
-
-Each entry is a list whose car is a request state (a symbol) and
-whose cdr is a list of handler functions called when
-transitioning to that state. The handlers are called in the
-sequence that they appear in the list, and each function receives
-the state machine as its only argument. Information about the
-request state can be retrieved via the machine's INFO slot, see
-`gptel-fsm'.
-
-Handlers are responsible for doing state-related tasks (like
-logging errors or inserting responses) and transitioning to the
-next state by calling `gptel--fsm-transition'.
-
-Handlers can be asynchronous, in which case the transition call
-should typically be placed in its callback.")
-
-(cl-defstruct (gptel-fsm (:constructor gptel-make-fsm)
- (:copier gptel-copy-fsm))
- "State machine for gptel requests.
-
-STATE: The current state of the machine, can be any symbol.
-
-TABLE: Alist mapping states to possible next states
-along with predicates to determine the next state. See
-`gptel-request--transitions' for an example.
-
-HANDLERS: Alist mapping states to state handler functions.
-Handlers are called when entering each state. See
-`gptel-request--handlers' for an example
-
-INFO: The state machine's current context. This is a plist
-holding all the information required for the ongoing request, and
-can be used to tweak and resume a paused request. This should be
-called \"context\", but context means too many things already in
-gptel's code!
-
-Each gptel request is passed an instance of this
-state machine and driven by it."
- (state 'INIT)
- (table gptel-request--transitions)
- (handlers gptel-request--handlers) info)
-
-(defun gptel--fsm-transition (machine &optional new-state)
- "Move MACHINE to its next state.
-
-MACHINE is an instance of `gptel-fsm'.
-
-The next state is NEW-STATE if given. Otherwise it is determined
-automatically from MACHINE's transition table."
- (unless new-state (setq new-state (gptel--fsm-next machine)))
- (push (gptel-fsm-state machine)
- (plist-get (gptel-fsm-info machine) :history))
- (setf (gptel-fsm-state machine) new-state)
- (when-let* ((handlers (alist-get new-state (gptel-fsm-handlers machine))))
- (mapc (lambda (h) (funcall h machine)) handlers)))
-
-(defun gptel--fsm-next (machine)
- "Determine MACHINE's next state according to its transition table.
-
-MACHINE is an instance of `gptel-fsm'"
- (let* ((current (gptel-fsm-state machine))
- (transitions (alist-get current (gptel-fsm-table machine))))
- (cl-loop
- with info = (gptel-fsm-info machine)
- for (pred . next) in transitions
- when (or (eq pred t) (funcall pred info))
- return next)))
-
-;;;; State machine handlers
-;; The next few functions are default state handlers for gptel's state machine,
-;; see `gptel-request--handlers'.
-
-(defun gptel--handle-wait (fsm)
- "Fire the request contained in state machine FSM's info."
- ;; Reset some flags in info. This is necessary when reusing fsm's context for
- ;; a second network request: gptel tests for the presence of these flags to
- ;; handle state transitions. (NOTE: Don't add :token to this.)
- (let ((info (gptel-fsm-info fsm)))
- (dolist (key '(:tool-success :tool-use :error :http-status :reasoning))
- (when (plist-get info key)
- (plist-put info key nil))))
- (funcall
- (if gptel-use-curl
- #'gptel-curl-get-response
- #'gptel--url-get-response)
- fsm)
- (run-hooks 'gptel-post-request-hook))
-
-(defun gptel--handle-tool-use (fsm)
- "Run tool calls captured in FSM, and advance the state machine with the results."
- (when-let* ((info (gptel-fsm-info fsm))
- (backend (plist-get info :backend))
- ;; This function might run many times, so only act on the remaining tool calls.
- (tool-use (cl-remove-if (lambda (tc) (plist-get tc :result))
- (plist-get info :tool-use)))
- (ntools (length tool-use))
- (tool-idx 0))
- (with-current-buffer (plist-get info :buffer)
- (let ((result-alist) (pending-calls))
- (mapc ; Construct function calls
- (lambda (tool-call)
- (letrec ((args (plist-get tool-call :args))
- (name (plist-get tool-call :name))
- (arg-values nil)
- (tool-spec
- (cl-find-if
- (lambda (ts) (equal (gptel-tool-name ts) name))
- (plist-get info :tools)))
- (process-tool-result
- (lambda (result)
- (plist-put info :tool-success t)
- (let ((result (gptel--to-string result)))
- (plist-put tool-call :result result)
- (push (list tool-spec args result) result-alist))
- (cl-incf tool-idx)
- (when (>= tool-idx ntools) ; All tools have run
- (gptel--inject-prompt
- backend (plist-get info :data)
- (gptel--parse-tool-results
- backend (plist-get info :tool-use)))
- (funcall (plist-get info :callback)
- (cons 'tool-result result-alist) info)
- (gptel--fsm-transition fsm)))))
- (if (null tool-spec)
- (if (equal name gptel--ersatz-json-tool) ;Could be a JSON response
- ;; Handle structured JSON output supplied as tool call
- (funcall (plist-get info :callback)
- (gptel--json-encode (plist-get tool-call :args))
- info)
- (message "Unknown tool called by model: %s" name))
- (setq arg-values
- (mapcar
- (lambda (arg)
- (let ((key (intern (concat ":" (plist-get arg :name)))))
- (plist-get args key)))
- (gptel-tool-args tool-spec)))
- ;; Check if tool requires confirmation
- (if (and gptel-confirm-tool-calls
- (or (eq gptel-confirm-tool-calls t) ;always confirm, or
- (and-let* ((confirm (gptel-tool-confirm tool-spec)))
- (or (not (functionp confirm)) (apply confirm arg-values)))))
- (push (list tool-spec arg-values process-tool-result)
- pending-calls)
- ;; If not, run the tool
- (if (gptel-tool-async tool-spec)
- (apply (gptel-tool-function tool-spec)
- process-tool-result arg-values)
- (let ((result
- (condition-case errdata
- (apply (gptel-tool-function tool-spec) arg-values)
- (error (mapconcat #'gptel--to-string errdata " ")))))
- (funcall process-tool-result result)))))))
- tool-use)
- (when pending-calls
- (plist-put info :tool-pending t)
- (funcall (plist-get info :callback)
- (cons 'tool-call pending-calls) info))))))
-
-(defun gptel--handle-post (fsm)
- "Run cleanup for `gptel-request' with FSM."
- (when-let* ((info (gptel-fsm-info fsm))
- (post (plist-get info :post)))
- (mapc (lambda (f) (funcall f info)) post)))
-
-;;;; State machine predicates
-;; Predicates used to find the next state to transition to, see
-;; `gptel-request--transitions'.
-
-(defun gptel--error-p (info) (plist-get info :error))
-
-(defun gptel--tool-use-p (info) (plist-get info :tool-use))
-
-(defun gptel--tool-result-p (info) (plist-get info :tool-success))
-
-\f
-;;; Send gptel requests
-(cl-defun gptel-request
- (&optional prompt &key callback
- (buffer (current-buffer))
- position context dry-run
- (stream nil) (in-place nil)
- (system gptel--system-message)
- schema transforms (fsm (gptel-make-fsm)))
- "Request a response from the `gptel-backend' for PROMPT.
-
-The request is asynchronous, this function returns immediately.
-
-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.
- (\"user msg 1\" \"llm msg 1\" \"user msg 2\" \"llm msg 2\" ...)
-- 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.
-
-Keyword arguments:
-
-CALLBACK, if supplied, is a function of two arguments, called
-with the RESPONSE (usually a string) and INFO (a plist):
-
- (funcall CALLBACK RESPONSE INFO)
-
-RESPONSE is
-
-- A string if the request was successful
-- nil if there was no response or an error.
-
-These are the only two cases you typically need to consider,
-unless you need to clean up after aborted requests, use LLM
-tools, handle \"reasoning\" content specially or stream
-responses (see STREAM). In these cases, RESPONSE can be
-
-- The symbol `abort' if the request is aborted, see `gptel-abort'.
-
-- A cons cell of the form
-
- (tool-call . ((TOOL ARGS CB) ...))
-
- where TOOL is a gptel-tool struct, ARGS is a plist of
- arguments, and CB is a function for handling the results. You
- can call CB with the result of calling the tool to continue the
- request.
-
-- A cons cell of the form
-
- (tool-result . ((TOOL ARGS RESULT) ...))
-
- where TOOL is a gptel-tool struct, ARGS is a plist of
- arguments, and RESULT was returned from calling the tool
- function.
-
-- A cons cell of the form
-
- (reasoning . text)
-
- where text is the contents of the reasoning block. (Also see
- STREAM if you are using streaming.)
-
-See `gptel--insert-response' for an example callback handling all
-cases.
-
-The INFO plist has (at least) the following keys:
-:data - The request data included with the query
-:position - marker at the point the request was sent, unless
- POSITION is specified.
-:buffer - The buffer current when the request was sent,
- unless BUFFER is specified.
-:status - Short string describing the result of the request,
- including possible HTTP errors.
-
-Example of a callback that messages the user with the response
-and info:
-
- (lambda (response info)
- (if (stringp response)
- (let ((posn (marker-position (plist-get info :position)))
- (buf (buffer-name (plist-get info :buffer))))
- (message \"Response for request from %S at %d: %s\"
- buf posn response))
- (message \"gptel-request failed with message: %s\"
- (plist-get info :status))))
-
-Or, for just the response:
-
- (lambda (response _)
- ;; Do something with response
- (message (rot13-string response)))
-
-If CALLBACK is omitted, the response is inserted at the point the
-request was sent.
-
-STREAM is a boolean that determines if the response should be
-streamed, as in `gptel-stream'. If the model or the backend does
-not support streaming, this will be ignored.
-
-When streaming responses
-
-- CALLBACK will be called repeatedly with each RESPONSE text
- chunk (a string) as it is received.
-- When the HTTP request ends successfully, CALLBACK will be
- called with a RESPONSE argument of t to indicate success.
-- Similarly, CALLBACK will be called with
- (reasoning . text-chunk) for each reasoning chunk, and
- (reasoning . t) to indicate the end of the reasoning block.
-
-BUFFER and POSITION are the buffer and position (integer or
-marker) at which the response is inserted. If a CALLBACK is
-specified, no response is inserted and these arguments are
-ignored, but they are still available in the INFO plist passed
-to CALLBACK for you to use.
-
-BUFFER defaults to the current buffer, and POSITION to the value
-of (point) or (region-end), depending on whether the region is
-active.
-
-CONTEXT is any additional data needed for the callback to run. It
-is included in the INFO argument to the callback.
-Note: This is intended for storing Emacs state to be used by
-CALLBACK, and unrelated to the context supplied to the LLM.
-
-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:
-
-IN-PLACE is a boolean used by the default callback when inserting
-the response to determine if delimiters are needed between the
-prompt and the response.
-
-If DRY-RUN is non-nil, do not send the request. Construct and
-return a state machine object that can be introspected and
-resumed.
-
-TRANSFORMS is a list of functions used to transform the prompt or query
-parameters dynamically. Each function is called in a temporary buffer
-containing the prompt to be sent, and can conditionally modify this
-buffer. This can include changing the (buffer-local) values of the
-model, backend or system prompt, or augmenting the prompt with
-additional information (such as from a RAG engine).
-
-- Synchronous transformers are called with zero or one argument, the
- state machine for the request.
-
-- Asynchronous transformers are called with two arguments, a callback
- and the state machine. It should run the callback after finishing its
- transformation.
-
-See `gptel-prompt-transform-functions' for more.
-
-If provided, SCHEMA forces the LLM to generate JSON output. Its value
-is a JSON schema, which can be provided as
-- an elisp object, a nested plist structure.
-- A JSON schema serialized to a string
-- A shorthand object/array description, see `gptel--dispatch-schema-type'.
-See the manual or the wiki for examples.
-
-Note: SCHEMA is presently experimental and subject to change, and not
-all providers support structured output.
-
-FSM is the state machine driving the request. This can be used
-to define a custom request control flow, see `gptel-fsm' for
-details. You can safely ignore this -- FSM is an unstable
-feature and subject to change.
-
-Note:
-
-1. This function is not fully self-contained. Consider
-let-binding the parameters `gptel-backend', `gptel-model',
-`gptel-use-tools' and `gptel-use-context' around calls to it as
-required.
-
-2. The return value of this function is a state machine that may
-be used to rerun or continue the request at a later time."
- (declare (indent 1))
- ;; TODO Remove this check in version 1.0
- (gptel--sanitize-model)
- (let* ((start-marker
- (cond
- ((null position)
- (if (use-region-p)
- (set-marker (make-marker) (region-end))
- (gptel--at-word-end (point-marker))))
- ((markerp position) position)
- ((integerp position)
- (set-marker (make-marker) position buffer))))
- (gptel--schema schema)
- (prompt-buffer
- (cond ;prompt from buffer or explicitly supplied
- ((null prompt)
- (gptel--create-prompt-buffer (point)))
- ((stringp prompt)
- (gptel--with-buffer-copy buffer nil nil
- (insert prompt)
- (current-buffer)))
- ((consp prompt)
- ;; (gptel--parse-list gptel-backend prompt)
- (gptel--with-buffer-copy buffer nil nil
- ;; TEMP Decide on the annoated prompt-list format
- (gptel--parse-list-and-insert prompt)
- (current-buffer)))))
- (system-list (gptel--parse-directive system 'raw)) ;eval function-valued system prompts
- (info (list :data prompt-buffer
- :buffer buffer
- :position start-marker)))
- (when transforms (plist-put info :transforms transforms))
- (with-current-buffer prompt-buffer
- (setq gptel--system-message ;guaranteed to be buffer-local
- ;; Retain single-part system messages as strings to avoid surprises
- ;; when applying presets
- (if (cdr system-list) system-list (car system-list))))
- (when stream (plist-put info :stream stream))
- ;; This context should not be confused with the context aggregation context!
- (when callback (plist-put info :callback callback))
- (when context (plist-put info :context context))
- (when in-place (plist-put info :in-place in-place))
- ;; Add info to state machine context
- (when dry-run (plist-put info :dry-run dry-run))
- (setf (gptel-fsm-info fsm) info))
-
- ;; TEMP: Augment in separate let block for now. Are we overcapturing?
- ;; FIXME(augment): Call augmentors with INFO, not FSM
- (let ((info (gptel-fsm-info fsm)))
- (with-current-buffer (plist-get info :data)
- (setq-local gptel-prompt-transform-functions (plist-get info :transforms))
- ;; Preset has highest priority because it can change prompt-transform-functions
- (when (memq 'gptel--transform-apply-preset gptel-prompt-transform-functions)
- (gptel--transform-apply-preset fsm)
- (setq gptel-prompt-transform-functions ;avoid mutation, copy transforms
- (remq 'gptel--transform-apply-preset gptel-prompt-transform-functions)))
- (let ((augment-total ;act like a hook, count total
- (if (memq t gptel-prompt-transform-functions)
- (length
- (setq gptel-prompt-transform-functions
- (nconc (remq t gptel-prompt-transform-functions)
- (default-value 'gptel-prompt-transform-functions))))
- (length gptel-prompt-transform-functions)))
- (augment-idx 0))
- (if (null gptel-prompt-transform-functions)
- (gptel--realize-query fsm)
- ;; FIXME(request-lib): Cannot use gptel--update-status from this file
- ;; (with-current-buffer (plist-get info :buffer) ;Apply prompt transformations
- ;; (gptel--update-status " Augmenting..." 'mode-line-emphasis))
-
- ;; FIXME(augment): This needs to be converted into a linear callback
- ;; chain to avoid race conditions with multiple async augmentors.
- (run-hook-wrapped
- 'gptel-prompt-transform-functions
- (lambda (func fsm-arg)
- (with-current-buffer (plist-get info :data)
- (goto-char (point-max))
- (if (= (car (func-arity func)) 2) ;async augmentor
- (funcall func (lambda ()
- (cl-incf augment-idx)
- (when (>= augment-idx augment-total) ;All augmentors have run
- (gptel--realize-query fsm-arg)))
- fsm-arg)
- (if (= (car (func-arity func)) 0)
- (funcall func)
- (funcall func fsm-arg)) ;sync augmentor
- (cl-incf augment-idx)
- (when (>= augment-idx augment-total) ;All augmentors have run
- (gptel--realize-query fsm-arg))))
- nil) ;always return nil so run-hook-wrapped doesn't abort
- fsm)))))
- fsm)
-
-(defun gptel--realize-query (fsm)
- "Realize the query payload for FSM from its prompt buffer.
-
-Initiate the request when done."
- (let ((info (gptel-fsm-info fsm)))
- (with-current-buffer (plist-get info :data)
- (let* ((directive (gptel--parse-directive gptel--system-message 'raw))
- ;; DIRECTIVE contains both the system message and the template prompts
- (gptel--system-message
- (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
- ;; Check model-specific request-params for streaming preference
- (let* ((model-params (gptel--model-request-params gptel-model))
- (stream-spec (plist-get model-params :stream)))
- ;; If not present, there is no model-specific preference
- (or (not (memq :stream model-params))
- ;; If present, it must not be :json-false or nil
- (and stream-spec (not (eq stream-spec :json-false)))))
- ;; Check backend-specific streaming settings
- (gptel-backend-stream gptel-backend)))
- (gptel-stream stream)
- (full-prompt))
- (when (cdr directive) ; prompt constructed from directive/template
- (save-excursion (goto-char (point-min))
- (gptel--parse-list-and-insert (cdr directive))))
- (goto-char (point-max))
- (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))))
- ;; 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 gptel-use-context (gptel--model-capable-p 'media))
- (gptel--inject-media gptel-backend full-prompt))
- (unless stream (cl-remf info :stream))
- (plist-put info :backend gptel-backend)
- (plist-put info :model gptel-model)
- (when gptel-include-reasoning ;Required for next-request-only scope
- (plist-put info :include-reasoning gptel-include-reasoning))
- (when (and gptel-use-tools gptel-tools)
- (plist-put info :tools gptel-tools))
- (plist-put info :data
- (gptel--request-data gptel-backend full-prompt)))
- (kill-buffer (current-buffer)))
- ;; INIT -> WAIT
- (unless (plist-get info :dry-run) (gptel--fsm-transition fsm))
- fsm))
-
-(defun gptel-abort (buf)
- "Stop any active gptel process associated with buffer BUF.
-
-BUF defaults to the current buffer."
- (interactive (list (current-buffer)))
- (when-let* ((proc-attrs
- (cl-find-if
- (lambda (entry)
- ;; each entry has the form (PROC . (FSM ABORT-FN))
- (eq (thread-first (cadr entry) ; FSM
- (gptel-fsm-info)
- (plist-get :buffer))
- buf))
- gptel--request-alist))
- (proc (car proc-attrs))
- (fsm (cadr proc-attrs))
- (info (gptel-fsm-info fsm))
- (abort-fn (cddr proc-attrs)))
- ;; Run :callback with abort signal
- (with-demoted-errors "Callback error: %S"
- (and-let* ((cb (plist-get info :callback))
- ((functionp cb)))
- (funcall cb 'abort info)))
- (funcall abort-fn)
- (setf (alist-get proc gptel--request-alist nil 'remove) nil)
- (gptel--fsm-transition fsm 'ABRT)
- (message "Stopped gptel request in buffer %S" (buffer-name buf))))
-
-\f
-;;; Prompt creation
-(defun gptel--create-prompt-buffer (&optional prompt-end)
- "Return a buffer with the conversation prompt to be sent.
-
-If the region is active limit the prompt text to the region contents.
-Otherwise the prompt text is constructed from the contents of the
-current buffer up to point, or PROMPT-END if provided."
- (save-excursion
- (save-restriction
- (let ((buf (current-buffer)))
- (cond
- ((derived-mode-p 'org-mode)
- (require 'gptel-org)
- ;; Also handles regions in Org mode
- (gptel-org--create-prompt-buffer prompt-end))
- ((use-region-p)
- (let ((rb (region-beginning)) (re (region-end)))
- (gptel--with-buffer-copy buf rb re
- (current-buffer))))
- (t (unless prompt-end (setq prompt-end (point)))
- (gptel--with-buffer-copy buf (point-min) prompt-end
- (current-buffer))))))))
-
-(defun gptel--create-prompt (&optional prompt-end)
- "Return a full conversation prompt from the contents of this buffer.
-
-If `gptel--num-messages-to-send' is set, limit to that many
-recent exchanges.
-
-If PROMPT-END (a marker) is provided, end the prompt contents
-there. This defaults to (point)."
- (with-current-buffer (gptel--create-prompt-buffer prompt-end)
- (unwind-protect
- (gptel--parse-buffer
- gptel-backend (and gptel--num-messages-to-send
- (* 2 gptel--num-messages-to-send)))
- (kill-buffer (current-buffer)))))
-
-(make-obsolete 'gptel--create-prompt 'gptel--create-prompt-buffer
- "0.9.9")
-
-(cl-defgeneric gptel--parse-buffer (backend max-entries)
- "Parse current buffer backwards from point and return a list of prompts.
-
-BACKEND is the LLM backend in use.
-
-MAX-ENTRIES is the number of queries/responses to include for
-contexbt.")
-
-(defun gptel--parse-list-and-insert (prompts)
- "Insert PROMPTS, a list of messages into the current buffer.
-
-Propertize the insertions in a format gptel can parse into a
-conversation.
-
-PROMPTS is typically the input to `gptel-request', either a list of strings
-representing a conversation with alternate prompt/response turns, or a list of
-lists with explicit roles (prompt/response/tool). See the documentation of
-`gptel-request' for the latter."
- (if (stringp (car prompts)) ; Simple format, list of strings
- (cl-loop for text in prompts
- for response = nil then (not response)
- when text
- if response
- do (insert gptel-response-separator
- (propertize text 'gptel 'response)
- gptel-response-separator)
- else do (insert text))
- (dolist (entry prompts) ; Advanced format, list of lists
- (pcase entry
- (`(prompt . ,msg) (insert (or (car-safe msg) msg)))
- (`(response . ,msg)
- (insert gptel-response-separator
- (propertize (or (car-safe msg) msg) 'gptel 'response)))
- (`(tool . ,call)
- (insert gptel-response-separator
- (propertize
- (concat
- "(:name " (plist-get call :name) " :args "
- (prin1-to-string (plist-get call :args)) ")\n\n"
- (plist-get call :result))
- 'gptel `(tool . ,(plist-get call :id)))))))))
-
-(cl-defgeneric gptel--parse-list (backend prompt-list)
- "Parse PROMPT-LIST and return a list of prompts for BACKEND.
-
-PROMPT-LIST is interpreted as a conversation, i.e. an alternating
-series of user prompts and LLM responses. The returned structure
-is suitable for including in the request payload.
-
-BACKEND is the LLM backend in use.")
-
-(cl-defgeneric gptel--parse-media-links (mode beg end)
- "Find media links between BEG and END.
-
-MODE is the major-mode of the buffer.
-
-Returns a plist where each entry is of the form
- (:text \"some text\")
-or
- (:media \"media uri or file path\")."
- (ignore mode) ;byte-compiler
- (list `(:text ,(buffer-substring-no-properties
- beg end))))
-
-(declare-function markdown-link-at-pos "markdown-mode")
-(declare-function mailcap-file-name-to-mime-type "mailcap")
-
-(defsubst gptel-markdown--validate-link (link)
- "Validate a Markdown LINK as sendable under the current gptel settings.
-
-Return a form (validp link-type path . REST), where REST is a list
-explaining why sending the link is not supported by gptel. Only the
-first nil value in REST is guaranteed to be correct."
- (let ((mime))
- (if-let* ((path (nth 3 link))
- (prefix (or (string-search "://" path) 0))
- (link-type (if (= prefix 0) "file" (substring path 0 prefix)))
- (path (if (and (equal link-type "file") (> prefix 0))
- (substring path (+ prefix 3)) path))
- (resource-type
- (or (and (equal link-type "file") 'file)
- (and (gptel--model-capable-p 'url)
- (member link-type '("http" "https" "ftp")) 'url)))
- (user-check (funcall gptel-markdown-validate-link link))
- (readablep (or (member link-type '("http" "https" "ftp"))
- (file-remote-p path)
- (file-readable-p path)))
- (mime-valid
- (if (or (eq resource-type 'url)
- (cdr (with-memoization
- (alist-get (expand-file-name path)
- gptel--link-type-cache
- nil nil #'string=)
- (cons t (gptel--file-binary-p path)))))
- (gptel--model-mime-capable-p
- (setq mime (mailcap-file-name-to-mime-type path)))
- t)))
- (list t link-type path resource-type user-check readablep mime-valid mime)
- (list nil link-type path resource-type user-check readablep mime-valid mime))))
-
-(cl-defmethod gptel--parse-media-links ((_mode (eql 'markdown-mode)) beg end)
- "Parse text and actionable links between BEG and END.
-
-Return a list of the form
- ((:text \"some text\")
- (:media \"/path/to/media.png\" :mime \"image/png\")
- (:text \"More text\"))
-for inclusion into the user prompt for the gptel request."
- (let ((parts) (from-pt))
- (save-excursion
- (setq from-pt (goto-char beg))
- (while (re-search-forward gptel-markdown--link-regex end t)
- (let* ((link-at-pt (markdown-link-at-pos (point)))
- (link-status (gptel-markdown--validate-link link-at-pt)))
- (cl-destructuring-bind
- (valid type path resource-type user-check readablep mime-valid mime)
- link-status
- (cond
- ((and valid (member type '("http" "https" "ftp")))
- ;; Collect text up to this image, and collect this image url
- (let ((text (buffer-substring-no-properties from-pt (car link-at-pt))))
- (unless (string-blank-p text) (push (list :text text) parts))
- (push (list :url path :mime mime) parts)
- (setq from-pt (cadr link-at-pt))))
- (valid ; Collect text up to this link, and collect this link data
- (let ((text (buffer-substring-no-properties from-pt (car link-at-pt))))
- (unless (string-blank-p text) (push (list :text text) parts))
- (push (if mime (list :media path :mime mime) (list :textfile path)) parts)
- (setq from-pt (cadr link-at-pt))))
- ((not resource-type)
- (message "Link source not followed for unsupported link type \"%s\"." type))
- ((not user-check)
- (message
- (if (eq gptel-markdown-validate-link 'gptel--link-standalone-p)
- "Ignoring non-standalone link \"%s\"."
- "Link %s failed to validate, see `gptel-markdown-validate-link'.")
- path))
- ((not readablep) (message "Ignoring inaccessible file \"%s\"." path))
- ((and (not mime-valid) (eq resource-type 'file))
- (message "Ignoring unsupported binary file \"%s\"." path)))))))
- (unless (= from-pt end)
- (push (list :text (buffer-substring-no-properties from-pt end)) parts))
- (nreverse parts)))
-
-(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'.
-Typically this is a list of plists.
-
-BACKEND is the gptel backend in use."
- (display-warning
- '(gptel context)
- (format "Context support not implemented for backend %s, ignoring context"
- (gptel-backend-name backend))))
-
-(cl-defgeneric gptel--request-data (backend prompts)
- "Generate a plist of all data for an LLM query.
-
-BACKEND is the LLM backend in use.
-
-PROMPTS is the plist of previous user queries and LLM responses.")
-
-(cl-defun gptel--sanitize-model (&key (backend gptel-backend)
- (model gptel-model)
- (shoosh t))
- "Check if MODEL is available in BACKEND, adjust accordingly.
-
-If SHOOSH is true, don't issue a warning."
- (let ((available (gptel-backend-models backend)))
- (when (stringp model)
- (unless shoosh
- (display-warning
- 'gptel
- (format "`gptel-model' expects a symbol, found string \"%s\"
- Resetting `gptel-model' to %s"
- model model)))
- (setq gptel-model (gptel--intern model)
- model gptel-model))
- (unless (member model available)
- (let ((fallback (car available)))
- (unless shoosh
- (display-warning
- 'gptel
- (format (concat "Preferred `gptel-model' \"%s\" not"
- "supported in \"%s\", using \"%s\" instead")
- model (gptel-backend-name backend) fallback)))
- (setq-local gptel-model fallback)))))
-
-\f
-;;; url-retrieve response handling
-(defun gptel--url-get-response (fsm)
- "Fetch response to prompt in state FSM from the LLM.
-
-FSM is the state machine driving this request. Its INFO slot
-contains the data required for setting up the request. INFO is a
-plist with the following keys, among others:
-- :data (the data being sent)
-- :buffer (the gptel buffer)
-- :position (marker at which to insert the response).
-- :callback (optional, the request callback)
-
-Call CALLBACK with the response and INFO afterwards. If omitted
-the response is inserted into the current buffer after point."
- (let* ((inhibit-message t)
- (message-log-max nil)
- (url-request-method "POST")
- (info (gptel-fsm-info fsm))
- ;; We have to let-bind the following two since their dynamic
- ;; values are used for key lookup and url resolution
- (gptel-backend (plist-get info :backend))
- (gptel-model (plist-get info :model))
- (url-request-extra-headers
- (append '(("Content-Type" . "application/json"))
- (when-let* ((header (gptel-backend-header gptel-backend)))
- (if (functionp header)
- (funcall header) header))))
- (callback (or (plist-get info :callback) ;if not the first run
- #'gptel--insert-response)) ;default callback
- ;; NOTE: We don't need the decode-coding-string dance here since we
- ;; don't pass it to the OS environment and Curl.
- (url-request-data
- (gptel--json-encode (plist-get info :data))))
- (when (with-current-buffer (plist-get info :buffer)
- (and (derived-mode-p 'org-mode)
- gptel-org-convert-response))
- (plist-put info :transformer #'gptel--convert-markdown->org))
- (plist-put info :callback callback)
- (when gptel-log-level ;logging
- (when (eq gptel-log-level 'debug)
- (gptel--log (gptel--json-encode
- (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair)))
- url-request-extra-headers))
- "request headers"))
- (gptel--log url-request-data "request body"))
- (let ((proc-buf
- (url-retrieve (let ((backend-url (gptel-backend-url gptel-backend)))
- (if (functionp backend-url)
- (funcall backend-url) backend-url))
- (lambda (_)
- (set-buffer-multibyte t)
- (set-buffer-file-coding-system 'utf-8-unix)
- (pcase-let ((`(,response ,http-status ,http-msg ,error)
- (gptel--url-parse-response
- (plist-get info :backend) info))
- (buf (current-buffer)))
- (plist-put info :http-status http-status)
- (plist-put info :status http-msg)
- (gptel--fsm-transition fsm) ;WAIT -> TYPE
- (when error (plist-put info :error error))
- (when response ;Look for a reasoning block
- (if (string-match-p "^\\s-*<think>" response)
- (when-let* ((idx (string-search "</think>" response)))
- (with-demoted-errors "gptel callback error: %S"
- (funcall callback
- (cons 'reasoning
- (substring response nil (+ idx 8)))
- info))
- (setq response (string-trim-left
- (substring response (+ idx 8)))))
- (when-let* ((reasoning (plist-get info :reasoning))
- ((stringp reasoning)))
- (funcall callback (cons 'reasoning reasoning) info))))
- (when (or response (not (member http-status '("200" "100"))))
- (with-demoted-errors "gptel callback error: %S"
- (funcall callback response info)))
- (gptel--fsm-transition fsm) ;TYPE -> next
- (setf (alist-get buf gptel--request-alist nil 'remove) nil)
- (kill-buffer buf)))
- nil t nil)))
- ;; TODO: Add transformer here.
- (setf (alist-get proc-buf gptel--request-alist)
- (cons fsm
- #'(lambda ()
- (plist-put info :callback #'ignore)
- (let (kill-buffer-query-functions)
- ;;Can't stop url-retrieve process
- (kill-buffer proc-buf))))))))
-
-(cl-defgeneric gptel--parse-response (backend response proc-info)
- "Response extractor for LLM requests.
-
-BACKEND is the LLM backend in use.
-
-RESPONSE is the parsed JSON of the response, as a plist.
-
-PROC-INFO is a plist with process information and other context.
-See `gptel-curl--get-response' for its contents.")
-
-(defun gptel--url-parse-response (backend proc-info)
- "Parse response from BACKEND with PROC-INFO."
- (when gptel-log-level ;logging
- (save-excursion
- (goto-char url-http-end-of-headers)
- (when (eq gptel-log-level 'debug)
- (gptel--log (gptel--json-encode (buffer-substring-no-properties (point-min) (point)))
- "response headers"))
- (gptel--log (buffer-substring-no-properties (point) (point-max))
- "response body")))
- (if-let* ((http-msg (string-trim (buffer-substring (line-beginning-position)
- (line-end-position))))
- (http-status
- (save-match-data
- (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
- (match-string 1 http-msg))))
- (response (progn (goto-char url-http-end-of-headers)
- (condition-case nil
- (gptel--json-read)
- (error 'json-read-error)))))
- (cond
- ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194
- ((or (memq url-http-response-status '(200 100))
- (string-match-p "\\(?:1\\|2\\)00 OK" http-msg))
- (list (and-let* ((resp (gptel--parse-response backend response proc-info))
- ((not (string-blank-p resp))))
- (string-trim resp))
- http-status http-msg))
- ((and-let* ((error-data
- (cond ((plistp response) (plist-get response :error))
- ((arrayp response)
- (cl-some (lambda (el) (plist-get el :error)) response)))))
- (list nil http-status http-msg error-data)))
- ((eq response 'json-read-error)
- (list nil http-status (concat "(" http-msg ") Malformed JSON in response.") "json-read-error"))
- (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.")
- "Could not parse HTTP response.")))
- (list nil (concat "(" http-msg ") Could not parse HTTP response.")
- "Could not parse HTTP response.")))
-
-\f
-;;; Curl request response handling
-
-(defun gptel-curl--get-args (info token)
- "Produce list of arguments for calling Curl.
-
-INFO contains the request data, TOKEN is a unique identifier."
- (let* ((data (plist-get info :data))
- ;; We have to let-bind the following three since their dynamic
- ;; values are used for key lookup and url resolution
- (gptel-backend (plist-get info :backend))
- (gptel-model (plist-get info :model))
- (gptel-stream (plist-get info :stream))
- (url (let ((backend-url (gptel-backend-url gptel-backend)))
- (if (functionp backend-url)
- (funcall backend-url) backend-url)))
- (data-json (decode-coding-string (gptel--json-encode data) 'utf-8 t))
- (headers
- (append '(("Content-Type" . "application/json"))
- (when-let* ((header (gptel-backend-header gptel-backend)))
- (if (functionp header)
- (funcall header) header)))))
- (when gptel-log-level
- (when (eq gptel-log-level 'debug)
- (gptel--log (gptel--json-encode
- (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair)))
- headers))
- "request headers"))
- (gptel--log data-json "request body"))
- (append
- gptel-curl--common-args
- gptel-curl-extra-args
- (and-let* ((curl-args (gptel-backend-curl-args gptel-backend)))
- (if (functionp curl-args) (funcall curl-args) curl-args))
- (list (format "-w(%s . %%{size_header})" token))
- (if (< (string-bytes data-json) gptel-curl-file-size-threshold)
- (list (format "-d%s" data-json))
- (let* ((write-region-inhibit-fsync t)
- (file-name-handler-alist nil)
- (inhibit-message t)
- (temp-filename (make-temp-file "gptel-curl-data" nil ".json" data-json))
- (cleanup-fn (lambda (&rest _) (when (file-exists-p temp-filename)
- (delete-file temp-filename)))))
- (plist-put info :post (cons cleanup-fn (plist-get info :post)))
- (list "--data-binary" (format "@%s" temp-filename))))
- (when (not (string-empty-p gptel-proxy))
- (list "--proxy" gptel-proxy
- "--proxy-negotiate"
- "--proxy-user" ":"))
- (cl-loop for (key . val) in headers
- collect (format "-H%s: %s" key val))
- (list url))))
-
-;;;###autoload
-(defun gptel-curl-get-response (fsm)
- "Fetch response to prompt in state FSM from the LLM using Curl.
-
-FSM is the state machine driving this request.
-
-FSM is the state machine driving this request. Its INFO slot
-contains the data required for setting up the request. INFO is a
-plist with the following keys, among others:
-- :data (the data being sent)
-- :buffer (the gptel buffer)
-- :position (marker at which to insert the response).
-- :callback (optional, the request callback)
-
-Call CALLBACK with the response and INFO afterwards. If omitted
-the response is inserted into the current buffer after point."
- (let* ((token (md5 (format "%s%s%s%s"
- (random) (emacs-pid) (user-full-name)
- (recent-keys))))
- (info (gptel-fsm-info fsm))
- (backend (plist-get info :backend))
- (args (gptel-curl--get-args info token))
- (stream (plist-get info :stream))
- (process (apply #'start-process "gptel-curl"
- (gptel--temp-buffer " *gptel-curl*") (gptel--curl-path) args)))
- (when (eq gptel-log-level 'debug)
- (gptel--log (mapconcat #'shell-quote-argument (cons (gptel--curl-path) args) " \\\n")
- "request Curl command" 'no-json))
- (with-current-buffer (process-buffer process)
- (cond
- ((eq (gptel-backend-coding-system backend) 'binary)
- ;; set-buffer-file-coding-system is not needed since we don't save this buffer
- (set-buffer-multibyte nil)
- (set-process-coding-system process 'binary 'binary))
- (t
- ;; Don't try to convert cr-lf to cr on Windows so that curl's "header size
- ;; in bytes" stays correct. Explicitly set utf-8 for non-win systems too,
- ;; for cases when buffer coding system is not set to utf-8.
- (set-process-coding-system process 'utf-8-unix 'utf-8-unix)))
- (set-process-query-on-exit-flag process nil)
- (if (plist-get info :token) ;not the first run, set only the token
- (plist-put info :token token)
- (setf (gptel-fsm-info fsm) ;fist run, set all process parameters
- (nconc (list :token token
- :transformer
- (when (with-current-buffer (plist-get info :buffer)
- (and (derived-mode-p 'org-mode)
- gptel-org-convert-response))
- (gptel--stream-convert-markdown->org
- (plist-get info :position))))
- (unless (plist-get info :callback)
- (list :callback (if stream
- #'gptel-curl--stream-insert-response
- #'gptel--insert-response)))
- info)))
- (if stream
- (progn (set-process-sentinel process #'gptel-curl--stream-cleanup)
- (set-process-filter process #'gptel-curl--stream-filter))
- (set-process-sentinel process #'gptel-curl--sentinel))
- (setf (alist-get process gptel--request-alist)
- (cons fsm
- #'(lambda ()
- ;; Clean up Curl process
- (set-process-sentinel process #'ignore)
- (delete-process process)
- (kill-buffer (process-buffer process))))))))
-
-;; ;; Ahead-Of-Time dispatch code for the parsers
-;; :parser ; FIXME `cl--generic-*' are internal functions
-;; (cl--generic-method-function
-;; (if stream
-;; (cl-loop
-;; for type in
-;; (cl--class-allparents (get (type-of backend) 'cl--class))
-;; with methods = (cl--generic-method-table
-;; (cl--generic 'gptel-curl--parse-stream))
-;; when (cl--generic-member-method `(,type t) nil methods)
-;; return (car it))
-;; (cl-loop
-;; for type in
-;; (cl--class-allparents (get (type-of backend) 'cl--class))
-;; with methods = (cl--generic-method-table
-;; (cl--generic 'gptel--parse-response))
-;; when (cl--generic-member-method `(,type t t) nil methods)
-;; return (car it))))
-
-(defun gptel-curl--log-response (proc-buf proc-info)
- "Parse response buffer PROC-BUF and log response.
-
-PROC-INFO is the plist containing process metadata."
- (with-current-buffer proc-buf
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "\r?\n\r?\n" nil t)
- (when (eq gptel-log-level 'debug)
- (gptel--log (gptel--json-encode
- (buffer-substring-no-properties
- (point-min) (1- (point))))
- "response headers"))
- (let ((p (point)))
- (when (search-forward (plist-get proc-info :token) nil t)
- (goto-char (1- (match-beginning 0)))
- (gptel--log (buffer-substring-no-properties p (point))
- "response body")))))))
-
-;; TODO: Separate user-messaging from this function
-(defun gptel-curl--stream-cleanup (process _status)
- "Process sentinel for gptel curl requests.
-
-PROCESS and _STATUS are process parameters."
- (let ((proc-buf (process-buffer process)))
- (let* ((fsm (car (alist-get process gptel--request-alist)))
- (info (gptel-fsm-info fsm))
- (http-status (plist-get info :http-status)))
- (when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging
- (if (member http-status '("200" "100")) ;Finish handling response
- ;; Run the callback one last time to signal that the process has ended
- (with-demoted-errors "gptel callback error: %S"
- (funcall (plist-get info :callback) t info))
- (with-current-buffer proc-buf ; Or Capture error message
- (goto-char (point-max))
- (search-backward (plist-get info :token))
- (backward-char)
- (pcase-let* ((`(,_ . ,header-size) (read (current-buffer)))
- (response (progn (goto-char header-size)
- (condition-case nil (gptel--json-read)
- (error 'json-read-error))))
- (error-data
- (cond ((plistp response) (plist-get response :error))
- ((arrayp response)
- (cl-some (lambda (el) (plist-get el :error)) response)))))
- (cond
- (error-data
- (plist-put info :error error-data))
- ((eq response 'json-read-error)
- (plist-put info :error "Malformed JSON in response."))
- (t (plist-put info :error "Could not parse HTTP response.")))))
- (with-demoted-errors "gptel callback error: %S"
- (funcall (plist-get info :callback) nil info)))
- (gptel--fsm-transition fsm)) ; Move to next state
- (setf (alist-get process gptel--request-alist nil 'remove) nil)
- (kill-buffer proc-buf)))
-
-(defun gptel-curl--stream-filter (process output)
- (let* ((fsm (car (alist-get process gptel--request-alist)))
- (proc-info (gptel-fsm-info fsm))
- (callback (or (plist-get proc-info :callback)
- #'gptel-curl--stream-insert-response)))
- (with-current-buffer (process-buffer process)
- ;; Insert output
- (save-excursion
- (goto-char (process-mark process))
- (insert output)
- (set-marker (process-mark process) (point)))
-
- ;; Find HTTP status
- (unless (plist-get proc-info :http-status)
- (save-excursion
- (goto-char (point-min))
- (when-let* (((not (= (line-end-position) (point-max))))
- (http-msg (buffer-substring (line-beginning-position)
- (line-end-position)))
- (http-status
- (save-match-data
- (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
- (match-string 1 http-msg)))))
- (plist-put proc-info :http-status http-status)
- (plist-put proc-info :status (string-trim http-msg))
- (gptel--fsm-transition fsm))))
-
- (when-let* ((http-msg (plist-get proc-info :status))
- (http-status (plist-get proc-info :http-status)))
- ;; Find data chunk(s) and run callback
- ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194
- (when (member http-status '("200" "100"))
- (let ((response (gptel-curl--parse-stream
- (plist-get proc-info :backend) proc-info))
- (reasoning-block (plist-get proc-info :reasoning-block)))
- ;; Depending on the API, there are two modes that reasoning or
- ;; chain-of-thought content appears: as part of the main response
- ;; but surrounded by <think>...</think> tags, or as a separate
- ;; JSON field in the response stream.
- ;;
- ;; These cases are handled using two PROC-INFO keys:
- ;;
- ;; :reasoning-block is nil before checking for reasoning, 'in when
- ;; in a reasoning block, t when we reach the end of the block, and
- ;; 'done afterwards or if no reasoning block is found. This
- ;; applies to both the modes above.
- ;;
- ;; :reasoning contains the reasoning text parsed from the separate
- ;; JSON field.
- ;;
- ;; NOTE: We assume here that the reasoning block always
- ;; precedes the main response block.
- (unless (eq reasoning-block 'done)
- (let ((reasoning (plist-get proc-info :reasoning)))
- (cond
- ((stringp reasoning)
- ;; Obtained from separate JSON field in response
- (funcall callback (cons 'reasoning reasoning) proc-info)
- (unless reasoning-block ;Record that we're in a reasoning block (#709)
- (plist-put proc-info :reasoning-block 'in))
- (plist-put proc-info :reasoning nil)) ;Reset for next parsing round
- ((and (string-blank-p response) ;Defer checking if response is blank
- (not reasoning-block))) ;unless we're in a reasoning block already
- ((and (null reasoning-block) (length> response 0))
- ;; Obtained from main response stream: reasoning block start
- (if-let* ((idx (string-match-p "<think>" response)))
- (progn
- (when (> idx 0) ;Collect leading whitespace before <think>
- (funcall callback (substring response 0 idx) proc-info)
- (setq response (substring response idx)))
- (setq response (cons 'reasoning response))
- (plist-put proc-info :reasoning-block 'in))
- (plist-put proc-info :reasoning-block 'done)))
- ((and (not (eq reasoning-block t)) (length> response 0))
- (if-let* ((idx (string-match-p "</think>" response)))
- (progn
- (funcall callback
- (cons 'reasoning (substring response nil (+ idx 8)))
- proc-info)
- (setq reasoning-block t) ;Signal end of reasoning stream
- (plist-put proc-info :reasoning-block t)
- (setq response (substring response (+ idx 8))))
- (setq response (cons 'reasoning response)))))
- (when (eq reasoning-block t) ;End of reasoning block
- (funcall callback '(reasoning . t) proc-info)
- (plist-put proc-info :reasoning-block 'done))))
- (unless (equal response "") ;Response callback
- (funcall callback response proc-info))))))))
-
-(cl-defgeneric gptel-curl--parse-stream (backend proc-info)
- "Stream parser for gptel-curl.
-
-Implementations of this function run as part of the process
-filter for the active query, and return partial responses from
-the LLM.
-
-BACKEND is the LLM backend in use.
-
-PROC-INFO is a plist with process information and other context.
-See `gptel-curl--get-response' for its contents.")
-
-(defun gptel-curl--sentinel (process _status)
- "Process sentinel for gptel curl requests.
-
-PROCESS and _STATUS are process parameters."
- (let ((proc-buf (process-buffer process)))
- (when-let* (((eq (process-status process) 'exit))
- (fsm (car (alist-get process gptel--request-alist)))
- (proc-info (gptel-fsm-info fsm))
- (proc-callback (plist-get proc-info :callback)))
- (when gptel-log-level (gptel-curl--log-response proc-buf proc-info)) ;logging
- (pcase-let ((`(,response ,http-status ,http-msg ,error)
- (with-current-buffer proc-buf
- (gptel-curl--parse-response proc-info))))
- (plist-put proc-info :http-status http-status)
- (plist-put proc-info :status http-msg)
- (gptel--fsm-transition fsm) ;WAIT -> TYPE
- (when error (plist-put proc-info :error error))
- ;; Look for a reasoning block
- (if (and (stringp response) (string-match-p "^\\s-*<think>" response))
- (when-let* ((idx (string-search "</think>" response)))
- (with-demoted-errors "gptel callback error: %S"
- (funcall proc-callback
- (cons 'reasoning (substring response nil (+ idx 8)))
- proc-info))
- (setq response
- (string-trim-left (substring response (+ idx 8)))))
- (when-let* ((reasoning (plist-get proc-info :reasoning))
- ((stringp reasoning)))
- (funcall proc-callback (cons 'reasoning reasoning) proc-info)))
- ;; Call callback with response text
- (when (or response (not (member http-status '("200" "100"))))
- (with-demoted-errors "gptel callback error: %S"
- (funcall proc-callback response proc-info))))
- (gptel--fsm-transition fsm)) ;TYPE -> next
- (setf (alist-get process gptel--request-alist nil 'remove) nil)
- (kill-buffer proc-buf)))
-
-(defun gptel-curl--parse-response (proc-info)
- "Parse the buffer BUF with curl's response.
-
-PROC-INFO is a plist with contextual information."
- (let ((token (plist-get proc-info :token)))
- (goto-char (point-max))
- (search-backward token)
- (backward-char)
- (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))))
- (goto-char (point-min))
-
- (if-let* ((http-msg (string-trim
- (buffer-substring (line-beginning-position)
- (line-end-position))))
- (http-status
- (save-match-data
- (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
- (match-string 1 http-msg))))
- (response (progn (goto-char header-size)
- (condition-case nil
- (gptel--json-read)
- (error 'json-read-error)))))
- (cond
- ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194
- ((member http-status '("200" "100"))
- (list (and-let* ((resp (gptel--parse-response
- (plist-get proc-info :backend) response proc-info))
- ((not (string-blank-p resp))))
- (string-trim resp))
- http-status http-msg))
- ((and-let* ((error-data
- (cond ((plistp response) (plist-get response :error))
- ((arrayp response)
- (cl-some (lambda (el) (plist-get el :error)) response)))))
- (list nil http-status http-msg error-data)))
- ((eq response 'json-read-error)
- (list nil http-status (concat "(" http-msg ") Malformed JSON in response.")
- "Malformed JSON in response"))
- (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.")
- "Could not parse HTTP response.")))
- (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.")
- "Could not parse HTTP response.")))))
-
-(provide 'gptel-request)
-;;; gptel-request.el ends here
+++ /dev/null
-;;; gptel-rewrite.el --- Refactoring functions for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2024 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords: hypermedia, convenience, tools
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-(require 'gptel-transient)
-(require 'cl-lib)
-
-(defvar eldoc-documentation-functions)
-(defvar diff-entire-buffers)
-(defvar ediff-window-setup-function)
-(defvar ediff-split-window-function)
-
-(declare-function diff-no-select "diff")
-(declare-function rmc--add-key-description "rmc")
-(declare-function ediff-setup-windows-plain "ediff-wind")
-
-;; * User options
-
-(defcustom gptel-rewrite-directives-hook nil
- "Hook run to generate gptel's default rewrite directives.
-
-Each function in this hook is called with no arguments until one
-returns a non-nil value, the base string to use as the
-rewrite instruction.
-
-Use this hook to tailor context-specific rewrite directives.
-For example, you can specialize the default rewrite directive
-for a particular major-mode or project."
- :group 'gptel
- :type 'hook)
-
-(defcustom gptel-post-rewrite-functions nil
- "Abnormal hook run after a `gptel-rewrite' action.
-
-This hook is called after the LLM response for the rewrite action
-has been fully received in a temporary buffer. Each function is
-called with two arguments: the response beginning and end
-positions.
-
-Note: this hook only runs if the rewrite request succeeds."
- :type 'hook
- :group 'gptel)
-
-(defcustom gptel-rewrite-default-action nil
- "Action to take when rewriting a text region using gptel.
-
-When the LLM response with the rewritten text is received, you can
-- merge it with the current region, possibly creating a merge conflict,
-- diff or ediff against the original region,
-- or accept it in place, replacing the original region.
-- display a dispatch menu with the above choices.
-
-If this option is nil (the default), gptel waits for an explicit
-command. Set it to the symbol `merge', `diff', `ediff', `accept'
-or `dispatch' to automatically do one of these things instead.
-
-You can also set it to a function of your choosing for a custom
-action. This function receives one argument, the rewrite
-overlay."
- :group 'gptel
- :type '(choice
- (const :tag "Wait" nil)
- (const :tag "Merge with current region" merge)
- (const :tag "Diff against current region" diff)
- (const :tag "Ediff against current region" ediff)
- (const :tag "Accept rewrite" accept)
- (const :tag "Dispatch" dispatch)
- (function :tag "Custom action")))
-
-(defface gptel-rewrite-highlight-face
- '((((class color) (min-colors 88) (background dark))
- :background "#041714" :extend t :inherit default)
- (((class color) (min-colors 88) (background light))
- :background "light goldenrod yellow" :extend t :inherit default)
- (t :inherit secondary-selection))
- "Face for highlighting regions with pending rewrites."
- :group 'gptel)
-
-;; * Variables
-
-(defvar-keymap gptel-rewrite-actions-map
- :doc "Keymap for gptel rewrite actions at point."
- "RET" #'gptel--rewrite-dispatch
- "<mouse-1>" #'gptel--rewrite-dispatch
- "C-c C-a" #'gptel--rewrite-accept
- "C-c C-r" #'gptel--rewrite-iterate
- "C-c C-k" #'gptel--rewrite-reject
- "C-c C-d" #'gptel--rewrite-diff
- "C-c C-e" #'gptel--rewrite-ediff
- "C-c C-n" #'gptel--rewrite-next
- "C-c C-p" #'gptel--rewrite-previous
- "C-c C-m" #'gptel--rewrite-merge)
-
-(defvar-local gptel--rewrite-overlays nil
- "List of active rewrite overlays in the buffer.")
-
-(defvar-local gptel--rewrite-message nil
- "Request-specific instructions for a gptel-rewrite action.")
-
-;; Add the rewrite directive to `gptel-directives'
-(unless (alist-get 'rewrite gptel-directives)
- (add-to-list 'gptel-directives `(rewrite . ,#'gptel--rewrite-directive-default)))
-
-(defvar gptel--rewrite-directive
- (or (alist-get 'rewrite gptel-directives)
- #'gptel--rewrite-directive-default)
- "Active system message for rewrite actions.
-
-This variable is for internal use only. To customize the rewrite
-system message, set a system message (or function that generates
-the system message) as the value of the `rewrite' key in
-`gptel-directives':
-
- (setf (alist-get \\='rewrite gptel-directives)
- #\\='my-rewrite-message-generator)
-
-You can also customize `gptel-rewrite-directives-hook' to
-dynamically inject a rewrite-specific system message.")
-
-(defun gptel--rewrite-directive-default ()
- "Generic directive for rewriting or refactoring.
-
-These are instructions not specific to any particular required
-change.
-
-The returned string is interpreted as the system message for the
-rewrite request. To use your own, add a different directive to
-`gptel-directives', or add to `gptel-rewrite-directives-hook',
-which see."
- (or (save-mark-and-excursion
- (run-hook-with-args-until-success
- 'gptel-rewrite-directives-hook))
- (let* ((lang (downcase (gptel--strip-mode-suffix major-mode)))
- (article (if (and lang (not (string-empty-p lang))
- (memq (aref lang 0) '(?a ?e ?i ?o ?u)))
- "an" "a")))
- (if (derived-mode-p 'prog-mode)
- (format (concat "You are %s %s programmer. "
- "Follow my instructions and refactor %s code I provide.\n"
- "- Generate ONLY %s code as output, without "
- "any explanation or markdown code fences.\n"
- "- Generate code in full, do not abbreviate or omit code.\n"
- "- Do not produce intermediate text or report on your progress.\n"
- "- Do not ask for further clarification, and make "
- "any assumptions you need to follow instructions.")
- article lang lang lang)
- (concat
- (if (string-empty-p lang)
- "You are an editor."
- (format "You are %s %s editor." article lang))
- " Follow my instructions and improve or rewrite the text I provide."
- " Do not produce intermediate text or report on your progress."
- " Generate ONLY the replacement text,"
- " without any explanation or markdown code fences.")))))
-
-(defvar gptel--rewrite-handlers
- `((WAIT ,#'gptel--handle-wait)
- (TOOL ,#'gptel--update-tool-call ,#'gptel--handle-tool-use))
- "Alist specifying FSM handlers for `gptel-rewrite' state transitions.")
-
-;; * Helper functions
-
-(defun gptel--rewrite-key-help (callback)
- "Eldoc documentation function for gptel rewrite actions.
-
-CALLBACK is supplied by Eldoc, see
-`eldoc-documentation-functions'."
- (when (and gptel--rewrite-overlays
- (get-char-property (point) 'gptel-rewrite))
- (funcall callback
- (format (substitute-command-keys "%s rewrite available: accept \\[gptel--rewrite-accept], iterate \\[gptel--rewrite-iterate], clear \\[gptel--rewrite-reject], merge \\[gptel--rewrite-merge], diff \\[gptel--rewrite-diff] or ediff \\[gptel--rewrite-ediff]")
- (propertize (gptel--model-name gptel-model) 'face 'mode-line-emphasis)))))
-
-(defun gptel--rewrite-move (search-func)
- "Move directionally to a gptel rewrite location using SEARCH-FUNC."
- (let* ((ov (cdr (get-char-property-and-overlay (point) 'gptel-rewrite)))
- (pt (save-excursion
- (if ov
- (goto-char
- (funcall search-func (overlay-start ov) 'gptel-rewrite))
- (goto-char
- (max (1- (funcall search-func (point) 'gptel-rewrite))
- (point-min))))
- (funcall search-func (point) 'gptel-rewrite))))
- (if (get-char-property pt 'gptel-rewrite)
- (goto-char pt)
- (user-error "No further rewrite regions!"))))
-
-(defun gptel--rewrite-next ()
- "Go to next pending LLM rewrite in buffer, if one exists."
- (interactive)
- (gptel--rewrite-move #'next-single-char-property-change))
-
-(defun gptel--rewrite-previous ()
- "Go to previous pending LLM rewrite in buffer, if one exists."
- (interactive)
- (gptel--rewrite-move #'previous-single-char-property-change))
-
-(defun gptel--rewrite-overlay-at (&optional pt)
- "Check for a gptel rewrite overlay at PT and return it.
-
-If no suitable overlay is found, raise an error."
- (pcase-let ((`(,response . ,ov)
- (get-char-property-and-overlay (or pt (point)) 'gptel-rewrite))
- (diff-entire-buffers nil))
- (unless ov (user-error "Could not find region being rewritten."))
- (unless response (user-error "No LLM output available for this rewrite."))
- ov))
-
-(defun gptel--rewrite-prepare-buffer (ovs &optional buf)
- "Prepare new buffer with LLM changes applied and return it.
-
-This is used for (e)diff purposes.
-
-RESPONSE is the LLM response. OVS are the overlays specifying
-the changed regions. BUF is the (current) buffer."
- (setq buf (or buf (overlay-buffer (or (car-safe ovs) ovs))))
- (with-current-buffer buf
- (let ((pmin (point-min))
- (pmax (point-max))
- (pt (point))
- ;; (mode major-mode)
- (newbuf (get-buffer-create "*gptel-diff*"))
- (inhibit-read-only t)
- (inhibit-message t))
- (save-restriction
- (widen)
- (with-current-buffer newbuf
- (erase-buffer)
- (insert-buffer-substring buf)))
- (with-current-buffer newbuf
- (narrow-to-region pmin pmax)
- (goto-char pt)
- ;; We mostly just want font-locking
- ;; (delay-mode-hooks (funcall mode))
- ;; Apply the changes to the new buffer
- (save-excursion
- (gptel--rewrite-accept ovs newbuf)))
- newbuf)))
-
-(defun gptel--rewrite-read-message (prompt &optional _ history)
- "Read a rewrite message from the minibuffer with custom keybindings for
-cycling, editing, and submitting the gptel rewrite.
-
-PROMPT is the prompt string to display. HISTORY, if provided, is the
-input history list."
- (let* ((rewrite-directive
- (car-safe (gptel--parse-directive gptel--rewrite-directive 'raw)))
- (cb (current-buffer))
- (cycle-prefix (lambda () (interactive)
- (gptel--read-with-prefix rewrite-directive)
- (push-mark) (goto-char (point-max))
- (activate-mark)))
- (set-rewrite-message
- (lambda ()
- (let ((message (buffer-substring-no-properties
- (minibuffer-prompt-end) (point-max))))
- (with-current-buffer cb (setq gptel--rewrite-message message))
- (setf (alist-get 'gptel--infix-rewrite-extra transient-history)
- (delete-dups (cons message transient--history))))))
- (start-rewrite-maybe
- (lambda () (interactive)
- (if transient--prefix ;Called from transient? Don't start rewrite
- (run-at-time 0 nil #'transient-setup 'gptel-rewrite)
- (run-at-time 0 nil #'gptel--suffix-rewrite gptel--rewrite-message))
- (when (minibufferp)
- (funcall set-rewrite-message)
- (exit-minibuffer))))
- (start-transient
- (lambda () (interactive)
- (run-at-time 0 nil #'transient-setup 'gptel-rewrite)
- (when (minibufferp)
- (funcall set-rewrite-message)
- (exit-minibuffer))))
- (edit-in-buffer
- (lambda () (interactive)
- (let ((offset (- (point) (minibuffer-prompt-end))))
- (gptel--edit-directive 'gptel--rewrite-message
- :prompt rewrite-directive :initial (minibuffer-contents)
- :buffer cb :setup (lambda () (ignore-errors (forward-char offset)))
- :callback
- (lambda (msg)
- (when msg
- (run-at-time 0 nil #'gptel--suffix-rewrite)
- (push (buffer-local-value 'gptel--rewrite-message cb)
- (alist-get 'gptel--infix-rewrite-extra transient-history)))
- (when (minibufferp) (exit-minibuffer)))))))
- (minibuffer-local-map
- (make-composed-keymap (define-keymap
- "TAB" cycle-prefix "<tab>" cycle-prefix
- "C-c C-e" edit-in-buffer
- "<remap> <exit-minibuffer>" start-rewrite-maybe
- "M-RET" start-transient)
- minibuffer-local-map)))
- (minibuffer-with-setup-hook cycle-prefix
- (read-string
- prompt (or gptel--rewrite-message "Rewrite: ")
- history))))
-
-;; * Rewrite action functions
-
-(defun gptel--rewrite-reject (&optional ovs)
- "Clear pending LLM responses in OVS or at point."
- (interactive (list (gptel--rewrite-overlay-at)))
- (dolist (ov (ensure-list ovs))
- (setq gptel--rewrite-overlays (delq ov gptel--rewrite-overlays))
- (delete-overlay ov))
- (unless gptel--rewrite-overlays
- (remove-hook 'eldoc-documentation-functions 'gptel--rewrite-key-help 'local))
- (message "Cleared pending LLM response(s)."))
-
-(defun gptel--rewrite-accept (&optional ovs buf)
- "Apply pending LLM responses in OVS or at point.
-
-BUF is the buffer to modify, defaults to the overlay buffer."
- (interactive (list (gptel--rewrite-overlay-at)))
- (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
- (buf (or buf ov-buf))
- ((buffer-live-p buf)))
- (with-current-buffer ov-buf
- (cl-loop for ov in (ensure-list ovs)
- for ov-beg = (overlay-start ov)
- for ov-end = (overlay-end ov)
- for response = (overlay-get ov 'gptel-rewrite)
- do (overlay-put ov 'before-string nil)
- (with-current-buffer buf
- (goto-char ov-beg)
- (delete-region ov-beg ov-end)
- (insert response))))
- (message "Replaced region(s) with LLM output in buffer: %s."
- (buffer-name ov-buf))))
-
-(defalias 'gptel--rewrite-iterate 'gptel-rewrite
- "Iterate on pending LLM response at point.")
-
-(defun gptel--rewrite-diff (&optional ovs switches)
- "Diff pending LLM responses in OVS or at point."
- (interactive (list (gptel--rewrite-overlay-at)))
- (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
- ((buffer-live-p ov-buf)))
- (require 'diff)
- (let* ((newbuf (gptel--rewrite-prepare-buffer ovs))
- (diff-buf (diff-no-select ov-buf newbuf switches)))
- (with-current-buffer diff-buf
- (setq-local diff-jump-to-old-file t))
- (display-buffer diff-buf))))
-
-(defun gptel--rewrite-ediff (&optional ovs)
- "Ediff pending LLM responses in OVS or at point."
- (interactive (list (gptel--rewrite-overlay-at)))
- (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
- ((buffer-live-p ov-buf)))
- (letrec ((newbuf (gptel--rewrite-prepare-buffer ovs))
- (cwc (current-window-configuration))
- (hideshow
- (lambda (&optional restore)
- (dolist (ov (ensure-list ovs))
- (when-let* ((overlay-buffer ov))
- (let ((disp (overlay-get ov 'display))
- (stored (overlay-get ov 'gptel--ediff)))
- (overlay-put ov 'face (and restore 'gptel-rewrite-highlight-face))
- (overlay-put ov 'display (and restore stored))
- (overlay-put ov 'gptel--ediff (unless restore disp)))))))
- (gptel--ediff-restore
- (lambda ()
- (when (window-configuration-p cwc)
- (set-window-configuration cwc))
- (funcall hideshow 'restore)
- (remove-hook 'ediff-quit-hook gptel--ediff-restore))))
- (funcall hideshow)
- (add-hook 'ediff-quit-hook gptel--ediff-restore)
- (let ((ediff-window-setup-function #'ediff-setup-windows-plain)
- (ediff-split-window-function #'split-window-horizontally))
- (ediff-buffers ov-buf newbuf)))))
-
-(defun gptel--rewrite-merge-git (beg end new-str)
- "Produce a merge conflict region between BEG and END.
-
-Merge the region with NEW-STR using git merge-file."
- (let ((original-temp-file (make-temp-file "gptel-merge-"))
- (empty-temp-file (make-temp-file "gptel-merge-")) ; use /dev/null? (windows?)
- (new-temp-file (make-temp-file "gptel-merge-")))
- (unwind-protect
- (progn (write-region beg end original-temp-file)
- (with-temp-file empty-temp-file (insert ""))
- (with-temp-file new-temp-file (insert new-str))
- (goto-char beg)
- (delete-region beg end)
- (call-process
- "git" nil (list (current-buffer) nil) nil
- "merge-file" "--no-diff3" "-L" "original" "-L" "Empty" "-L"
- (gptel-backend-name gptel-backend) "-p"
- original-temp-file empty-temp-file new-temp-file)
- ;; Make merge marker active if required
- (goto-char beg) (unless (bolp) (insert "\n")))
- (delete-file original-temp-file)
- (delete-file empty-temp-file)
- (delete-file new-temp-file))))
-
-(defun gptel--rewrite-merge-simple (beg end new-str)
- "Produce a merge conflict region between BEG and END.
-
-NEW-STR is the new string intended to replace the region."
- (goto-char end) ;End first to preserve ordering
- (unless (bolp) (insert "\n"))
- (insert "=======\n" new-str "\n>>>>>>> "
- (gptel-backend-name gptel-backend) "\n")
- (goto-char beg)
- (unless (bolp) (insert "\n"))
- (insert-before-markers "<<<<<<< original\n"))
-
-(defun gptel--rewrite-merge (&optional ovs)
- "Insert pending LLM responses in OVS as merge conflicts."
- (interactive (list (gptel--rewrite-overlay-at)))
- (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
- ((buffer-live-p ov-buf)))
- (with-current-buffer ov-buf
- (let ((changed))
- (dolist (ov (ensure-list ovs))
- (save-excursion
- (when-let* ((new-str (overlay-get ov 'gptel-rewrite)))
- (if (executable-find "git") ;Replace overlay content with merge result
- (gptel--rewrite-merge-git (overlay-start ov) (overlay-end ov) new-str)
- (gptel--rewrite-merge-simple (overlay-start ov) (overlay-end ov) new-str))
- (setq changed t))))
- (when changed (smerge-mode 1)))
- (gptel--rewrite-reject ovs))))
-
-(defun gptel--rewrite-dispatch (&optional ov ci)
- "Dispatch actions for gptel rewrites.
-
-OV is the rewrite overlay, CI is true for interactive calls."
- (interactive (list (gptel--rewrite-overlay-at) t))
- (let ((choice))
- (unwind-protect
- (pcase-let ((choices '((?a "accept") (?k "reject") (?r "iterate")
- (?m "merge") (?d "diff") (?e "ediff")))
- (hint-str (concat "[" (gptel--model-name gptel-model) "]\n")))
- (overlay-put
- ov 'before-string
- (concat
- (unless (eq (char-before (overlay-start ov)) ?\n) "\n")
- (propertize "REWRITE READY: " 'face 'success)
- (when (fboundp #'rmc--add-key-description) ; introduced in Emacs 29
- (mapconcat (lambda (e) (cdr e)) (mapcar #'rmc--add-key-description choices) ", "))
- (propertize
- " " 'display `(space :align-to (- right ,(1+ (length hint-str)))))
- (propertize hint-str 'face 'success)))
- (setq choice (read-multiple-choice "Action: " choices)))
- (overlay-put ov 'before-string nil))
- (if ci
- (call-interactively (intern (concat "gptel--rewrite-" (cadr choice))))
- (funcall (intern (concat "gptel--rewrite-" (cadr choice))) ov))))
-
-(defun gptel--rewrite-callback (response info)
- "Callback for gptel rewrite actions.
-
-Show the rewrite result in an overlay over the original text, and
-set up dispatch actions.
-
-RESPONSE is the response received. It may also be t (to indicate
-success) nil (to indicate failure), or the symbol `abort'.
-
-INFO is the async communication channel for the rewrite request."
- (when-let* ((ov-and-buf (plist-get info :context))
- (ov (car ov-and-buf))
- (proc-buf (cdr ov-and-buf))
- (buf (overlay-buffer ov)))
- (cond
- ((stringp response) ;partial or fully successful result
- (with-current-buffer proc-buf ;auxiliary buffer, insert text here and copy to overlay
- (let ((inhibit-modification-hooks nil)
- (inhibit-read-only t))
- (when (= (buffer-size) 0)
- (buffer-disable-undo)
- (overlay-put ov 'gptel-rewrite nil)
- (insert-buffer-substring buf (overlay-start ov) (overlay-end ov))
- (when (eq (char-before (point-max)) ?\n)
- (plist-put info :newline t))
- (setq major-mode (buffer-local-value 'major-mode buf)) ;Don't turn on major-mode (#730, #722)
- (add-text-properties (point-min) (point-max) '(face shadow font-lock-face shadow))
- (goto-char (point-min)))
- (insert response)
- (unless (eobp) (ignore-errors (delete-char (length response))))
- (font-lock-ensure)
- (overlay-put ov 'display (buffer-string))))
- (unless (plist-get info :stream) (gptel--rewrite-callback t info)))
-
- ((eq response 'abort) ;request aborted
- (when-let* ((proc-buf (cdr-safe (plist-get info :context))))
- (kill-buffer proc-buf))
- (delete-overlay ov))
-
- ((eq (car-safe response) 'tool-call) ;tool call confirmation
- (gptel--display-tool-calls ;use minibuffer if buffer is read-only
- (cdr response) info (buffer-local-value 'buffer-read-only buf)))
-
- ((null response) ;finished with error
- (message (concat "LLM response error: %s. Rewrite in buffer %s canceled.")
- (plist-get info :status) (plist-get info :buffer))
- (gptel--rewrite-callback 'abort info))
-
- ((consp response)) ;reasoning or tool call result -- don't care
-
- (t
- (if (plist-get info :tool-use) ;stopped to use tools
- ;; Clear text inserted so far
- (with-current-buffer proc-buf (delete-region (point-min) (point)))
- (let ((mkb (propertize "<mouse-1>" 'face 'help-key-binding))) ;or finished successfully
- (with-current-buffer proc-buf
- (let ((inhibit-read-only t))
- (delete-region (point) (point-max))
- ;; Run post-rewrite-functions on rewritten text in its buffer
- (setq-local gptel-post-rewrite-functions
- (buffer-local-value 'gptel-post-rewrite-functions buf))
- (with-demoted-errors "gptel-post-rewrite-functions: %S"
- (run-hook-with-args 'gptel-post-rewrite-functions (point-min) (point-max)))
- (when (and (plist-get info :newline)
- (not (eq (char-before (point-max)) ?\n)))
- (insert "\n"))
- (font-lock-ensure))
- (overlay-put ov 'display (buffer-string))
- (overlay-put ov 'gptel-rewrite (buffer-string))
- (kill-buffer proc-buf))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (pulse-momentary-highlight-region (overlay-start ov) (overlay-end ov))
- (add-hook 'eldoc-documentation-functions #'gptel--rewrite-key-help nil 'local)
- ;; (overlay-put ov 'gptel-rewrite response)
- (overlay-put ov 'face 'gptel-rewrite-highlight-face)
- (overlay-put ov 'priority 2000)
- (overlay-put ov 'keymap gptel-rewrite-actions-map)
- (overlay-put ov 'mouse-face 'highlight)
- (overlay-put
- ov 'help-echo
- (format (concat "%s rewrite available: %s or \\[gptel--rewrite-dispatch] for options")
- (concat (gptel-backend-name gptel-backend) ":" (gptel--model-name gptel-model))
- mkb))
- (push ov gptel--rewrite-overlays))
- (if-let* ((sym gptel-rewrite-default-action))
- (if-let* ((action (intern (concat "gptel--rewrite-" (symbol-name sym))))
- ((functionp action)))
- (funcall action ov) (funcall sym ov))
- (message (concat
- "LLM rewrite output"
- (unless (eq (current-buffer) buf)
- (format " in buffer %s " (buffer-name buf)))
- (concat " ready: " mkb ", " (propertize "RET" 'face 'help-key-binding)
- " or " (substitute-command-keys "\\[gptel-rewrite] to continue."))))))))))))
-
-;; * Transient Prefixes for rewriting
-
-(transient-define-prefix gptel--rewrite-directive-menu ()
- "Set the directive (system message) for rewrite actions.
-
-By default, gptel uses the directive associated with the `rewrite'
- key in `gptel-directives'. You can add more rewrite-specific
- directives to `gptel-directives' and pick one from here."
- [:description gptel-system-prompt--format
- [(gptel--suffix-rewrite-directive)]
- [(gptel--infix-variable-scope)]]
- [:class transient-column
- :setup-children
- (lambda (_) (transient-parse-suffixes
- 'gptel--rewrite-directive-menu
- (gptel--setup-directive-menu
- 'gptel--rewrite-directive "Rewrite directive")))
- :pad-keys t])
-
-;;;###autoload (autoload 'gptel-rewrite "gptel-rewrite" nil t)
-(transient-define-prefix gptel-rewrite ()
- "Rewrite or refactor text region using an LLM."
- [:description
- (lambda ()
- (gptel--describe-directive
- gptel--rewrite-directive (max (- (window-width) 14) 20) " "))
- [""
- (gptel--preset
- :if (lambda () (or (get-char-property (point) 'gptel-rewrite)
- (use-region-p)))
- :key "@" :format "%d"
- :description
- (lambda ()
- (concat (propertize "Instructions" 'face 'transient-heading)
- (gptel--format-preset-string))))
- ("s" "Set full directive" gptel--rewrite-directive-menu)
- (gptel--infix-rewrite-extra)]]
- ;; FIXME: We are requiring `gptel-transient' because of this suffix, perhaps
- ;; we can get find some way around that?
- [:description "Context for rewrite"
- :if use-region-p
- (gptel--infix-context-remove-all :key "-d")
- (gptel--suffix-context-buffer :key "C" :format " %k %d")]
- [[:description "Diff Options"
- :if (lambda () gptel--rewrite-overlays)
- ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change"))
- ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space"))
- ("-i" "Ignore case" ("-i" "--ignore-case"))
- (gptel--infix-rewrite-diff:-U)]
- [:description "Accept all"
- :if (lambda () gptel--rewrite-overlays)
- (gptel--suffix-rewrite-merge)
- (gptel--suffix-rewrite-accept)
- "Reject all"
- (gptel--suffix-rewrite-reject)]]
- [[:description "Diff rewrite regions"
- :if (lambda () gptel--rewrite-overlays)
- (gptel--suffix-rewrite-diff)
- (gptel--suffix-rewrite-ediff)]]
- [[:description "Rewrite"
- :if (lambda () (or (get-char-property (point) 'gptel-rewrite)
- (use-region-p)))
- (gptel--suffix-rewrite)]
- ["Dry Run"
- :if (lambda () (and (or gptel-log-level gptel-expert-commands)
- (or (get-char-property (point) 'gptel-rewrite)
- (use-region-p))))
- ("I" "Inspect query (Lisp)"
- (lambda ()
- "Inspect the query that will be sent as a lisp object."
- (interactive)
- (gptel--sanitize-model)
- (gptel--inspect-query
- (gptel--suffix-rewrite gptel--rewrite-message t))))
- ("J" "Inspect query (JSON)"
- (lambda ()
- "Inspect the query that will be sent as a JSON object."
- (interactive)
- (gptel--sanitize-model)
- (gptel--inspect-query
- (gptel--suffix-rewrite gptel--rewrite-message t)
- 'json)))]]
- (interactive)
- (gptel--rewrite-sanitize-overlays)
- (cond
- ((use-region-p) ;Start a/another rewrite
- (let ((transient--history ;No transient reader, so We manage history ourselves
- (alist-get 'gptel--infix-rewrite-extra transient-history)))
- (gptel--rewrite-read-message
- (concat "Instructions (" gptel--read-with-prefix-help
- (format " %s%s) "
- (propertize "M-RET" 'face 'help-key-binding)
- (propertize ": More options" 'face 'default)))
- nil (cons 'transient--history 1))))
- (gptel--rewrite-overlays ;Rewrite actions pending, show options
- (transient-setup 'gptel-rewrite))
- (t (user-error
- "`gptel-rewrite' requires an active region or rewrite in progress."))))
-
-;; * Transient infixes for rewriting
-
-(transient-define-infix gptel--infix-rewrite-extra ()
- "Chat directive (system message) to use for rewriting or refactoring."
- :description "Rewrite instruction"
- :class 'gptel-lisp-variable
- :variable 'gptel--rewrite-message
- :set-value #'gptel--set-with-scope
- :display-nil "(None)"
- :key "d"
- :format " %k %d %v"
- :prompt (concat "Instructions (" gptel--read-with-prefix-help ") ")
- :reader #'gptel--rewrite-read-message)
-
-(transient-define-argument gptel--infix-rewrite-diff:-U ()
- :description "Context lines"
- :class 'transient-option
- :argument "-U"
- :reader #'transient-read-number-N0)
-
-;; * Transient suffixes for rewriting
-
-(transient-define-suffix gptel--suffix-rewrite-directive (&optional cancel)
- "Edit Rewrite directive.
-
-CANCEL is used to avoid touching dynamic rewrite directives,
-generated from functions."
- :transient 'transient--do-exit
- :description "Edit full rewrite directive"
- :key "s"
- (interactive
- (list (and
- (functionp gptel--rewrite-directive)
- (not (y-or-n-p
- "Rewrite directive is dynamically generated: Edit its current value instead?")))))
- (if cancel (progn (message "Edit canceled")
- (call-interactively #'gptel-rewrite))
- (gptel--edit-directive 'gptel--rewrite-directive
- :callback (lambda (_) (call-interactively #'gptel-rewrite))
- :setup #'activate-mark)))
-
-(transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message dry-run)
- "Rewrite or refactor region contents."
- :key "r"
- :description (lambda () (if (get-char-property (point) 'gptel-rewrite) "Iterate" "Rewrite"))
- (interactive (list gptel--rewrite-message))
- (let* ((nosystem (gptel--model-capable-p 'nosystem))
- ;; Try to send context with system message
- (gptel-use-context
- (and gptel-use-context (if nosystem 'user 'system)))
- (prompt (list (or (get-char-property (point) 'gptel-rewrite)
- (buffer-substring-no-properties (region-beginning) (region-end)))
- "What is the required change? I will generate only the final replacement."
- (or rewrite-message gptel--rewrite-message))))
- (when nosystem
- (setcar prompt (concat (car-safe (gptel--parse-directive
- gptel--rewrite-directive 'raw))
- "\n\n" (car prompt))))
- (prog1 (gptel-request prompt
- :dry-run dry-run
- :system gptel--rewrite-directive
- :stream gptel-stream
- :context
- (let ((ov (or (cdr-safe (get-char-property-and-overlay (point) 'gptel-rewrite))
- (make-overlay (region-beginning) (region-end) nil t))))
- (overlay-put ov 'category 'gptel)
- (overlay-put ov 'evaporate t)
- ;; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 (#724)
- (cons ov (gptel--temp-buffer " *gptel-rewrite*")))
- :transforms gptel-prompt-transform-functions
- :fsm (gptel-make-fsm :handlers gptel--rewrite-handlers)
- :callback #'gptel--rewrite-callback)
- ;; Move back so that the cursor is on the overlay when done.
- (unless (get-char-property (point) 'gptel-rewrite)
- (when (= (point) (region-end)) (backward-char 1)))
- (deactivate-mark))))
-
-;; Allow this to be called non-interactively for dry runs
-(put 'gptel--suffix-rewrite 'interactive-only nil)
-
-(transient-define-suffix gptel--suffix-rewrite-diff (&optional switches)
- "Diff LLM output against buffer."
- :if (lambda () gptel--rewrite-overlays)
- :key "D"
- :description "Diff LLM rewrites"
- (interactive (list (transient-args transient-current-command)))
- (gptel--rewrite-diff gptel--rewrite-overlays switches))
-
-(transient-define-suffix gptel--suffix-rewrite-ediff ()
- "Ediff LLM output against buffer."
- :if (lambda () gptel--rewrite-overlays)
- :key "E"
- :description "Ediff LLM rewrites"
- (interactive)
- (gptel--rewrite-ediff gptel--rewrite-overlays))
-
-(transient-define-suffix gptel--suffix-rewrite-merge ()
- "Insert LLM output as merge conflicts"
- :if (lambda () gptel--rewrite-overlays)
- :key "M"
- :description "Merge with conflicts"
- (interactive)
- (gptel--rewrite-merge gptel--rewrite-overlays))
-
-(transient-define-suffix gptel--suffix-rewrite-accept ()
- "Accept pending LLM rewrites."
- :if (lambda () gptel--rewrite-overlays)
- :key "A"
- :description "Accept and replace"
- (interactive)
- (gptel--rewrite-accept gptel--rewrite-overlays))
-
-(transient-define-suffix gptel--suffix-rewrite-reject ()
- "Clear pending LLM rewrites."
- :if (lambda () gptel--rewrite-overlays)
- :key "K"
- :description "Clear pending rewrites"
- (interactive)
- (gptel--rewrite-reject gptel--rewrite-overlays))
-
-(provide 'gptel-rewrite)
-;;; gptel-rewrite.el ends here
-
-;; Local Variables:
-;; outline-regexp: "^;; \\*+"
-;; End:
+++ /dev/null
-;;; gptel-transient.el --- Transient menu for gptel -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
-;; Keywords: convenience
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-(require 'cl-lib)
-(require 'gptel)
-(require 'transient)
-
-(declare-function ediff-regions-internal "ediff")
-(declare-function ediff-make-cloned-buffer "ediff-utils")
-(declare-function org-escape-code-in-string "org-src")
-
-\f
-;; * Helper functions and vars
-
-(defvar-local gptel--rewrite-overlays nil
- "List of active rewrite overlays in the buffer.")
-
-(defun gptel--rewrite-sanitize-overlays ()
- "Ensure gptel's rewrite overlays in buffer are consistent."
- (setq gptel--rewrite-overlays
- (cl-delete-if-not #'overlay-buffer
- gptel--rewrite-overlays)))
-
-(defvar gptel--set-buffer-locally nil
- "Set model parameters from `gptel-menu' buffer-locally.
-
-Affects the system message too.")
-
-(defun gptel--set-with-scope (sym value &optional scope)
- "Set SYM's symbol value to VALUE with SCOPE.
-
-If SCOPE is t, set it buffer-locally.
-If SCOPE is 1, reset it after the next gptel request. (oneshot)
-Otherwise, clear any buffer-local value and set its default
-global value."
- (pcase scope
- (1 (put sym 'gptel-history (symbol-value sym))
- (set sym value)
- (letrec ((restore-value
- (lambda ()
- (remove-hook 'gptel-post-request-hook restore-value)
- (run-at-time ; Required to work around let bindings
- 0 nil (lambda (s) ; otherwise this change is overwritten!
- (set s (get s 'gptel-history))
- (put s 'gptel-history nil))
- sym))))
- (add-hook 'gptel-post-request-hook restore-value)))
- ('t (set (make-local-variable sym) value))
- (_ (kill-local-variable sym)
- (set sym value))))
-
-(defvar gptel--preset nil
- "Name of last applied gptel preset.
-
-For internal use only.")
-
-(defun gptel--preset-mismatch-p (name)
- "Check if gptel preset with NAME is in effect."
- (let ((elm (or (gptel-get-preset name)
- (gptel-get-preset (intern-soft name))))
- key val)
- (catch 'mismatch
- (while elm
- (setq key (pop elm) val (pop elm))
- (cond
- ((memq key '(:description :parents)) 'nil)
- ((eq key :system)
- (or (equal gptel--system-message val)
- (functionp val) ; Ignore functions, modify-specs for speed here
- (and (consp val) (keywordp (car val)))
- (and-let* (((symbolp val))
- (p (assq val gptel-directives)))
- (equal gptel--system-message (cdr p)))
- (throw 'mismatch t)))
- ((eq key :backend)
- (or (if (stringp val)
- (equal (gptel-backend-name gptel-backend) val)
- (eq gptel-backend val))
- (throw 'mismatch t)))
- ((eq key :tools)
- (setq val (cl-loop ; Check against tool names, not tools (faster with sorting)
- for tool in (ensure-list (gptel--modify-value gptel-tools val))
- for tool-name = (or (and (stringp tool) tool)
- (ignore-errors (gptel-tool-name tool)))
- if (not (member tool-name uniq-tool-names))
- collect tool-name into uniq-tool-names
- finally return uniq-tool-names))
- (or (equal (sort val #'string-lessp) ;preset tools same as gptel-tools?
- (sort (mapcar #'gptel-tool-name gptel-tools)
- #'string-lessp))
- (throw 'mismatch t)))
- (t (let* ((suffix (substring
- (if (symbolp key) (symbol-name key) key) 1))
- (sym (or (intern-soft (concat "gptel-" suffix))
- (intern-soft (concat "gptel--" suffix)))))
- ;; FIXME(modify-list): Fix for values specified with a spec, like :eval
- (or (null sym)
- (and (boundp sym) (equal (eval sym) val))
- (throw 'mismatch t)))))))))
-
-(defun gptel--get-directive (args)
- "Find the additional directive in the transient ARGS.
-
-Meant to be called when `gptel-menu' is active."
- (cl-some (lambda (s) (and (stringp s) (string-prefix-p ":" s)
- (substring s 1)))
- args))
-
-(defun gptel--instructions-make-overlay (text &optional ov)
- "Make or move overlay OV with TEXT."
- (save-excursion
- ;; Move point to overlay position
- (cond
- ((use-region-p)
- (if (pos-visible-in-window-p (region-beginning))
- (goto-char (region-beginning))))
- ((gptel--in-response-p)
- (gptel-beginning-of-response)
- (skip-chars-forward "\n \t"))
- (t (text-property-search-backward 'gptel 'response)
- (skip-chars-forward "\n \t")))
- ;; Make overlay
- (if (and ov (overlayp ov))
- (move-overlay ov (point) (point) (current-buffer))
- (setq ov (make-overlay (point) (point) nil t)))
- (overlay-put ov 'before-string nil)
- ;; (unless (or (bobp) (eq (char-before) "\n"))
- ;; (overlay-put ov 'before-string (propertize "\n" 'font-lock-face 'shadow)))
- (overlay-put ov 'category 'gptel)
- (overlay-put
- ov 'after-string
- (concat (propertize (concat "DIRECTIVE: " text)
- 'font-lock-face '(:inherit shadow :weight bold :box t))
- "\n"))
- ov))
-
-(defconst gptel--read-with-prefix-help
- (concat
- (propertize "TAB" 'face 'help-key-binding)
- (propertize ": expand, " 'face 'default)
- (propertize "M-n" 'face 'help-key-binding)
- (propertize "/" 'face 'default)
- (propertize "M-p" 'face 'help-key-binding)
- (propertize ": next/previous" 'face 'default))
- "Help string (TODO).")
-
-(defun gptel--read-with-prefix (prefix)
- "Show string PREFIX in the minibuffer after the minibuffer prompt.
-
-PREFIX is shown in an overlay. Repeated calls to this function
-will toggle its visibility state."
- (unless (minibufferp)
- (user-error "This command is intended to be used in the minibuffer"))
- (let* ((update
- (lambda (ov s)
- (overlay-put
- ov 'after-string
- (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow)
- (make-separator-line))))))
- (max-width (- (window-width) (minibuffer-prompt-end)))
- (max (or max-mini-window-height 0.4))
- (max-height (- (or (and (natnump max) max)
- (floor (* max (frame-height))))
- 5)))
- (if (and prefix (not (string-empty-p prefix)) (> max-height 1))
- (progn
- (unless visual-line-mode (visual-line-mode 1))
- (goto-char (minibuffer-prompt-end))
- (pcase-let ((`(,prop . ,ov)
- (get-char-property-and-overlay
- (point-min) 'gptel)))
- (unless ov
- (setq ov (make-overlay
- (point-min) (minibuffer-prompt-end) nil t)))
- (pcase prop
- ('partial
- (if (> (length prefix) max-width)
- (progn
- (overlay-put ov 'gptel 'prefix)
- (let ((disp-size
- (cl-loop for char across prefix
- for idx upfrom 0
- with n = 0 with max-length = (* max-height max-width)
- if (eq char ?\n) do (cl-incf n)
- if (> n max-height) return idx
- if (> idx max-length)
- return idx
- finally return nil)))
- (funcall update ov
- (if disp-size
- (truncate-string-to-width
- prefix disp-size nil nil 'ellipsis)
- prefix))))
- (overlay-put ov 'gptel 'hide)
- (funcall update ov nil)))
- ('prefix (overlay-put ov 'gptel 'hide)
- (funcall update ov nil))
- (_ (overlay-put ov 'gptel 'partial)
- (funcall update ov (truncate-string-to-width
- prefix max-width nil nil
- 'ellipsis))))))
- (when-let* ((prop-ov (get-char-property-and-overlay (point-min) 'gptel)))
- (when (overlayp (cdr prop-ov)) (delete-overlay (cdr prop-ov)))))))
-
-(defvar gptel--minibuffer-prompt-history nil
- "History of prompts read from the minibuffer by gptel.")
-
-(defun gptel--read-minibuffer-prompt (&optional read-prompt)
- "Read a user prompt from the minibuffer.
-
-Prompt with READ-PROMPT if supplied. Return a cons cell of the buffer
-region (if included) and the provided instructions."
- (let* ((include-region (use-region-p))
- (cb (current-buffer))
- (get-region (lambda () (with-current-buffer cb
- (and include-region
- (buffer-substring-no-properties
- (region-beginning) (region-end))))))
- (cycle-prefix (lambda () (interactive)
- (let ((p (point)))
- (gptel--read-with-prefix (funcall get-region))
- (goto-char p))))
- (toggle-region (lambda () (interactive)
- (if include-region
- (progn (setq include-region nil)
- (gptel--read-with-prefix nil))
- (setq include-region t)
- (funcall cycle-prefix))))
- (edit-in-buffer
- (lambda () (interactive)
- (gptel--edit-directive nil
- :initial (minibuffer-contents)
- :prompt (if include-region
- (with-current-buffer cb (buffer-substring-no-properties
- (region-beginning) (region-end)))
- "# Edit prompt below")
- :setup (lambda () (goto-char (point-max)) (run-at-time 0 nil #'recenter))
- :callback (lambda (msg)
- (if (not msg)
- (minibuffer-quit-recursive-edit)
- (delete-region (minibuffer-prompt-end) (point-max))
- (insert msg) (exit-minibuffer))))))
- (minibuffer-local-map
- (make-composed-keymap (define-keymap
- "M-RET" toggle-region "C-c C-e" edit-in-buffer)
- minibuffer-local-map)))
- (let ((user-prompt
- (minibuffer-with-setup-hook
- (lambda () (add-hook 'completion-at-point-functions
- #'gptel-preset-capf nil t)
- (funcall cycle-prefix)
- ;; HACK for lucid Emacs, where `make-separator-line' is wonky. The
- ;; minibuffer prompt gets cut off -- force redisplay to fix:
- (insert " ") (redisplay) (delete-char -1))
- (read-string
- (or read-prompt
- (concat (format "Ask %s" (gptel-backend-name gptel-backend))
- (if (use-region-p) ;NOTE: not "include-region" as this is only read once
- (concat " (" (propertize "M-RET" 'face 'help-key-binding)
- (propertize ": Include/Ignore selection" 'face 'default)
- "): ")
- ": ")))
- nil 'gptel--minibuffer-prompt-history))))
- (cons (funcall get-region) user-prompt))))
-
-(defun gptel--transient-read-number (prompt _initial-input history)
- "Read a numeric value from the minibuffer.
-
-PROMPT, _INITIAL-INPUT and HISTORY are as in the transient reader
-documention. Return nil if user does not provide a number, for default."
- ;; Workaround for buggy transient behaviour when dealing with
- ;; non-string values. See: https://github.com/magit/transient/issues/172
- (when-let* ((val (symbol-value history)))
- (when (not (stringp (car val)))
- (setcar val (number-to-string (car val)))))
- (let* ((minibuffer-default-prompt-format "")
- (num (read-number prompt -1 history)))
- (if (= num -1) nil num)))
-
-(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 "
- 'face 'transient-heading)
- (propertize (gptel--model-name gptel-model)
- 'face 'warning)
- (propertize "]" 'face 'transient-heading))
- (if message
- (gptel--describe-directive
- message (max (- (window-width) 12) 14) "⮐ ")
- "[No system message set]")))
-
-(defun gptel--tools-init-value (obj)
- "Set the initial state of a tool OBJ in variable `gptel-tools'.
-
-OBJ is a tool-infix of type `gptel--switch'."
- (when-let* ((name (car (member (oref obj argument)
- (mapcar #'cadr
- (plist-get (transient-scope) :tools))))))
- (oset obj value (list (oref obj category) name))))
-
-(defvar gptel--crowdsourced-prompts-url
- "https://raw.githubusercontent.com/f/awesome-chatgpt-prompts/main/prompts.csv"
- "URL for crowdsourced LLM system prompts.")
-
-(defvar gptel--crowdsourced-prompts
- (make-hash-table :test #'equal)
- "Crowdsourced LLM system prompts.")
-
-(defun gptel--read-csv-column ()
- "Read next CSV column in the current buffer.
-
-Supports both quoted and non-quoted columns (RFC 4180)."
- (let ((start (point)))
- (unless (eolp)
- (let ((column
- (if (eq (char-after) ?\")
- (when (re-search-forward "\",\\|\"$" nil t)
- (let ((end (match-beginning 0)))
- (buffer-substring-no-properties (+ start 1) (if (eolp) (- end 1) end))))
- (when (search-forward "," (line-end-position) t)
- (let ((end (match-beginning 0)))
- (buffer-substring-no-properties start end))))))
- (string-replace "\"\"" "\"" column)))))
-
-(defun gptel--crowdsourced-prompts ()
- "Acquire and read crowdsourced LLM system prompts.
-
-These are stored in the variable `gptel--crowdsourced-prompts',
-which see."
- (when (hash-table-p gptel--crowdsourced-prompts)
- (when (hash-table-empty-p gptel--crowdsourced-prompts)
- (unless gptel-crowdsourced-prompts-file
- (run-at-time 0 nil #'gptel-system-prompt)
- (user-error "No crowdsourced prompts available"))
- (unless (and (file-exists-p gptel-crowdsourced-prompts-file)
- (time-less-p
- (time-subtract (current-time) (days-to-time 14))
- (file-attribute-modification-time
- (file-attributes gptel-crowdsourced-prompts-file))))
- (when (y-or-n-p
- (concat
- "Fetch crowdsourced system prompts from "
- (propertize "https://github.com/f/awesome-chatgpt-prompts" 'face 'link)
- "?"))
- ;; Fetch file
- (message "Fetching prompts...")
- (let ((dir (file-name-directory gptel-crowdsourced-prompts-file)))
- (unless (file-exists-p dir) (mkdir dir 'create-parents))
- (if (url-copy-file gptel--crowdsourced-prompts-url
- gptel-crowdsourced-prompts-file
- 'ok-if-already-exists)
- (message "Fetching prompts... done.")
- (message "Could not retrieve new prompts.")))))
- (if (not (file-readable-p gptel-crowdsourced-prompts-file))
- (progn (message "No crowdsourced prompts available")
- (call-interactively #'gptel-system-prompt))
- (with-temp-buffer
- (insert-file-contents gptel-crowdsourced-prompts-file)
- (goto-char (point-min))
- (forward-line 1)
- (while (not (eobp))
- (when-let* ((act (gptel--read-csv-column))
- (prompt (gptel--read-csv-column)))
- (puthash act prompt gptel--crowdsourced-prompts))
- (forward-line 1)))))
- gptel--crowdsourced-prompts))
-
-;; FIXME(targeted-context): This does not handle :bounds and :lines.
-(defun gptel--describe-infix-context ()
- "Return a count of the number of context chunks."
- (if (null gptel-context) "Context"
- (pcase-let*
- ((buffer-count (length gptel-context))
- (`(,file-count ,ov-count)
- (if (> buffer-count 0)
- (cl-loop for entry in gptel-context
- for (buf-file . spec) = (ensure-list entry)
- if (bufferp buf-file)
- sum (max (length (plist-get spec :overlays)) 1)
- into ov-count
- else count (stringp buf-file) into file-count
- finally return (list file-count ov-count))
- (list 0 0))))
- (concat "Context ("
- (propertize
- (concat
- (and (> ov-count 0)
- (format "%d region%s in %d buffer%s"
- ov-count (if (> ov-count 1) "s" "")
- (- buffer-count file-count)
- (if (> ( - buffer-count file-count) 1) "s" "")))
- (and (> file-count 0)
- (format "%s%d file%s"
- (if (> ov-count 0) ", " "") file-count
- (if (> file-count 1) "s" ""))))
- 'face 'warning)
- ")"))))
-
-(defun gptel--describe-suffix-send ()
- "Describe the action of `gptel--suffix-send'."
- (cl-flet ((ptv (s) (propertize s 'face 'warning))
- (pth (s) (propertize s 'face 'transient-heading)))
- (let* ((args (or (and transient-current-command
- (transient-args transient-current-command))
- ;; Not yet exported, simulate. HACK: We are accessing
- ;; Transient's internal variables here for live updates.
- (let* ((transient-current-command (oref transient--prefix command))
- (transient-current-suffixes transient--suffixes))
- (transient-args transient-current-command))))
- (lbeg (line-number-at-pos (if (use-region-p) (region-beginning)
- (point-min))))
- (lend (line-number-at-pos (if (use-region-p) (region-end)
- (point))))
- (ltext (ptv (if (> lend lbeg)
- (format " (lines %d-%d)" lbeg lend)
- (format " (line %d)" lbeg))))
- (dest) (context))
- (setq dest (cond
- ((member "e" args) (ptv "echo area"))
- ((member "k" args) (ptv "kill-ring"))
- ((cl-some (lambda (s)
- (and (stringp s) (memq (aref s 0) '(?g ?b))
- (not (equal (substring s 1) (buffer-name)))
- (concat (pth "buffer ") (ptv (substring s 1)))))
- args))))
- (setq context
- (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)
- (concat (pth "Read prompt from ") (ptv "minibuffer")
- context
- (if dest (concat (pth ", response to ") dest)
- (concat (pth ", insert response at point")))))
- ((member "y" args)
- (concat (pth "Send prompt from ")
- (concat (ptv "kill-ring (")
- (if-let* ((val (current-kill 0))
- (val (substring-no-properties val))
- (len (length val)))
- (ptv (concat
- "\"" (string-replace
- "\n" "⮐"
- (truncate-string-to-width
- val 20 nil nil t))
- "\"" (when (> len 20)
- (concat
- ", "
- (file-size-human-readable len 'si " ")
- " chars"))))
- (propertize "empty" 'face 'error))
- (ptv ")"))
- context
- (if dest (concat (pth ", response to ") dest)
- (concat (pth ", insert response at point")))))
- ((member "i" args)
- (let* ((reg (use-region-p))
- (src (ptv (if reg "selection" (buffer-name)))))
- (if dest (concat (pth "Send ") src ltext context (pth ", with response to ")
- (ptv dest) (pth "; kill") ltext
- (and (not reg) (concat (pth " in ") src)))
- (concat (pth "Replace ") src ltext (pth " with response")
- (and context
- (concat (pth " ( with") (substring context 11) " )"))))))
- ((use-region-p)
- (concat (pth "Send ") (ptv "selection") ltext
- context (if dest (concat (pth ", with response to ") dest)
- (concat (pth ", insert response at region end")))))
- (t (concat (pth "Send ") (ptv (buffer-name)) ltext
- context (if dest (concat (pth ", with response to ") dest)
- (concat (pth ", insert response at point")))))))))
-
-(defun gptel--format-preset-string ()
- "Format the preset indicator display for `gptel-menu'."
- (if (and gptel--known-presets gptel--preset)
- (apply
- #'format " (%s%s)"
- (let ((mismatch (gptel--preset-mismatch-p gptel--preset)))
- (list (propertize "@" 'face (if mismatch 'transient-key
- '( :inherit transient-key
- :inherit secondary-selection
- :box -1 :weight bold)))
- (propertize (format "%s" gptel--preset) 'face
- (if mismatch
- '(:inherit warning :strike-through t)
- '(:inherit secondary-selection :box -1))))))
- (format " (%s%s)"
- (propertize "@" 'face 'transient-key)
- (propertize "preset" 'face 'transient-inactive-value))))
-
-;; TODO(preset): Unify this with `gptel--apply-preset'?
-(defun gptel--read-apply-preset (name)
- "Read gptel preset NAME and apply it."
- (interactive
- (list
- (let ((completion-extra-properties
- `(:annotation-function
- ,(lambda (comp)
- (and-let* ((desc
- (plist-get (gptel-get-preset (intern-soft comp))
- :description)))
- (concat (propertize " " 'display '(space :align-to 32))
- (if (string-match "\\(\n\\)" desc)
- (substring desc 0 (match-beginning 1))
- desc)))))))
- (intern
- (completing-read (format "Apply preset (%s): "
- (pcase gptel--set-buffer-locally
- (1 "for next request only")
- ('t "buffer-locally")
- (_ "globally")))
- gptel--known-presets nil t)))))
- (gptel--set-with-scope 'gptel--preset name gptel--set-buffer-locally)
- (gptel--apply-preset
- name (lambda (sym val)
- (gptel--set-with-scope sym val gptel--set-buffer-locally)))
- (message "Applied gptel preset %s"
- (propertize (symbol-name name) 'face 'transient-value))
- (when transient--stack (run-at-time 0 nil #'transient-setup)))
-
-\f
-;; * Transient classes and methods for gptel
-
-;; ** Class for generic gptel elisp variables
-
-(defclass gptel-lisp-variable (transient-lisp-variable)
- ((display-nil :initarg :display-nil) ;String to display if value if nil
- (display-map :initarg :display-map :initform nil)) ;Display string from alist display-map
- "Lisp variables that show :display-nil instead of nil.")
-
-(cl-defmethod transient-format-value ((obj gptel-lisp-variable))
- (let ((display-value
- (with-slots (value display-nil display-map) obj
- (cond ((null value) display-nil)
- (display-map (or (cdr (assoc value display-map)) value))
- (t value)))))
- (propertize
- (if (stringp display-value) display-value (prin1-to-string display-value))
- 'face 'transient-value)))
-
-(cl-defmethod transient-infix-set ((obj gptel-lisp-variable) value)
- (funcall (oref obj set-value)
- (oref obj variable)
- (oset obj value value)
- gptel--set-buffer-locally))
-
-;; ** Class for managing gptel tools
-
-(defclass gptel--switch (transient-switch)
- ((category :initarg :category))
- "Class used for arguments that share a category.")
-
-(cl-defmethod transient-infix-set ((obj gptel--switch) value)
- "Set VALUE of a `gptel--switch' OBJ.
-
-It is a list of the category and argument, e.g.
- (\"filesystem\" \"read_file\")."
- (let ((state (transient-scope))
- (category (oref obj category)))
- (if value
- (progn
- (cl-pushnew (list category value)
- (plist-get state :tools) :test #'equal)
- (oset obj value (list category value)))
- (plist-put state :tools
- (delete (list category (oref obj argument))
- (plist-get state :tools)))
- (oset obj value nil))
- (oset transient--prefix scope state)))
-
-;; ** Class for managing gptel tool categories
-
-(defclass gptel--switch-category (transient-switch)
- ((category :initarg :category))
- "Class used for arguments that switch a group of other arguments.
-
-Their own value is ignored")
-
-(cl-defmethod transient-format-value ((obj gptel--switch-category))
- (let* ((category (oref obj category))
- (active-count
- (cl-count-if (lambda (tl) (equal (car tl) category))
- (plist-get (transient-scope) :tools)))
- (total-count (length (cdr (assoc category gptel--known-tools)))))
- (if (> active-count 0)
- (propertize (format "(%d/%d)" active-count total-count) 'face 'transient-value)
- (propertize (format "(0/%d)" total-count) 'face 'transient-inactive-value))))
-
-;; Pressing a tool category key should have different behaviors in different
-;; contexts:
-;; - If the tools for the category are not shown, show them, do nothing else
-;; - If the tools are showing and any of them are selected, deselect all
-;; - If the tools are showing and none of them are selected, select all
-
-;; To do this we independently track whether the category tools are visible
-;; ("active"), and whether any category tools have been "selected":
-(cl-defmethod transient-infix-read ((obj gptel--switch-category))
- "Determine OBJ value according to category toggle settings."
- (let* ((category (oref obj category))
- (active (equal category (plist-get (transient-scope) :category)))
- (selected (cl-some (lambda (tool-spec) (equal category (car tool-spec)))
- (plist-get (transient-scope) :tools))))
- (if (not active)
- (oref obj value)
- (if selected nil (oref obj argument)))))
-
-(cl-defmethod transient-infix-set ((obj gptel--switch-category) value)
- "When setting VALUE, set all options in the category of OBJ."
- (dolist (suffix-obj transient--suffixes)
- ;; Find all suffixes that have this category
- (when-let* (((cl-typep suffix-obj 'gptel--switch))
- ((equal (oref suffix-obj category)
- (oref obj category)))
- (arg (if (slot-boundp suffix-obj 'argument)
- (oref suffix-obj argument)
- (oref obj argument-format))))
- (if value ; Turn on/off all members in category
- (transient-infix-set suffix-obj arg)
- (transient-infix-set suffix-obj nil))))
- ;; Update the active menu category and key in the prefix scope
- (plist-put (transient-scope) :category (oref obj category))
- (plist-put (transient-scope) :key (oref obj key))
- ;; Finally set the "value" of the category itself
- (oset obj value value))
-
-;; ** Class for gptel options that are three-way switches
-
-(defclass gptel--switches (gptel-lisp-variable)
- ((display-if-true :initarg :display-if-true :initform "True")
- (display-if-false :initarg :display-if-false :initform "False"))
- "Boolean Lisp variable class for gptel-transient.")
-
-(cl-defmethod transient-infix-read ((obj gptel--switches))
- "Cycle through the mutually exclusive switches for OBJ."
- (not (oref obj value)))
-
-(cl-defmethod transient-format-value ((obj gptel--switches))
- (with-slots (value display-if-true display-if-false) obj
- (format
- (propertize "(%s)" 'face 'transient-delimiter)
- (concat
- (propertize display-if-false
- 'face (if value 'transient-inactive-value 'transient-value))
- (propertize "|" 'face 'transient-delimiter)
- (propertize display-if-true
- 'face (if value 'transient-value 'transient-inactive-value))))))
-
-;; ** Class for gptel's scope management, singleton
-
-(defclass gptel--scope (gptel--switches)
- ((display-if-true :initarg :display-if-true :initform "buffer")
- (display-if-false :initarg :display-if-false :initform "global"))
- "Singleton Lisp variable class for `gptel--set-buffer-locally'.
-
-This is used only for setting this variable via `gptel-menu'.")
-
-(cl-defmethod transient-infix-read ((obj gptel--scope))
- "Cycle through the mutually exclusive switches for OBJ."
- (with-slots (value) obj
- (pcase value
- ('t (message "Parameters will be set for the next request only"))
- ('nil (message "Parameters will be set buffer-locally"))
- (1 (message "Parameters will be set globally")))
- (pcase value ('t 1) ('nil t) (1 nil))))
-
-(cl-defmethod transient-format-value ((obj gptel--scope))
- (with-slots (value display-if-true display-if-false) obj
- (format
- (propertize "(%s)" 'face 'transient-delimiter)
- (concat
- (propertize display-if-false
- 'face (if (null value) 'transient-value 'transient-inactive-value))
- (propertize "|" 'face 'transient-delimiter)
- (propertize display-if-true
- 'face (if (eq value t) 'transient-value 'transient-inactive-value))
- (propertize "|" 'face 'transient-delimiter)
- (propertize "oneshot" 'face
- (if (eql value 1) 'transient-value 'transient-inactive-value))))))
-
-(cl-defmethod transient-infix-set ((obj gptel--scope) value)
- (funcall (oref obj set-value)
- (oref obj variable)
- (oset obj value value)))
-
-;; ** Class for managing gptel's backend and model, singleton
-
-(defclass gptel-provider-variable (transient-lisp-variable)
- ((backend :initarg :backend)
- (backend-value :initarg :backend-value)
- (always-read :initform t)
- (set-value :initarg :set-value :initform #'set))
- "Class used for gptel-backends.")
-
-(cl-defmethod transient-format-value ((obj gptel-provider-variable))
- (propertize (concat
- (gptel-backend-name
- (buffer-local-value (oref obj backend) transient--original-buffer)) ":"
- (gptel--model-name (oref obj value)))
- 'face 'transient-value))
-
-(cl-defmethod transient-infix-set ((obj gptel-provider-variable) value)
- (pcase-let ((`(,backend-value ,model-value) value))
- (funcall (oref obj set-value)
- (oref obj variable)
- (oset obj value model-value)
- gptel--set-buffer-locally)
- (funcall (oref obj set-value)
- (oref obj backend)
- (oset obj backend-value backend-value)
- gptel--set-buffer-locally))
- (transient-setup))
-
-;; ** Class for infix options with in-buffer overlay display
-
-(defclass gptel-option-overlaid (transient-option)
- ((display-nil :initarg :display-nil)
- (overlay :initarg :overlay))
- "Transient options for overlays displayed in the working buffer.")
-
-(cl-defmethod transient-format-value ((obj gptel-option-overlaid))
- "Set up the in-buffer overlay for additional directive, a string.
-
-Also format the value of OBJ in the transient menu."
- (let ((value (oref obj value))
- (ov (oref obj overlay))
- (argument (oref obj argument)))
- ;; Making an overlay
- (if (or (not value) (string-empty-p value))
- (when ov (delete-overlay ov))
- (with-current-buffer transient--original-buffer
- (oset obj overlay (gptel--instructions-make-overlay value ov)))
- (letrec ((ov-clear-hook
- (lambda () (when-let* ((ov (oref obj overlay))
- ((overlayp ov)))
- (remove-hook 'transient-exit-hook
- ov-clear-hook)
- (delete-overlay ov)))))
- (add-hook 'transient-exit-hook ov-clear-hook)))
- ;; Updating transient menu display
- (if value
- (propertize (concat argument (truncate-string-to-width value 35 nil nil t))
- 'face 'transient-value)
- (propertize
- (concat "(" (symbol-name (oref obj display-nil)) ")")
- 'face 'transient-inactive-value))))
-
-\f
-;; * Transient Prefixes
-
-;;;###autoload (autoload 'gptel-menu "gptel-transient" nil t)
-(transient-define-prefix gptel-menu ()
- "Change parameters of prompt to send to the LLM."
- :incompatible '(("m" "y" "i") ("e" "g" "b" "k"))
- ;; :value (list (concat "b" (buffer-name)))
- [:description gptel-system-prompt--format
- [""
- :if (lambda () (not (gptel--model-capable-p 'nosystem)))
- "Instructions"
- ("s" "Set system message" gptel-system-prompt :transient t)
- (gptel--infix-add-directive)]
- [:pad-keys t ""
- (:info #'gptel--describe-infix-context
- :face transient-heading :format "%d")
- (gptel--infix-context-add-current-kill)
- (gptel--infix-context-add-region)
- (gptel--infix-context-add-buffer)
- (gptel--infix-context-add-file)
- (gptel--infix-context-remove-all)
- (gptel--suffix-context-buffer)]
- [:pad-keys t
- :if (lambda () (and gptel-use-tools
- (or gptel--known-tools (featurep 'gptel-integrations))))
- "" (:info
- (lambda ()
- (concat
- "Tools" (and gptel-tools
- (concat " (" (propertize (format "%d selected"
- (length gptel-tools))
- 'face 'warning)
- ")"))))
- :format "%d" :face transient-heading)
- ("t" "Select tools" gptel-tools :transient t)
- ("T" "Continue tool calls"
- (lambda () (interactive) (gptel--handle-tool-use gptel--fsm-last))
- :if (lambda () (and gptel--fsm-last
- (eq (gptel-fsm-state gptel--fsm-last) 'TOOL))))]]
- [[(gptel--preset
- :key "@" :format "%d"
- :description
- (lambda ()
- (concat (propertize "Request Parameters" 'face 'transient-heading)
- (gptel--format-preset-string))))
- (gptel--infix-variable-scope)
- (gptel--infix-provider)
- (gptel--infix-max-tokens)
- (gptel--infix-num-messages-to-send
- :if (lambda () (and gptel-expert-commands
- (or gptel-mode gptel-track-response))))
- (gptel--infix-temperature :if (lambda () gptel-expert-commands))
- (gptel--infix-use-context)
- (gptel--infix-include-reasoning)
- (gptel--infix-use-tools)
- (gptel--infix-track-response
- :if (lambda () (and gptel-expert-commands (not gptel-mode))))
- (gptel--infix-track-media :if (lambda () gptel-mode))]
- [" <Prompt from"
- ("m" "Minibuffer instead" "m")
- ("y" "Kill-ring instead" "y")
- ""
- ("i" "Respond in place" "i")]
- [" >Response to"
- ("e" "Echo area" "e")
- ("b" "Other buffer" "b"
- :class transient-option
- :prompt "Output to buffer: "
- :reader (lambda (prompt _ _history)
- (read-buffer prompt (buffer-name (other-buffer)) nil)))
- ("g" "gptel session" "g"
- :class transient-option
- :prompt "Existing or new gptel session: "
- :reader
- (lambda (prompt _ _history)
- (read-buffer
- prompt (generate-new-buffer-name
- (concat "*" (gptel-backend-name gptel-backend) "*"))
- nil (lambda (buf-name)
- (if (consp buf-name) (setq buf-name (car buf-name)))
- (let ((buf (get-buffer buf-name)))
- (and (buffer-local-value 'gptel-mode buf)
- (not (eq (current-buffer) buf))))))))
- ("k" "Kill-ring" "k")]]
- [[:description (lambda () (concat (and gptel--rewrite-overlays "Continue ")
- "Rewrite"))
- :if (lambda () (or (use-region-p)
- (and gptel--rewrite-overlays
- (gptel--rewrite-sanitize-overlays))))
- ("r"
- (lambda () (if (get-char-property (point) 'gptel-rewrite)
- "Iterate" "Rewrite"))
- gptel-rewrite)]
- ["Tweak Response" :if gptel--in-response-p :pad-keys t
- ("SPC" "Mark" gptel--mark-response)
- ("M-RET" "Regenerate" gptel--regenerate :if gptel--in-response-p)
- ("P" "Previous variant" gptel--previous-variant
- :if gptel--at-response-history-p
- :transient t)
- ("N" "Next variant" gptel--previous-variant
- :if gptel--at-response-history-p
- :transient t)
- ("E" "Ediff previous" gptel--ediff
- :if gptel--at-response-history-p)]
- ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands))
- ("I" "Inspect query (Lisp)"
- (lambda ()
- "Inspect the query that will be sent as a lisp object."
- (interactive)
- (gptel--sanitize-model)
- (gptel--inspect-query
- (gptel--suffix-send
- (cons "I" (transient-args transient-current-command))))))
- ("J" "Inspect query (JSON)"
- (lambda ()
- "Inspect the query that will be sent as a JSON object."
- (interactive)
- (gptel--sanitize-model)
- (gptel--inspect-query
- (gptel--suffix-send
- (cons "I" (transient-args transient-current-command)))
- 'json)))]
- ["Logging"
- :if (lambda () (or gptel-log-level gptel-expert-commands))
- ("-l" "Log level" "-l"
- :class gptel-lisp-variable
- :variable gptel-log-level
- :set-value gptel--set-with-scope
- :display-nil "Off"
- :prompt "Log level: "
- :reader
- (lambda (prompt _ _)
- "Manage gptel's logging."
- (let ((state (completing-read
- prompt '("off" "info" "debug") nil t)))
- (message "Log level set to %s" state)
- (if (string= state "off") nil (intern state)))))
- ("L" "Inspect Log"
- (lambda () (interactive)
- (pop-to-buffer (get-buffer-create gptel--log-buffer-name)))
- :format " %k %d")]]
- [(gptel--suffix-send)]
- (interactive)
- (gptel--sanitize-model)
- (when gptel-context ;MAYBE: Move this to a dedicated sanitize function?
- (setq gptel-context
- (cl-delete-if
- (lambda (entry)
- (let ((first (or (car-safe entry) entry)))
- (and (bufferp first) (not (buffer-live-p first)))))
- gptel-context)))
- (transient-setup 'gptel-menu))
-
-;; ** Prefix for setting the system prompt.
-
-(defun gptel--setup-directive-menu (sym msg &optional external)
- "Return a list of infix definitions for setting gptel directives.
-
-SYM is the symbol whose value is set to the selected directive..
-MSG is the meaning of symbol, used when messaging.
-If EXTERNAL is non-nil, include external sources of directives."
- (cl-loop for (type . prompt) in gptel-directives
- ;; Avoid clashes with the custom directive key
- with unused-keys = (delete ?s (nconc (number-sequence ?a ?z)
- (number-sequence ?0 ?9)))
- with width = (window-width)
- for name = (symbol-name type)
- for key = (seq-find (lambda (k) (member k unused-keys)) name (seq-first unused-keys))
- do (setq unused-keys (delete key unused-keys))
- ;; The explicit declaration ":transient transient--do-return" here
- ;; appears to be required for Transient v0.5 and up. Without it, these
- ;; 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 "(" (gptel--describe-directive prompt (- width 30)) ")")
- 'face 'shadow))
- `(lambda () (interactive)
- (message "%s: %s" ,msg ,(gptel--describe-directive prompt 100 "⮐ "))
- (gptel--set-with-scope ',sym ',prompt gptel--set-buffer-locally))
- :transient 'transient--do-return)
- into prompt-suffixes
- finally return
- (nconc
- prompt-suffixes
- (list (list "DEL" "None"
- `(lambda () (interactive)
- (message "%s unset" ,msg)
- (gptel--set-with-scope ',sym nil gptel--set-buffer-locally))
- :transient 'transient--do-return))
- (and external
- (list (list "SPC" "Pick crowdsourced prompt"
- 'gptel--read-crowdsourced-prompt
- ;; NOTE: Quitting the completing read when picking a
- ;; crowdsourced prompt will cause the transient to exit
- ;; instead of returning to the system prompt menu.
- :transient 'transient--do-exit))))))
-
-;;;###autoload (autoload 'gptel-system-prompt "gptel-transient" nil t)
-(transient-define-prefix gptel-system-prompt ()
- "Set the LLM system message for LLM interactions.
-
-The \"system message\" establishes directives for the chat
-session and modifies the behavior of the LLM. Some examples of
-system prompts are:
-
-You are a helpful assistant. Answer as concisely as possible.
-Reply only with shell commands and no prose.
-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-system-prompt--format
- [(gptel--suffix-system-message)]
- [(gptel--infix-variable-scope)]]
- [:class transient-column
- :setup-children
- (lambda (_) (transient-parse-suffixes
- 'gptel-system-prompt
- (gptel--setup-directive-menu
- 'gptel--system-message "Directive" t)))
- :pad-keys t])
-
-;; ** Prefix for saving and applying presets
-
-(transient-define-prefix gptel--preset ()
- "Apply a gptel preset, or save the current configuration as a preset.
-
-A \"preset\" is a collection of gptel settings, such as the model,
-backend, system message and enabled tools, that are applied and used
-together. See `gptel-make-preset' for details."
- :transient-suffix #'transient--do-return
- [:description "Save or apply a preset collection of gptel options"
- [:pad-keys t
- ("@" "Select via completing-read" gptel--read-apply-preset)
- ("C-s" "Save current settings as new preset" gptel--save-preset)]]
- [:if (lambda () gptel--known-presets)
- :class transient-column
- :setup-children
- (lambda (_)
- (transient-parse-suffixes
- 'gptel--preset
- (cl-loop
- for (name-sym . preset) in gptel--known-presets
- for name = (format "%s" name-sym)
- with unused-keys = (nconc (number-sequence ?a ?z)
- (number-sequence ?0 ?9))
- for description = (plist-get preset :description)
- for key = (seq-find (lambda (k) (member k unused-keys))
- name (seq-first unused-keys))
- do (setq unused-keys (delq key unused-keys))
- collect
- (list
- (key-description (list key))
- (concat name
- (propertize " " 'display '(space :align-to 20))
- (and description
- (propertize (concat
- "(" (gptel--describe-directive
- description (- (window-width) 30))
- ")")
- 'face 'shadow)))
- `(lambda () (interactive)
- (gptel--set-with-scope 'gptel--preset ',name-sym
- gptel--set-buffer-locally)
- (gptel--apply-preset ',preset
- (lambda (sym val) (gptel--set-with-scope
- sym val gptel--set-buffer-locally)))
- (message "Applied gptel preset %s"
- (propertize ,name 'face 'transient-value))
- (when transient--stack
- (run-at-time 0 nil #'transient-setup))))
- into generated
- finally return
- (nconc (list '(gptel--infix-variable-scope
- :format "%d %k %v"
- :description
- (lambda () (format "%s %s"
- (propertize "Apply preset" 'face 'transient-heading)
- (propertize "Scope" 'face 'transient-active-prefix)))))
- generated))))])
-
-;; ** Prefix for selecting tools
-
-;; gptel-tools offers a two-level menu for selecting tools, its design is a
-;; little convoluted so here's an explanation:
-;;
-;; Normally a transient prefix exports its value via transient-args, to be
-;; consumed by suffixes, where these args are determined by the state of the
-;; menu at the time of export. The gptel-tools menu is dynamic and needs to
-;; store tool selections that may not be visible in the meny any more, so we
-;; cannot use the transient-args.
-;;
-;; We can not (should not?) control the value of the prefix directly, so we
-;; instead use the scope (a secondary value) of the prefix to maintain the
-;; history of selections. When running a suffix, we gather tool selections from
-;; the scope. The scope is also used as a message channel for connecting the
-;; category menu and the tool list menu for that category.
-
-;;;###autoload (autoload 'gptel-tools "gptel-transient" nil t)
-(transient-define-prefix gptel-tools ()
- "Select tools to include with gptel requests.
-
-Tools are organized into categories. Selecting the category
-toggles all the tools with that category.
-
-To add tools to this list, use `gptel-make-tool', which see.
-
-Using the scope option, you can set tools to use with gptel
-requests globally, in this buffer or for the next request
-only (\"oneshot\")."
- :refresh-suffixes t
- [:description "Provide the LLM with tools to run tasks for you"
- [""
- (gptel--infix-variable-scope)
- (gptel--infix-use-tools)
- (gptel--infix-confirm-tool-calls)
- (gptel--infix-include-tool-results)]
- [""
- ("RET" "Confirm selection"
- (lambda (tools)
- ;; We don't care about the transient args of this prefix at all, since
- ;; the state is managed entirely through its transient-scope:
- (interactive (list (plist-get (transient-scope 'gptel-tools) :tools)))
- (gptel--set-with-scope
- 'gptel-tools
- (mapcar (lambda (category-and-name)
- (map-nested-elt gptel--known-tools category-and-name))
- (cl-delete-if-not #'consp tools))
- gptel--set-buffer-locally))
- :transient transient--do-return)
- ("q" "Cancel" transient-quit-one)]]
- [[:class transient-column ;Display known categories
- :setup-children
- (lambda (_)
- (transient-parse-suffixes
- 'gptel-tools
- (cl-loop ;loop through gptel--known tools and collect categories
- for (category . tools-alist) in gptel--known-tools
- with unused-keys = (nconc (delete ?q (number-sequence ?a ?z))
- (number-sequence ?0 ?9)
- (delete ?M (number-sequence ?A ?Z))) ;M used by MCP integration
- for category-key = (seq-find (lambda (k) (member k unused-keys))
- (string-remove-prefix "mcp-" category)
- (seq-first unused-keys))
- do (setq unused-keys (delete category-key unused-keys))
- collect (list (key-description (list category-key))
- (concat (propertize category 'face 'transient-heading)
- (make-string (max (- 14 (length category)) 0) ? ))
- (char-to-string category-key)
- :format " %k %d %v"
- :class 'gptel--switch-category
- :category category)
- into categories
- finally do (plist-put (transient-scope) :keys unused-keys)
- finally return categories)))]
- [:class transient-column ;Display known tools for selected category
- :setup-children
- (lambda (_)
- (transient-parse-suffixes
- 'gptel-tools
- (when-let* ((category (plist-get (transient-scope) :category))
- (tool-keys (plist-get (transient-scope) :keys)))
- (cl-loop ;for each category, collect tools as infixes
- with tools-alist = (cdr (assoc category gptel--known-tools))
- for (name . tool) in tools-alist
- for tool-key = (seq-find (lambda (k) (member k tool-keys)) name (seq-first tool-keys))
- do (setq tool-keys (delete tool-key tool-keys))
- collect ;Each list is a transient infix of type gptel--switch
- (list (key-description (list tool-key))
- (concat (make-string (max (- 20 (length name)) 0) ? )
- (propertize
- (concat "(" (gptel--describe-directive
- (gptel-tool-description tool) (- (window-width) 60))
- ")")
- 'face 'shadow))
- (gptel-tool-name tool)
- :format " %k %v %d"
- :init-value #'gptel--tools-init-value
- :class 'gptel--switch
- :category category)
- into infixes-for-category
- finally return
- (cons (list :info
- (lambda () (concat
- (propertize (plist-get (transient-scope) :key)
- 'face 'transient-key)
- (propertize " toggle all" 'face 'transient-heading)))
- :format " %d")
- infixes-for-category)))))]]
- (interactive)
- (transient-setup
- 'gptel-tools nil nil
- :scope (list :tools (mapcar (lambda (tool) (list (or (gptel-tool-category tool) "misc")
- (gptel-tool-name tool)))
- gptel-tools))))
-
-\f
-;; * Transient Infixes
-
-;; ** Infixes for context aggregation
-
-(transient-define-infix gptel--infix-use-context ()
- "Describe target destination for context injection.
-
-gptel will include with the LLM request any additional context
-added with `gptel-add'. This context can be ignored, included
-with the system message or included with the user prompt.
-
-Where in the request this context is included depends on the
-value of `gptel-use-context', set from here."
- :description "Include context"
- :class 'gptel-lisp-variable
- :variable 'gptel-use-context
- :format " %k %d %v"
- :set-value #'gptel--set-with-scope
- :display-nil "No"
- :display-map '((nil . "No")
- (system . "with system message")
- (user . "with user prompt"))
- :key "-i"
- :reader (lambda (prompt &rest _)
- (let* ((choices '(("No" . nil)
- ("with system message" . system)
- ("with user prompt" . user)))
- (destination (completing-read prompt choices nil t)))
- (cdr (assoc destination choices)))))
-
-;; ** Infixes for model parameters
-
-(transient-define-infix gptel--infix-variable-scope ()
- "Set gptel's model parameters and system message in this buffer or globally."
- :argument "scope"
- :variable 'gptel--set-buffer-locally
- :class 'gptel--scope
- :format " %k %d %v"
- :key "="
- :description (propertize "Scope" 'face 'transient-inactive-argument))
-
-(transient-define-infix gptel--infix-num-messages-to-send ()
- "Number of recent messages to send with each exchange.
-
-By default, the full conversation history is sent with every new
-prompt. This retains the full context of the conversation, but
-can be expensive in token size. Set how many recent messages to
-include."
- :description "previous responses"
- :class 'gptel-lisp-variable
- :variable 'gptel--num-messages-to-send
- :set-value #'gptel--set-with-scope
- :display-nil 'all
- :format " %k %v %d"
- :key "-n"
- :prompt "Number of past messages to include for context (leave empty for all): "
- :reader 'gptel--transient-read-number)
-
-(transient-define-infix gptel--infix-max-tokens ()
- "Max tokens per response.
-
-This is roughly the number of words in the response. 100-300 is a
-reasonable range for short answers, 400 or more for longer
-responses."
- :description "Response length (tokens)"
- :class 'gptel-lisp-variable
- :variable 'gptel-max-tokens
- :set-value #'gptel--set-with-scope
- :display-nil 'auto
- :key "-c"
- :prompt "Response length in tokens (leave empty: default, 80-200: short, 200-500: long): "
- :reader 'gptel--transient-read-number)
-
-;; TODO(links): Run `gptel-refresh-buffer-hook' after a model change
-(transient-define-infix gptel--infix-provider ()
- "AI Provider for Chat."
- :description "Model"
- :class 'gptel-provider-variable
- :prompt "Model: "
- :variable 'gptel-model
- :set-value #'gptel--set-with-scope
- :backend 'gptel-backend
- :key "-m"
- :reader (lambda (prompt &rest _)
- (cl-loop
- for (name . backend) in gptel--known-backends
- nconc (cl-loop for model in (gptel-backend-models backend)
- collect (list (concat name ":" (gptel--model-name model))
- backend model))
- into models-alist
- with completion-extra-properties =
- `(:annotation-function
- ,(lambda (comp)
- (let* ((model (nth 2 (assoc comp models-alist)))
- (desc (get model :description))
- (caps (get model :capabilities))
- (context (get model :context-window))
- (input-cost (get model :input-cost))
- (output-cost (get model :output-cost))
- (cutoff (get model :cutoff-date)))
- (when (or desc caps context input-cost output-cost cutoff)
- (concat
- (propertize " " 'display `(space :align-to 40))
- (when desc (truncate-string-to-width desc 70 nil ? t t))
- " " (propertize " " 'display `(space :align-to 112))
- (when caps (truncate-string-to-width (prin1-to-string caps) 21 nil ? t t))
- " " (propertize " " 'display `(space :align-to 134))
- (when context (format "%5dk" context))
- " " (propertize " " 'display `(space :align-to 142))
- (when input-cost (format "$%5.2f in" input-cost))
- (if (and input-cost output-cost) "," " ")
- " " (propertize " " 'display `(space :align-to 153))
- (when output-cost (format "$%6.2f out" output-cost))
- " " (propertize " " 'display `(space :align-to 166))
- cutoff)))))
- finally return
- (cdr (assoc (completing-read prompt models-alist nil t nil nil
- (concat (gptel-backend-name gptel-backend) ":"
- (gptel--model-name gptel-model)))
- models-alist)))))
-
-(transient-define-infix gptel--infix-temperature ()
- "Temperature of request."
- :description "Temperature (0 - 2.0)"
- :display-nil "default"
- :class 'gptel-lisp-variable
- :variable 'gptel-temperature
- :set-value #'gptel--set-with-scope
- :key "-T"
- :prompt "Temperature controls the response randomness (0.0-2.0, leave empty for API default): "
- :reader 'gptel--transient-read-number)
-
-(transient-define-infix gptel--infix-track-response ()
- "Distinguish between user messages and LLM responses.
-
-When creating a prompt to send to the LLM, gptel distinguishes
-between text entered by the user and past LLM responses. This is
-required for multi-turn conversations, and is always the case in
-dedicated chat buffers (in `gptel-mode').
-
-In regular buffers, you can toggle this behavior here or by
-customizing `gptel-track-response'. When response tracking is
-turned off, all text will be assigned the \"user\" role when
-querying the LLM."
- :description "Track LLM responses"
- :class 'gptel--switches
- :variable 'gptel-track-response
- :set-value #'gptel--set-with-scope
- :display-if-true "Yes"
- :display-if-false "No"
- :key "-R")
-
-(transient-define-suffix gptel--infix-track-media ()
- "Send media from links in the prompt.
-
-gptel can send images or other media from links in the buffer to the
-LLM. What link types are sent depends on the mime-types the model
-supports. See `gptel-track-media' for more information."
- :description "Send media from links"
- :transient t
- :class 'gptel--switches
- :variable 'gptel-track-media
- :set-value #'gptel--set-with-scope
- :display-if-true "Yes"
- :display-if-false "No"
- :key "-I"
- (interactive)
- (let ((obj (transient-suffix-object)))
- (transient-infix-set obj (transient-infix-read obj))
- (transient--show))
- (if gptel-track-media
- (run-hooks 'gptel-refresh-buffer-hook)
- (gptel--annotate-link-clear)))
-
-;; ** Infixes for adding and removing context
-
-(declare-function gptel-context--at-point "gptel-context")
-(declare-function gptel-add "gptel-context")
-(declare-function gptel-context-add-current-kill "gptel-context")
-
-(transient-define-suffix gptel--infix-context-add-current-kill (&optional arg)
- "Add current kill to gptel's context."
- :transient 'transient--do-stay
- :key "C-y"
- :if (lambda () gptel-expert-commands)
- :description
- "Yank to context"
- (interactive "P")
- (require 'gptel-context)
- (gptel-context-add-current-kill arg)
- (transient-setup))
-
-(transient-define-suffix gptel--infix-context-add-region ()
- "Add current region to gptel's context."
- :transient 'transient--do-stay
- :key "-r"
- :if (lambda () (or (use-region-p)
- (and (fboundp 'gptel-context--at-point)
- (gptel-context--at-point))))
- :description
- (lambda ()
- (if (and (fboundp 'gptel-context--at-point)
- (gptel-context--at-point))
- "Remove context at point"
- "Add region to context"))
- (interactive)
- (gptel-add)
- (transient-setup))
-
-(transient-define-suffix gptel--infix-context-add-buffer ()
- "Add a buffer to gptel's context."
- :transient 'transient--do-stay
- :key "-b"
- :description "Add a buffer to context"
- (interactive)
- (gptel-add '(4))
- (transient-setup))
-
-(declare-function gptel-add-file "gptel-context")
-(declare-function gptel-context-remove-all "gptel-context")
-
-(transient-define-suffix gptel--infix-context-add-file ()
- "Add a file to gptel's context."
- :transient 'transient--do-stay
- :key "-f"
- :description "Add a file to context"
- (interactive)
- (call-interactively #'gptel-add-file)
- (transient-setup))
-
-(transient-define-suffix gptel--infix-context-remove-all ()
- "Clear gptel's context."
- :if (lambda () gptel-context)
- :transient 'transient--do-stay
- :key "-d"
- :description "Remove all"
- (interactive)
- (gptel-context-remove-all t)
- (transient-setup))
-
-;; ** Infix for additional directive
-
-(transient-define-infix gptel--infix-add-directive ()
- "Additional directive intended for the next query only.
-
-This is useful to define a quick task on top of a more extensive
-or detailed system message.
-
-For example, with code/text selected:
-
-- Rewrite this function to do X while avoiding Y.
-- Change the tone of the following paragraph to be more direct.
-
-Or in an extended conversation:
-
-- Phrase you next response in ten words or less.
-- Pretend for now that you're an anthropologist."
- :class 'gptel-option-overlaid
- ;; :variable 'gptel--instructions
- :display-nil 'none
- :overlay nil
- :argument ":"
- :prompt (concat "Add instructions for next request only ("
- gptel--read-with-prefix-help ") ")
- ;; TODO: Add the ability to edit this in a separate buffer, with
- ;; `gptel--edit-directive'. This requires setting up gptel-menu with the
- ;; result as the :scope.
- :reader (lambda (prompt initial history)
- (let* ((directive
- (car-safe (gptel--parse-directive gptel--system-message 'raw)))
- (cycle-prefix (lambda () (interactive)
- (gptel--read-with-prefix directive)))
- (minibuffer-local-map
- (make-composed-keymap
- (define-keymap "TAB" cycle-prefix "<tab>" cycle-prefix)
- minibuffer-local-map))
- (extra (minibuffer-with-setup-hook cycle-prefix
- (read-string prompt (or initial " ") history))))
- (unless (string-empty-p extra) extra)))
- :format " %k %d %v"
- :key "d"
- :argument ":"
- :description "Add instruction"
- :transient t)
-
-;; ** Infix for reasoning block control
-
-(transient-define-infix gptel--infix-include-reasoning ()
- "How to handle reasoning/thinking response blocks.
-
-Some LLMs include in their response a \"thinking\" section. This
-text improves the quality of the LLM's final output, but may not
-be interesting to you by itself.
-
-You can control how gptel should handle the thinking blocks via
-this option, or by setting the variable `gptel-include-reasoning'
-via elisp, which see.
-
-Available behaviors are
-- to include thinking blocks with the response,
-- to omit them entirely,
-- to include them but ignore them in consequent conversation turns, and
-- to append them to a buffer of your choosing."
- :description "Include reasoning"
- :class 'gptel-lisp-variable
- :variable 'gptel-include-reasoning
- :format " %k %d %v"
- :set-value #'gptel--set-with-scope
- :display-nil "No"
- :display-map '((nil . "No")
- (ignore . "and ignore")
- (t . "with response"))
- :key "-v"
- :prompt "Include reasoning: "
- :reader (lambda (prompt &rest _)
- (let* ((choices '(("no" . nil)
- ("ignore" . ignore)
- ("yes" . t)
- ("other buffer" . buffer)))
- (destination
- (completing-read prompt choices nil t)))
- (if (equal destination "other buffer")
- (read-buffer "Append reasoning to buffer: ")
- (cdr (assoc destination choices))))))
-
-;; ** Infixes for tool use
-
-(transient-define-infix gptel--infix-use-tools ()
- "Whether LLM tool use with gptel is enabled.
-
-This is a three-way toggle. Assuming one or more tools to be
-sent with requests have been selected, tool use can be
-
-- disabled,
-- enabled, where the LLM may choose to respond with tool calls
-- forced, where the LLM must respond with one or more tool calls.
-
-You can set this here or by customizing `gptel-use-tools', which
-see."
- :description "Use tools"
- :class 'gptel-lisp-variable
- :variable 'gptel-use-tools
- :set-value (lambda (sym value scope)
- (gptel--set-with-scope sym value scope)
- (transient-setup))
- :display-nil "off"
- :display-map '((nil . "off")
- (t . "on")
- (force . "force"))
- :prompt "Use tools? "
- :reader (lambda (prompt &rest _)
- (let* ((choices '(("disable" . nil)
- ("enable" . t)
- ("force" . force)))
- (pref (completing-read prompt choices nil t)))
- (cdr (assoc pref choices))))
- :key "-t")
-
-(transient-define-infix gptel--infix-confirm-tool-calls ()
- "Whether tool calls should wait for the user to run them.
-
-This is a three-way toggle between these behaviors:
-
-- All tool calls run without confirmation.
-- All tool calls wait for confirmation.
-- Decided per-tool, according to the value of the tool spec's
- :confirm slot.
-
-This sets the variable `gptel-confirm-tool-calls', which see."
- :key "-c"
- :description "Confirm tool calls"
- :class 'gptel-lisp-variable
- :variable 'gptel-confirm-tool-calls
- :set-value #'gptel--set-with-scope
- :display-nil "never"
- :display-map '((nil . "never")
- (t . "always")
- (auto . "auto"))
- :prompt "Tool calls require confirmation? "
- :reader (lambda (prompt &rest _)
- (let* ((choices '(("no" . nil)
- ("always" . t)
- ("tool decides" . auto)))
- (pref (completing-read prompt choices nil t)))
- (cdr (assoc pref choices)))))
-
-(transient-define-infix gptel--infix-include-tool-results ()
- "Whether tool call results should be included in the response.
-
-This is a three-way toggle between these behaviors:
-
-- All tool results are included.
-- No tool results are included.
-- Decided per-tool, according to the value of the tool spec's
- :include slot.
-
-This sets the variable `gptel-include-tool-results', which see."
- :key "-i"
- :description "Include results "
- :class 'gptel-lisp-variable
- :variable 'gptel-include-tool-results
- :set-value #'gptel--set-with-scope
- :display-nil "never"
- :display-map '((nil . "never")
- (t . "always")
- (auto . "auto"))
- :prompt "Include tool results in LLM response? "
- :reader (lambda (prompt &rest _)
- (let* ((choices '(("never" . nil)
- ("always" . t)
- ("tool decides" . auto)))
- (pref (completing-read prompt choices nil t)))
- (cdr (assoc pref choices)))))
-
-\f
-;; * Transient Suffixes
-
-;; ** Suffix to send prompt
-
-(transient-define-suffix gptel--suffix-send (args)
- "Send ARGS."
- :key "RET"
- :description #'gptel--describe-suffix-send
- (interactive (list (transient-args
- (or transient-current-command 'gptel-menu))))
- (let ((stream gptel-stream)
- (in-place (and (member "i" args) t))
- (redirect-output)
- (backend gptel-backend)
- (model gptel-model)
- (backend-name (gptel-backend-name gptel-backend))
- (buffer) (position)
- (callback) (gptel-buffer-name)
- (system-extra (gptel--get-directive args))
- (dry-run (and (member "I" args) t))
- ;; Input redirection: grab prompt from elsewhere?
- (prompt
- (cond
- ((member "m" args) (gptel--read-minibuffer-prompt))
- ((member "y" args)
- (unless (car-safe kill-ring)
- (user-error "`kill-ring' is empty! Nothing to send"))
- (if current-prefix-arg
- (read-from-kill-ring "Prompt from kill-ring: ")
- (current-kill 0))))))
-
- ;; Output redirection: Send response elsewhere?
- (cond
- ((member "e" args)
- (setq redirect-output t)
- (setq stream nil)
- (setq callback
- (lambda (resp info &optional _raw)
- (pcase resp
- ((pred stringp) (message "%s response: %s" backend-name resp))
- (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer))
- (_ (when (and (null resp) (plist-get info :error))
- (message "%s response error: %s"
- backend-name (plist-get info :status))))))))
- ((member "k" args)
- (setq redirect-output t)
- (setq stream nil)
- (setq callback
- (let ((accum))
- (lambda (resp info &optional _raw)
- (pcase resp
- ((pred stringp) (push resp accum)
- (unless (plist-get info :tool-use)
- (kill-new (apply #'concat (nreverse accum)))
- (message "%s response: \"%s\" copied to kill-ring." backend-name
- (truncate-string-to-width resp 30 nil nil t))))
- (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer))
- (_ (when (and (null resp) (plist-get info :error))
- (if accum (kill-new (apply #'concat (nreverse accum))))
- (message
- (concat "%s response error: %s."
- (and accum " Partial response copied to kill-ring."))
- backend-name (plist-get info :status)))))))))
- ((setq gptel-buffer-name
- (cl-some (lambda (s) (and (stringp s) (string-prefix-p "g" s)
- (substring s 1)))
- args))
- (setq redirect-output t)
- (let* ((reduced-prompt ;For inserting into the gptel buffer as
- ;context, not the prompt used for the
- ;request itself
- (or prompt
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning)
- (region-end))
- (buffer-substring-no-properties
- (save-excursion
- (text-property-search-backward
- 'gptel 'response
- (when (get-char-property (max (point-min) (1- (point)))
- 'gptel)
- t))
- (point))
- (gptel--at-word-end (point))))))
- (gptel-buffer (get-buffer gptel-buffer-name))
- (gptel-buffer-mode
- (if (buffer-live-p gptel-buffer)
- (buffer-local-value 'major-mode gptel-buffer)
- gptel-default-mode)))
- ;; Add code fences or Org src markers around the reduced-prompt
- (cond ((and (stringp prompt) (eq major-mode gptel-buffer-mode)))
- ((provided-mode-derived-p gptel-buffer-mode 'org-mode)
- (setq reduced-prompt
- (if (consp reduced-prompt);either (region . prompt) or prompt
- (concat (and (car reduced-prompt)
- (concat "#+begin_src " (gptel--strip-mode-suffix major-mode)
- "\n" (org-escape-code-in-string (car reduced-prompt))
- "\n#+end_src\n\n"))
- (cdr reduced-prompt))
- (concat "#+begin_src " (gptel--strip-mode-suffix major-mode)
- "\n" (org-escape-code-in-string
- (or (cdr-safe reduced-prompt) reduced-prompt))
- "\n#+end_src"))))
- (t (setq reduced-prompt
- (if (consp reduced-prompt);either (region . prompt) or prompt
- (concat (and (car reduced-prompt)
- (concat "``` " (gptel--strip-mode-suffix major-mode) "\n"
- (car reduced-prompt) "\n```\n\n"))
- (cdr reduced-prompt))
- (concat "``` " (gptel--strip-mode-suffix major-mode) "\n"
- (or (cdr-safe reduced-prompt) reduced-prompt) "\n```" )))))
- (cond
- ((buffer-live-p gptel-buffer)
- ;; Insert into existing gptel session
- (setq buffer gptel-buffer)
- (with-current-buffer buffer
- (goto-char (point-max))
- (unless (or buffer-read-only
- (get-char-property (point) 'read-only))
- (unless (bolp) (insert "\n"))
- (insert reduced-prompt))
- (setq position (point))
- (when (and gptel-mode (not dry-run))
- (gptel--update-status " Waiting..." 'warning))))
- ;; Insert into new gptel session
- (t (setq buffer
- (gptel gptel-buffer-name
- (condition-case nil
- (gptel--get-api-key)
- ((error user-error)
- (setq gptel-api-key
- (read-passwd
- (format "%s API key: "
- (gptel-backend-name
- gptel-backend))))))
- reduced-prompt))
- ;; Set backend and model in new session from current buffer
- (with-current-buffer buffer
- (setq gptel-backend backend)
- (setq gptel-model model)
- (unless dry-run
- (gptel--update-status " Waiting..." 'warning))
- (setq position (point)))))))
- ((setq gptel-buffer-name
- (cl-some (lambda (s) (and (stringp s) (string-prefix-p "b" s)
- (substring s 1)))
- args))
- (setq redirect-output t)
- (setq buffer (get-buffer-create gptel-buffer-name))
- (with-current-buffer buffer (setq position (point)))))
-
- ;; MAYBE: This is no a good way to handle two-part (region + instruction) prompts
- ;; If the prompt is a cons (region-text . instructions), collapse it
- (when (consp prompt) (setq prompt (concat (car prompt) "\n\n" (cdr prompt))))
-
- (prog1 (gptel-request prompt
- :buffer (or buffer (current-buffer))
- :position position
- :in-place in-place
- :stream stream
- :system
- (if system-extra
- (gptel--merge-additional-directive system-extra)
- gptel--system-message)
- :callback callback
- :transforms gptel-prompt-transform-functions
- :fsm (gptel-make-fsm :handlers gptel-send--handlers)
- :dry-run dry-run)
-
- (unless dry-run
- (gptel--update-status " Waiting..." 'warning))
-
- ;; NOTE: Possible future race condition here if Emacs ever drops the GIL.
- ;; The HTTP request callback might modify the buffer before the in-place
- ;; text is killed below.
- (when in-place
- (if (or buffer-read-only (get-char-property (point) 'read-only))
- (message "Not replacing prompt: region is read-only")
- (let ((beg (if (use-region-p)
- (region-beginning)
- (max (previous-single-property-change
- (point) 'gptel nil (point-min))
- (previous-single-property-change
- (point) 'read-only nil (point-min)))))
- (end (if (use-region-p) (region-end) (point))))
- (unless redirect-output
- ;; store the killed text in gptel-history
- (gptel--attach-response-history
- (list (buffer-substring-no-properties beg end))))
- (kill-region beg end))))
-
- (when (and redirect-output gptel-buffer-name)
- (message (concat "Prompt sent to buffer: "
- (propertize gptel-buffer-name 'face 'help-key-binding)))
- (display-buffer
- buffer '((display-buffer-reuse-window
- 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))
- (cons (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)
-
-;; ** Suffix to regenerate response
-
-(defun gptel--regenerate ()
- "Regenerate gptel response at point."
- (interactive)
- (when (gptel--in-response-p)
- (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds))
- (history (get-char-property (point) 'gptel-history))
- (prev-responses (cons (buffer-substring-no-properties beg end)
- history)))
- (when gptel-mode ;Remove prefix/suffix
- (save-excursion
- (goto-char beg)
- (when (looking-back (concat "\n+" (regexp-quote (gptel-response-prefix-string)))
- (point-min) 'greedy)
- (setq beg (match-beginning 0)))
- (goto-char end)
- (when (looking-at
- (concat "\n+" (regexp-quote (gptel-prompt-prefix-string))))
- (setq end (match-end 0)))))
- (delete-region beg end)
- (gptel--attach-response-history prev-responses)
- (call-interactively #'gptel--suffix-send))))
-
-;; ** Set system message
-(defun gptel--read-crowdsourced-prompt ()
- "Pick a crowdsourced system prompt for gptel.
-
-This uses the prompts in the variable
-`gptel--crowdsourced-prompts', which see."
- (interactive)
- (if (not (hash-table-empty-p (gptel--crowdsourced-prompts)))
- (let ((choice
- (completing-read
- "Pick and edit prompt: "
- (lambda (str pred action)
- (if (eq action 'metadata)
- `(metadata
- (affixation-function .
- (lambda (cands)
- (mapcar
- (lambda (c)
- (list c ""
- (concat (propertize " " 'display '(space :align-to 22))
- " " (propertize (gethash c gptel--crowdsourced-prompts)
- 'face 'completions-annotations))))
- cands))))
- (complete-with-action action gptel--crowdsourced-prompts str pred)))
- nil t)))
- (when-let* ((prompt (gethash choice gptel--crowdsourced-prompts)))
- (gptel--set-with-scope
- 'gptel--system-message prompt gptel--set-buffer-locally)
- (gptel--edit-directive 'gptel--system-message
- :callback (lambda (_) (call-interactively #'gptel-menu)))))
- (message "No prompts available.")))
-
-(transient-define-suffix gptel--suffix-system-message (&optional cancel)
- "Edit LLM system message.
-
-CANCEL is used to avoid touching dynamic system messages,
-generated from functions."
- :transient 'transient--do-exit
- :description "Set or edit system message"
- :format " %k %d"
- :key "s"
- (interactive
- (list (and (functionp gptel--system-message)
- (not (y-or-n-p
- "Active directive is dynamically generated: Edit its current value instead?")))))
- (if cancel (progn (message "Edit canceled")
- (call-interactively #'gptel-menu))
- (gptel--edit-directive 'gptel--system-message
- :setup #'activate-mark
- :callback (lambda (_) (call-interactively #'gptel-menu)))))
-
-;; MAYBE: Eventually can be simplified with string-edit, after we drop support
-;; for Emacs 28.2.
-(cl-defun gptel--edit-directive (&optional sym &key prompt initial callback setup buffer)
- "Edit a gptel directive in a dedicated buffer.
-
-Store the result in SYM, a symbol. PROMPT and INITIAL are the heading
-and initial text. If SETUP is a function, run it after setting up the
-buffer. If CALLBACK is specified, it is run after exiting the edit. It
-is called with one argument: the buffer text or with nil depending on
-whether the action is confirmed/cancelled."
- (declare (indent 1))
- (let ((orig-buf (or buffer (current-buffer)))
- (msg-start (make-marker))
- (directive (symbol-value sym)))
- (when (functionp directive)
- (setq directive (funcall directive)))
- ;; TODO: Handle editing list-of-strings directives
- (with-current-buffer (get-buffer-create "*gptel-prompt*")
- (let ((inhibit-read-only t) (inhibit-message t))
- (erase-buffer)
- (text-mode)
- (visual-line-mode 1)
- (setq header-line-format
- (concat "Edit your instructions 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
- (or prompt
- (concat
- "# 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) (point)
- (list 'read-only t 'face 'font-lock-comment-face 'front-sticky t 'rear-nonsticky t))
- (set-marker msg-start (point))
- (save-excursion
- ;; If it's a list, insert only the system message part
- ;; If all is nil, insert "" at least
- (insert (or initial (car-safe (gptel--parse-directive directive 'raw)) ""))
- (push-mark nil 'nomsg))
- (and (functionp setup) (funcall setup)))
- (display-buffer (current-buffer)
- `((display-buffer-below-selected
- display-buffer-use-some-window)
- (some-window . lru)
- (body-function . ,#'select-window)
- (window-height . ,#'fit-window-to-buffer)))
- (let ((quit-to-menu
- (lambda () "Cancel system message update and return."
- (quit-window)
- (unless (minibufferp)
- (display-buffer orig-buf
- `((display-buffer-reuse-window
- display-buffer-use-some-window)
- (body-function . ,#'select-window)))))))
- (use-local-map
- (make-composed-keymap
- (define-keymap
- "C-c C-c"
- (lambda () "Confirm system message and return."
- (interactive)
- (let ((system-message
- (buffer-substring-no-properties msg-start (point-max))))
- (when sym
- (with-current-buffer orig-buf
- (gptel--set-with-scope
- sym (if (cdr-safe directive) ;Handle list of strings
- (prog1 directive (setcar directive system-message))
- system-message)
- gptel--set-buffer-locally)))
- (funcall quit-to-menu)
- (when (functionp callback) (funcall callback system-message))))
- "C-c C-k" (lambda () (interactive)
- (funcall quit-to-menu)
- (when (functionp callback) (funcall callback nil))))
- text-mode-map))))))
-
-;; ** Suffix for displaying and removing context
-(declare-function gptel-context--buffer-setup "gptel-context")
-(declare-function gptel-context--collect "gptel-context")
-
-(transient-define-suffix gptel--suffix-context-buffer ()
- "Display all contexts from all buffers & files."
- :transient 'transient--do-exit
- :key " C"
- :if (lambda () gptel-context)
- :description "Inspect context"
- (interactive)
- (gptel-context--buffer-setup nil nil gptel-context))
-
-(provide 'gptel-transient)
-;;; gptel-transient.el ends here
-
-;; Local Variables:
-;; outline-regexp: "^;; \\*+"
-;; eval: (outline-minor-mode 1)
-;; End:
+++ /dev/null
-;;; gptel.el --- Interact with ChatGPT or other LLMs -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2023-2025 Karthik Chikmagalur
-
-;; Author: Karthik Chikmagalur <karthik.chikmagalurNOSPAMgmail.com>
-;; Package-Version: 20260123.739
-;; Package-Revision: 96199593c107
-;; Package-Requires: ((emacs "27.1") (transient "0.7.4") (compat "30.1.0.0"))
-;; Keywords: convenience, tools
-;; URL: https://github.com/karthink/gptel
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;; This file is NOT part of GNU Emacs.
-
-;;; Commentary:
-
-;; gptel is a simple Large Language Model chat client, with support for multiple
-;; models and backends.
-;;
-;; It works in the spirit of Emacs, available at any time and in any buffer.
-;;
-;; gptel supports:
-;;
-;; - The services ChatGPT, Azure, Gemini, Anthropic AI, Together.ai, Perplexity,
-;; AI/ML API, Anyscale, OpenRouter, Groq, PrivateGPT, DeepSeek, Cerebras, Github Models,
-;; GitHub Copilot chat, AWS Bedrock, Novita AI, xAI, Sambanova, Mistral Le
-;; Chat and Kagi (FastGPT & Summarizer).
-;; - Local models via Ollama, Llama.cpp, Llamafiles or GPT4All
-;;
-;; Additionally, any LLM service (local or remote) that provides an
-;; OpenAI-compatible API is supported.
-;;
-;; Features:
-;;
-;; - Interact with LLMs from anywhere in Emacs (any buffer, shell, minibuffer,
-;; wherever).
-;; - LLM responses are in Markdown or Org markup.
-;; - Supports conversations and multiple independent sessions.
-;; - Supports tool-use to equip LLMs with agentic capabilities.
-;; - Supports Model Context Protocol (MCP) integration using the mcp.el package.
-;; - Supports multi-modal models (send images, documents).
-;; - Supports "reasoning" content in LLM responses.
-;; - Save chats as regular Markdown/Org/Text files and resume them later.
-;; - You can go back and edit your previous prompts or LLM responses when
-;; continuing a conversation. These will be fed back to the model.
-;; - Redirect prompts and responses easily
-;; - Rewrite, refactor or fill in regions in buffers.
-;; - Write your own commands for custom tasks with a simple API.
-;;
-;; Requirements for ChatGPT, Azure, Gemini or Kagi:
-;;
-;; - You need an appropriate API key. Set the variable `gptel-api-key' to the
-;; key or to a function of no arguments that returns the key. (It tries to
-;; use `auth-source' by default)
-;;
-;; ChatGPT is configured out of the box. For the other sources:
-;;
-;; - For Azure: define a gptel-backend with `gptel-make-azure', which see.
-;; - For Gemini: define a gptel-backend with `gptel-make-gemini', which see.
-;; - For Anthropic (Claude): define a gptel-backend with `gptel-make-anthropic',
-;; which see.
-;; - For AI/ML API, Together.ai, Anyscale, Groq, OpenRouter, DeepSeek, Cerebras or
-;; Github Models: define a gptel-backend with `gptel-make-openai', which see.
-;; - For PrivateGPT: define a backend with `gptel-make-privategpt', which see.
-;; - For Perplexity: define a backend with `gptel-make-perplexity', which see.
-;; - For Deepseek: define a backend with `gptel-make-deepseek', which see.
-;; - For Kagi: define a gptel-backend with `gptel-make-kagi', which see.
-;;
-;; For local models using Ollama, Llama.cpp or GPT4All:
-;;
-;; - The model has to be running on an accessible address (or localhost)
-;; - Define a gptel-backend with `gptel-make-ollama' or `gptel-make-gpt4all',
-;; which see.
-;; - Llama.cpp or Llamafiles: Define a gptel-backend with `gptel-make-openai'.
-;;
-;; Consult the package README for examples and more help with configuring
-;; backends.
-;;
-;; Usage:
-;;
-;; gptel can be used in any buffer or in a dedicated chat buffer. The
-;; interaction model is simple: Type in a query and the response will be
-;; inserted below. You can continue the conversation by typing below the
-;; response.
-;;
-;; To use this in any buffer:
-;;
-;; - Call `gptel-send' to send the buffer's text up to the cursor. Select a
-;; region to send only the region.
-;;
-;; - You can select previous prompts and responses to continue the conversation.
-;;
-;; - Call `gptel-send' with a prefix argument to access a menu where you can set
-;; your backend, model and other parameters, or to redirect the
-;; prompt/response.
-;;
-;; To use this in a dedicated buffer:
-;;
-;; - M-x gptel: Start a chat session.
-;;
-;; - In the chat session: Press `C-c RET' (`gptel-send') to send your prompt.
-;; Use a prefix argument (`C-u C-c RET') to access a menu. In this menu you
-;; can set chat parameters like the system directives, active backend or
-;; model, or choose to redirect the input or output elsewhere (such as to the
-;; kill ring or the echo area).
-;;
-;; - You can save this buffer to a file. When opening this file, turn on
-;; `gptel-mode' before editing it to restore the conversation state and
-;; continue chatting.
-;;
-;; - To include media files with your request, you can add them to the context
-;; (described next), or include them as links in Org or Markdown mode chat
-;; buffers. Sending media is disabled by default, you can turn it on globally
-;; via `gptel-track-media', or locally in a chat buffer via the header line.
-;;
-;; Include more context with requests:
-;;
-;; If you want to provide the LLM with more context, you can add arbitrary
-;; regions, buffers, files or directories to the query with `gptel-add'. To add
-;; text or media files, call `gptel-add' in Dired or use the dedicated
-;; `gptel-add-file'.
-;;
-;; You can also add context from gptel's menu instead (`gptel-send' with a
-;; prefix arg), as well as examine or modify context.
-;;
-;; When context is available, gptel will include it with each LLM query.
-;;
-;; LLM Tool use:
-;;
-;; gptel supports "tool calling" behavior, where LLMs can specify arguments with
-;; which to call provided "tools" (elisp functions). The results of running the
-;; tools are fed back to the LLM, giving it capabilities and knowledge beyond
-;; what is available out of the box. For example, tools can perform web
-;; searches or API lookups, modify files and directories, and so on.
-;;
-;; Tools can be specified via `gptel-make-tool', or obtained from other
-;; repositories, or from Model Context Protocol (MCP) servers using the mcp.el
-;; package. See the README for details.
-;;
-;; Tools can be included with LLM queries using gptel's menu, or from
-;; `gptel-tools'.
-;;
-;; Rewrite interface
-;;
-;; In any buffer: with a region selected, you can rewrite prose, refactor code
-;; or fill in the region. This is accessible via `gptel-rewrite', and also from
-;; the `gptel-send' menu.
-;;
-;; Presets
-;;
-;; Define a bundle of configuration (model, backend, system message, tools etc)
-;; as a "preset" that can be applied together, making it easy to switch between
-;; tasks in gptel. Presets can be saved and applied from gptel's transient
-;; menu. You can also include a cookie of the form "@preset-name" in the prompt
-;; to send a request with a preset applied. This feature works everywhere, but
-;; preset cookies are also fontified in chat buffers.
-;;
-;; gptel in Org mode:
-;;
-;; gptel offers a few extra conveniences in Org mode:
-;;
-;; - You can limit the conversation context to an Org heading with
-;; `gptel-org-set-topic'.
-;;
-;; - You can have branching conversations in Org mode, where each hierarchical
-;; outline path through the document is a separate conversation branch.
-;; See the variable `gptel-org-branching-context'.
-;;
-;; - You can declare the gptel model, backend, temperature, system message and
-;; other parameters as Org properties with the command
-;; `gptel-org-set-properties'. gptel queries under the corresponding heading
-;; will always use these settings, allowing you to create mostly reproducible
-;; LLM chat notebooks.
-;;
-;; Finally, gptel offers a general purpose API for writing LLM ineractions that
-;; suit your workflow. See `gptel-request', and `gptel-fsm' for more advanced
-;; usage.
-
-;;; Code:
-(defconst gptel-version "0.9.9.3")
-
-(declare-function markdown-mode "markdown-mode")
-(declare-function gptel-menu "gptel-transient")
-(declare-function gptel-system-prompt "gptel-transient")
-(declare-function gptel-tools "gptel-transient")
-(declare-function pulse-momentary-highlight-region "pulse")
-
-(declare-function ediff-make-cloned-buffer "ediff-util")
-(declare-function ediff-regions-internal "ediff")
-(declare-function hl-line-highlight "hl-line")
-
-(declare-function org-escape-code-in-string "org-src")
-(declare-function gptel-org-set-topic "gptel-org")
-(declare-function gptel-org--save-state "gptel-org")
-(declare-function gptel-org--restore-state "gptel-org")
-(declare-function gptel-org--annotate-links "gptel-org")
-(define-obsolete-function-alias
- 'gptel-set-topic 'gptel-org-set-topic "0.7.5")
-
-(declare-function markdown-link-at-pos "markdown-mode")
-
-(eval-when-compile
- (require 'subr-x))
-(require 'cl-lib)
-(require 'compat nil t)
-(require 'url)
-(require 'map)
-(require 'text-property-search)
-(require 'cl-generic)
-(require 'gptel-request)
-
-\f
-;;; User options
-(defcustom gptel-pre-response-hook nil
- "Hook run before inserting the LLM response into the current buffer.
-
-This hook is called in the buffer where the LLM response will be
-inserted.
-
-Note: this hook only runs if the request succeeds."
- :type 'hook
- :group 'gptel)
-
-(define-obsolete-variable-alias
- 'gptel-post-response-hook 'gptel-post-response-functions
- "0.6.0"
- "Post-response functions are now called with two arguments: the
-start and end buffer positions of the response.")
-
-(defcustom gptel-post-response-functions nil
- "Abnormal hook run after inserting the LLM response into the current buffer.
-
-This hook is called in the buffer to which the LLM response is
-sent, and after the full response has been inserted. Each
-function is called with two arguments: the response beginning and
-end positions.
-
-Note: this hook runs even if the request fails. In this case the
-response beginning and end positions are both the cursor position
-at the time of the request."
- :type 'hook
- :group 'gptel)
-
-(add-hook 'gptel-post-response-functions 'pulse-momentary-highlight-region 70)
-
-(defcustom gptel-post-stream-hook nil
- "Hook run after each insertion of the LLM's streaming response.
-
-This hook is called in the buffer from which the prompt was sent
-to the LLM, and after a text insertion."
- :type 'hook
- :group 'gptel)
-
-(defcustom gptel-save-state-hook nil
- "Hook run before gptel saves model parameters to a file.
-
-You can use this hook to store additional conversation state or
-model parameters to the chat buffer, or to modify the buffer in
-some other way."
- :type 'hook
- :group 'gptel)
-
-(defcustom gptel-default-mode (if (fboundp 'markdown-mode)
- 'markdown-mode
- 'text-mode)
- "The default major mode for dedicated chat buffers.
-
-If `markdown-mode' is available, it is used. Otherwise gptel
-defaults to `text-mode'."
- :type 'function
- :group 'gptel)
-
-(defcustom gptel-use-header-line t
- "Whether `gptel-mode' should use header-line for status information.
-
-When set to nil, use the mode line for (minimal) status
-information and the echo area for messages."
- :type 'boolean
- :group 'gptel)
-
-;; Set minimally to avoid display-buffer action alist conflicts (#533)
-(defcustom gptel-display-buffer-action `(nil (body-function . ,#'select-window))
- "The action used to display gptel chat buffers.
-
-The gptel buffer is displayed in a window using
-
- (display-buffer BUFFER gptel-display-buffer-action)
-
-The value of this option has the form (FUNCTION . ALIST),
-where FUNCTION is a function or a list of functions. Each such
-function should accept two arguments: a buffer to display and an
-alist of the same form as ALIST. See info node `(elisp)Choosing
-Window' for details."
- :type display-buffer--action-custom-type
- :group 'gptel)
-
-(defcustom gptel-crowdsourced-prompts-file
- (let ((cache-dir (or (eval-when-compile
- (require 'xdg)
- (xdg-cache-home))
- user-emacs-directory)))
- (expand-file-name "gptel-crowdsourced-prompts.csv" cache-dir))
- "File used to store crowdsourced system prompts.
-
-These are prompts cached from an online source (see
-`gptel--crowdsourced-prompts-url'), and can be set from the
-transient menu interface provided by `gptel-menu'."
- :type 'file
- :group 'gptel)
-
-(defvar gptel-refresh-buffer-hook '(jit-lock-refontify)
- "Hook run in gptel buffers after changing gptel's configuration.
-
-This hook runs in gptel chat buffers after making a change to gptel's
-configuration that might require a UI update.")
-
-(defvar-local gptel--bounds nil)
-(put 'gptel--bounds 'safe-local-variable #'always)
-
-(defvar-local gptel--tool-names nil
- "Store to persist tool names to file across Emacs sessions.
-
-Note: Changing this variable does not affect gptel\\='s behavior
-in any way.")
-(put 'gptel--tool-names 'safe-local-variable #'always)
-
-(defvar-local gptel--backend-name nil
- "Store to persist backend name across Emacs sessions.
-
-Note: Changing this variable does not affect gptel\\='s behavior
-in any way.")
-(put 'gptel--backend-name 'safe-local-variable #'always)
-
-(defvar-local gptel--old-header-line nil)
-
-(defvar gptel--markdown-block-map
- (define-keymap
- "<tab>" 'gptel-markdown-cycle-block
- "TAB" 'gptel-markdown-cycle-block)
- "Keymap for folding and unfolding Markdown code blocks.")
-
-\f
-;;; Utility functions
-(defun gptel--modify-value (original new-spec)
- "Combine ORIGINAL with NEW-SPEC and return the new result.
-
-This function is non-destructive, ORIGINAL is not modified.
-
-NEW-SPEC is either a declarative action spec (plist) of the form
- (:key val ...), or a simple value. Recognized spec keys are :append,
-:prepend, :eval, :function and :merge. If NEW-SPEC does not have this
-form it is returned as is.
-
-- :append and :prepend will append/prepend val (a list or string) to ORIGINAL.
- Actions on strings are idempotent, they will only be appended/prepended once.
-- :eval will evaluate val and return the result, and
-- :function will call val with ORIGINAL as its argument, and return the result.
-- :merge will treat ORIGINAL and NEW-SPEC as plists and return a merged plist,
- with NEW-SPEC taking precedence."
- (if (not (and (consp new-spec) (keywordp (car new-spec))))
- new-spec
- (let ((current original) (tail new-spec))
- (while tail
- (let ((key (pop tail)) (form (pop tail)))
- (setq current
- (pcase key
- (:append (if (stringp form)
- (if (string-suffix-p form current t)
- current (concat current form))
- (append current form)))
- (:prepend (if (stringp form)
- (if (string-prefix-p form current t)
- current (concat form current))
- (append form current)))
- (:eval (eval form t))
- (:function (funcall form current))
- (:merge (gptel--merge-plists (copy-sequence current) form))
- (_ new-spec)))))
- current)))
-
-(defun gptel-auto-scroll ()
- "Scroll window if LLM response continues below viewport.
-
-Note: This will move the cursor."
- (when-let* ((win (get-buffer-window (current-buffer) 'visible))
- ((not (pos-visible-in-window-p (point) win)))
- (scroll-error-top-bottom t))
- (condition-case nil
- (with-selected-window win
- (scroll-up-command))
- (error nil))))
-
-(defun gptel-beginning-of-response (&optional beg _end arg)
- "Move point to BEG, or to the beginning of the LLM response ARG times."
- (interactive (list nil nil
- (prefix-numeric-value current-prefix-arg)))
- (gptel-end-of-response beg nil (- (or arg 1))))
-
-(defun gptel-end-of-response (&optional beg end arg)
- "Move point to end of LLM response.
-
-With BEG, start search from BEG when ARG is negative.
-With END, start search from END when ARG is positive.
-Otherwise move ARG times, defaulting to 1."
- (interactive (list nil nil
- (prefix-numeric-value current-prefix-arg)))
- (unless arg (setq arg 1))
- (let* ((search (if (> arg 0)
- #'text-property-search-forward
- #'text-property-search-backward))
- (goto-prefix-end
- (lambda () (when-let* ((prefix (gptel-prompt-prefix-string))
- ((not (string-empty-p prefix)))
- ((looking-at (concat "\n\\{1,2\\}"
- (regexp-quote prefix) "?"))))
- (goto-char (match-end 0)))))
- (goto-prefix-beg
- (lambda () (when-let* ((prefix (gptel-response-prefix-string))
- ((not (string-empty-p prefix)))
- ((looking-back (concat (regexp-quote prefix) "?")
- (point-min))))
- (goto-char (match-beginning 0))))))
- (cond
- ((and end (> arg 0)) (goto-char end) (cl-decf arg) (funcall goto-prefix-end))
- ((and beg (< arg 0)) (goto-char beg) (cl-incf arg) (funcall goto-prefix-beg)))
- (dotimes (_ (abs arg))
- (funcall search 'gptel 'response t)
- (if (> arg 0)
- (funcall goto-prefix-end)
- (funcall goto-prefix-beg)))))
-
-(defun gptel-markdown-cycle-block ()
- "Cycle code blocks in Markdown."
- (interactive)
- (save-excursion
- (forward-line 0)
- (let (start end (parity 0))
- (cond ;Find start and end of block, with possible nested blocks
- ((looking-at-p "^``` *\n") ;end of block, find corresponding start
- (setq parity -1 end (line-end-position))
- (while (and (not (= parity 0)) (not (bobp)) (forward-line -1))
- (cond ((looking-at-p "^``` *\n") (cl-decf parity))
- ((looking-at-p "^``` ?[a-z]") (cl-incf parity))))
- (when (= parity 0) (setq start (point))))
-
- ((looking-at-p "^``` ?[a-z]") ;beginning of block, find corresponding end
- (setq parity 1 start (point))
- (while (and (not (= parity 0)) (not (eobp)) (forward-line 1))
- (cond ((looking-at-p "^``` *\n") (cl-decf parity))
- ((looking-at-p "^``` ?[a-z]") (cl-incf parity))))
- (when (= parity 0) (setq end (line-end-position)))))
- (when (and start end)
- (goto-char start)
- (end-of-line)
- (pcase-let* ((`(,value . ,hide-ov)
- (get-char-property-and-overlay (point) 'invisible)))
- (if (and hide-ov (eq value t))
- (delete-overlay hide-ov)
- (unless hide-ov (setq hide-ov (make-overlay (point) end)))
- (overlay-put hide-ov 'evaporate t)
- (overlay-put hide-ov 'invisible t)
- (overlay-put hide-ov 'before-string
- (propertize "..." 'face 'shadow))))))))
-
-(defsubst gptel--annotate-link (ov link-status)
- "Annotate link overlay OV according to LINK-STATUS.
-
-LINK-STATUS is a list of link properties relevant to gptel queries, of
-the form (valid . REST). See `gptel-markdown--validate-link' for
-details. Indicate the (in)validity of the link for inclusion with gptel
-queries via OV."
- (cl-destructuring-bind
- (valid _ path resource-type user-check readablep mime-valid _mime)
- link-status
- (if valid
- (progn
- (overlay-put
- ov 'before-string
- (concat (propertize "SEND" 'face '(:inherit success :height 0.8))
- (if (display-graphic-p)
- (propertize " " 'display '(space :width 0.5)) " ")))
- (overlay-put ov 'help-echo
- (format "Sending %s %s with gptel requests" resource-type path)))
- (overlay-put ov 'before-string
- (concat (propertize "!" 'face '(:inherit error))
- (propertize " " 'display '(space :width 0.3))))
- (overlay-put
- ov 'help-echo
- (concat
- "Sending only link text with gptel requests, "
- "this link will not be followed to its source.\n\nReason: "
- (cond
- ((not resource-type) "Not a supported link type\
- (Only \"file\" and \"attachment\" are supported)")
- ((not user-check)
- (concat
- "\nNot a standalone link -- separate link from text around it. \n (OR)
-Link failed to validate, see `gptel-markdown-validate-link' or `gptel-org-validate-link'."))
- ((not readablep) (format "File %s is not readable" path))
- ((not mime-valid)
- (pcase resource-type
- ('file (format "%s does not support binary file %s" gptel-model path))
- ('url (format "%s does not support fetching non-image URLs" gptel-model))))))))))
-
-(defun gptel--annotate-link-clear (&optional beg end)
- "Delete all gptel org link annotations between BEG and END."
- (mapc #'delete-overlay
- (cl-delete-if-not
- (lambda (o) (overlay-get o 'gptel-track-media))
- (overlays-in (or beg (point-min)) (or end (point-max))))))
-
-;;;; Response text recognition
-
-(defun gptel--get-buffer-bounds ()
- "Return the gptel response boundaries in the buffer as an alist."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-max))
- (let ((bounds) (prev-pt (point)))
- (while (and (/= prev-pt (point-min))
- (goto-char (previous-single-property-change
- (point) 'gptel nil (point-min))))
- (when-let* ((prop (get-char-property (point) 'gptel)))
- (let* ((prop-name (if (symbolp prop) prop (car prop)))
- (val (when (consp prop) (cdr prop)))
- (bound (if val
- (list (point) prev-pt val)
- (list (point) prev-pt))))
- (push bound (alist-get prop-name bounds))))
- (setq prev-pt (point)))
- bounds))))
-
-(define-obsolete-function-alias
- 'gptel--get-bounds 'gptel--get-response-bounds "0.9.8")
-
-(defun gptel--get-response-bounds ()
- "Return the gptel response boundaries around point."
- (let (prop)
- (save-excursion
- (when (text-property-search-forward
- 'gptel 'response t)
- (when (setq prop (text-property-search-backward
- 'gptel 'response t))
- (cons (prop-match-beginning prop)
- (prop-match-end prop)))))))
-
-(defun gptel--in-response-p (&optional pt)
- "Check if position PT is inside a gptel response."
- (eq (get-char-property (or pt (point)) 'gptel) 'response))
-
-(defun gptel--at-response-history-p (&optional pt)
- "Check if gptel response at position PT has variants."
- (get-char-property (or pt (point)) 'gptel-history))
-
-(defvar gptel--mode-description-alist
- '((js2-mode . "Javascript")
- (sh-mode . "Shell")
- (enh-ruby-mode . "Ruby")
- (yaml-mode . "Yaml")
- (yaml-ts-mode . "Yaml")
- (rustic-mode . "Rust")
- (tuareg-mode . "OCaml"))
- "Mapping from unconventionally named major modes to languages.
-
-This is used when generating system prompts for rewriting and
-when including context from these major modes.")
-
-\f
-;;; Saving and restoring state
-
-(defun gptel--restore-props (bounds-alist)
- "Restore text properties from BOUNDS-ALIST.
-BOUNDS-ALIST is (PROP . BOUNDS). BOUNDS is a list of BOUND. Each BOUND
-is either (BEG END VAL) or (BEG END).
-
-For (BEG END VAL) forms, even if VAL is nil, the gptel property will be
-set to (PROP . VAL). For (BEG END) forms, except when PROP is response,
-the gptel property is set to just PROP.
-
-The legacy structure, a list of (BEG . END) is also supported and will be
-applied before being re-persisted in the new structure."
- (let ((modified (buffer-modified-p)))
- (if (symbolp (caar bounds-alist))
- (mapc
- (lambda (bounds)
- (let* ((prop (pop bounds)))
- (mapc
- (lambda (bound)
- (let ((prop-has-val (> (length bound) 2)))
- (add-text-properties
- (pop bound) (pop bound)
- (if (eq prop 'response)
- '(gptel response front-sticky (gptel))
- (list 'gptel
- (if prop-has-val
- (cons prop (pop bound))
- prop))))))
- bounds)))
- bounds-alist)
- (mapc (lambda (bound)
- (add-text-properties
- (car bound) (cdr bound) '(gptel response front-sticky (gptel))))
- bounds-alist))
- (set-buffer-modified-p modified)))
-
-(defun gptel--restore-state ()
- "Restore gptel state when turning on `gptel-mode'."
- (when (buffer-file-name)
- (if (derived-mode-p 'org-mode)
- (progn
- (require 'gptel-org)
- (gptel-org--restore-state))
- (when gptel--bounds
- (gptel--restore-props gptel--bounds)
- (message "gptel chat restored."))
- (when gptel--backend-name
- (if-let* ((backend (alist-get
- gptel--backend-name gptel--known-backends
- nil nil #'equal)))
- (setq-local gptel-backend backend)
- (message
- (substitute-command-keys
- (concat
- "Could not activate gptel backend \"%s\"! "
- "Switch backends with \\[universal-argument] \\[gptel-send]"
- " before using gptel."))
- gptel--backend-name)))
- (when gptel--tool-names
- (if-let* ((tools (cl-loop
- for tname in gptel--tool-names
- for tool = (with-demoted-errors "gptel: %S"
- (gptel-get-tool tname))
- if tool collect tool else do
- (display-warning
- '(gptel org tools)
- (format "Tool %s not found, ignoring" tname)))))
- (setq-local gptel-tools tools))))))
-
-(defun gptel--save-state ()
- "Write the gptel state to the buffer.
-
-This saves chat metadata when writing the buffer to disk. To
-restore a chat session, turn on `gptel-mode' after opening the
-file."
- (run-hooks 'gptel-save-state-hook)
- (if (derived-mode-p 'org-mode)
- (progn
- (require 'gptel-org)
- (gptel-org--save-state))
- (let ((print-escape-newlines t))
- (save-excursion
- (save-restriction
- (add-file-local-variable 'gptel-model gptel-model)
- (add-file-local-variable 'gptel--backend-name
- (gptel-backend-name gptel-backend))
- (unless (equal (default-value 'gptel--system-message)
- gptel--system-message)
- (add-file-local-variable
- 'gptel--system-message ;TODO: Handle nil case correctly
- (car-safe (gptel--parse-directive gptel--system-message))))
- (if gptel-tools
- (add-file-local-variable
- 'gptel--tool-names (mapcar #'gptel-tool-name gptel-tools))
- (delete-file-local-variable 'gptel--tool-names))
- (if (equal (default-value 'gptel-temperature) gptel-temperature)
- (delete-file-local-variable 'gptel-temperature)
- (add-file-local-variable 'gptel-temperature gptel-temperature))
- (if gptel-max-tokens
- (add-file-local-variable 'gptel-max-tokens gptel-max-tokens)
- (delete-file-local-variable 'gptel-max-tokens))
- (if (natnump gptel--num-messages-to-send)
- (add-file-local-variable 'gptel--num-messages-to-send
- gptel--num-messages-to-send)
- (delete-file-local-variable 'gptel--num-messages-to-send))
- (add-file-local-variable 'gptel--bounds (gptel--get-buffer-bounds)))))))
-
-\f
-;;; Minor modes and UI
-
-;; NOTE: It's not clear that this is the best strategy:
-(cl-pushnew '(gptel . t) (default-value 'text-property-default-nonsticky)
- :test #'equal)
-
-(defun gptel--inherit-stickiness (beg end _pre)
- "Mark any change to an LLM response region as a response.
-
-Intended to be added to `after-change-functions' in gptel chat buffers,
-which see for BEG, END and PRE."
- (and (/= beg end) (< end (point-max))
- (and-let* ((val (get-text-property end 'gptel)))
- (add-text-properties
- beg end `(gptel ,val front-sticky (gptel))))))
-
-(defun gptel-markdown--annotate-links (beg end)
- "Annotate Markdown links whose sources will be sent with `gptel-send'.
-
-Search between BEG and END."
- (when gptel-track-media
- (save-excursion
- (goto-char beg) (forward-line -1)
- (let ((link-ovs (cl-loop for o in (overlays-in (point) end)
- if (overlay-get o 'gptel-track-media)
- collect o into os finally return os)))
- (while (re-search-forward gptel-markdown--link-regex end t)
- (unless (gptel--in-response-p (1- (point)))
- (let* ((link (markdown-link-at-pos (point)))
- (from (car link)) (to (cadr link))
- (link-status (gptel-markdown--validate-link link))
- (ov (cl-loop for o in (overlays-in from to)
- if (overlay-get o 'gptel-track-media)
- return o)))
- (if ov ; Ensure overlay over each link
- (progn (move-overlay ov from to)
- (setq link-ovs (delq ov link-ovs)))
- (setq ov (make-overlay from to nil t))
- (overlay-put ov 'gptel-track-media t)
- (overlay-put ov 'evaporate t)
- (overlay-put ov 'priority -80))
- ;; Check if link will be sent, and annotate accordingly
- (gptel--annotate-link ov link-status))))
- (and link-ovs (mapc #'delete-overlay link-ovs))))
- `(jit-lock-bounds ,beg . ,end)))
-
-(defvar gptel--header-line-info
- '(:eval
- (let* ((model (gptel--model-name gptel-model))
- (system
- (propertize
- (buttonize
- (format "[Prompt: %s]"
- (or (car-safe (rassoc gptel--system-message gptel-directives))
- (gptel--describe-directive gptel--system-message 15)))
- (lambda (&rest _) (gptel-system-prompt)))
- 'mouse-face 'highlight
- 'help-echo "System message for session"))
- (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 (not gptel-track-media))
- (if gptel-track-media
- (progn
- (run-hooks 'gptel-refresh-buffer-hook)
- (message "Sending media from included links."))
- (without-restriction (gptel--annotate-link-clear))
- (message "Ignoring links. Only link text will be sent."))
- (run-at-time 0 nil #'force-mode-line-update)))
- (track-media
- (and (gptel--model-capable-p 'media)
- (if gptel-track-media
- (propertize
- (buttonize "[Sending media]" toggle-track-media)
- 'mouse-face 'highlight
- 'help-echo
- "Sending media from links/urls when supported.\nClick to toggle")
- (propertize
- (buttonize "[Ignoring media]" toggle-track-media)
- 'mouse-face 'highlight
- 'help-echo
- "Ignoring media from links/urls.\nClick to toggle"))))
- (toggle-tools (lambda (&rest _) (interactive)
- (run-at-time 0 nil
- (lambda () (call-interactively #'gptel-tools)))))
- (tools (when (and gptel-use-tools gptel-tools)
- (propertize
- (buttonize (pcase (length gptel-tools)
- (0 "[No tools]") (1 "[1 tool]")
- (len (format "[%d tools]" len)))
- toggle-tools)
- 'mouse-face 'highlight
- 'help-echo "Select tools"))))
- (concat
- (propertize
- " " 'display
- `(space :align-to (- right
- ,(+ 5 (length model) (length system)
- (length track-media) (length context) (length tools)))))
- tools (and track-media " ") track-media (and context " ") context " " system " "
- (propertize
- (buttonize (concat "[" model "]")
- (lambda (&rest _) (gptel-menu)))
- 'mouse-face 'highlight
- 'help-echo "Model in use"))))
- "Information segment for the header-line in gptel-mode.")
-
-(defun gptel-use-header-line ()
- "Set up the header-line for a gptel buffer.
-
-It is composed of three segments: the backend name, the
-status (Ready/Waiting etc) and the info segment, showing the current
-context, tools, system prompt, model and more."
- (setq
- header-line-format
- (list '(:eval (concat (propertize " " 'display '(space :align-to 0))
- (format "%s" (gptel-backend-name gptel-backend))))
- (propertize " Ready" 'face 'success)
- gptel--header-line-info)))
-
-;;;###autoload
-(define-minor-mode gptel-mode
- "Minor mode for interacting with LLMs."
- :lighter " GPT"
- :keymap
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c RET") #'gptel-send)
- map)
- (if gptel-mode
- (progn
- (unless (derived-mode-p 'org-mode 'markdown-mode 'text-mode)
- (gptel-mode -1)
- (user-error (format "`gptel-mode' is not supported in `%s'." major-mode)))
- (add-hook 'before-save-hook #'gptel--save-state nil t)
- (add-hook 'after-change-functions 'gptel--inherit-stickiness nil t)
- (gptel--prettify-preset)
- (cond
- ((derived-mode-p 'org-mode)
- (require 'gptel-org)
- (jit-lock-register 'gptel-org--annotate-links)
- ;; Work around bug in `org-fontify-extend-region'.
- (add-hook 'gptel-post-response-functions #'font-lock-flush nil t))
- ((derived-mode-p 'markdown-mode)
- (font-lock-add-keywords ;keymap is a font-lock-managed property in markdown-mode
- nil '(("^```[ \t]*\\([[:alpha:]][^\n]*\\)?$" ;match code fences
- 0 (list 'face nil 'keymap gptel--markdown-block-map))))
- (jit-lock-register 'gptel-markdown--annotate-links)))
- (gptel--restore-state)
- (if gptel-use-header-line
- (progn (setq gptel--old-header-line header-line-format)
- (gptel-use-header-line))
- (setq mode-line-process
- '(:eval (concat " " (buttonize (gptel--model-name gptel-model)
- (lambda (&rest _) (gptel-menu))))))))
- (remove-hook 'before-save-hook #'gptel--save-state t)
- (remove-hook 'after-change-functions 'gptel--inherit-stickiness t)
- (cond
- ((derived-mode-p 'org-mode)
- (jit-lock-unregister #'gptel-org--annotate-links)
- (without-restriction (gptel--annotate-link-clear)))
- ((derived-mode-p 'markdown-mode)
- (jit-lock-unregister #'gptel-markdown--annotate-links)
- (without-restriction (gptel--annotate-link-clear))))
- (gptel--prettify-preset)
- (if gptel-use-header-line
- (setq header-line-format gptel--old-header-line
- gptel--old-header-line nil)
- (setq mode-line-process nil))))
-
-;; ;TODO(request-lib): Declaration no longer needed
-(defvar gptel--fsm-last) ;Defined further below
-(defun gptel--update-status (&optional msg face)
- "Update status MSG in FACE."
- (when gptel-mode
- (if gptel-use-header-line
- (and (consp header-line-format)
- (setf (nth 1 header-line-format)
- (thread-first
- msg
- (buttonize (lambda (_) (gptel--inspect-fsm)))
- (propertize 'face face 'mouse-face 'highlight))))
- (if (member msg '(" Typing..." " Waiting..."))
- (setq mode-line-process (propertize msg 'face face))
- (setq mode-line-process
- '(:eval (concat " "
- (buttonize (gptel--model-name gptel-model)
- (lambda (&rest _) (gptel-menu))))))
- (message (propertize msg 'face face))))
- (force-mode-line-update)))
-
-\f
-;;;; gptel-highlight-mode
-
-(defcustom gptel-highlight-methods '(margin)
- "Types of LLM response highlighting used by `gptel-highlight-mode'.
-
-This must be a list of symbols denoting types of highlighting for LLM responses:
-- face: highlight LLM responses using face `gptel-response-highlight'.
-- fringe: highlight using a (left) fringe marker.
-- margin: highlight in the (left) display margin.
-
-margin and fringe markings are mutually exclusive, and use the
-`gptel-response-fringe-highlight' face."
- :type '(set (const :tag "Fringe marker" fringe)
- (const :tag "Face highlighting" face)
- (const :tag "Margin indicator" margin))
- :group 'gptel)
-
-(defface gptel-response-highlight
- '((((background light) (min-colors 88)) :background "linen" :extend t)
- (((background dark) (min-colors 88)) :background "gray14" :extend t)
- (t :inherit mode-line))
- "Face used to highlight LLM responses when using `gptel-highlight-mode'.
-
-To enable this face for responses, `gptel-highlight-methods' must be set."
- :group 'gptel)
-
-(defface gptel-response-fringe-highlight
- '((t :inherit outline-1 :height reset))
- "LLM response fringe/margin face when using `gptel-highlight-mode'.
-
-To enable response highlights in the fringe, `gptel-highlight-methods'
-must be set."
- :group 'gptel)
-
-(define-fringe-bitmap 'gptel-highlight-fringe
- (make-vector 28 #b01100000)
- nil nil 'center)
-
-;; Common options for margin indicator:
-;; BOX DRAWINGS LIGHT VERTICAL 0x002502
-;; LEFT ONE QUARTER BLOCK 0x00258E
-;; LEFT THREE EIGHTHS BLOCK 0x00258D
-;; BOX DRAWINGS HEAVY VERTICAL 0x002503
-;; VERTICAL ONE EIGHTH BLOCK-2 0x01FB70
-
-(defun gptel-highlight--margin-prefix (type)
- "Create margin prefix string for TYPE.
-
-Supported TYPEs are response, ignore and tool calls."
- (propertize ">" 'display
- `( (margin left-margin)
- ,(propertize "▎" 'face
- (pcase type
- ('response 'gptel-response-fringe-highlight)
- ('ignore 'shadow)
- (`(tool . ,_) 'shadow))))))
-
-(defun gptel-highlight--fringe-prefix (type)
- "Create fringe prefix string for TYPE.
-
-Supported TYPEs are response, ignore and tool calls."
- (propertize ">" 'display
- `( left-fringe gptel-highlight-fringe
- ,(pcase type
- ('response 'gptel-response-fringe-highlight)
- ('ignore 'shadow)
- (`(tool . ,_) 'shadow)))))
-
-(defun gptel-highlight--decorate (ov &optional val)
- "Decorate gptel indicator overlay OV whose type is VAL."
- (overlay-put ov 'evaporate t)
- (overlay-put ov 'gptel-highlight t)
- (when (memq 'face gptel-highlight-methods)
- (overlay-put ov 'font-lock-face
- (pcase val
- ('response 'gptel-response-highlight)
- ('ignore 'shadow)
- (`(tool . ,_) 'shadow))))
- (when-let* ((prefix
- (cond ((memq 'margin gptel-highlight-methods)
- (gptel-highlight--margin-prefix (or val 'response)))
- ((memq 'fringe gptel-highlight-methods)
- (gptel-highlight--fringe-prefix (or val 'response))))))
- (overlay-put ov 'line-prefix prefix)
- (overlay-put ov 'wrap-prefix prefix)))
-
-(defun gptel-highlight--update (beg end)
- "JIT-lock function: mark gptel response/reasoning regions.
-
-BEG and END delimit the region to refresh."
- (save-excursion ;Scan across region for the gptel text property
- (let ((prev-pt (goto-char end)))
- (while (and (goto-char (previous-single-property-change
- (point) 'gptel nil beg))
- (/= (point) prev-pt))
- (pcase (get-char-property (point) 'gptel)
- ((and (or 'response 'ignore `(tool . ,_)) val)
- (if-let* ((ov (or (cdr-safe (get-char-property-and-overlay
- (point) 'gptel-highlight))
- (cdr-safe (get-char-property-and-overlay
- prev-pt 'gptel-highlight))))
- (from (overlay-start ov)) (to (overlay-end ov)))
- (unless (<= from (point) prev-pt to)
- (move-overlay ov (min from (point)) (max to prev-pt)))
- (gptel-highlight--decorate ;Or make new overlay covering just region
- (make-overlay (point) prev-pt nil t) val)))
- ('nil ;If there's an overlay, we need to split it.
- (when-let* ((ov (cdr-safe (get-char-property-and-overlay
- (point) 'gptel-highlight)))
- (from (overlay-start ov)) (to (overlay-end ov)))
- (move-overlay ov from (point)) ;Move overlay to left side
- (gptel-highlight--decorate ;Make a new one on the right
- (make-overlay prev-pt to nil t)
- (get-char-property prev-pt 'gptel)))))
- (setq prev-pt (point)))))
- `(jit-lock-bounds ,beg . ,end))
-
-(define-minor-mode gptel-highlight-mode
- "Visually highlight LLM respones regions.
-
-Highlighting is via fringe or margin markers, and optionally a response
-face. See `gptel-highlight-methods' for highlighting methods, and
-`gptel-response-highlight' and `gptel-response-fringe-highlight' for the
-faces.
-
-This minor mode can be used anywhere in Emacs, and not just gptel chat
-buffers."
- :lighter nil
- :global nil
- (cond
- (gptel-highlight-mode
- (when (memq 'margin gptel-highlight-methods)
- (setq left-margin-width (1+ left-margin-width))
- (if-let* ((win (get-buffer-window (current-buffer))))
- (set-window-buffer win (current-buffer))))
- (jit-lock-register #'gptel-highlight--update)
- (gptel-highlight--update (point-min) (point-max)))
- (t (when (memq 'margin gptel-highlight-methods)
- (setq left-margin-width (max (1- left-margin-width) 0))
- (if-let* ((win (get-buffer-window (current-buffer))))
- (set-window-buffer win (current-buffer))))
- (jit-lock-unregister #'gptel-highlight--update)
- (without-restriction
- (remove-overlays nil nil 'gptel-highlight t)))))
-
-\f
-;;; State machine additions for `gptel-send'.
-
-(defvar gptel-send--handlers
- `((WAIT ,#'gptel--handle-wait ,#'gptel--update-wait)
- (TYPE ,#'gptel--handle-pre-insert)
- (ERRS ,#'gptel--handle-error ,#'gptel--fsm-last)
- (TOOL ,#'gptel--update-tool-call ,#'gptel--handle-tool-use ,#'gptel--update-tool-ask)
- (DONE ,#'gptel--handle-post-insert ,#'gptel--fsm-last)
- (ABRT ,#'gptel--handle-abort))
- "Alist specifying handlers for `gptel-send' state transitions.
-
-See `gptel-request--handlers' for details.")
-
-(defvar-local gptel--fsm-last nil
- "State machine for latest request in the buffer.")
-
-(defun gptel--fsm-last (fsm)
- "Capture the latest request state FSM for introspection."
- (let ((info (gptel-fsm-info fsm)))
- (unless gptel-log-level
- (let ((data (plist-get info :data)))
- (dolist (key '(:messages :contents :query))
- (setf (plist-get data key) nil))))
- (setf (gptel-fsm-info fsm)
- (plist-put info :end-time (current-time-string)))
- (with-current-buffer (plist-get info :buffer)
- (setq gptel--fsm-last fsm))))
-
-(defun gptel--inspect-fsm (&optional fsm)
- "Inspect gptel request state FSM.
-
-FSM defaults to the state of the last request in the current
-buffer."
- (unless fsm
- (setq fsm (or (cdr-safe (cl-find-if
- (lambda (proc-list)
- (eq (thread-first (cadr proc-list)
- (gptel-fsm-info)
- (plist-get :buffer))
- (current-buffer)))
- gptel--request-alist))
- gptel--fsm-last)))
- (unless (cl-typep gptel--fsm-last 'gptel-fsm)
- (user-error "No gptel request log in this buffer yet!"))
- (require 'tabulated-list)
- (with-current-buffer (get-buffer-create "*gptel-diagnostic*")
- (setq tabulated-list-format [("Request attribute" 30 t) ("Value" 30)])
- (let* ((pb (lambda (s) (propertize s 'face 'font-lock-builtin-face)))
- (ps (lambda (s) (propertize s 'face 'font-lock-string-face)))
- (fmt (lambda (s) (cond ((memq (car-safe s) '(closure lambda))
- (format "#<lambda %#x>" (sxhash s)))
- ((byte-code-function-p s)
- (format "#<compiled %#x>" (sxhash s)))
- ((stringp s) (string-replace "\n" "⮐ " s))
- (t (prin1-to-string s)))))
- (inhibit-read-only t)
- (info (gptel-fsm-info fsm))
- (entries-info
- (cl-loop
- for idx upfrom 3
- for (key val) on info by #'cddr
- unless (memq key '(:data :history :tools
- :partial_text :partial_json))
- collect
- (list idx `[,(funcall pb (symbol-name key))
- ,(funcall ps (funcall fmt val))])))
- (entries-data
- (cl-loop
- for idx upfrom 50
- for (key val) on (plist-get info :data) by #'cddr
- unless (memq key '(:messages :stream :contents :query))
- collect
- (list idx `[,(funcall pb (symbol-name key))
- ,(funcall ps (funcall fmt val))]))))
- (setq tabulated-list-entries
- (nconc (list `(2 [,(funcall pb ":state")
- ,(funcall ps
- (mapconcat
- fmt (reverse (cons (gptel-fsm-state fsm)
- (plist-get info :history)))
- " → "))]))
- entries-info
- entries-data))
- (tabulated-list-print)
- (tabulated-list-mode)
- (tabulated-list-init-header)
- (hl-line-mode 1)
- (display-buffer
- (current-buffer)
- '((display-buffer-in-side-window)
- (side . bottom)
- (window-height . fit-window-to-buffer)
- (slot . 10)
- (body-function . select-window))))))
-
-;;;; State machine handlers
-;; The next few functions are default state handlers for gptel-send, see
-;; `gptel-send--handlers'.
-
-(defun gptel--handle-pre-insert (fsm)
- "Tasks before inserting the LLM response for state FSM.
-
-Handle read-only buffers and run pre-response hooks (but only if
-the request succeeded)."
- (let* ((info (gptel-fsm-info fsm))
- (start-marker (plist-get info :position)))
- (when (and
- (memq (plist-get info :callback)
- '(gptel--insert-response gptel-curl--stream-insert-response))
- (with-current-buffer (plist-get info :buffer)
- (or buffer-read-only
- (get-char-property start-marker 'read-only))))
- (message "Buffer is read only, displaying reply in buffer \"*LLM response*\"")
- (display-buffer
- (with-current-buffer (get-buffer-create "*LLM response*")
- (visual-line-mode 1)
- (goto-char (point-max))
- (move-marker start-marker (point) (current-buffer))
- (current-buffer))
- '((display-buffer-reuse-window
- display-buffer-pop-up-window)
- (reusable-frames . visible))))
- (with-current-buffer (marker-buffer start-marker)
- (when (plist-get info :stream)
- (gptel--update-status " Typing..." 'success))
- (save-excursion
- (goto-char start-marker)
- (when (and (member (plist-get info :http-status) '("200" "100"))
- gptel-pre-response-hook)
- (run-hooks 'gptel-pre-response-hook))))))
-
-(defun gptel--handle-post-insert (fsm)
- "Tasks after successfully inserting the LLM response with state FSM.
-
-Indicate gptel status, pulse the inserted text and run post-response hooks.
-
-No state transition here since that's handled by the process sentinels."
- (let* ((info (gptel-fsm-info fsm))
- (start-marker (plist-get info :position))
- (tracking-marker (or (plist-get info :tracking-marker)
- start-marker))
- ;; start-marker may have been moved if :buffer was read-only
- (gptel-buffer (marker-buffer start-marker)))
- (with-current-buffer gptel-buffer
- (if (not tracking-marker) ;Empty response
- (when gptel-mode (gptel--update-status " Empty response" 'success))
- (set-marker-insertion-type tracking-marker nil) ;Lock tracking-marker
- (when gptel-mode
- (unless (plist-get info :in-place)
- (save-excursion (goto-char tracking-marker)
- (insert gptel-response-separator
- (gptel-prompt-prefix-string))))
- (gptel--update-status " Ready" 'success))))
- ;; Run hook in visible window to set window-point, BUG #269
- (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible)))
- (with-selected-window gptel-window
- (mapc (lambda (f) (funcall f info)) (plist-get info :post))
- (run-hook-with-args
- 'gptel-post-response-functions
- (marker-position start-marker) (marker-position tracking-marker)))
- (with-current-buffer gptel-buffer
- (mapc (lambda (f) (funcall f info)) (plist-get info :post))
- (run-hook-with-args
- 'gptel-post-response-functions
- (marker-position start-marker) (marker-position tracking-marker))))))
-
-(defun gptel--handle-error (fsm)
- "Check for errors in request state FSM.
-
-Perform UI updates and run post-response hooks."
- (when-let* ((info (gptel-fsm-info fsm))
- (error-data (plist-get info :error))
- (http-msg (plist-get info :status))
- (gptel-buffer (plist-get info :buffer))
- (start-marker (plist-get info :position))
- (tracking-marker (or (plist-get info :tracking-marker)
- start-marker))
- (backend-name
- (gptel-backend-name
- (buffer-local-value 'gptel-backend gptel-buffer))))
- (if (stringp error-data)
- (message "%s error: (%s) %s" backend-name http-msg (string-trim error-data))
- (when-let* ((error-type (plist-get error-data :type)))
- (setq http-msg (concat "(" http-msg ") "
- (string-trim (gptel--to-string error-type)))))
- (when-let* ((error-msg (plist-get error-data :message)))
- (message "%s error: (%s) %s" backend-name http-msg
- (string-trim (gptel--to-string error-msg)))))
- (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible)))
- (with-selected-window gptel-window
- (mapc (lambda (f) (funcall f info)) (plist-get info :post))
- (run-hook-with-args
- 'gptel-post-response-functions
- (marker-position start-marker) (marker-position tracking-marker)))
- (with-current-buffer gptel-buffer
- (mapc (lambda (f) (funcall f info)) (plist-get info :post))
- (run-hook-with-args
- 'gptel-post-response-functions
- (marker-position start-marker) (marker-position tracking-marker))))
- (with-current-buffer gptel-buffer
- (when gptel-mode
- (gptel--update-status
- (format " Error: %s" http-msg) 'error)))))
-
-(defun gptel--handle-abort (fsm)
- "Perform UI update on `gptel-abort' for FSM."
- (when-let* ((info (gptel-fsm-info fsm))
- (gptel-buffer (plist-get info :buffer))
- (start-marker (plist-get info :position))
- (tracking-marker (or (plist-get info :tracking-marker)
- start-marker)))
- (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible)))
- (with-selected-window gptel-window
- (mapc (lambda (f) (funcall f info)) (plist-get info :post))
- (run-hook-with-args
- 'gptel-post-response-functions
- (marker-position start-marker) (marker-position tracking-marker)))
- (with-current-buffer gptel-buffer
- (mapc (lambda (f) (funcall f info)) (plist-get info :post))
- (run-hook-with-args
- 'gptel-post-response-functions
- (marker-position start-marker) (marker-position tracking-marker))))
- (with-current-buffer gptel-buffer
- (when gptel-mode (gptel--update-status " Abort" 'error)))))
-
-(defun gptel--update-wait (fsm)
- "Update gptel's status after sending a request."
- (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer)
- (when gptel-mode
- (gptel--update-status " Waiting..." 'warning))))
-
-(defun gptel--update-tool-call (fsm)
- "Update gptel's status when calling a tool."
- (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer)
- (setq gptel--fsm-last fsm)
- (when gptel-mode
- (gptel--update-status " Calling tool..." 'mode-line-emphasis))))
-
-(defun gptel--update-tool-ask (fsm)
- "Update gptel's status when there are pending tool calls."
- (when (plist-get (gptel-fsm-info fsm) :tool-pending)
- (plist-put (gptel-fsm-info fsm) :tool-pending nil)
- (when gptel-mode
- (gptel--update-status " Run tools?" 'mode-line-emphasis))))
-
-\f
-;;; Send queries, handle responses
-;;;###autoload
-(defun gptel-send (&optional arg)
- "Submit this prompt to the current LLM backend.
-
-By default, the contents of the buffer up to the cursor position
-are sent. If the region is active, its contents are sent
-instead.
-
-The response from the LLM is inserted below the cursor position
-at the time of sending. To change this behavior or model
-parameters, use prefix arg ARG activate a transient menu with
-more options instead.
-
-This command is asynchronous, you can continue to use Emacs while
-waiting for the response."
- (interactive "P")
- (if (and arg (require 'gptel-transient nil t))
- (call-interactively #'gptel-menu)
- (gptel--sanitize-model)
- (let ((fsm (gptel-make-fsm :handlers gptel-send--handlers)))
- (gptel-request nil
- :stream gptel-stream
- :transforms gptel-prompt-transform-functions
- :fsm fsm)
- (message "Querying %s..."
- (thread-first (gptel-fsm-info fsm)
- (plist-get :backend)
- (or gptel-backend)
- (gptel-backend-name))))
- (gptel--update-status " Waiting..." 'warning)))
-
-(declare-function json-pretty-print-buffer "json")
-(defun gptel--inspect-query (&optional request-fsm format)
- "Show the full LLM query that will be sent in a buffer.
-
-This functions as a dry run of `gptel-send'. The request data
-may be edited and the query continued from this buffer.
-
-REQUEST-FSM is the state of the request, as returned by
-`gptel-request'. If FORMAT is the symbol json, show the encoded
-JSON query instead of the Lisp structure gptel uses."
- (unless request-fsm (setq request-fsm gptel--fsm-last))
- (if (bufferp (plist-get (gptel-fsm-info request-fsm) :data))
- (letrec ((dry-run-poll
- (run-with-timer
- 0 1 (lambda (fsm form)
- (unless (bufferp (plist-get (gptel-fsm-info fsm) :data))
- (cancel-timer dry-run-poll)
- (gptel--inspect-query fsm form)))
- request-fsm format))))
- (with-current-buffer (plist-get (gptel-fsm-info request-fsm) :buffer)
- (gptel--update-status " Ready" 'success))
- (with-current-buffer (get-buffer-create "*gptel-query*")
- (let* ((standard-output (current-buffer))
- (inhibit-read-only t)
- (request-data
- (plist-get (gptel-fsm-info request-fsm) :data)))
- (buffer-disable-undo)
- (erase-buffer)
- (if (eq format 'json)
- (progn (fundamental-mode)
- (insert (gptel--json-encode request-data))
- (json-pretty-print-buffer))
- (lisp-data-mode)
- (prin1 request-data)
- (pp-buffer))
- (setq-local gptel--fsm-last request-fsm)
- (goto-char (point-min))
- (view-mode 1)
- (setq buffer-undo-list nil)
- (use-local-map
- (make-composed-keymap
- (define-keymap
- "C-c C-c" #'gptel--continue-query
- "C-c C-w" (lambda () "Copy Curl command for query."
- (interactive) (gptel--continue-query 'copy))
- "C-c C-k" #'quit-window)
- (current-local-map)))
- (unless header-line-format
- (setq header-line-format
- (substitute-command-keys
- (concat
- "Edit request: \\[read-only-mode],"
- " Send request: \\[gptel--continue-query],"
- (format " Copy Curl: %s"
- (propertize "C-c C-w" 'face 'help-key-binding))
- " Quit: \\[quit-window]"))))
- (display-buffer (current-buffer) gptel-display-buffer-action)))))
-
-(defun gptel--continue-query (&optional copy)
- "Continue sending the gptel query displayed in this buffer.
-
-The request is continued with the same parameters as originally
-specified.
-
-With prefix arg COPY, copy the Curl command for the request to the
-kill ring instead."
- (interactive "P" lisp-data-mode fundamental-mode)
- (unless (equal (buffer-name) "*gptel-query*")
- (user-error "This command is meant for use in a gptel dry-run buffer"))
- (save-excursion
- (goto-char (point-min))
- (condition-case-unless-debug nil
- (when-let* ((data (if (eq major-mode 'lisp-data-mode)
- (read (current-buffer))
- (gptel--json-read))))
- (cl-assert (cl-typep gptel--fsm-last 'gptel-fsm))
- (plist-put (gptel-fsm-info gptel--fsm-last) :data data)
- (if copy ;Copy Curl command instead of sending request
- (let ((args (gptel-curl--get-args (gptel-fsm-info gptel--fsm-last)
- (md5 (format "%s" (random))))))
- (kill-new
- (mapconcat #'shell-quote-argument
- (cons (gptel--curl-path) args) " \\\n"))
- (message "Curl command for request copied to kill-ring"))
- (gptel--fsm-transition gptel--fsm-last) ;INIT -> WAIT
- (quit-window)))
- (error
- (user-error "Can not resume request: could not read data from buffer!")))))
-
-(defun gptel--insert-response (response info &optional raw)
- "Insert the LLM RESPONSE into the gptel buffer.
-
-INFO is a plist containing information relevant to this buffer.
-See `gptel--url-get-response' for details.
-
-Optional RAW disables text properties and transformation."
- (let* ((gptel-buffer (plist-get info :buffer))
- (start-marker (plist-get info :position))
- (tracking-marker (plist-get info :tracking-marker)))
- (pcase response
- ((pred stringp) ;Response text
- (with-current-buffer gptel-buffer
- (when tracking-marker ;separate from previous response
- (setq response (concat gptel-response-separator response)))
- (save-excursion
- (with-current-buffer (marker-buffer start-marker)
- (goto-char (or tracking-marker start-marker))
- ;; (run-hooks 'gptel-pre-response-hook)
- (unless (or (bobp) (plist-get info :in-place)
- tracking-marker)
- (insert gptel-response-separator)
- (when gptel-mode
- (insert (gptel-response-prefix-string)))
- (move-marker start-marker (point)))
- (unless raw
- (when-let* ((transformer (plist-get info :transformer)))
- (setq response (funcall transformer response)))
- (add-text-properties
- 0 (length response) '(gptel response front-sticky (gptel)) response))
- (insert response)
- (plist-put info :tracking-marker (setq tracking-marker (point-marker)))
- ;; for uniformity with streaming responses
- (set-marker-insertion-type tracking-marker t)))))
- (`(reasoning . ,text)
- (when-let* ((include (plist-get info :include-reasoning)))
- (if (stringp include)
- (with-current-buffer (get-buffer-create
- (plist-get info :include-reasoning))
- (save-excursion (goto-char (point-max)) (insert text)))
- (with-current-buffer (marker-buffer start-marker)
- (let ((separator ;Separate from response prefix if required
- (and (not tracking-marker) gptel-mode
- (not (string-suffix-p "\n" (gptel-response-prefix-string)))
- "\n"))
- (blocks (if (derived-mode-p 'org-mode)
- `("#+begin_reasoning\n" . ,(concat "\n#+end_reasoning"
- gptel-response-separator))
- ;; TODO(reasoning) remove properties and strip instead
- (cons (propertize "``` reasoning\n" 'gptel 'ignore
- 'keymap gptel--markdown-block-map)
- (concat (propertize "\n```" 'gptel 'ignore
- 'keymap gptel--markdown-block-map)
- gptel-response-separator)))))
- (if (eq include 'ignore)
- (progn
- (add-text-properties
- 0 (length text) '(gptel ignore front-sticky (gptel)) text)
- (gptel--insert-response
- (concat (car blocks) text (cdr blocks)) info t))
- (gptel--insert-response (concat separator (car blocks)) info t)
- (gptel--insert-response text info)
- (gptel--insert-response (cdr blocks) info t))
- (save-excursion
- (goto-char (plist-get info :tracking-marker))
- (if (derived-mode-p 'org-mode) ;fold block
- (progn (search-backward "#+end_reasoning" start-marker t)
- (when (looking-at "^#\\+end_reasoning")
- (org-cycle)))
- (when (re-search-backward "^```" start-marker t)
- (gptel-markdown-cycle-block)))))))))
- (`(tool-call . ,tool-calls)
- (gptel--display-tool-calls tool-calls info))
- (`(tool-result . ,tool-results)
- (gptel--display-tool-results tool-results info)))))
-
-(defun gptel-curl--stream-insert-response (response info &optional raw)
- "Insert streaming RESPONSE from an LLM into the gptel buffer.
-
-INFO is a mutable plist containing information relevant to this buffer.
-See `gptel--url-get-response' for details.
-
-Optional RAW disables text properties and transformation."
- (pcase response
- ((pred stringp)
- (let ((start-marker (plist-get info :position))
- (tracking-marker (plist-get info :tracking-marker))
- (transformer (plist-get info :transformer)))
- (with-current-buffer (marker-buffer start-marker)
- (save-excursion
- (unless tracking-marker
- (goto-char start-marker)
- (unless (or (bobp) (plist-get info :in-place))
- (insert gptel-response-separator)
- (when gptel-mode
- ;; Put prefix before AI response.
- (insert (gptel-response-prefix-string)))
- (move-marker start-marker (point)))
- (setq tracking-marker (set-marker (make-marker) (point)))
- (set-marker-insertion-type tracking-marker t)
- (plist-put info :tracking-marker tracking-marker))
- (goto-char tracking-marker)
- (unless raw
- (when transformer
- (setq response (funcall transformer response)))
- (add-text-properties
- 0 (length response) '(gptel response front-sticky (gptel))
- response))
- ;; (run-hooks 'gptel-pre-stream-hook)
- (insert response)
- (run-hooks 'gptel-post-stream-hook)))))
- (`(reasoning . ,text)
- (gptel--display-reasoning-stream text info))
- (`(tool-call . ,tool-calls)
- (gptel--display-tool-calls tool-calls info))
- (`(tool-result . ,tool-results)
- (gptel--display-tool-results tool-results info)
- ;; Adjust for tool calls inside reasoning blocks
- (when (eq (plist-get info :reasoning-block) 'in)
- (when-let* ((rm (plist-get info :reasoning-marker))
- (tm (plist-get info :tracking-marker)))
- (move-marker rm tm (marker-buffer tm)))))))
-
-;;;###autoload
-(defun gptel (name &optional _ initial interactivep)
- "Switch to or start a chat session with NAME.
-
-Ask for API-KEY if `gptel-api-key' is unset.
-
-If region is active, use it as the INITIAL prompt. Returns the
-buffer created or switched to.
-
-INTERACTIVEP is t when gptel is called interactively."
- (interactive
- (let* ((backend (default-value 'gptel-backend))
- (backend-name
- (format "*%s*" (gptel-backend-name backend))))
- (list (read-buffer
- "Create or choose gptel buffer: "
- backend-name nil ; DEFAULT and REQUIRE-MATCH
- (lambda (b) ; PREDICATE
- ;; NOTE: buffer check is required (#450)
- (and-let* ((buf (get-buffer (or (car-safe b) b))))
- (buffer-local-value 'gptel-mode buf))))
- (condition-case nil
- (gptel--get-api-key
- (gptel-backend-key backend))
- ((error user-error)
- (setq gptel-api-key
- (read-passwd
- (format "%s API key: " backend-name)))))
- (and (use-region-p)
- (buffer-substring (region-beginning)
- (region-end)))
- t)))
- (with-current-buffer (get-buffer-create name)
- (cond ;Set major mode
- ((eq major-mode gptel-default-mode))
- ((eq gptel-default-mode 'text-mode)
- (text-mode)
- (visual-line-mode 1))
- (t (funcall gptel-default-mode)))
- (gptel--sanitize-model :backend (default-value 'gptel-backend)
- :model (default-value 'gptel-model)
- :shoosh nil)
- (unless gptel-mode (gptel-mode 1))
- (goto-char (point-max))
- (skip-chars-backward "\t\r\n")
- (if (bobp) (insert (or initial (gptel-prompt-prefix-string))))
- (when interactivep
- (display-buffer (current-buffer) gptel-display-buffer-action)
- (message "Send your query with %s!"
- (substitute-command-keys "\\[gptel-send]")))
- (current-buffer)))
-
-\f
-;;; Reasoning content UI
-(defun gptel--display-reasoning-stream (text info)
- "Show reasoning TEXT in an appropriate location.
-
-INFO is the request INFO, see `gptel--url-get-response'. This is
-for streaming responses only."
- (when-let* ((include (plist-get info :include-reasoning)))
- (if (stringp include)
- (unless (eq text t)
- (with-current-buffer (get-buffer-create include)
- (save-excursion (goto-char (point-max))
- (insert text))))
- (let* ((reasoning-marker (plist-get info :reasoning-marker))
- (tracking-marker (plist-get info :tracking-marker))
- (start-marker (plist-get info :position)))
- (with-current-buffer (marker-buffer start-marker)
- (if (eq text t) ;end of stream
- (progn
- (gptel-curl--stream-insert-response
- (concat (if (derived-mode-p 'org-mode)
- "\n#+end_reasoning"
- ;; TODO(reasoning) remove properties and strip instead
- (propertize "\n```" 'gptel 'ignore
- 'keymap gptel--markdown-block-map))
- gptel-response-separator)
- info t)
- (ignore-errors ;fold block
- (save-excursion
- (goto-char tracking-marker)
- (if (derived-mode-p 'org-mode)
- (progn (search-backward "#+end_reasoning" start-marker t)
- (when (looking-at "^#\\+end_reasoning")
- (org-cycle)))
- (when (re-search-backward "^```" start-marker t)
- (gptel-markdown-cycle-block))))))
- (unless (and reasoning-marker tracking-marker
- (= reasoning-marker tracking-marker))
- (let ((separator ;Separate from response prefix if required
- (and (not tracking-marker) gptel-mode
- (not (string-suffix-p
- "\n" (gptel-response-prefix-string)))
- "\n")))
- (gptel-curl--stream-insert-response
- (concat separator
- (if (derived-mode-p 'org-mode)
- "#+begin_reasoning\n"
- ;; TODO(reasoning) remove properties and strip instead
- (propertize "``` reasoning\n" 'gptel 'ignore
- 'keymap gptel--markdown-block-map)))
- info t)))
- (if (eq include 'ignore)
- (progn
- (add-text-properties
- 0 (length text) '(gptel ignore front-sticky (gptel)) text)
- (gptel-curl--stream-insert-response text info t))
- (gptel-curl--stream-insert-response text info)))
- (setq tracking-marker (plist-get info :tracking-marker))
- (if reasoning-marker
- (move-marker reasoning-marker tracking-marker)
- (plist-put info :reasoning-marker
- (copy-marker tracking-marker nil))))))))
-
-(defvar gptel--tool-preview-alist nil
- "Alist mapping tool names to preview functions for tools.
-
-Each key is a tool name (string) and value is a list of one or two
-functions, for preview-setup and (optional) preview-teardown.
-
-The preview-setup function is called with two arguments: a list of the
-corresponding tool call arguments and the request INFO plist. It must
-set up the preview for the tool call and return a handle to the preview,
-which can be any object, but typically an overlay or a buffer.
-
-The preview-setup can integrate with gptel's default previewer by
-inserting at point (and moving point), or use a different preview method
-entirely.
-
-The preview-teardown function, if provided, is called with this handle
-when the tool call is accepted or rejected, and it must clear the
-preview.
-
-Note: This tool call preview API is currently experimental.")
-
-\f
-;;; Tool use UI
-(defvar-keymap gptel-tool-call-actions-map
- :doc "Keymap for actions on tool calls."
- "<mouse-1>" #'gptel--dispatch-tool-calls
- "C-c C-c" #'gptel--accept-tool-calls
- "C-c C-k" #'gptel--reject-tool-calls
- "C-c C-i" #'gptel--inspect-tool-calls)
-
-(defun gptel--display-tool-calls (tool-calls info &optional use-minibuffer)
- "Handle tool call confirmation.
-
-TOOL-CALLS should be a list of tool call specifications or results,
-structured as:
-
- ((tool args callback) ...)
-
-for tool call specifications to be confirmed. INFO contains the
-state of the request. To prompt for tool call confirmation, use
-either an overlay in the request buffer or the minibuffer (if
-USE-MINIBUFFER is non-nil)."
- (let* ((start-marker (plist-get info :position))
- (tracking-marker (plist-get info :tracking-marker)))
- ;; pending tool calls look like ((tool callback args) ...)
- (with-current-buffer (plist-get info :buffer)
- (if (or use-minibuffer ;prompt for confirmation from the minibuffer
- buffer-read-only ;TEMP(tool-preview) Handle read-only buffers better
- (get-char-property
- (max (point-min) (1- (or tracking-marker start-marker)))
- 'read-only))
- (let* ((minibuffer-allow-text-properties t)
- (backend-name (gptel-backend-name (plist-get info :backend)))
- (prompt (format "%s wants to run " backend-name)))
- (map-y-or-n-p
- (lambda (tool-call-spec)
- (concat prompt (propertize (gptel-tool-name (car tool-call-spec))
- 'face 'font-lock-keyword-face)
- ": "))
- (lambda (tcs) (gptel--accept-tool-calls (list tcs) nil))
- tool-calls '("tool call" "tool calls" "run")
- `((?i ,(lambda (_) (save-window-excursion
- (with-selected-window
- (gptel--inspect-fsm gptel--fsm-last)
- (goto-char (point-min))
- (when (search-forward-regexp "^:tool-use" nil t)
- (forward-line 0) (hl-line-highlight))
- (use-local-map
- (make-composed-keymap
- (define-keymap "q" (lambda () (interactive)
- (quit-window)
- (exit-recursive-edit)))
- (current-local-map)))
- (recursive-edit) nil)))
- "inspect call(s)"))))
- ;; Prompt for confirmation from the chat buffer
- (let* ((backend-name (gptel-backend-name (plist-get info :backend)))
- (actions-string
- (concat (propertize "Run tools: " 'face 'font-lock-string-face)
- (propertize "C-c C-c" 'face 'help-key-binding)
- (propertize ", Cancel request: " 'face 'font-lock-string-face)
- (propertize "C-c C-k" 'face 'help-key-binding)
- (propertize ", Inspect: " 'face 'font-lock-string-face)
- (propertize "C-c C-i" 'face 'help-key-binding)))
- (confirm-strings)
- ;; FIXME(tool) use a wrapper instead of a manual text-property search,
- ;; this is fragile
- (ov-start (save-excursion
- (goto-char start-marker)
- (text-property-search-backward 'gptel 'response)
- (point)))
- (preview-handlers)
- (ov (or (cdr-safe (get-char-property-and-overlay
- start-marker 'gptel-tool))
- (make-overlay ov-start (or tracking-marker start-marker)
- nil nil nil)))
- (prompt-ov))
- ;; If the cursor is at the overlay-end, it ends up outside, so move it back
- (unless tracking-marker
- (when (= (point) start-marker) (ignore-errors (backward-char))))
- (save-excursion
- (goto-char (overlay-end ov))
- (pcase-dolist (`(,tool-spec ,arg-values _) tool-calls)
- ;; Call tool-specific confirmation prompt
- (if-let* ((funcs (cdr (assoc (gptel-tool-name tool-spec)
- gptel--tool-preview-alist)))
- ((functionp (car-safe funcs))))
- ;;preview-teardown func preview-handle overlay/buffer
- (push (list (cadr funcs) (funcall (car funcs) arg-values info))
- preview-handlers)
- (push (gptel--format-tool-call (gptel-tool-name tool-spec) arg-values)
- confirm-strings)))
- (and confirm-strings (apply #'insert (nreverse confirm-strings)))
- (add-text-properties (overlay-end ov) (1- (point))
- '(read-only t font-lock-fontified t))
- (setq prompt-ov (make-overlay (overlay-end ov) (point) nil t))
- (overlay-put
- prompt-ov 'before-string
- (concat "\n"
- (propertize " " 'display `(space :align-to (- right ,(length actions-string) 2))
- 'face '(:inherit font-lock-string-face :underline t :extend t))
- actions-string
- (format (propertize "\n%s wants to run:\n\n"
- 'face 'font-lock-string-face)
- backend-name)))
- (overlay-put
- prompt-ov 'after-string
- (concat (propertize "\n" 'face
- '(:inherit font-lock-string-face :underline t :extend t))))
- (overlay-put prompt-ov 'evaporate t)
- (overlay-put ov 'prompt prompt-ov)
- (move-overlay ov ov-start (point)))
- ;; Add confirmation prompt to the overlay
- (when preview-handlers (overlay-put ov 'previews preview-handlers))
- (overlay-put ov 'mouse-face 'highlight)
- (overlay-put ov 'gptel-tool tool-calls)
- (overlay-put ov 'help-echo
- (concat "Tool call(s) requested: " actions-string))
- (overlay-put ov 'keymap gptel-tool-call-actions-map)
- prompt-ov)))))
-
-(defun gptel--display-tool-results (tool-results info)
- "Insert TOOL-RESULTS into buffer.
-
-TOOL-RESULTS is
-
- ((tool args result) ...)
-
-for tool call results. INFO contains the state of the request."
- (let* ((start-marker (plist-get info :position))
- (tool-marker (plist-get info :tool-marker))
- (tracking-marker (plist-get info :tracking-marker)))
- ;; Insert tool results
- (with-current-buffer (marker-buffer start-marker)
- (when gptel-include-tool-results
- (cl-loop
- for (tool args result) in tool-results
- with include-names =
- (mapcar #'gptel-tool-name
- (cl-remove-if-not #'gptel-tool-include (plist-get info :tools)))
- if (or (eq gptel-include-tool-results t)
- (member (gptel-tool-name tool) include-names))
- do (funcall
- (plist-get info :callback)
- (let* ((name (gptel-tool-name tool))
- (separator ;Separate from response prefix if required
- (cond ((not tracking-marker)
- (and gptel-mode
- (not (string-suffix-p
- "\n" (gptel-response-prefix-string)))
- "\n")) ;start of response
- ((not (and tool-marker ;not consecutive tool result blocks
- (= tracking-marker tool-marker)))
- gptel-response-separator)))
- (tool-use
- ;; TODO(tool) also check args since there may be more than
- ;; one call/result for the same tool
- (cl-find-if
- (lambda (tu) (equal (plist-get tu :name) name))
- (plist-get info :tool-use)))
- (id (plist-get tool-use :id))
- (display-call (format "(%s %s)" name
- (string-trim (prin1-to-string args) "(" ")")))
- (call (prin1-to-string `(:name ,name :args ,args)))
- (truncated-call
- (string-replace "\n" " "
- (truncate-string-to-width
- display-call
- (floor (* (window-width) 0.6)) 0 nil " ...)"))))
- (if (derived-mode-p 'org-mode)
- (concat
- separator
- "#+begin_tool "
- truncated-call
- (propertize
- (org-escape-code-in-string (concat "\n" call "\n\n" result))
- 'gptel `(tool . ,id))
- "\n#+end_tool\n")
- ;; TODO(tool) else branch is handling all front-ends as markdown.
- ;; At least escape markdown.
- (concat
- separator
- ;; TODO(tool) remove properties and strip instead of ignoring
- (propertize (format "``` tool %s" truncated-call)
- 'gptel 'ignore 'keymap gptel--markdown-block-map)
- (propertize
- ;; TODO(tool) escape markdown in result
- (concat "\n" call "\n\n" result)
- 'gptel `(tool . ,id))
- ;; TODO(tool) remove properties and strip instead of ignoring
- (propertize "\n```\n" 'gptel 'ignore
- 'keymap gptel--markdown-block-map))))
- info
- 'raw)
- ;; tool-result insertion has updated the tracking marker
- (unless tracking-marker
- (setq tracking-marker (plist-get info :tracking-marker)))
- (if tool-marker
- (move-marker tool-marker tracking-marker)
- (setq tool-marker (copy-marker tracking-marker nil))
- (plist-put info :tool-marker tool-marker))
- (ignore-errors ;fold drawer
- (save-excursion
- (goto-char tracking-marker)
- (forward-line -1)
- (if (derived-mode-p 'org-mode)
- (when (looking-at-p "^#\\+end_tool") (org-cycle))
- (when (looking-at-p "^```") (gptel-markdown-cycle-block))))))))))
-
-(defun gptel--format-tool-call (name arg-values)
- "Format a tool call for display in the buffer.
-
-NAME and ARG-VALUES are the name and arguments for the call."
- (format "(%s %s)\n"
- (propertize name 'font-lock-face 'font-lock-keyword-face)
- (propertize
- (mapconcat (lambda (arg)
- (cond ((stringp arg)
- (prin1-to-string
- (replace-regexp-in-string
- "\n" "⮐" (truncate-string-to-width
- arg (floor (window-width) 2)
- nil nil t))))
- (t (prin1-to-string arg))))
- arg-values " ")
- 'font-lock-face 'font-lock-constant-face)))
-
-(defun gptel--inspect-tool-calls ()
- (interactive)
- (with-selected-window
- (gptel--inspect-fsm gptel--fsm-last)
- (goto-char (point-min))
- (when (search-forward-regexp "^:tool-use" nil t)
- (forward-line 0)
- (hl-line-highlight))))
-
-(defun gptel--accept-tool-calls (&optional response ov)
- (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay
- (point) 'gptel-tool)))
- (list resp o)))
- (gptel--update-status " Calling tool..." 'mode-line-emphasis)
- (message "Continuing query...")
- (cl-loop for (tool-spec arg-values process-tool-result) in response
- do
- (if (gptel-tool-async tool-spec)
- (apply (gptel-tool-function tool-spec)
- process-tool-result arg-values)
- (let ((result
- (condition-case errdata
- (apply (gptel-tool-function tool-spec) arg-values)
- (error (mapconcat #'gptel--to-string errdata " ")))))
- (funcall process-tool-result result))))
- (when (and (overlayp ov) (overlay-buffer ov))
- (with-current-buffer (overlay-buffer ov)
- (when-let* ((preview-handles (overlay-get ov 'previews)))
- (dolist (func-to-handle preview-handles)
- (when (car func-to-handle) (apply func-to-handle))))
- (when-let* ((prompt-ov (overlay-get ov 'prompt))
- ((overlay-buffer prompt-ov))
- (inhibit-read-only t))
- (delete-region (overlay-start prompt-ov)
- (overlay-end prompt-ov))))
- (delete-overlay ov)))
-
-(defun gptel--reject-tool-calls (&optional _response ov)
- (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay
- (point) 'gptel-tool)))
- (list resp o)))
- (gptel--update-status " Tools cancelled" 'error)
- (message (substitute-command-keys
- "Tool calls canceled. \\[gptel-menu] to continue them!"))
- (when (and (overlayp ov) (overlay-buffer ov))
- (with-current-buffer (overlay-buffer ov)
- (when-let* ((preview-handles (overlay-get ov 'previews)))
- (dolist (func-to-handle preview-handles)
- (when (car func-to-handle) (apply func-to-handle))))
- (when-let* ((prompt-ov (overlay-get ov 'prompt))
- ((overlay-buffer prompt-ov))
- (inhibit-read-only t))
- (delete-region (overlay-start prompt-ov)
- (overlay-end prompt-ov))))
- (delete-overlay ov)))
-
-(defun gptel--dispatch-tool-calls (choice)
- (interactive
- (list
- (let ((choices '((?y "yes") (?n "do nothing")
- (?k "cancel request") (?i "inspect call(s)"))))
- (read-multiple-choice "Run tool calls? " choices))))
- (pcase (car choice)
- (?y (call-interactively #'gptel--accept-tool-calls))
- (?k (call-interactively #'gptel--reject-tool-calls))
- (?i (gptel--inspect-fsm gptel--fsm-last))))
-
-\f
-;;; Presets
-;;;; Presets implementation
-(defvar gptel--known-presets nil
- "Alist of presets for gptel.
-
-Each entry maps a preset name (a symbol) to a plist of
-specifications (see `gptel-make-preset').")
-
-(defun gptel-make-preset (name &rest keys)
- "Define a gptel preset with NAME.
-
-A preset is a combination of gptel options intended to be applied and
-used together. Presets can make it less tedious to change gptel
-settings on the fly.
-
-Typically this will include a model, backend, system message and perhaps
-some tools, but any set of gptel options can be set this way.
-
-NAME must be a symbol. KEYS is a plist corresponding to the options
-being set. All KEYS are optional.
-
-Recognized keys:
-
-DESCRIPTION is a description of the preset, used when selecting a
-preset.
-
-PARENTS is a preset name (or list of preset names) to apply before this
-one.
-
-PRE and POST are functions to run before and after the preset is
-applied. They take no arguments.
-
-BACKEND is the `gptel-backend' to set, or its name (like \"ChatGPT\").
-
-MODEL is the `gptel-model', a symbol.
-
-SYSTEM is the directive. It can be
-- the system message (a string),
-- a list of strings (a conversation template)
-- or a function (dynamic system message).
-- It can also be a symbol naming a directive in `gptel-directives'.
-
-TOOLS is a list of gptel tools or tool names, like
-\\='(\"read_url\" \"read_buffer\" ...)
-
-Recognized keys are not limited to the above. Any other key (like
-`:foo') corresponds to the value of either `gptel-foo' (preferred) or
-`gptel--foo'.
-- So TOOLS corresponds to option `gptel-tools',
-- CONFIRM-TOOL-CALLS to `gptel-confirm-tool-calls',
-- TEMPERATURE to `gptel-temperature' and so on.
-See gptel's customization options for all available settings.
-
-Specifying the value of a key will set the corresponding gptel option to
-it. For example,
-
- (gptel-make-preset \\='websearch
- :tools \\='(\"search_web\" \"read_url\")
- :system \"Use the provided tools to search the web
- for up-to-date information\")
-
-will replace the currently active option `gptel-tools' and the system
-message.
-
-Alternatively,
-
-- You can require that the value be appended or prepended to the
- existing value instead of replacing it. This can be done by
- specifying the value as a plist instead with the keys `:prepend' or
- `:append'.
-
- (gptel-make-preset \\='websearch
- :tools \\='(:append (\"search_web\" \"read_url\"))
- :system \\='(:prepend \"Use the provided tools to search the web
- for up-to-date information.\"))
-
-- You can dynamically compute the value for a key at the time the preset
- is applied with `:eval' or `:function'. This is mostly useful when
- using presets in the prompt, as @preset-name.
-
- An `:eval' form is evaluated when the preset is applied:
-
- (gptel-make-preset \\='visible-buffers
- :description \"Include the full text of all buffers visible in the
- frame.\"
- :context \\='(:eval (mapcar #\\='window-buffer (window-list))))
- ▲ ▲
- │ ╰╴evaluated when preset is applied
- ╰╴sets `gptel-context'
-
- `:function' should take the current value of the key as an input and
- return the new value. Here we combine it with `:append' in the plist.
-
- (gptel-make-preset \\='github-read-only
- :description \"Provide read-only GitHub tools\"
- :pre (lambda () (gptel-mcp-connect \\='(\"github\") \\='sync))
- :tools
- \\='( :append (\"mcp-github\") ;Adds all github MCP tools
- :function (lambda (tools)
- (cl-delete-if ;Remove \"write\" access to GitHub
- (lambda (tool)
- (string-match-p \"create_\" (gptel-tool-name tool)))
- tools))))
-
- NOTE: `:eval' and `:function' are evaluated in a temporary buffer, and
- not the buffer from which the request is sent."
- (declare (indent 1))
- (if-let* ((p (assoc name gptel--known-presets)))
- (setcdr p keys)
- (setq gptel--known-presets ;Add at end of presets for menu ordering
- (nconc gptel--known-presets (list (cons name keys))))))
-
-(defun gptel-get-preset (name)
- "Get the gptel preset spec with NAME."
- (alist-get name gptel--known-presets nil nil #'equal))
-
-(defun gptel--save-preset (name &optional description)
- "Save gptel's current settings as a preset with NAME.
-
-NAME must be a symbol. DESCRIPTION is added if provided. In addition
-to registering the preset, elisp code to do the same is copied to the
-`kill-ring'."
- (interactive
- (list (intern (completing-read "Save gptel settings to (existing or new) preset: "
- gptel--known-presets))
- (read-string "Description (optional): ")))
- (let ((preset-code
- `(gptel-make-preset ',name
- :description ,(when (and description
- (not (string-blank-p description)))
- description)
- :backend ,(gptel-backend-name gptel-backend)
- :model ',gptel-model
- :system ,(if-let* ((directive (car-safe (rassoc gptel--system-message
- gptel-directives))))
- `',directive
- gptel--system-message)
- :tools ',(mapcar #'gptel-tool-name gptel-tools)
- :stream ,gptel-stream
- :temperature ,gptel-temperature
- :max-tokens ,gptel-max-tokens
- :use-context ',gptel-use-context
- :track-media ,gptel-track-media
- :include-reasoning ,(let ((reasoning gptel-include-reasoning))
- (if (eq reasoning 'ignore)
- ''ignore reasoning)))))
- (kill-new (pp-to-string preset-code))
- (eval preset-code)
- (message "Preset %s saved. (Lisp expression for preset saved to kill-ring)"
- (propertize (symbol-name name) 'face 'highlight))))
-
-(defvar gptel--rewrite-directive)
-(defun gptel--apply-preset (preset &optional setter)
- "Apply gptel PRESET with SETTER.
-
-PRESET is the name of a preset, or a spec (plist) of the form
- (:KEY1 VAL1 :KEY2 VAL2 ...).
-
-SETTER is the function used to set the gptel options. It must accept
-two arguments, the symbol being set and the value to set it to. It
-defaults to `set', and can be set to a different function to (for
-example) apply the preset buffer-locally."
- (when (memq (type-of preset) '(string symbol))
- (let ((spec (or (gptel-get-preset preset)
- (user-error "gptel preset \"%s\": Cannot find preset"
- preset))))
- (setq preset spec)))
- (unless setter (setq setter #'set))
- (when-let* ((func (plist-get preset :pre))) (funcall func))
- (when-let* ((parents (plist-get preset :parents)))
- (mapc (lambda (parent) (gptel--apply-preset parent setter)) (ensure-list parents)))
- (map-do
- (lambda (key val)
- (pcase key
- ((or :parents :description :pre :post) nil)
- ((or :system :system-message :rewrite-directive)
- (let ((sym (if (eq key :rewrite-directive)
- 'gptel--rewrite-directive 'gptel--system-message)))
- (when (consp val)
- ;; Possibly complain about trying to compose a system message string
- ;; with a non-string
- ;; TODO(modify-list): Catch other incompatible combinations
- (and (or (plist-member val :append) (plist-member val :prepend))
- (not (stringp (symbol-value sym)))
- (user-error "Composing non-string system messages is not implemented"))
- (setq val (gptel--modify-value (symbol-value sym) val)))
- (if (and (symbolp val) (not (functionp val)))
- (if-let* ((directive (alist-get val gptel-directives)))
- (funcall setter sym directive)
- (user-error "gptel preset: Cannot find directive %s" val))
- (funcall setter sym val))))
- (:backend
- (when (consp val) (setq val (gptel--modify-value 'gptel-backend val)))
- (setq val (cl-etypecase val
- (gptel-backend val)
- (string (gptel-get-backend val))))
- (unless val
- (user-error "gptel preset: Cannot find backend %s" val))
- (funcall setter 'gptel-backend val))
- (:tools ;TEMP Confirm this `:append' convention
- (setq val (gptel--modify-value gptel-tools val))
- (let* ((tools
- (flatten-list
- (cl-loop for tool-name in (ensure-list val)
- for tool = (cl-etypecase tool-name
- (gptel-tool tool-name)
- (string (ignore-errors
- (gptel-get-tool tool-name))))
- do (unless tool
- (user-error "gptel preset: Cannot find tool %S"
- tool-name))
- collect tool))))
- (funcall setter 'gptel-tools (cl-delete-duplicates tools :test #'eq))))
- ((and (let sym (or (intern-soft
- (concat "gptel-" (substring (symbol-name key) 1)))
- (intern-soft
- (concat "gptel--" (substring (symbol-name key) 1)))))
- (guard (and sym (boundp sym))))
- (funcall setter sym (if (consp val)
- (gptel--modify-value (symbol-value sym) val)
- val)))
- (_ (display-warning
- '(gptel presets)
- (format "gptel preset: setting for %s not found, ignoring." key)))))
- preset)
- (when-let* ((func (plist-get preset :post))) (funcall func)))
-
-(defun gptel--preset-syms (preset)
- "Return a list of gptel variables (symbols) set by PRESET.
-
-PRESET is the name of a preset, or a spec (plist) of the form
- (:KEY1 VAL1 :KEY2 VAL2 ...)."
- (when (memq (type-of preset) '(string symbol))
- (let ((spec (or (gptel-get-preset preset)
- (user-error "gptel preset \"%s\": Cannot find preset"
- preset))))
- (setq preset spec)))
- (let* ((index preset)
- syms key val)
- (while index
- (setq key (pop index) val (pop index))
- (pcase key
- ((or :description :pre :post))
- (:parents
- (mapc (lambda (parent-preset)
- (nconc syms (gptel--preset-syms parent-preset)))
- (ensure-list val)))
- (:system (push 'gptel--system-message syms))
- (_ (if-let* ((var (or (intern-soft
- (concat "gptel-" (substring (symbol-name key) 1)))
- (intern-soft
- (concat "gptel--" (substring (symbol-name key) 1))))))
- (push var syms)
- (display-warning
- '(gptel presets)
- (format "gptel preset \"%s\": setting for %s not found, ignoring."
- (car preset) key))))))
- (cl-delete-duplicates syms)))
-
-;; This is identical to `cl-progv', only we let-bind symbols SYM from the preset
-;; to their current values instead of evaluating the values explicitly. (#1005)
-(defmacro gptel-with-preset (name &rest body)
- "Run BODY with gptel preset NAME applied.
-
-This macro can be used to create `gptel-request' command with settings
-from a gptel preset applied.
-
-NAME is the name of a preset, or a spec (plist) of the form
- (:KEY1 VAL1 :KEY2 VAL2 ...). It must be quoted."
- (declare (indent 1))
- (let ((syms (make-symbol "syms"))
- (binds (make-symbol "binds"))
- (bodyfun (make-symbol "body")))
- `(let* ((,syms (gptel--preset-syms ,name))
- (,bodyfun (lambda () (gptel--apply-preset ,name) ,@body))
- (,binds nil))
- (while ,syms (push (list (car ,syms) (pop ,syms)) ,binds))
- (eval (list 'let (nreverse ,binds) (list 'funcall (list 'quote ,bodyfun)))))))
-
-;;;; Presets in-buffer UI
-(defun gptel--transform-apply-preset (_fsm)
- "Apply a gptel preset to the buffer depending on the prompt.
-
-If the last user prompt includes @foo, the preset foo is applied.
-Before applying the preset, \"@foo\" is removed from the prompt and
-point is placed at its position."
- (when gptel--known-presets
- (text-property-search-backward 'gptel nil t)
- (while (re-search-forward "@\\([^[:space:]]+\\)\\_>" nil t)
- ;; The following convoluted check is because re-search is much faster if
- ;; the search pattern begins with a non-whitespace char.
- (when (or (= (match-beginning 0) (point-min))
- (memq (char-syntax (char-before (match-beginning 0))) '(32 62)))
- (when-let* ((name (match-string 1))
- (preset (or (gptel-get-preset (intern-soft name))
- (gptel-get-preset name))))
- (delete-region (match-beginning 0) (match-end 0))
- ;; Point must be after @foo when the preset is applied to allow for
- ;; more advanced transformations.
- (gptel--apply-preset preset
- (lambda (sym val)
- (set (make-local-variable sym) val))))))))
-
-;; ;; Alternative approach with string search
-;; (search-forward "@" nil t)
-;; (if (and (memq (char-syntax (char-before (1- (point)))) '(32 62))
-;; (looking-at "\\([^[:blank:]]+?\\)[[:punct:]]?\\s-+"))
-;; do-stuff)
-
-(defun gptel--fontify-preset-keyword (end)
- "Font-lock function for preset indicators in chat buffers.
-
-Return preset fontification info for text up to END."
- (and (re-search-forward "@\\([^[:space:]]+\\)\\_>" end t)
- (or (= (match-beginning 0) (point-min))
- (memq (char-syntax (char-before (match-beginning 0))) '(32 62)))
- (not (plist-get (text-properties-at (match-beginning 1)) 'gptel))))
-
-(defun gptel-preset-capf ()
- "Completion at point for gptel presets in `gptel-mode'.
-
-Add this to `completion-at-point-functions'."
- (and gptel--known-presets
- (save-excursion
- (let ((num (- (skip-syntax-backward "w_"))))
- (when (eql (char-before) ?@)
- (list (point) (+ (point) num)
- gptel--known-presets
- :exclusive 'no
- :annotation-function
- #'(lambda (c) (thread-first
- (intern-soft c)
- (assq gptel--known-presets) (cdr)
- (plist-get :description)))))))))
-
-(defun gptel--prettify-preset ()
- "Get visual and completion help with presets in gptel buffers.
-
-Intended to be added to `gptel-mode-hook'."
- (let ((keyword '((gptel--fontify-preset-keyword
- ;; subexp 0 here is not required, we retain it to make it
- ;; easy to swtich to more complex patterns in the future
- 0 (when-let* ((comps (all-completions (match-string 1)
- gptel--known-presets))
- ((member (match-string 1) comps)))
- '(:box -1 :inherit secondary-selection))
- prepend))))
- (cond
- (gptel-mode
- (font-lock-add-keywords nil keyword t)
- (add-hook 'completion-at-point-functions #'gptel-preset-capf nil t))
- (t (font-lock-remove-keywords nil keyword)
- (remove-hook 'completion-at-point-functions #'gptel-preset-capf t)))))
-
-\f
-;;; Response tweaking commands
-
-(defun gptel--attach-response-history (history &optional buf)
- "Attach HISTORY to the next gptel response in buffer BUF.
-
-HISTORY is a list of strings typically containing text replaced
-by gptel. BUF is the current buffer if not specified.
-
-This is used to maintain variants of prompts or responses to diff
-against if required."
- (with-current-buffer (or buf (current-buffer))
- (letrec ((gptel--attach-after
- (lambda (b e)
- (when (and b e)
- (add-text-properties
- b e `(gptel-history
- ,(append (ensure-list history)
- (get-char-property (1- e) 'gptel-history))
- front-sticky (gptel gptel-history))))
- (remove-hook 'gptel-post-response-functions
- gptel--attach-after 'local))))
- (add-hook 'gptel-post-response-functions gptel--attach-after
- nil 'local))))
-
-(defun gptel--ediff (&optional arg bounds-func)
- "Ediff response at point against previous gptel responses.
-
-If prefix ARG is non-nil, select the previous response to ediff
-against interactively.
-
-If specified, use BOUNDS-FUNC to compute the bounds of the
-response at point. This can be used to include additional
-context for the ediff session."
- (interactive "P")
- (when (gptel--at-response-history-p)
- (pcase-let* ((`(,beg . ,end) (funcall (or bounds-func #'gptel--get-response-bounds)))
- (prev-response
- (if arg
- (completing-read "Choose response variant to diff against: "
- (get-char-property (point) 'gptel-history)
- nil t)
- (car-safe (get-char-property (point) 'gptel-history))))
- (buffer-mode major-mode)
- (bufname (buffer-name))
- (`(,new-buf ,new-beg ,new-end)
- (with-current-buffer
- (get-buffer-create (concat bufname "-PREVIOUS-*"))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (delay-mode-hooks (funcall buffer-mode))
- (visual-line-mode)
- (insert prev-response)
- (goto-char (point-min))
- (list (current-buffer) (point-min) (point-max))))))
- (unless prev-response (user-error "gptel response is additive: no changes to ediff"))
- (require 'ediff)
- (letrec ((cwc (current-window-configuration))
- (gptel--ediff-restore
- (lambda ()
- (when (window-configuration-p cwc)
- (set-window-configuration cwc))
- (kill-buffer (get-buffer (concat bufname "-PREVIOUS-*")))
- (kill-buffer (get-buffer (concat bufname "-CURRENT-*")))
- (remove-hook 'ediff-quit-hook gptel--ediff-restore))))
- (add-hook 'ediff-quit-hook gptel--ediff-restore)
- (apply
- #'ediff-regions-internal
- (get-buffer (ediff-make-cloned-buffer (current-buffer) "-CURRENT-*"))
- beg end new-buf new-beg new-end
- nil
- (list 'ediff-regions-wordwise 'word-wise nil)
- ;; (if (transient-arg-value "-w" args)
- ;; (list 'ediff-regions-wordwise 'word-wise nil)
- ;; (list 'ediff-regions-linewise nil nil))
- )))))
-
-(defun gptel--mark-response ()
- "Mark gptel response at point, if any."
- (interactive)
- (unless (gptel--in-response-p) (user-error "No gptel response at point"))
- (pcase-let ((`(,beg . ,end) (gptel--get-response-bounds)))
- (goto-char beg) (push-mark) (goto-char end) (activate-mark)))
-
-(defun gptel--previous-variant (&optional arg)
- "Switch to ARG previous gptel-response at this point, if it exists."
- (interactive "p")
- (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds))
- (history (get-char-property (point) 'gptel-history))
- (alt-response (car-safe history))
- (offset))
- (unless (and history alt-response)
- (user-error "No variant responses available"))
- (if (> arg 0)
- (setq history (append (cdr history)
- (list (buffer-substring-no-properties beg end))))
- (setq
- alt-response (car (last history))
- history (cons (buffer-substring-no-properties beg end)
- (nbutlast history))))
- (add-text-properties
- 0 (length alt-response)
- `(gptel response gptel-history ,history)
- alt-response)
- (setq offset (min (- (point) beg) (1- (length alt-response))))
- (delete-region beg end)
- (insert alt-response)
- (goto-char (+ beg offset))
- (pulse-momentary-highlight-region beg (+ beg (length alt-response)))))
-
-(defun gptel--next-variant (&optional arg)
- "Switch to ARG next gptel-response at this point, if it exists."
- (interactive "p")
- (gptel--previous-variant (- arg)))
-
-(provide 'gptel)
-;;; gptel.el ends here
-
-;; Local Variables:
-;; bug-reference-url-format: "https://github.com/karthink/gptel/issues/%s"
-;; End:
--- /dev/null
+gptel is a simple Large Language Model chat client, with support for multiple
+models and backends.
+
+It works in the spirit of Emacs, available at any time and in any buffer.
+
+gptel supports:
+
+- The services ChatGPT, Azure, Gemini, Anthropic AI, Together.ai, Perplexity,
+ AI/ML API, Anyscale, OpenRouter, Groq, PrivateGPT, DeepSeek, Cerebras, Github Models,
+ GitHub Copilot chat, AWS Bedrock, Novita AI, xAI, Sambanova, Mistral Le
+ Chat and Kagi (FastGPT & Summarizer).
+- Local models via Ollama, Llama.cpp, Llamafiles or GPT4All
+
+Additionally, any LLM service (local or remote) that provides an
+OpenAI-compatible API is supported.
+
+Features:
+
+- Interact with LLMs from anywhere in Emacs (any buffer, shell, minibuffer,
+ wherever).
+- LLM responses are in Markdown or Org markup.
+- Supports conversations and multiple independent sessions.
+- Supports tool-use to equip LLMs with agentic capabilities.
+- Supports Model Context Protocol (MCP) integration using the mcp.el package.
+- Supports multi-modal models (send images, documents).
+- Supports "reasoning" content in LLM responses.
+- Save chats as regular Markdown/Org/Text files and resume them later.
+- You can go back and edit your previous prompts or LLM responses when
+ continuing a conversation. These will be fed back to the model.
+- Redirect prompts and responses easily
+- Rewrite, refactor or fill in regions in buffers.
+- Write your own commands for custom tasks with a simple API.
+
+Requirements for ChatGPT, Azure, Gemini or Kagi:
+
+- You need an appropriate API key. Set the variable `gptel-api-key' to the
+ key or to a function of no arguments that returns the key. (It tries to
+ use `auth-source' by default)
+
+ChatGPT is configured out of the box. For the other sources:
+
+- For Azure: define a gptel-backend with `gptel-make-azure'.
+- For Gemini: define a gptel-backend with `gptel-make-gemini'.
+- For Anthropic (Claude): define a gptel-backend with `gptel-make-anthropic'.
+- For AI/ML API, Together.ai, Anyscale, Groq, OpenRouter, DeepSeek, Cerebras
+ or Github Models: define a gptel-backend with `gptel-make-openai'.
+- For PrivateGPT: define a backend with `gptel-make-privategpt'.
+- For Perplexity: define a backend with `gptel-make-perplexity'.
+- For Deepseek: define a backend with `gptel-make-deepseek'.
+- For Kagi: define a gptel-backend with `gptel-make-kagi'.
+
+For local models using Ollama, Llama.cpp or GPT4All:
+
+- The model has to be running on an accessible address (or localhost)
+- Define a gptel-backend with `gptel-make-ollama' or `gptel-make-gpt4all'.
+- Llama.cpp or Llamafiles: Define a gptel-backend with `gptel-make-openai'.
+
+Consult the package README for examples and more help with configuring
+backends.
+
+Usage:
+
+gptel can be used in any buffer or in a dedicated chat buffer. The
+interaction model is simple: Type in a query and the response will be
+inserted below. You can continue the conversation by typing below the
+response.
+
+To use this in any buffer:
+
+- Call `gptel-send' to send the buffer's text up to the cursor. Select a
+ region to send only the region.
+
+- You can select previous prompts and responses to continue the conversation.
+
+- Call `gptel-send' with a prefix argument to access a menu where you can set
+ your backend, model and other parameters, or to redirect the
+ prompt/response.
+
+To use this in a dedicated buffer:
+
+- M-x gptel: Start a chat session.
+
+- In the chat session: Press `C-c RET' (`gptel-send') to send your prompt.
+ Use a prefix argument (`C-u C-c RET') to access a menu. In this menu you
+ can set chat parameters like the system directives, active backend or
+ model, or choose to redirect the input or output elsewhere (such as to the
+ kill ring or the echo area).
+
+- You can save this buffer to a file. When opening this file, turn on
+ `gptel-mode' before editing it to restore the conversation state and
+ continue chatting.
+
+- To include media files with your request, you can add them to the context
+ (described next), or include them as links in Org or Markdown mode chat
+ buffers. Sending media is disabled by default, you can turn it on globally
+ via `gptel-track-media', or locally in a chat buffer via the header line.
+
+Include more context with requests:
+
+If you want to provide the LLM with more context, you can add arbitrary
+regions, buffers, files or directories to the query with `gptel-add'. To add
+text or media files, call `gptel-add' in Dired or use the dedicated
+`gptel-add-file'.
+
+You can also add context from gptel's menu instead (`gptel-send' with a
+prefix arg), as well as examine or modify context.
+
+When context is available, gptel will include it with each LLM query.
+
+LLM Tool use:
+
+gptel supports "tool calling" behavior, where LLMs can specify arguments with
+which to call provided "tools" (elisp functions). The results of running the
+tools are fed back to the LLM, giving it capabilities and knowledge beyond
+what is available out of the box. For example, tools can perform web
+searches or API lookups, modify files and directories, and so on.
+
+Tools can be specified via `gptel-make-tool', or obtained from other
+repositories, or from Model Context Protocol (MCP) servers using the mcp.el
+package. See the README for details.
+
+Tools can be included with LLM queries using gptel's menu, or from
+`gptel-tools'.
+
+Rewrite interface
+
+In any buffer: with a region selected, you can rewrite prose, refactor code
+or fill in the region. This is accessible via `gptel-rewrite', and also from
+the `gptel-send' menu.
+
+Presets
+
+Define a bundle of configuration (model, backend, system message, tools etc)
+as a "preset" that can be applied together, making it easy to switch between
+tasks in gptel. Presets can be saved and applied from gptel's transient
+menu. You can also include a cookie of the form "@preset-name" in the prompt
+to send a request with a preset applied. This feature works everywhere, but
+preset cookies are also fontified in chat buffers.
+
+gptel in Org mode:
+
+gptel offers a few extra conveniences in Org mode:
+
+- You can limit the conversation context to an Org heading with
+ `gptel-org-set-topic'.
+
+- You can have branching conversations in Org mode, where each hierarchical
+ outline path through the document is a separate conversation branch.
+ See the variable `gptel-org-branching-context'.
+
+- You can declare the gptel model, backend, temperature, system message and
+ other parameters as Org properties with the command
+ `gptel-org-set-properties'. gptel queries under the corresponding heading
+ will always use these settings, allowing you to create mostly reproducible
+ LLM chat notebooks.
+
+Finally, gptel offers a general purpose API for writing LLM ineractions that
+suit your workflow. See `gptel-request', and `gptel-fsm' for more advanced
+usage.
--- /dev/null
+;;; gptel-anthropic.el --- Anthropic AI suppport for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for Anthropic's Messages API to gptel
+
+;;; Code:
+(require 'cl-generic)
+(require 'cl-lib)
+(require 'map)
+(eval-and-compile (require 'gptel-request))
+
+(defvar json-object-type)
+
+(declare-function prop-match-value "text-property-search")
+(declare-function text-property-search-backward "text-property-search")
+(declare-function json-read "json" ())
+(declare-function gptel-context--wrap "gptel-context")
+(declare-function gptel-context--collect-media "gptel-context")
+
+;;; Anthropic (Messages API)
+(cl-defstruct (gptel-anthropic (:constructor gptel--make-anthropic)
+ (:copier nil)
+ (:include gptel-backend)))
+
+(defun gptel--anthropic-update-tokens (usage info)
+ "Update token usage information from USAGE.
+USAGE is part of the response, INFO is the request plist."
+ (when usage
+ (let* ((tokens (plist-get info :tokens))
+ (input (+ (or (plist-get usage :input_tokens) 0)
+ (or (plist-get tokens :input) 0)))
+ (output (+ (or (plist-get usage :output_tokens) 0)
+ (or (plist-get tokens :output) 0)))
+ (cached (+ (or (plist-get usage :cache_read_input_tokens) 0)
+ (or (plist-get tokens :cached) 0)))
+ (cache (+ (or (plist-get usage :cache_creation_input_tokens) 0)
+ (or (plist-get tokens :cache) 0))))
+ (list :input input :output output
+ :cache cache :cached cached))))
+
+;; NOTE the crucial difference between
+;; - (push val (plist-get info :key)) and
+;; (plist-put (plist-get info :key) (cons val ...))
+;;
+;; - (setf (plist-get info :key) val) and
+;; (plist-put info :key val)
+;;
+;; in the following function. The first variant conses at the head of info, the
+;; second one at the tail. This means only the second option is viable for
+;; mutating a plist function argument that's passed by reference.
+;; Do NOT change the plist-put to push or setf!
+
+;; NOTE: The stream parser looks complicated only because it handles streaming
+;; tool calls, streaming "thinking" blocks and their interactions. Stream
+;; parsing is simple: if you are studying this code, look instead at a commit
+;; from before tool-use support was added to gptel.
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-anthropic) info)
+ "Parse an Anthropic data stream.
+
+Return the text response accumulated since the last call to this
+function. Additionally, mutate state INFO to add tool-use
+information if the stream contains it. Not my best work, I know."
+ (let* ((content-strs)
+ (pt (point)))
+ (condition-case nil
+ (while (re-search-forward "^event: " nil t)
+ (setq pt (match-beginning 0))
+ (if (equal (line-end-position) (point-max))
+ (error "Data block incomplete"))
+ (cond
+ ((looking-at "content_block_delta") ;collect incremental
+ (forward-line 1) (forward-char 5) ;text, tool or thinking block
+ (when-let* ((delta (plist-get (gptel--json-read) :delta)))
+ (if-let* ((content (plist-get delta :text))
+ ((not (eq content :null))))
+ (push content content-strs) ;collect text
+ (if-let* ((partial-json (plist-get delta :partial_json)))
+ (plist-put ;collect partial tool input
+ info :partial_json
+ (cons partial-json (plist-get info :partial_json)))
+ (if-let* ((thinking (plist-get delta :thinking)))
+ (plist-put info :reasoning
+ (concat (plist-get info :reasoning) thinking))
+ (if-let* ((signature (plist-get delta :signature)))
+ (plist-put info :signature
+ (concat (plist-get info :signature) signature))))))))
+
+ ((looking-at "content_block_start") ;Is the following block text or tool-use?
+ (forward-line 1) (forward-char 5)
+ (when-let* ((cblock (plist-get (gptel--json-read) :content_block)))
+ (pcase (plist-get cblock :type)
+ ("text" (push (plist-get cblock :text) content-strs))
+ ("tool_use" (plist-put info :tool-use
+ (cons (list :id (plist-get cblock :id)
+ :name (plist-get cblock :name)
+ :input nil) ;ensure :input key is always present
+ (plist-get info :tool-use))))
+ ("thinking" (plist-put info :reasoning (plist-get cblock :thinking))
+ (plist-put info :reasoning-block 'in)))))
+
+ ((looking-at "content_block_stop")
+ (cond
+ ((plist-get info :partial_json) ;End of tool block
+ (condition-case-unless-debug nil ;Combine partial tool inputs
+ (let* ((args-json (apply #'concat (nreverse (plist-get info :partial_json))))
+ (args-decoded ;Handle blank argument strings
+ (if (string-empty-p args-json)
+ nil (gptel--json-read-string args-json))))
+ ;; Add the input to the tool-call spec
+ (plist-put (car (plist-get info :tool-use)) :input args-decoded))
+ ;; If there was an error in reading that tool, we ignore it:
+ ;; TODO(tool) handle this error better
+ (error (pop (plist-get info :tool-use)))) ;TODO: nreverse :tool-use list
+ (plist-put info :partial_json nil))
+
+ ((eq (plist-get info :reasoning-block) 'in) ;End of reasoning block
+ (plist-put info :reasoning-block t)))) ;Signal end of reasoning stream to filter
+
+ ((looking-at "message_delta")
+ ;; collect stop_reason, usage_tokens and prepare tools
+ (forward-line 1) (forward-char 5)
+ (when-let* ((tool-use (plist-get info :tool-use))
+ (response (gptel--json-read)))
+ (let* ((data (plist-get info :data))
+ (prompts (plist-get data :messages)))
+ (plist-put ; Append a COPY of response text + tool-use to the prompts list
+ data :messages
+ (vconcat
+ prompts
+ `((:role "assistant"
+ :content ,(vconcat ;Insert any LLM text and thinking text
+ (and-let* ((reasoning (plist-get info :partial_reasoning)))
+ `((:type "thinking" :thinking ,reasoning
+ :signature ,(plist-get info :signature))))
+ (and-let* ((strs (plist-get info :partial_text)))
+ `((:type "text" :text ,(apply #'concat (nreverse strs)))))
+ (mapcar (lambda (tool-call) ;followed by the tool calls
+ (append (list :type "tool_use")
+ (copy-sequence tool-call)))
+ tool-use))))))
+ (plist-put info :partial_text nil) ; Clear any captured text
+ ;; Then shape the tool-use block by adding args so we can call the functions
+ (mapc (lambda (tool-call)
+ (plist-put tool-call :args (plist-get tool-call :input))
+ (plist-put tool-call :input nil)
+ (plist-put tool-call :id (plist-get tool-call :id)))
+ tool-use))
+ ;; Capture token usage
+ (plist-put info :tokens (gptel--anthropic-update-tokens
+ (plist-get response :usage) info))
+ (plist-put info :stop-reason
+ (map-nested-elt response '(:delta :stop_reason)))))))
+ (error (goto-char pt)))
+ (let ((response-text (apply #'concat (nreverse content-strs))))
+ (unless (string-empty-p response-text)
+ (plist-put info :partial_text
+ (cons response-text (plist-get info :partial_text))))
+ (when (plist-get info :tools)
+ (when-let* ((reasoning (plist-get info :reasoning)))
+ (plist-put info :partial_reasoning
+ (concat (plist-get info :partial_reasoning) reasoning))))
+ response-text)))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-anthropic) response info)
+ "Parse an Anthropic (non-streaming) RESPONSE and return response text.
+
+Mutate state INFO with response metadata."
+ (plist-put info :stop-reason (plist-get response :stop_reason))
+ (plist-put info :tokens (gptel--anthropic-update-tokens
+ (plist-get response :usage) info))
+ (cl-loop
+ with content = (plist-get response :content)
+ for cblock across content
+ for type = (plist-get cblock :type)
+ if (equal type "text")
+ ;; TODO(tool) can :text be :null?
+ collect (plist-get cblock :text) into content-strs
+ else if (equal type "tool_use")
+ collect cblock into tool-use
+ else if (equal type "thinking")
+ do
+ (plist-put
+ info :reasoning
+ (concat (plist-get info :reasoning)
+ (plist-get cblock :thinking)))
+ finally do
+ (when tool-use
+ ;; First, add the tool call to the prompts list
+ (let* ((data (plist-get info :data))
+ (prompts (plist-get data :messages)))
+ (plist-put
+ data :messages
+ (vconcat prompts `((:role "assistant" :content ,content)))))
+ ;; Then capture the tool call data for running the tool
+ (cl-loop
+ for call-raw in tool-use
+ for call = (copy-sequence call-raw) do
+ (plist-put call :args (plist-get call :input))
+ (plist-put call :input nil)
+ (plist-put call :id (plist-get call :id))
+ collect call into calls
+ finally do (plist-put info :tool-use calls)))
+ finally return
+ (and content-strs (apply #'concat content-strs))))
+
+(cl-defmethod gptel--request-data ((backend gptel-anthropic) prompts)
+ "JSON encode PROMPTS for sending to ChatGPT."
+ (let ((prompts-plist
+ `( :model ,(gptel--model-name gptel-model)
+ :stream ,(or gptel-stream :json-false)
+ :max_tokens ,(or gptel-max-tokens 4096)
+ :messages [,@prompts]))
+ (cachep (and (or (eq gptel-cache t) (memq 'system gptel-cache))
+ (gptel--model-capable-p 'cache))))
+ (when gptel--system-message
+ ;; gptel--system-message is a string or a list of strings
+ (plist-put
+ prompts-plist :system
+ (cond
+ ((consp gptel--system-message) ;multi-part system message
+ (vconcat (mapcar (lambda (part)
+ (nconc (list :type "text" :text part)
+ (and cachep
+ (list :cache_control
+ '(:type "ephemeral")))))
+ gptel--system-message)))
+ (cachep `[(:type "text" :text ,gptel--system-message
+ :cache_control (:type "ephemeral"))])
+ (t gptel--system-message))))
+ (when gptel-temperature
+ (plist-put prompts-plist :temperature gptel-temperature))
+ (when gptel-use-tools
+ (when (eq gptel-use-tools 'force)
+ (plist-put prompts-plist :tool_choice '(:type "any")))
+ (when gptel-tools
+ (let ((tools-array (gptel--parse-tools backend gptel-tools)))
+ (plist-put prompts-plist :tools tools-array)
+ (when (and (or (eq gptel-cache t) (memq 'tool gptel-cache))
+ (gptel--model-capable-p 'cache))
+ (nconc (aref tools-array (1- (length tools-array)))
+ '(:cache_control (:type "ephemeral")))))))
+ (when gptel--schema
+ (plist-put prompts-plist :tools
+ (vconcat
+ (list (gptel--parse-schema backend gptel--schema))
+ (plist-get prompts-plist :tools)))
+ (plist-put prompts-plist :tool_choice
+ `(:type "tool" :name ,gptel--ersatz-json-tool)))
+ ;; Merge request params with model and backend params.
+ (gptel--merge-plists
+ prompts-plist
+ gptel--request-params
+ (gptel-backend-request-params gptel-backend)
+ (gptel--model-request-params gptel-model))))
+
+(cl-defmethod gptel--parse-schema ((_backend gptel-anthropic) schema)
+ ;; Unlike the other backends, Anthropic generates JSON using a tool call. We
+ ;; write the tool here, meant to be added to :tools.
+ (list
+ :name "response_json"
+ :description "Record JSON output according to user prompt"
+ :input_schema (gptel--preprocess-schema
+ (gptel--dispatch-schema-type schema))))
+
+(cl-defmethod gptel--parse-tools ((_backend gptel-anthropic) tools)
+ "Parse TOOLS to the Anthropic API tool definition spec.
+
+TOOLS is a list of `gptel-tool' structs, which see."
+ (vconcat
+ (mapcar
+ (lambda (tool)
+ (list :name (gptel-tool-name tool)
+ :description (gptel-tool-description tool)
+ :input_schema ;NOTE: Anthropic wants "{}" if the function takes no args, not null
+ (list :type "object"
+ ;; See the generic implementation for an explanation of this
+ ;; transformation.
+ :properties
+ (cl-loop
+ for arg in (gptel-tool-args tool)
+ for argspec = (copy-sequence arg)
+ for name = (plist-get arg :name) ;handled differently
+ for newname = (or (and (keywordp name) name)
+ (make-symbol (concat ":" name)))
+ do ;ARGSPEC is ARG without unrecognized keys
+ (cl-remf argspec :name)
+ (cl-remf argspec :optional)
+ if (equal (plist-get arg :type) "object")
+ do (unless (plist-member argspec :required)
+ (plist-put argspec :required []))
+ append (list newname argspec))
+ :required
+ (vconcat
+ (delq nil (mapcar
+ (lambda (arg) (and (not (plist-get arg :optional))
+ (plist-get arg :name)))
+ (gptel-tool-args tool)))))))
+ (ensure-list tools))))
+
+(cl-defmethod gptel--parse-tool-results ((_backend gptel-anthropic) tool-use)
+ "Return a prompt containing tool call results in TOOL-USE.
+
+TOOL-USE is a list of plists containing tool names, arguments and call results."
+ ;; (declare (side-effect-free t))
+ (list
+ :role "user"
+ :content
+ (vconcat
+ (mapcar
+ (lambda (tool-call)
+ (let* ((result (plist-get tool-call :result))
+ (formatted
+ (list :type "tool_result"
+ :tool_use_id (plist-get tool-call :id)
+ :content (if (stringp result) result
+ (prin1-to-string result)))))
+ (prog1 formatted
+ (when (plist-get tool-call :error)
+ (plist-put formatted :is_error t)))))
+ tool-use))))
+
+;; NOTE: No `gptel--inject-prompt' method required for gptel-anthropic, since
+;; this is handled by its defgeneric implementation
+
+(cl-defmethod gptel--inject-tool-call ((_backend gptel-anthropic) data tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+BACKEND is the `gptel-backend'. See the generic function documentation
+for details. This implementation handles the Anthropic API."
+ ;; FIXME: We currently assume that the tool call being modified is in the last
+ ;; position in the messages array.
+ (if-let* ((messages (plist-get data :messages))
+ (entry (aref messages (1- (length messages))))
+ (contents (plist-get entry :content))
+ (id (plist-get tool-call :id))
+ (indexed-call
+ (cl-loop for chunk across contents
+ for i upfrom 0
+ if (equal (plist-get chunk :id) id)
+ return (cons i chunk)
+ finally return nil))
+ (index (car indexed-call))
+ (call (cdr indexed-call)))
+ (if (null new-call)
+ (if (= (length contents) 1)
+ (plist-put data :messages (substring messages nil -1))
+ (plist-put entry :content
+ (vconcat (substring contents 0 index)
+ (substring contents (1+ index)))))
+ (when-let* ((args (plist-get new-call :args)))
+ (plist-put call :input args))
+ (when-let* ((name (plist-get new-call :name)))
+ (plist-put call :name name)))
+ (display-warning
+ '(gptel tool-call)
+ (format "Could not inject updated tool-call arguments for tool call %s, %s"
+ (plist-get tool-call :name)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))))
+
+;; TODO: Remove these functions (#792)
+(defun gptel--anthropic-format-tool-id (tool-id)
+ (unless tool-id
+ (setq tool-id (substring
+ (md5 (format "%s%s" (random) (float-time)))
+ nil 24)))
+ (if (or (string-prefix-p "call_" tool-id)
+ (string-prefix-p "toolu_" tool-id))
+ tool-id
+ (format "toolu_%s" tool-id)))
+
+(defun gptel--anthropic-unformat-tool-id (tool-id)
+ (or (and (string-match "toolu_\\(.+\\)" tool-id)
+ (match-string 1 tool-id))
+ tool-id))
+
+(cl-defmethod gptel--parse-list ((backend gptel-anthropic) prompt-list)
+ (let ((full-prompt
+ (if (consp (car prompt-list))
+ (let ((prompts))
+ (dolist (entry prompt-list) ; Advanced format, list of lists
+ (pcase entry
+ (`(prompt . ,msg)
+ (push (list :role "user"
+ :content `[(:type "text" :text ,(or (car-safe msg) msg))])
+ prompts))
+ (`(response . ,msg)
+ (push (list :role "assistant"
+ :content `[(:type "text" :text ,(or (car-safe msg) msg))])
+ prompts))
+ (`(tool . ,call)
+ (unless (plist-get call :id)
+ (plist-put call :id (gptel--anthropic-format-tool-id nil)))
+ (push (list :role "assistant"
+ :content `[( :type "tool_use" :id ,(plist-get call :id)
+ :name ,(plist-get call :name)
+ :input ,(plist-get call :args))])
+ prompts)
+ (push (gptel--parse-tool-results backend (list (cdr entry))) prompts))))
+ (nreverse prompts))
+ (cl-loop for text in prompt-list ; Simple format, list of strings
+ for role = t then (not role)
+ if text
+ collect (list :role (if role "user" "assistant")
+ :content `[(:type "text" :text ,text)])))))
+ ;; cache messages if required: add cache_control to the last message
+ (when (and (or (eq gptel-cache t) (memq 'message gptel-cache))
+ (gptel--model-capable-p 'cache))
+ (nconc (aref (plist-get (car (last full-prompt)) :content) 0)
+ '(:cache_control (:type "ephemeral"))))
+ full-prompt))
+
+(cl-defmethod gptel--parse-buffer ((backend gptel-anthropic) &optional max-entries)
+ (let ((prompts) (prev-pt (point)))
+ (if (or gptel-mode gptel-track-response)
+ (while (and (or (not max-entries) (>= max-entries 0))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min)))
+ (not (= (point) prev-pt)))
+ ;; HACK Until we can find a more robust solution for editing
+ ;; responses, ignore prompts containing only whitespace, as the
+ ;; Anthropic API can't handle it. See #452, #409, #406, #351 and #321
+ ;; We check for blank prompts by skipping whitespace and comparing
+ ;; point against the previous.
+ (unless (save-excursion (skip-syntax-forward " ") (>= (point) prev-pt))
+ (pcase (get-char-property (point) 'gptel)
+ ('response
+ (when-let* ((content
+ (gptel--trim-prefixes
+ (buffer-substring-no-properties (point) prev-pt))))
+ (when (not (string-blank-p content))
+ (push (list :role "assistant" :content content) prompts))))
+ (`(tool . ,id)
+ (save-excursion
+ (condition-case nil
+ (let* ((tool-call (read (current-buffer)))
+ ;; (id (gptel--anthropic-format-tool-id id))
+ (name (plist-get tool-call :name))
+ (arguments (plist-get tool-call :args)))
+ (unless id (setq id (gptel--anthropic-format-tool-id nil)))
+ (plist-put tool-call :id id)
+ (plist-put tool-call :result
+ (string-trim (buffer-substring-no-properties
+ (point) prev-pt)))
+ (push (gptel--parse-tool-results backend (list tool-call))
+ prompts)
+ (push (list :role "assistant"
+ :content `[( :type "tool_use" :id ,id :name ,name
+ :input ,arguments)])
+ prompts))
+ ((end-of-file invalid-read-syntax)
+ (message (format "Could not parse tool-call %s on line %s"
+ id (line-number-at-pos (point))))))))
+ ('ignore)
+ ('nil ; user role: possibly with media
+ (if gptel-track-media
+ (when-let* ((content (gptel--anthropic-parse-multipart
+ (gptel--parse-media-links major-mode (point) prev-pt))))
+ (when (> (length content) 0)
+ (push (list :role "user" :content content) prompts)))
+ (when-let* ((content (gptel--trim-prefixes
+ (buffer-substring-no-properties (point) prev-pt))))
+ (push (list :role "user" :content content) prompts))))))
+ (setq prev-pt (point))
+ (and max-entries (cl-decf max-entries)))
+ (when-let* ((content (string-trim (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ ;; XXX fails if content is empty. The correct error behavior is left to
+ ;; a future discussion.
+ (push (list :role "user" :content content) prompts)))
+ ;; Cache messages if required: add cache_control to the last message
+ (if (and (or (eq gptel-cache t) (memq 'message gptel-cache))
+ (gptel--model-capable-p 'cache))
+ (let ((last-message (plist-get (car (last prompts)) :content)))
+ (if (stringp last-message)
+ (plist-put
+ (car (last prompts)) :content
+ `[(:type "text" :text ,last-message
+ :cache_control (:type "ephemeral"))])
+ (nconc (aref (plist-get (car (last prompts)) :content) 0)
+ '(:cache_control (:type "ephemeral"))))))
+ prompts))
+
+(defun gptel--anthropic-parse-multipart (parts)
+ "Convert a multipart prompt PARTS to the Anthropic API format.
+
+The input is an alist of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\")).
+
+The output is a vector of entries in a backend-appropriate
+format."
+ (cl-loop
+ for part in parts
+ for n upfrom 1
+ with last = (length parts)
+ with type
+ for text = (plist-get part :text)
+ for mime = (plist-get part :mime)
+ for media = (plist-get part :media)
+ if text do
+ (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and
+ if text
+ collect `(:type "text" :text ,text) into parts-array end
+ else if media
+ do
+ (setq type (cond ;Currently supported: Images and PDFs
+ ((equal (substring mime 0 5) "image") "image")
+ ;; NOTE: Only Claude 3.5 Sonnet supports PDF documents:
+ ((equal mime "application/pdf") "document")
+ (t (error (concat "(gptel-anthropic) Request aborted: "
+ "trying to send unsupported MIME type %s")
+ mime))))
+ and collect
+ `(:type ,type
+ :source (:type "base64"
+ :media_type ,(plist-get part :mime)
+ :data ,(gptel--base64-encode media)))
+ into parts-array
+ else if (plist-get part :textfile) collect
+ `(:type "text"
+ :text ,(with-temp-buffer
+ (gptel--insert-file-string (plist-get part :textfile))
+ (buffer-string)))
+ into parts-array
+ finally return (vconcat parts-array)))
+
+(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)
+ (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))
+;; (vector (vconcat `((:type "text" :text ,previous))
+;; previous))
+;; (t context-string)))
+;; (plist-get (car (last prompts)) :content)))
+
+(defconst gptel--anthropic-models
+ '((claude-sonnet-4-6
+ :description "The best combination of speed and intelligence"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 1000
+ :input-cost 3
+ :output-cost 15
+ :cutoff-date "2025-08")
+ (claude-sonnet-4-5-20250929
+ :description "High-performance model with exceptional reasoning and efficiency"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 3
+ :output-cost 15
+ :cutoff-date "2025-07")
+ (claude-haiku-4-5-20251001
+ :description "Near-frontier intelligence at blazing speeds with extended thinking"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 1
+ :output-cost 5
+ :cutoff-date "2025-02")
+ (claude-sonnet-4-20250514
+ :description "High-performance model with exceptional reasoning and efficiency"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 3
+ :output-cost 15
+ :cutoff-date "2025-03")
+ (claude-opus-4-7
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 1000
+ :input-cost 5
+ :output-cost 25
+ :cutoff-date "2026-01")
+ (claude-opus-4-6
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 5
+ :output-cost 25
+ :cutoff-date "2025-08")
+ (claude-opus-4-5-20251101
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 5
+ :output-cost 25
+ :cutoff-date "2025-03")
+ (claude-opus-4-1-20250805
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 15
+ :output-cost 75
+ :cutoff-date "2025-03")
+ (claude-opus-4-20250514
+ :description "Anthropic's previous flagship model"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 15
+ :output-cost 75
+ :cutoff-date "2025-03")
+ (claude-3-7-sonnet-20250219
+ :description "Hybrid model capable of standard thinking and extended thinking modes"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 3
+ :output-cost 15
+ :cutoff-date "2025-02")
+ (claude-3-5-sonnet-20241022
+ :description "Highest level of intelligence and capability"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 200
+ :input-cost 3
+ :output-cost 15
+ :cutoff-date "2024-04")
+ (claude-3-5-sonnet-20240620
+ :description "Highest level of intelligence and capability (earlier version)"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 200
+ :input-cost 3
+ :output-cost 15
+ :cutoff-date "2024-04")
+ (claude-3-5-haiku-20241022
+ :description "Intelligence at blazing speeds"
+ :capabilities (tool-use cache)
+ :context-window 200
+ :input-cost 1.00
+ :output-cost 5.00
+ :cutoff-date "2024-07")
+ (claude-3-opus-20240229
+ :description "Top-level performance, intelligence, fluency, and understanding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 200
+ :input-cost 15
+ :output-cost 75
+ :cutoff-date "2023-08")
+ (claude-3-haiku-20240307
+ :description "Fast and most compact model for near-instant responsiveness"
+ :capabilities (tool-use cache)
+ :context-window 200
+ :input-cost 0.25
+ :output-cost 1.25
+ :cutoff-date "2023-08"))
+ "List of available Anthropic models and associated properties.
+Keys:
+
+- `:description': a brief description of the model.
+
+- `:capabilities': a list of capabilities supported by the model.
+
+- `:mime-types': a list of supported MIME types for media files.
+
+- `:context-window': the context window size, in thousands of tokens.
+
+- `:input-cost': the input cost, in US dollars per million tokens.
+
+- `:output-cost': the output cost, in US dollars per million tokens.
+
+- `:cutoff-date': the knowledge cutoff date.
+
+- `:request-params': a plist of additional request parameters to
+ include when using this model.
+
+Information about the Anthropic models was obtained from the following
+comparison table:
+
+URL `https://docs.anthropic.com/en/docs/about-claude/models#model-comparison-table'")
+
+;;;###autoload
+(cl-defun gptel-make-anthropic
+ (name &key curl-args stream key request-params
+ (header
+ (lambda (_info) (when-let* ((key (gptel--get-api-key)))
+ `(("x-api-key" . ,key)
+ ("anthropic-version" . "2023-06-01")
+ ("anthropic-beta" . "extended-cache-ttl-2025-04-11")))))
+ (models gptel--anthropic-models)
+ (host "api.anthropic.com")
+ (protocol "https")
+ (endpoint "/v1/messages"))
+ "Register an Anthropic API-compatible backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, \"api.anthropic.com\" by default.
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--anthropic-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(claude-3-haiku-20240307 ;Simple specs
+ claude-3-opus-20240229
+ (claude-3-5-sonnet-20240620 ;Full spec
+ :description \"Balance of intelligence and speed\"
+ :capabilities (media tool json)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/messages\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for."
+ (declare (indent 1))
+ (let ((backend (gptel--make-anthropic
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint)))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+(provide 'gptel-anthropic)
+;;; gptel-anthropic.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from gptel.el
+
+(autoload 'gptel-mode "gptel"
+"Minor mode for interacting with LLMs.
+
+This is a minor mode. If called interactively, toggle the `GPTel mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate the variable `gptel-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(autoload 'gptel-send "gptel"
+"Submit this prompt to the current LLM backend.
+
+By default, the contents of the buffer up to the cursor position
+are sent. If the region is active, its contents are sent
+instead.
+
+The response from the LLM is inserted below the cursor position
+at the time of sending. To change this behavior or model
+parameters, use prefix arg ARG activate a transient menu with
+more options instead.
+
+This command is asynchronous, you can continue to use Emacs while
+waiting for the response.
+
+(fn &optional ARG)" t)
+(autoload 'gptel "gptel"
+"Switch to or start a chat session with NAME.
+
+Ask for API-KEY if `gptel-api-key' is unset.
+
+If region is active, use it as the INITIAL prompt. Returns the
+buffer created or switched to.
+
+INTERACTIVEP is t when gptel is called interactively.
+
+(fn NAME &optional _ INITIAL INTERACTIVEP)" t)
+(register-definition-prefixes "gptel" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-anthropic.el
+
+(autoload 'gptel-make-anthropic "gptel-anthropic"
+"Register an Anthropic API-compatible backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, \"api.anthropic.com\" by default.
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--anthropic-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(claude-3-haiku-20240307 ;Simple specs
+ claude-3-opus-20240229
+ (claude-3-5-sonnet-20240620 ;Full spec
+ :description \"Balance of intelligence and speed\"
+ :capabilities (media tool json)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/messages\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"x-api-key\" \\=\\, key) (\"anthropic-version\" . \"2023-06-01\") (\"anthropic-beta\" . \"extended-cache-ttl-2025-04-11\"))))) (MODELS gptel--anthropic-models) (HOST \"api.anthropic.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/messages\"))")
+(function-put 'gptel-make-anthropic 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-anthropic" '("gptel--anthropic-"))
+
+\f
+;;; Generated autoloads from gptel-bedrock.el
+
+(autoload 'gptel-make-bedrock "gptel-bedrock"
+"Register an AWS Bedrock backend for gptel with NAME.
+
+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.
+
+(fn NAME &key REGION (MODELS gptel--bedrock-models) (MODEL-REGION nil) STREAM CURL-ARGS REQUEST-PARAMS AWS-PROFILE AWS-BEARER-TOKEN (PROTOCOL \"https\"))")
+(function-put 'gptel-make-bedrock 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-bedrock" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-context.el
+
+ (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t)
+ (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t)
+(autoload 'gptel-context--wrap "gptel-context"
+"Add request context to DATA-BUF and run CALLBACK.
+
+DATA-BUF is the buffer where the request prompt is constructed.
+
+(fn CALLBACK DATA-BUF)")
+(autoload 'gptel-context--collect "gptel-context"
+"Get the list of all active context sources from CONTEXT-ALIST.
+
+CONTEXT-ALIST defaults to the current value of `gptel-context'.
+
+Ignore overlays, buffers and files that are not live or readable.
+
+(fn &optional CONTEXT-ALIST)")
+(register-definition-prefixes "gptel-context" '("gptel-context-"))
+
+\f
+;;; Generated autoloads from gptel-gemini.el
+
+(autoload 'gptel-make-gemini "gptel-gemini"
+"Register a Gemini backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, defaults to
+\"generativelanguage.googleapis.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--gemini-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(gemini-2.0-flash-lite ;Simple specs
+ gemini-1.5-flash
+ (gemini-1.5-pro-latest ;Full spec
+ :description
+ \"Complex reasoning tasks, problem solving and data extraction\"
+ :capabilities (tool json)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\")))
+
+
+STREAM is a boolean to enable streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, \"https\" by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1beta/models\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+(fn NAME &key CURL-ARGS KEY REQUEST-PARAMS (STREAM nil) (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"X-goog-api-key\" \\=\\, key))))) (HOST \"generativelanguage.googleapis.com\") (PROTOCOL \"https\") (MODELS gptel--gemini-models) (ENDPOINT \"/v1beta/models\"))")
+(function-put 'gptel-make-gemini 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-gemini" '("gptel--gemini-"))
+
+\f
+;;; Generated autoloads from gptel-gh.el
+
+(autoload 'gptel-make-gh-copilot "gptel-gh"
+"Register a Github Copilot chat backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, typically \"api.githubcopilot.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--openai-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(gpt-3.5-turbo ;Simple specs
+ gpt-4-turbo
+ (gpt-4o-mini ;Full spec
+ :description
+ \"Affordable and intelligent small model for lightweight tasks\"
+ :capabilities (media tool json url)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
+
+Defaults to a list of models supported by GitHub Copilot.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/chat/completions\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+Defaults to headers required by GitHub Copilot.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+(fn NAME &key CURL-ARGS REQUEST-PARAMS (HEADER (lambda (info) (gptel--gh-auth) \\=`((\"openai-intent\" . \"conversation-panel\") (\"authorization\" \\=\\, (concat \"Bearer \" (plinbsp;(MODELS gptel--gh-models))")
+(function-put 'gptel-make-gh-copilot 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-gh" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-integrations.el
+
+(register-definition-prefixes "gptel-integrations" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-kagi.el
+
+(autoload 'gptel-make-kagi "gptel-kagi"
+"Register a Kagi FastGPT backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is the Kagi host (with port), defaults to \"kagi.com\".
+
+MODELS is a list of available Kagi models: only fastgpt is supported.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false. Kagi does not support a streaming API yet.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/api/v0/fastgpt\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+Example:
+-------
+
+ (gptel-make-kagi \"Kagi\" :key my-kagi-key)
+
+(fn NAME &key CURL-ARGS STREAM KEY (HOST \"kagi.com\") (HEADER (lambda (_info) \\=`((\"Authorization\" \\=\\, (concat \"Bot \" (gptel--get-api-key)))))) (MODELS \\='((fastgpt :capabilities (nosystem)) (summarize:cecil :capabilities (nosystem)) (summarize:agnes :capabilities (nosystem)) (summarize:daphne :capabilities (nosystem)) (summarize:muriel :capabilities (nosystem)))) (PROTOCOL \"https\") (ENDPOINT \"/api/v0/\"))")
+(function-put 'gptel-make-kagi 'lisp-indent-function 1)
+
+\f
+;;; Generated autoloads from gptel-ollama.el
+
+(autoload 'gptel-make-ollama "gptel-ollama"
+"Register an Ollama backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is where Ollama runs (with port), defaults to localhost:11434
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+Currently recognized plist keys are :description, :capabilities
+and :mime-types. An example of a model specification including
+both kinds of specs:
+
+:models
+\\='(mistral:latest ;Simple specs
+ openhermes:latest
+ (llava:13b ;Full spec
+ :description
+ \"Llava 1.6: Large Lanuage and Vision Assistant\"
+ :capabilities (media)
+ :mime-types (\"image/jpeg\" \"image/png\")))
+
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, http by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/api/generate\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key. This is typically not required
+for local models like Ollama.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+ (gptel-make-ollama
+ \"Ollama\"
+ :host \"localhost:11434\"
+ :models \\='(mistral:latest)
+ :stream t)
+
+(fn NAME &key CURL-ARGS HEADER KEY MODELS STREAM REQUEST-PARAMS (HOST \"localhost:11434\") (PROTOCOL \"http\") (ENDPOINT \"/api/chat\"))")
+(function-put 'gptel-make-ollama 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-ollama" '("gptel--ollama-"))
+
+\f
+;;; Generated autoloads from gptel-openai.el
+
+(autoload 'gptel-make-openai "gptel-openai"
+"Register an OpenAI API-compatible backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, typically \"api.openai.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--openai-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(gpt-3.5-turbo ;Simple specs
+ gpt-4-turbo
+ (gpt-4o-mini ;Full spec
+ :description
+ \"Affordable and intelligent small model for lightweight tasks\"
+ :capabilities (media tool json url)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/chat/completions\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+(fn NAME &key CURL-ARGS (MODELS gptel--openai-models) STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.openai.com\") (PROTOCOL \"https\") ENDPOINT)")
+(function-put 'gptel-make-openai 'lisp-indent-function 1)
+(autoload 'gptel-make-azure "gptel-openai"
+"Register an Azure backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is the API host.
+
+MODELS is a list of available model names, as symbols.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT is the API endpoint for completions.
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+ (gptel-make-azure
+ \"Azure-1\"
+ :protocol \"https\"
+ :host \"RESOURCE_NAME.openai.azure.com\"
+ :endpoint
+ \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\"
+ :stream t
+ :models \\='(gpt-3.5-turbo gpt-4))
+
+(fn NAME &key CURL-ARGS HOST (PROTOCOL \"https\") (HEADER (lambda (_info) \\=`((\"api-key\" \\=\\, (gptel--get-api-key))))) (KEY \\='gptel-api-key) MODELS STREAM ENDPOINT REQUEST-PARAMS)")
+(function-put 'gptel-make-azure 'lisp-indent-function 1)
+(defalias 'gptel-make-gpt4all 'gptel-make-openai
+"Register a GPT4All backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is where GPT4All runs (with port), typically localhost:4891
+
+MODELS is a list of available model names, as symbols.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/api/v1/completions\"
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key. This is typically not required for
+local models like GPT4All.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+(gptel-make-gpt4all
+ \"GPT4All\"
+ :protocol \"http\"
+ :host \"localhost:4891\"
+ :models \\='(mistral-7b-openorca.Q4_0.gguf))")
+(register-definition-prefixes "gptel-openai" '("gptel--openai-"))
+
+\f
+;;; Generated autoloads from gptel-openai-extras.el
+
+(autoload 'gptel-make-privategpt "gptel-openai-extras"
+"Register an Privategpt API-compatible backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, \"api.privategpt.com\" by default.
+
+MODELS is a list of available model names.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/messages\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+((\"Content-Type\" . \"application/json\"))
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+CONTEXT and SOURCES: if true (the default), use available context
+and provide sources used by the model to generate the response.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"localhost:8001\") (PROTOCOL \"http\") (MODELS \\='(private-gpt)) (ENDPOINT \"/v1/chat/completions\") (CONTEXT t) (SOURCES t))")
+(function-put 'gptel-make-privategpt 'lisp-indent-function 1)
+(autoload 'gptel-make-perplexity "gptel-openai-extras"
+"Register a Perplexity backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, \"api.perplexity.ai\" by default.
+
+MODELS is a list of available model names.
+
+STREAM is a boolean to toggle streaming responses.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions.
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist.
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters.
+
+(fn NAME &key CURL-ARGS STREAM KEY (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.perplexity.ai\") (PROTOCOL \"https\") (MODELS \\='(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research)) (ENDPOINT \"/chat/completions\") REQUEST-PARAMS)")
+(function-put 'gptel-make-perplexity 'lisp-indent-function 1)
+(autoload 'gptel-make-deepseek "gptel-openai-extras"
+"Register a DeepSeek backend for gptel with NAME.
+
+For the meanings of the keyword arguments, see `gptel-make-openai'.
+
+(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.deepseek.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((deepseek-reasoner :capabilities (tool reasoning) :context-window 128 :input-cost 0.28 :output-cost 0.42) (deepseek-chat :capabilities (tool) :context-window 128 :input-cost 0.28 :output-cost 0.42))))")
+(function-put 'gptel-make-deepseek 'lisp-indent-function 1)
+(autoload 'gptel-make-xai "gptel-openai-extras"
+"Register an xAI backend for gptel with NAME.
+
+Keyword arguments:
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+The other keyword arguments are all optional. For their meanings
+see `gptel-make-openai'.
+
+(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.x.ai\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((grok-4-1-fast-reasoning :description \"Fast tool-calling model\" :capabilities (tool-use uot;) :context-window 32 :input-cost 2 :output-cost 10))))")
+(function-put 'gptel-make-xai 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-openai-extras" '("gptel--p"))
+
+\f
+;;; Generated autoloads from gptel-openai-responses.el
+
+(autoload 'gptel-make-openai-responses "gptel-openai-responses"
+"Register an OpenAI Responses API backend for gptel with NAME.
+
+The Responses API is OpenAI's new API for agentic applications that
+provides built-in tools like web search, code interpreter, and file
+search.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, typically \"api.openai.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--openai-models'.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/responses\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+ (gptel-make-openai-responses
+ \"OpenAI-Responses\"
+ :stream t
+ :models '((gpt-4o
+ :capabilities (media tool-use json url responses-api)
+ :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))
+ (gpt-4o-mini
+ :capabilities (media tool-use json url responses-api)
+ :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))))
+
+(fn NAME &key CURL-ARGS (MODELS gptel--openai-models) STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.openai.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/responses\"))")
+(function-put 'gptel-make-openai-responses 'lisp-indent-function 1)
+(register-definition-prefixes "gptel-openai-responses" '("gptel--openai-responses-"))
+
+\f
+;;; Generated autoloads from gptel-org.el
+
+(autoload 'gptel--convert-markdown->org "gptel-org"
+"Convert string STR from markdown to org markup.
+
+This is a very basic converter that handles only a few markup
+elements.
+
+(fn STR)")
+(autoload 'gptel--stream-convert-markdown->org "gptel-org"
+"Return a Markdown to Org converter.
+
+This function parses a stream of Markdown text to Org
+continuously when it is called with successive chunks of the
+text stream.
+
+START-MARKER is used to identify the corresponding process when
+cleaning up after.
+
+(fn START-MARKER)")
+(register-definition-prefixes "gptel-org" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-request.el
+
+(autoload 'gptel-curl-get-response "gptel-request"
+"Fetch response to prompt in state FSM from the LLM using Curl.
+
+FSM is the state machine driving this request.
+
+FSM is the state machine driving this request. Its INFO slot
+contains the data required for setting up the request. INFO is a
+plist with the following keys, among others:
+- :data (the data being sent)
+- :buffer (the gptel buffer)
+- :position (marker at which to insert the response).
+- :callback (optional, the request callback)
+
+Call CALLBACK with the response and INFO afterwards. If omitted
+the response is inserted into the current buffer after point.
+
+(fn FSM)")
+(register-definition-prefixes "gptel-request" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-rewrite.el
+
+ (autoload 'gptel-rewrite "gptel-rewrite" nil t)
+(register-definition-prefixes "gptel-rewrite" '("gptel-"))
+
+\f
+;;; Generated autoloads from gptel-transient.el
+
+ (autoload 'gptel-menu "gptel-transient" nil t)
+ (autoload 'gptel-system-prompt "gptel-transient" nil t)
+(autoload 'gptel-preset "gptel-transient"
+"Load gptel PRESET with SETTER.
+
+Interactively, query for PRESET, allow the preset scope to be set
+dynamically, and offer to save the current gptel settings as a new or
+existing preset, as well.
+
+(fn PRESET &optional SETTER)" t)
+ (autoload 'gptel-tools "gptel-transient" nil t)
+(register-definition-prefixes "gptel-transient" '("gptel-"))
+\f
+;;; End of scraped data
+
+(provide 'gptel-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; gptel-autoloads.el ends here
--- /dev/null
+;;; gptel-bedrock.el --- AWS Bedrock support for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Karthik Chikmagalur
+
+;; Keywords: comm, convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for AWS Bedrock to gptel. Documentation for the request data and the
+;; response payloads can be found at these two links:
+;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html
+;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ConverseStream.html
+
+;;; Code:
+(require 'cl-lib)
+(require 'map)
+(require 'mail-parse)
+(eval-and-compile (require 'gptel-request))
+
+(declare-function gptel-context--collect-media "gptel-context")
+(declare-function gptel-context--wrap "gptel-context")
+
+(cl-defstruct (gptel-bedrock (:constructor gptel--make-bedrock)
+ (:copier nil)
+ (:include gptel-backend))
+ model-region)
+
+(defun gptel--bedrock-update-tokens (usage info)
+ "Update token usage information from USAGE.
+USAGE is part of the response, INFO is the request plist.
+
+This function accumulates token counts across multiple turns in a
+multi-turn request (e.g., during tool use where results are fed
+back to the LLM)."
+ (when usage
+ (let* ((tokens (plist-get info :tokens))
+ (input (+ (or (plist-get usage :inputTokens) 0)
+ (or (plist-get tokens :input) 0)))
+ (output (+ (or (plist-get usage :outputTokens) 0)
+ (or (plist-get tokens :output) 0)))
+ (cached (+ (or (plist-get usage :cacheReadInputTokens) 0)
+ (or (plist-get tokens :cached) 0)))
+ (cache (+ (or (plist-get usage :cacheWriteInputTokens) 0)
+ (or (plist-get tokens :cache) 0))))
+ (list :input input :output output
+ :cache cache :cached cached))))
+
+(defconst gptel-bedrock--prompt-type
+ ;; For documentation purposes only -- this describes the type of prompt objects that get passed
+ ;; around. https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Message.html
+ '(plist
+ :role (member "user" "assistant")
+ :content (array (or (plist :text string)
+ (plist :image (:format (member "png" "jpeg" "gif" "webp")
+ :source (plist :bytes string))) ; bytes is b64 encoded
+ (plist :document (:format (member "pdf" "csv" "doc" "docx" "xls" "xlsx" "html" "txt" "md")
+ :name string
+ :source (plist :bytes string))) ; bytes is b64 encoded
+ (plist :toolUse (plist :input any :name string :toolUseId string))
+ (plist :toolResult (plist
+ :toolUseId string
+ :status (member "success" "error")
+ ;; AWS allows more result types in
+ ;; ToolResultContentBlock, but we only send text results
+ :content (array (plist :text string))))))))
+
+(cl-defmethod gptel--request-data ((backend gptel-bedrock) prompts)
+ "Prepare request data for AWS Bedrock BACKEND from PROMPTS."
+ ;; First, build the core Bedrock request data structure.
+ (let ((base-request-data
+ (nconc
+ `(:messages [,@prompts] :inferenceConfig (:maxTokens ,(or gptel-max-tokens 500)))
+ (when gptel--system-message `(:system [(:text ,gptel--system-message)]))
+ (when gptel-temperature `(:temperature ,gptel-temperature))
+ (when (and gptel-use-tools gptel-tools)
+ `(:toolConfig (:toolChoice ,(if (eq gptel-use-tools 'force) '(:any '()) '(:auto '()))
+ :tools ,(gptel--parse-tools backend gptel-tools)))))))
+
+ ;; Finally, merge all potential :request-params sources.
+ (gptel--merge-plists
+ base-request-data ; The core data we just built
+ gptel--request-params ; Global/buffer-local gptel--request-params
+ (gptel-backend-request-params backend) ; From `gptel-make-bedrock` call
+ (gptel--model-request-params gptel-model)))) ; From the model's properties
+
+(cl-defmethod gptel--parse-tools ((_backend gptel-bedrock) tools)
+ "Parse TOOLS and return a list of ToolSpecification objects.
+
+TOOLS is a list of `gptel-tool' structs, which see."
+ ;; https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ToolSpecification.html
+ (let ((default-outputs (cl-call-next-method))) ;; use openai tool-parse
+ (cl-map 'vector
+ (lambda (tool spec)
+ (list :toolSpec
+ (list
+ :name (gptel-tool-name tool)
+ :description (gptel-tool-description tool)
+ :inputSchema (list :json (plist-get (plist-get spec :function) :parameters)))))
+ (ensure-list tools) default-outputs)))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-bedrock) response info)
+ "Parse a Bedrock (non-streaming) RESPONSE and return response text.
+
+Mutate state INFO with response metadata."
+ (plist-put info :stop-reason (plist-get response :stopReason))
+ (plist-put info :tokens (gptel--bedrock-update-tokens
+ (plist-get response :usage) info))
+
+ (let* ((message (map-nested-elt response '(:output :message)))
+ (content-strs (thread-last (plist-get message :content)
+ (mapcar (lambda (cblock) (plist-get cblock :text)))
+ (delq nil))))
+ (gptel-bedrock--record-tool-use message info)
+ (and content-strs (apply #'concat content-strs))))
+
+(defun gptel-bedrock--record-tool-use (message info)
+ "If MESSAGE has tool use requests, save those to INFO."
+ (let* ((content (plist-get message :content))
+ (tool-use-blocks (cl-remove-if-not
+ (lambda (cblock) (plist-get cblock :toolUse))
+ content)))
+ (when tool-use-blocks
+ (cl-callf vconcat (plist-get (plist-get info :data) :messages) (list message))
+
+ (plist-put info :tool-use
+ (mapcar (lambda (block)
+ (let ((tool-use (plist-get block :toolUse)))
+ (list
+ :name (plist-get tool-use :name)
+ :args (plist-get tool-use :input)
+ :id (plist-get tool-use :toolUseId))))
+ tool-use-blocks)))))
+
+(cl-defmethod gptel--parse-list ((_backend gptel-bedrock) prompt-strings)
+ "Create a list of prompt objects from PROMPT-STRINGS.
+
+Assumes this is a conversation with alternating roles."
+ (cl-loop for text in prompt-strings
+ for role = t then (not role)
+ if text collect
+ (list :role (if role "user" "assistant")
+ :content `[(:text ,text)])))
+
+(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))))
+
+(defvar-local gptel-bedrock--stream-cursor nil
+ "Marker to indicate last point parsed.")
+
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-bedrock) info)
+ "Parse an AWS Bedrock streaming response from the ConverseStream API.
+INFO is a plist containing the request context."
+ (cl-block fn
+ (save-excursion
+ ;; Each streaming request uses a fresh buffer, so the cursor starts out null. We keep it unset
+ ;; until we have received all the headers
+ (when (null gptel-bedrock--stream-cursor)
+ (goto-char (point-min))
+ (unless (search-forward "\r\n\r\n" nil t) (cl-return-from fn))
+ (save-restriction
+ (narrow-to-region (point-min) (point)) ; Required by mail-fetch-field
+ (let ((content-type (mail-header-parse-content-type
+ (mail-fetch-field "Content-Type"))))
+ (cl-assert content-type nil "No Content-Type header found")
+ (cl-assert (string-equal (car content-type) "application/vnd.amazon.eventstream")
+ t "Unexpected Content-Type %S, expected %S")))
+ (setq gptel-bedrock--stream-cursor (point-marker))
+
+ ;; :accumulated-events contains the events from an in-progress message, from the
+ ;; messageStart onwards. With each messageStop it gets cleared
+ (plist-put info :accumulated-events nil))
+
+ ;; Start of main routine
+ (let ((acc-cell (cdr (plist-member info :accumulated-events))) strings prompts)
+ (goto-char gptel-bedrock--stream-cursor)
+ (while-let ((event (gptel-bedrock--parse-stream-message)))
+ (let ((event-type (assoc-default ":event-type" (plist-get event :headers))))
+ (when (member event-type '("messageStart" "contentBlockStart" "contentBlockDelta"
+ "contentBlockStop"))
+ (push event (car acc-cell)))
+ (pcase event-type
+ ("metadata"
+ (plist-put info :tokens (gptel--bedrock-update-tokens
+ (map-nested-elt event '(:payload :usage)) info)))
+ ("contentBlockDelta"
+ (when-let ((delta-text (map-nested-elt event '(:payload :delta :text))))
+ (push delta-text strings)))
+ ("messageStop"
+ (push (gptel-bedrock--assemble-content-blocks (nreverse (car acc-cell))) prompts)
+ (setf (car acc-cell) nil)
+ (plist-put info :stop-reason (map-nested-elt event '(:payload :stopReason)))
+ (plist-put info :message-complete t)))))
+ (move-marker gptel-bedrock--stream-cursor (point))
+
+ (dolist (message prompts) (gptel-bedrock--record-tool-use message info))
+ (apply #'concat (nreverse strings))))))
+
+(defun gptel-bedrock--parse-stream-message ()
+ "Parse AWS Bedrock event-stream message starting at current position.
+Point should be at the beginning of an event in the `vnd.amazon.event-stream'
+format. Returns plist with :headers and :payload keys if successful, nil if
+incomplete."
+ ;; https://github.com/awslabs/aws-c-event-stream has documentation of this format
+ ;; The format consists of three main sections: Prelude, Data, and Message CRC.
+ ;; 1. Prelude (12 bytes)
+ ;; a. Total Byte Length (4 bytes): Specifies the total length of the message.
+ ;; b. Headers Byte Length (4 bytes): Indicates the length of the headers section.
+ ;; c. Prelude CRC (4 bytes): A CRC value for validating the integrity of the prelude.
+ ;; 2. Data (variable length)
+ ;; a. Headers: An array of packed headers. Each header has a specific format documented in
+ ;; gptel-bedrock--parse-headers
+ ;; b. Payload: The main message content, also of variable length. Length can be computed from
+ ;; the prelude fields by subtracting the prelude length, headers length, and message CRC
+ ;; length from the total.
+ ;; 3. Message CRC (4 bytes): A 4-byte CRC to validate the integrity of the entire message.
+
+ ;; (point-max) is the position after the last character, hence the use of >= and not > below
+ (when (>= (- (point-max) (point)) 12)
+ (let* ((prelude-start (point))
+ (prelude-length 12)
+ (prelude-end (+ prelude-start prelude-length))
+ (prelude (buffer-substring-no-properties prelude-start prelude-end))
+ (total-length (gptel-bedrock--bytes-to-int32 (substring prelude 0 4)))
+ (headers-length (gptel-bedrock--bytes-to-int32 (substring prelude 4 8)))
+ (headers-start prelude-end)
+ (headers-end (+ headers-start headers-length))
+ headers payload)
+ ;; We don't validate either CRC because isn't that what the networking stack is for?
+
+ (when (>= (point-max) (+ prelude-start total-length))
+ (goto-char headers-start)
+ (setq headers (gptel-bedrock--parse-headers (buffer-substring (point) headers-end)))
+ (cl-assert (equal (assoc-default ":message-type" headers) "event")
+ t "Unknown message type %S; expected %S")
+ (cl-assert (equal (assoc-default ":content-type" headers) "application/json")
+ t "Unexpected content-type %S is not %S")
+
+ (goto-char headers-end)
+ (setq payload (gptel--json-read))
+ (let* ((message-crc 4)
+ (payload-length (- total-length headers-length prelude-length message-crc)))
+ (cl-assert (= (- (point) headers-end) payload-length)
+ t "Unexpected payload length %d; expected %d."))
+
+ (goto-char (+ prelude-start total-length))
+ `(:headers ,headers :payload ,payload)))))
+
+(defun gptel-bedrock--parse-headers (headers-data)
+ "Parse HEADERS-DATA into alist of (NAME . VALUE).
+Keys are string-valued, lower-cased names."
+ ;; Header wire format:
+ ;; 1. Header Name Byte Length (1 byte): Specifies the length of the header name.
+ ;; 2. Header Name (String) (Variable length): Contains the name of the header.
+ ;; 3. Header Value Type (1 byte): Identifies the type of the header value.
+ ;; 4. Value String Byte Length (2 bytes): Indicates the length of the value string.
+ ;; 5. Value (Variable length): Holds the actual value bytes
+ (let ((pos 0) (max (length headers-data)) headers)
+ (cl-flet ((pos++ () (prog1 pos (cl-incf pos)))
+ (++pos (n) (cl-incf pos n))
+ (utf8 (unibyte-string) (decode-coding-string unibyte-string 'utf-8 t)))
+ (while (< pos max)
+ (let* ((name-len (aref headers-data (pos++)))
+ (name (substring headers-data pos (++pos name-len)))
+ (type (aref headers-data (pos++)))
+ (value-len (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2))))
+ (value
+ (pcase type
+ ;; Header types from https://awslabs.github.io/aws-crt-python/api/eventstream.html
+ (0 t)
+ (1 :json-false)
+ (2 (let ((res (aref headers-data (pos++)))) ; int8
+ (if (> res 127) (- res 256) res)))
+ (3 (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2)))) ; int16
+ (4 (gptel-bedrock--bytes-to-int32 (substring headers-data pos (++pos 4)))) ; int32
+ (5 (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8)))) ; int64
+ (6 (substring headers-data pos (++pos value-len))) ; raw bytes
+ (7 (utf8 (substring headers-data pos (++pos value-len)))) ; utf8 string
+ (8 (decode-time ; 64 bit int with seconds since the Unix epoch
+ (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8))) t))
+ (9 (gptel-bedrock--bytes-to-uuid ; 16 byte UUID
+ (substring headers-data pos (++pos 16))))
+ (_ (error "Unknown header type: %d" type)))))
+ (push (cons (downcase (utf8 name)) value) headers)))
+ (cl-assert (= pos max) t "Headers did not parse cleanly. pos=%d header-len=%d")
+ headers)))
+
+(defun gptel-bedrock--bytes-to-int16 (bytes)
+ "Convert 2-byte string BYTES to big-endian signed integer."
+ (let ((b0 (logand (aref bytes 0) 255))
+ (b1 (logand (aref bytes 1) 255)))
+ (let ((result (+ (ash b0 8) b1)))
+ (if (>= b0 #x80) (- result (ash 1 16)) result))))
+
+(defun gptel-bedrock--bytes-to-int32 (bytes)
+ "Convert 4-byte string BYTES to big-endian signed integer."
+ (let ((b0 (logand (aref bytes 0) 255))
+ (b1 (logand (aref bytes 1) 255))
+ (b2 (logand (aref bytes 2) 255))
+ (b3 (logand (aref bytes 3) 255)))
+ (let ((result (+ (ash b0 24) (ash b1 16) (ash b2 8) b3)))
+ (if (>= b0 #x80) (- result (ash 1 32)) result))))
+
+(defun gptel-bedrock--bytes-to-int64 (bytes)
+ "Convert 8-byte string BYTES to big-endian signed integer."
+ (let ((b0 (logand (aref bytes 0) 255))
+ (b1 (logand (aref bytes 1) 255))
+ (b2 (logand (aref bytes 2) 255))
+ (b3 (logand (aref bytes 3) 255))
+ (b4 (logand (aref bytes 4) 255))
+ (b5 (logand (aref bytes 5) 255))
+ (b6 (logand (aref bytes 6) 255))
+ (b7 (logand (aref bytes 7) 255)))
+ (let ((result-u63 (+ (ash (logand b0 #x7f) 56) (ash b1 48)
+ (ash b2 40) (ash b3 32) (ash b4 24) (ash b5 16) (ash b6 8) b7)))
+ (if (>= b0 #x80)
+ (- result-u63 (ash 1 63))
+ result-u63))))
+
+(defun gptel-bedrock--bytes-to-uuid (bytes)
+ "Convert a 16-byte unibyte BYTES to a 36 character UUID string."
+ (unless (and (stringp bytes) (= (length bytes) 16))
+ (error "Input must be a 16-byte unibyte string"))
+ (let ((hex (mapconcat (lambda (i) (format "%02x" (aref bytes i))) (number-sequence 0 15) "")))
+ (format "%s-%s-%s-%s-%s"
+ (substring hex 0 8)
+ (substring hex 8 12)
+ (substring hex 12 16)
+ (substring hex 16 20)
+ (substring hex 20 32))))
+
+(defun gptel-bedrock--assemble-content-blocks (events)
+ "Build a completed prompt object contained from EVENTS.
+EVENTS should be a list of messageStart, contentBlockStart,
+contentBlockDelta, and contentBlockStop stream messages as
+returned by `gptel-bedrock--parse-stream-message', in the order
+received."
+ (let ((blocks (make-hash-table :test #'eql))
+ role contents)
+ (dolist (event events)
+ (let* ((headers (plist-get event :headers))
+ (payload (plist-get event :payload))
+ (event-type (assoc-default ":event-type" headers)))
+ (pcase event-type
+ ("messageStart" (setq role (plist-get payload :role)))
+ ("contentBlockStart"
+ (puthash (plist-get payload :contentBlockIndex) (list event) blocks))
+ ("contentBlockDelta"
+ (push event (gethash (plist-get payload :contentBlockIndex) blocks)))
+ ("contentBlockStop"
+ (let* ((block-index (plist-get payload :contentBlockIndex))
+ (block-events (nreverse (gethash block-index blocks)))
+ (start (car block-events))
+ (deltas (cdr block-events)))
+ (when-let ((tool-use (map-nested-elt start '(:payload :start :toolUse))))
+ (let* ((id (plist-get tool-use :toolUseId))
+ (name (plist-get tool-use :name))
+ (input-str
+ (mapconcat (lambda (delta) (map-nested-elt
+ delta '(:payload :delta :toolUse :input)))
+ deltas))
+ (input (unless (string-blank-p input-str)
+ (gptel--json-read-string input-str))))
+ (push
+ (list :toolUse (list :input input :name name :toolUseId id))
+ contents)))
+ (when-let ((texts (delq nil (mapcar (lambda (d) (map-nested-elt d '(:payload :delta :text)))
+ deltas))))
+ (push (list :text (apply #'concat texts)) contents))
+ ;; Currently we discard any reasoning content but this would be the spot to handle it
+ ))
+ (_ (error "Unexpected event-type %S" event-type)))))
+ (list :role role :content (vconcat (nreverse contents)))))
+
+(cl-defmethod gptel--parse-buffer ((_backend gptel-bedrock) &optional max-entries)
+ "Parse current buffer and return a list of prompt objects for Bedrock.
+
+MAX-ENTRIES is the maximum number of prompts to include."
+ (unless max-entries (setq max-entries most-positive-fixnum))
+ (let ((prompts nil) (prev-pt (point))
+ (include-media (and gptel-track-media (gptel--model-capable-p 'media))))
+ (cl-flet ((capture-prompt (role beg end)
+ (let* ((content (if include-media
+ (gptel-bedrock--parse-multipart
+ (gptel--parse-media-links major-mode beg end))
+ `[(:text ,(gptel--trim-prefixes
+ (buffer-substring-no-properties beg end)))]))
+ (prompt (list :role role :content content)))
+ (push prompt prompts))))
+
+ (if (or gptel-mode gptel-track-response)
+ (while (and (> max-entries 0)
+ (/= prev-pt (point-min))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min))))
+ (capture-prompt (pcase (get-char-property (point) 'gptel)
+ ('response "assistant")
+ ('nil "user"))
+ (point) prev-pt)
+ (setq prev-pt (point))
+ (cl-decf max-entries))
+ (capture-prompt "user" (point-min) (point-max)))
+ prompts)))
+
+(defconst gptel-bedrock--image-formats
+ '(("image/jpg" . "jpeg")
+ ("image/jpeg" . "jpeg")
+ ("image/png" . "png")
+ ("image/gif" . "gif")
+ ("image/webp" . "webp"))
+ "Map of mime type to image formats as used in AWS's ImageBlock.")
+
+(defconst gptel-bedrock--doc-formats
+ '(("application/pdf" . "pdf")
+ ("text/csv" . "csv")
+ ("application/msword" . "doc")
+ ("application/vnd.openxmlformats-officedocument.wordprocessingml.document" . "docx")
+ ("application/vnd.ms-excel" . "xls")
+ ("application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" . "xlsx")
+ ("text/html" . "html")
+ ("text/plain" . "txt")
+ ("text/markdown" . "md"))
+ "Map of mime type to document formats as used in AWS's DocumentBlock.")
+
+(defun gptel-bedrock--parse-multipart (parts)
+ "Convert a multipart prompt PARTS to the AWS Bedrock API format.
+
+The input is a list of text and media plists of the form:
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\")).
+
+The output is a vector of entries in Bedrock API format."
+ (thread-last parts
+ (cl-maplist
+ (lambda (tail)
+ (let* ((part (car tail))
+ (text (plist-get part :text))
+ (mime (plist-get part :mime))
+ (media (plist-get part :media))
+ (textfile (plist-get part :textfile))
+ format)
+ (cond
+ (text (when (or (eq part (car parts)) (null (cdr tail)))
+ (setq text (gptel--trim-prefixes text)))
+ (unless (string-empty-p text)
+ `(:text ,text)))
+ (media
+ (cond
+ ((setq format (assoc mime gptel-bedrock--image-formats))
+ `(:image (:format ,(cdr format) :source (:bytes ,(gptel--base64-encode media)))))
+ ((setq format (assoc mime gptel-bedrock--doc-formats))
+ `(:document (:format ,(cdr format)
+ :name ,(file-name-nondirectory media)
+ :source (:bytes ,(gptel--base64-encode media)))))
+ (t (error "Unsupported MIME type %s for AWS Bedrock" mime))))
+ (textfile `(:text ,(with-temp-buffer
+ (gptel--insert-file-string textfile)
+ (buffer-string))))))))
+ (delq nil)
+ (vconcat)))
+
+;; gptel--inject-prompt not needed since the default implementation works here
+
+(cl-defmethod gptel--inject-tool-call ((_backend gptel-bedrock) data tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+BACKEND is the `gptel-backend'. See the generic function documentation
+for details. This implementation handles the AWS Bedrock API."
+ ;; FIXME: We currently assume that the tool call being modified is in the last
+ ;; position in the messages array.
+ (if-let* ((messages (plist-get data :messages))
+ (entry (aref messages (1- (length messages))))
+ (contents (plist-get entry :content))
+ (id (plist-get tool-call :id))
+ (indexed-call
+ (cl-loop for chunk across contents
+ for i upfrom 0
+ for tool-use = (plist-get chunk :toolUse)
+ if (and tool-use (equal (plist-get tool-use :toolUseId) id))
+ return (list i chunk tool-use)
+ finally return nil))
+ (index (nth 0 indexed-call))
+ (chunk (nth 1 indexed-call))
+ (call (nth 2 indexed-call)))
+ (if (null new-call)
+ (if (= (length contents) 1)
+ (plist-put data :messages (substring messages nil -1))
+ (plist-put entry :content
+ (vconcat (substring contents 0 index)
+ (substring contents (1+ index)))))
+ (when-let* ((args (plist-get new-call :args)))
+ (setq call (plist-put call :input args)))
+ (when-let* ((name (plist-get new-call :name)))
+ (setq call (plist-put call :name name)))
+ (plist-put chunk :toolUse call))
+ (display-warning
+ '(gptel tool-call)
+ (format "Could not inject updated tool-call arguments for tool call %s, %s"
+ (plist-get tool-call :name)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))))
+
+(cl-defmethod gptel--parse-tool-results ((_backend gptel-bedrock) tool-use-requests)
+ "Return a backend-appropriate prompt containing tool call results.
+
+TOOL-USE-REQUESTS is a list of request plists that have been
+completed. Returns a single prompt object to inject into the
+conversation."
+ (list
+ :role "user"
+ :content
+ (vconcat
+ (mapcar
+ (lambda (tool-call)
+ `(:toolResult (:toolUseId ,(plist-get tool-call :id)
+ :status "success"
+ :content [(:text ,(plist-get tool-call :result))])))
+ tool-use-requests))))
+
+(defvar gptel-bedrock--aws-profile-cache nil
+ "Cache for AWS profile credentials in the form of (PROFILE . CREDS).")
+
+(defvar gptel-bedrock-aws-cli-command (executable-find "aws")
+ "Path to the AWS CLI command.
+
+Can be customized to use a specific AWS CLI installation,
+e.g. \"/usr/local/bin/aws\".")
+
+(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=)
+ (car (push (cons profile nil) gptel-bedrock--aws-profile-cache)))))
+ (or (and (not clear-cache) (cdr cell))
+ (setf (cdr cell)
+ (with-temp-buffer
+ (unless (zerop (apply #'call-process gptel-bedrock-aws-cli-command
+ 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))
+ (date-to-time exp))))
+ (cond
+ ((time-less-p (current-time) expiration)
+ (let ((access-key (gethash "AccessKeyId" creds-json))
+ (secret-key (gethash "SecretAccessKey" creds-json))
+ (session-token (gethash "SessionToken" creds-json)))
+ (cl-values access-key secret-key session-token)))
+ ((not clear-cache)
+ (gptel-bedrock--fetch-aws-profile-credentials profile t))
+ (t (user-error "AWS credentials expired for profile: %s" profile)))))
+
+(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).
+
+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 (or profile (getenv "AWS_PROFILE"))))
+ (cond
+ ((and profile) (gptel-bedrock--fetch-aws-profile-credentials profile))
+ ((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
+ '((claude-sonnet-4-6 . "anthropic.claude-sonnet-4-6")
+ (claude-opus-4-6 . "anthropic.claude-opus-4-6-v1")
+ (claude-sonnet-4-5-20250929 . "anthropic.claude-sonnet-4-5-20250929-v1:0")
+ (claude-haiku-4-5-20251001 . "anthropic.claude-haiku-4-5-20251001-v1:0")
+ (claude-opus-4-5-20251101 . "anthropic.claude-opus-4-5-20251101-v1:0")
+ (claude-opus-4-1-20250805 . "anthropic.claude-opus-4-1-20250805-v1:0")
+ (claude-sonnet-4-20250514 . "anthropic.claude-sonnet-4-20250514-v1:0")
+ (claude-opus-4-20250514 . "anthropic.claude-opus-4-20250514-v1:0")
+ (claude-3-7-sonnet-20250219 . "anthropic.claude-3-7-sonnet-20250219-v1:0")
+ (claude-3-5-sonnet-20241022 . "anthropic.claude-3-5-sonnet-20241022-v2:0")
+ (claude-3-5-sonnet-20240620 . "anthropic.claude-3-5-sonnet-20240620-v1:0")
+ (claude-3-5-haiku-20241022 . "anthropic.claude-3-5-haiku-20241022-v1:0")
+ (claude-3-opus-20240229 . "anthropic.claude-3-opus-20240229-v1:0")
+ (claude-3-haiku-20240307 . "anthropic.claude-3-haiku-20240307-v1:0")
+ (nova-2-lite-v1 . "amazon.nova-2-lite-v1:0")
+ (mistral-7b . "mistral.mistral-7b-instruct-v0:2")
+ (mistral-8x7b . "mistral.mixtral-8x7b-instruct-v0:1")
+ (mistral-large-2402 . "mistral.mistral-large-2402-v1:0")
+ (mistral-large-2407 . "mistral.mistral-large-2407-v1:0")
+ (mistral-small-2402 . "mistral.mistral-small-2402-v1:0")
+ (llama-3-8b . "meta.llama3-8b-instruct-v1:0")
+ (llama-3-70b . "meta.llama3-70b-instruct-v1:0")
+ (llama-3-1-8b . "meta.llama3-1-8b-instruct-v1:0")
+ (llama-3-1-70b . "meta.llama3-1-70b-instruct-v1:0")
+ (llama-3-1-405b . "meta.llama3-1-405b-instruct-v1:0")
+ (llama-3-2-1b . "meta.llama3-2-1b-instruct-v1:0")
+ (llama-3-2-3b . "meta.llama3-2-3b-instruct-v1:0")
+ (llama-3-2-11b . "meta.llama3-2-11b-instruct-v1:0")
+ (llama-3-2-90b . "meta.llama3-2-90b-instruct-v1:0")
+ (llama-3-3-70b . "meta.llama3-3-70b-instruct-v1:0"))
+ "Map of model name to bedrock id.
+
+IDs can be added or replaced by calling
+\(push (model-name . \"model-id\") gptel-bedrock--model-ids).")
+
+(defvar gptel--bedrock-models
+ (mapcar #'car gptel-bedrock--model-ids)
+ "List of available AWS Bedrock models and associated properties.")
+
+(defun gptel-bedrock--get-model-id (model &optional region)
+ "Return the Bedrock model ID for MODEL.
+
+REGION is one of global, apac, eu or us."
+ (concat
+ (when region
+ (or (member region '(global apac eu us))
+ (error "Unknown Bedrock region %s" region))
+ (concat (symbol-name region) "."))
+ (or (alist-get model gptel-bedrock--model-ids nil nil #'eq)
+ (error "Unknown Bedrock model: %s" model))))
+
+(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."
+ (let* ((output (shell-command-to-string "curl --version"))
+ (version (and (string-match "^curl \\([0-9.]+\\)" output)
+ (match-string 1 output))))
+ version))
+
+;;;###autoload
+(cl-defun gptel-make-bedrock
+ (name &key
+ region
+ (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.
+
+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 (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
+ :name name
+ :host host
+ :header nil ; x-amz-security-token is set in curl-args if needed
+ :models (gptel--process-models models)
+ :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 aws-profile aws-bearer-token)))
+ :request-params request-params
+ :url
+ (lambda (_info)
+ (concat protocol "://" host
+ "/model/" (gptel-bedrock--get-model-id gptel-model model-region)
+ "/" (if stream "converse-stream" "converse")))))))
+
+(provide 'gptel-bedrock)
+;;; gptel-bedrock.el ends here
--- /dev/null
+;;; gptel-context.el --- Context aggregator for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: daedsidog <contactNOSPAMdaedsidog.com>
+;; Keywords: convenience, buffers
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The context allows you to conveniently create contexts which can be fed
+;; to gptel.
+
+;;; Code:
+
+(eval-and-compile (require 'gptel-request))
+(require 'cl-lib)
+(require 'project)
+
+(declare-function gptel-menu "gptel-transient")
+(declare-function dired-get-marked-files "dired")
+(declare-function ibuffer-get-marked-buffers "ibuffer")
+(declare-function ibuffer-current-buffer "ibuffer")
+(declare-function image-file-name-regexp "image-file")
+(declare-function create-image "image")
+
+(defface gptel-context-highlight-face
+ '((((background dark) (min-colors 88)) :background "gray4" :extend t)
+ (((background light) (min-colors 88)) :background "alice blue" :extend t)
+ (t :inherit mode-line))
+ "Face used to highlight gptel contexts in buffers."
+ :group 'gptel)
+
+(defface gptel-context-deletion-face
+ '((((class color) (min-colors 257) (background light))
+ :background "#ffeeee" :extend t)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffdddd" :extend t)
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333" :extend t)
+ (((class color)) :foreground "red" :extend t))
+ "Face used to highlight gptel contexts to be deleted.
+
+This is used in gptel context buffers."
+ :group 'gptel)
+
+(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")
+
+(defcustom gptel-context-string-function #'gptel-context--string
+ "Function to prepare the context string sent with the gptel request.
+
+This function can be synchronous or asynchronous, and receives one or
+two arguments respectively.
+
+Synchronous: An alist of contexts with buffers or files (the context
+alist).
+Asynchronous: A callback to call with the result, and the context alist.
+
+Entries in the context alist can have one of these forms:
+
+ (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 overlay covers a buffer region containing the
+context chunk. This is accessible as, for example:
+
+ (with-current-buffer buffer1
+ (buffer-substring (overlay-start overlay1)
+ (overlay-end overlay1)))"
+ :group 'gptel
+ :type 'function)
+
+(defcustom gptel-context-restrict-to-project-files t
+ "Restrict files eligible to be added to the context to project files.
+
+When set to t, files in a VCS that are not project files (such as files
+listed in `.gitignore' in a Git repository) will not be added to the
+context."
+ :group 'gptel
+ :type 'boolean)
+
+(defvar gptel-context--project-files nil
+ "Cached alist of project files per project.")
+
+(defvar gptel-context--reset-cache nil
+ "Whether a project files cache-buster has been scheduled.")
+
+;;; Commands
+
+(defun gptel-context-add-current-kill (&optional arg)
+ "Add current kill to gptel, accumulating if ARG is non-nil."
+ (interactive "P")
+ (let ((kill (current-kill 0)))
+ (with-current-buffer (get-buffer-create " *gptel-kill-ring-context*")
+ (if (not arg)
+ (kill-region (point-min) (point-max))
+ (goto-char (point-max))
+ (unless (bobp)
+ (insert "\n----\n")))
+ (insert kill)
+ (gptel-context--add-region (current-buffer)
+ (point-min) (point-max))
+ (message "*current-kill* has been added as context."))))
+
+(defun gptel-context-add (&optional arg confirm)
+ "Add context to gptel in a DWIM fashion.
+
+- If a region is selected, add the selected region to the
+ context. If there is already a gptel context at point, remove it
+ instead.
+
+- If in Dired, add marked files or file at point to the context. If
+ the selection includes directories, add all their files recursively,
+ prompting the user for confirmation if called interactively or
+ CONFIRM is non-nil. With negative prefix ARG, remove all files from
+ the context instead.
+
+- If in IBuffer, add marked buffers or buffer at point to the context.
+ With negative prefix ARG, remove buffers from the context instead.
+
+- Otherwise add the current buffer to the context. With positive
+ prefix ARG, prompt for a buffer name and add it to the context.
+
+- With negative prefix ARG, remove all gptel contexts from the current
+ buffer, prompting the user for confirmation if called interactively
+ or CONFIRM is non-nil."
+ (interactive "P\np")
+ (cond
+ ;; A region is selected.
+ ((use-region-p)
+ (gptel-context--add-region (current-buffer)
+ (region-beginning)
+ (region-end))
+ (deactivate-mark)
+ (message "Current region added as context."))
+ ;; If in dired
+ ((derived-mode-p 'dired-mode)
+ (let* ((files (dired-get-marked-files))
+ (dirs (cl-remove-if-not #'file-directory-p files))
+ (remove-p (< (prefix-numeric-value arg) 0))
+ (action-fn (if remove-p
+ #'gptel-context-remove
+ #'gptel-context-add-file)))
+ (when (or remove-p (null dirs) (null confirm)
+ (y-or-n-p (format "Recursively add files from %d director%s? "
+ (length dirs)
+ (if (= (length dirs) 1) "y" "ies"))))
+ (mapc action-fn files))))
+ ;; If in ibuffer
+ ((derived-mode-p 'ibuffer-mode)
+ (let* ((buffers (or (ibuffer-get-marked-buffers)
+ (list (ibuffer-current-buffer))))
+ (remove-p (< (prefix-numeric-value arg) 0))
+ (action-fn (if remove-p
+ #'gptel-context-remove
+ #'gptel-context--add-buffer)))
+ (mapc action-fn buffers)))
+ ;; If in an image buffer
+ ((and (derived-mode-p 'image-mode)
+ (gptel--model-capable-p 'media)
+ (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)))
+ ;; 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: "
+ (current-buffer) t))
+ (start (with-current-buffer buffer-name (point-min)))
+ (end (with-current-buffer buffer-name (point-max))))
+ (gptel-context--add-region
+ (get-buffer buffer-name) start end t)
+ (message "Buffer '%s' added as context." buffer-name)))
+ ;; No region is selected, and ARG is negative.
+ ((and arg (< (prefix-numeric-value arg) 0))
+ (when (or (null confirm)
+ (y-or-n-p "Remove all contexts from this buffer? "))
+ (let ((removed-contexts 0))
+ (cl-loop for cov in
+ (gptel-context--in-region (current-buffer) (point-min) (point-max))
+ do (progn
+ (cl-incf removed-contexts)
+ (gptel-context-remove cov)))
+ (message (format "%d context%s removed from current buffer."
+ removed-contexts
+ (if (= removed-contexts 1) "" "s"))))))
+ (t ; Default behavior
+ (if (gptel-context--at-point)
+ (progn
+ (gptel-context-remove
+ (car (gptel-context--in-region (current-buffer)
+ (max (point-min) (1- (point)))
+ (point))))
+ (message "Context under point has been removed."))
+ (gptel-context--add-buffer (current-buffer))))))
+
+;;;###autoload (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t)
+(defalias 'gptel-add #'gptel-context-add)
+
+(defun gptel-context--add-buffer (buffer)
+ "Add BUFFER to context."
+ (with-current-buffer buffer
+ (gptel-context--add-region (current-buffer) (point-min) (point-max) t))
+ (message "Buffer \"%s\" added to context." (buffer-name buffer)))
+
+(defun gptel-context--add-text-file (path)
+ "Add text file at PATH to context."
+ (cl-pushnew (list path) gptel-context :test #'equal)
+ (message "File \"%s\" added to context." path)
+ path)
+
+(defun gptel-context--add-binary-file (path)
+ "Add binary file at PATH to context if supported.
+Return PATH if added, nil if ignored."
+ (if-let* (((gptel--model-capable-p 'media))
+ (mime (mailcap-file-name-to-mime-type path))
+ ((gptel--model-mime-capable-p mime)))
+ (prog1 path
+ (cl-pushnew (list path :mime mime)
+ gptel-context :test #'equal)
+ (message "File \"%s\" added to context." path))
+ (message "Ignoring unsupported binary file \"%s\"." path)
+ nil))
+
+(defun gptel-context--add-directory (path action)
+ "Process all files in directory at PATH according to ACTION.
+ACTION should be either `add' or `remove'."
+ (dolist (file (directory-files-recursively path "."))
+ (pcase-exhaustive action
+ ('add
+ (unless gptel-context--reset-cache
+ (setq gptel-context--reset-cache t)
+ (run-at-time
+ 0 nil
+ (lambda () (setq gptel-context--reset-cache nil
+ gptel-context--project-files nil))))
+ (if (gptel-context--skip-p file)
+ ;; Don't message about .git, as this creates thousands of messages
+ (unless (string-match-p "\\.git/" file)
+ (gptel-context--message-skipped file))
+ (gptel-context-add-file file)))
+ ('remove
+ (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.
+
+If PATH is a directory, recursively add all files in it. PATH should be
+readable as text."
+ (interactive "fChoose file to add to context: ")
+ (cond ((file-directory-p path)
+ (gptel-context--add-directory path 'add))
+ ((gptel--file-binary-p path)
+ (gptel-context--add-binary-file path))
+ (t (gptel-context--add-text-file path))))
+
+;;;###autoload (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t)
+(defalias 'gptel-add-file #'gptel-context-add-file)
+
+;;; project-related functions
+(defun gptel-context--get-project-files (dir)
+ "Return a list of files in the project DIR, or nil if no project is found."
+ (when-let* ((project (project-current nil dir)))
+ (with-memoization (alist-get dir gptel-context--project-files
+ nil nil #'equal)
+ (project-files project))))
+
+(defun gptel-context--skip-p (file)
+ "Return non-nil if FILE should not be added to the context."
+ (when (and gptel-context-restrict-to-project-files
+ (not (file-remote-p file)))
+ (and-let* ((file-dir (or (file-name-directory file) default-directory))
+ (project (project-current nil file-dir)))
+ (not (member (expand-file-name file)
+ (gptel-context--get-project-files (project-root project)))))))
+
+(defun gptel-context--message-skipped (file)
+ "Message that FILE is skipped because it is not a project file."
+ (let* ((type (if (file-directory-p file) "directory" "file"))
+ (reminder (format "To include it, unset `%S'."
+ 'gptel-context-restrict-to-project-files)))
+ (if-let* ((root (cl-some (lambda (dir) (and (file-in-directory-p file dir) dir))
+ (map-keys gptel-context--project-files)))
+ (rel-file (file-relative-name file root)))
+ (message "Skipping %s \"%s\" in project \"%s\". %s"
+ type rel-file root reminder)
+ (message "Skipping %s \"%s\". %s" type file reminder))))
+
+;;; Remove context
+(defun gptel-context-remove (&optional context)
+ "Remove the CONTEXT overlay from the contexts list.
+
+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) ;Overlay in buffer
+ (when-let* ((buf (overlay-buffer context)))
+ (delete-overlay context)
+ ;; FIXME: Quadratic cost when clearing a bunch of contexts at once
+ (unless
+ (cl-loop
+ for ov in
+ (plist-get (alist-get buf gptel-context) :overlays)
+ thereis (overlay-start ov))
+ (setf (alist-get buf gptel-context nil 'remove) nil))))
+ ((bufferp context) ;Full buffer
+ (setf (alist-get context gptel-context nil 'remove) nil)
+ (when (buffer-live-p context)
+ (with-current-buffer context
+ (without-restriction
+ (remove-overlays nil nil 'gptel-context t)))))
+ ((stringp context) ;file or directory
+ (if (file-directory-p context)
+ (gptel-context--add-directory context 'remove)
+ (setf (alist-get context gptel-context nil 'remove #'equal) nil)
+ (message "File \"%s\" removed from context." context)))
+ ((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 ;Anything at point
+ (when-let* ((ctx (gptel-context--at-point)))
+ (delete-overlay ctx)))))
+
+(defun gptel-context-remove-all (&optional verbose)
+ "Remove all gptel context.
+
+If VERBOSE is non-nil, ask for confirmation and message
+afterwards."
+ (interactive (list t))
+ (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 context in gptel-context
+ for (source . spec) = (ensure-list context)
+ if (bufferp source) do ;Buffers and buffer regions
+ (mapc #'gptel-context-remove (plist-get spec :overlays))
+ else do (gptel-context-remove source) ;files or other types
+ finally do (setq gptel-context nil))
+ (when verbose (message "Removed all gptel context sources.")))))
+
+;;; Context wrap
+(defun gptel-context--make-overlay (start end &optional advance)
+ "Highlight the region from START to END.
+
+ADVANCE controls the overlay boundary behavior."
+ (let ((overlay (make-overlay start end nil (not advance) advance))
+ (buf-entry (alist-get (current-buffer) gptel-context)))
+ (overlay-put overlay 'evaporate t)
+ (overlay-put overlay 'face 'gptel-context-highlight-face)
+ (overlay-put overlay 'gptel-context t)
+ (setf (alist-get (current-buffer) gptel-context)
+ (plist-put buf-entry :overlays
+ (cons overlay (plist-get buf-entry :overlays))))
+ overlay))
+
+;;;###autoload
+(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 context-string "\n\n" gptel--system-message)))
+ (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 context-string "\n\n" (car gptel--system-message))
+ (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.
+
+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)
+ for (path . props) = (ensure-list context)
+ when (and (stringp path) (plist-get props :mime))
+ collect (cons :media context)))
+
+(cl-defun gptel-context--add-region (buffer region-beginning region-end &optional advance)
+ "Add region delimited by REGION-BEGINNING, REGION-END in BUFFER as context.
+
+If ADVANCE is non-nil, the context overlay envelopes changes at
+the beginning and end."
+ ;; Remove existing contexts in the same region, if any.
+ (mapc #'gptel-context-remove
+ (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.")))
+
+(defun gptel-context--in-region (buffer start end)
+ "Return the list of context overlays in the given region, if any, in BUFFER.
+START and END signify the region delimiters."
+ (with-current-buffer buffer
+ (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context))
+ (overlays-in start end))))
+
+(defun gptel-context--at-point ()
+ "Return the context overlay at point, if any."
+ (cl-find-if (lambda (ov) (overlay-get ov 'gptel-context))
+ (overlays-at (point))))
+
+;;;###autoload
+(defun gptel-context--collect (&optional context-alist)
+ "Get the list of all active context sources from CONTEXT-ALIST.
+
+CONTEXT-ALIST defaults to the current value of `gptel-context'.
+
+Ignore overlays, buffers and files that are not live or readable."
+ ;; Get only the non-degenerate overlays, collect them, and update the overlays variable.
+ (let ((res))
+ (dolist (entry (or context-alist gptel-context))
+ (pcase entry ;Context entry is:
+ (`(,buf . ,data)
+ (cond
+ ((buffer-live-p buf)
+ ;; (<buf> :overlays ... :lines ... :bounds ...)
+ (when-let* ((ovs (plist-get data :overlays))) ;Clear dead overlays
+ (plist-put data :overlays (cl-remove-if-not #'overlay-start ovs)))
+ (push (cons buf data) res))
+ ((and (stringp buf) (file-readable-p buf))
+ ;; ("/file/path" :mime ... :bounds ... :line ...)
+ (push (cons buf data) res))))
+
+ ((and (pred stringp) (pred file-readable-p)) ;Just a file, figure out mimetype
+ (if (file-directory-p entry)
+ (progn
+ (unless gptel-context--reset-cache
+ (setq gptel-context--reset-cache t)
+ (run-at-time
+ 0 nil
+ (lambda () (setq gptel-context--reset-cache nil
+ gptel-context--project-files nil))))
+ (dolist (f (directory-files-recursively entry "."))
+ (unless (gptel-context--skip-p f)
+ (push `(,f ,@(and (gptel--file-binary-p f)
+ (list :mime (mailcap-file-name-to-mime-type entry))))
+ res))))
+ (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
+ res))
+
+(defun gptel-context--collect-regions (buffer context-data)
+ "Collect BUFFER regions from CONTEXT-DATA specification.
+
+CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds.
+Returns a sorted list of (START . END) position pairs."
+ (let ((regions ; Collect bounds (already in position format)
+ (when-let* ((bounds (plist-get context-data :bounds)))
+ (if (consp (car bounds)) bounds (list bounds)))))
+ (with-current-buffer buffer
+ (without-restriction
+ ;; Collect overlays
+ (dolist (ov (plist-get context-data :overlays))
+ (when (overlay-start ov)
+ (push (cons (overlay-start ov) (overlay-end ov))
+ regions))) ;(start1 . end1)
+ ;; Collect lines (convert line numbers to positions)
+ (when-let* ((line-bounds (plist-get context-data :lines)))
+ (dolist (pair (if (consp (car line-bounds)) ;Handle single (BEG . END)
+ line-bounds (list line-bounds)))
+ (push (cons (progn (goto-char (point-min))
+ (forward-line (1- (car pair)))
+ (point))
+ (progn (goto-char (point-min))
+ (forward-line (cdr pair))
+ (point)))
+ regions)))))
+ ;; TODO: Update sort for Emacs 28+ calling convention
+ ;; Sort by start position.
+ ;; NOTE: This can modify `:bounds' of `context-data' by side-effect!
+ (sort regions #'car-less-than-car)))
+
+(defun gptel-context--insert-buffer-string (buffer context-data &optional header)
+ "Insert at point a context string from CONTEXT-DATA in BUFFER.
+
+CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds to
+include specific overlays, line ranges or position bounds instead of the
+entire buffer. See `gptel-context'.
+
+HEADER is an optional header to insert before the contents."
+ (let ((is-top-snippet t)
+ (previous-line 1)
+ (regions (gptel-context--collect-regions buffer context-data)))
+
+ ;; Insert header
+ (insert (or header (format "In buffer `%s`:\n\n```"(buffer-name buffer)))
+ (gptel--strip-mode-suffix (buffer-local-value
+ 'major-mode buffer))
+ "\n")
+ (if (not regions)
+ (insert-buffer-substring-no-properties buffer)
+ (dolist (region regions)
+ (let ((start (car region)) (end (cdr region)))
+ (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)))))
+ ;; 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"))
+ (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-buffer-substring-no-properties buffer start end)))
+ (unless (>= (cdr (car (last regions))) (point-max))
+ (insert "\n...")))
+ (insert "\n```")))
+
+(defun gptel-context--insert-file-string (path &optional spec)
+ "Insert at point the contents of file at PATH as context.
+
+SPEC is a plist specifying :lines or position :bounds to include instead
+of the entire file. See `gptel-context' for details."
+ (if (not (and spec (or (plist-member spec :lines)
+ (plist-member spec :bounds))))
+ ;; Insert whole file
+ (gptel--insert-file-string path)
+ ;; Insert only regions from lines and/or bounds
+ (let* ((visiting-buf (find-buffer-visiting ;Reuse buffer
+ path (lambda (b) (not (buffer-modified-p b)))))
+ (file-buf (or visiting-buf ;temp buf to dump file contents
+ (gptel--temp-buffer " *gptel-file-context*"))))
+ (unless visiting-buf
+ (with-current-buffer file-buf (insert-file-contents path)))
+ (gptel-context--insert-buffer-string
+ file-buf spec (format "In file `%s`:\n\n```\n"
+ (abbreviate-file-name path)))
+ (unless visiting-buf (kill-buffer file-buf)))))
+
+(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'."
+ (with-temp-buffer
+ (cl-loop for entry in context-alist
+ for (source . spec) = (ensure-list entry)
+ if (bufferp source)
+ do (gptel-context--insert-buffer-string source spec)
+ else if (or (not (plist-get spec :mime))
+ (string-match-p "^text/" (plist-get spec :mime)))
+ do (gptel-context--insert-file-string source spec) end
+ do (insert "\n\n")
+ finally do
+ (skip-chars-backward "\n\t\r ")
+ (delete-region (point) (point-max))
+ (unless (bobp)
+ (goto-char (point-min))
+ (insert "Request context:\n\n"))
+ finally return
+ (and (> (buffer-size) 0)
+ (buffer-string)))))
+
+;;; Major mode for context inspection buffers
+(defvar-keymap gptel-context-buffer-mode-map
+ "C-c C-c" #'gptel-context-confirm
+ "C-c C-k" #'gptel-context-quit
+ "RET" #'gptel-context-visit
+ "n" #'gptel-context-next
+ "p" #'gptel-context-previous
+ "d" #'gptel-context-flag-deletion)
+
+(define-derived-mode gptel-context-buffer-mode special-mode "gptel-context"
+ "Major-mode for inspecting context used by gptel."
+ :group 'gptel
+ (add-hook 'post-command-hook #'gptel-context--post-command
+ nil t)
+ (setq-local revert-buffer-function #'gptel-context--buffer-setup))
+
+;; FIXME(targeted-context): This does not handle :bounds and :lines. Reuse
+;; `gptel-context--insert-buffer-string'?
+(defun gptel-context--buffer-setup (&optional _ignore-auto _noconfirm context-alist)
+ "Set up the gptel context buffer.
+
+CONTEXT-ALIST is the alist of contexts to use to populate the buffer."
+ (with-current-buffer (get-buffer-create "*gptel-context*")
+ (gptel-context-buffer-mode)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (setq header-line-format
+ (substitute-command-keys
+ (concat
+ "\\[gptel-context-flag-deletion]: Mark/unmark deletion, "
+ "\\[gptel-context-next]/\\[gptel-context-previous]: next/previous, "
+ "\\[gptel-context-visit]: visit, "
+ "\\[gptel-context-confirm]: apply, "
+ "\\[gptel-context-quit]: cancel, "
+ "\\[quit-window]: quit")))
+ (save-excursion
+ (let ((contexts (gptel-context--collect context-alist)))
+ (if (length= contexts 0)
+ (insert "There are no active gptel contexts.")
+ (let (beg ov l1 l2)
+ (pcase-dolist (`(,buf . ,spec) contexts)
+ (cond
+ ((bufferp buf)
+ (if (not spec) ;BUF is a full buffer, not specific ranges
+ (progn
+ (insert (propertize (format "In buffer %s:\n\n"
+ (buffer-name buf))
+ 'face 'bold))
+ (setq beg (point))
+ (insert-buffer-substring buf)
+ (insert "\n")
+ (setq ov (make-overlay beg (point))))
+ (dolist (source-ov (plist-get spec :overlays)) ;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 spec :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
+ display-buffer-below-selected)
+ (body-function . ,#'select-window)
+ (window-height . ,#'fit-window-to-buffer)))))
+
+(defvar gptel-context--buffer-reverse nil
+ "Last direction of cursor movement in gptel context buffer.
+
+If non-nil, indicates backward movement.")
+
+(defalias 'gptel-context--post-command
+ (let ((highlight-overlay))
+ (lambda ()
+ ;; Only update if point moved outside the current region.
+ (unless (memq highlight-overlay (overlays-at (point)))
+ (let ((context-overlay
+ (cl-loop for ov in (overlays-at (point))
+ thereis (and (overlay-get ov 'gptel-overlay) ov))))
+ (when highlight-overlay
+ (overlay-put highlight-overlay 'face nil))
+ (when context-overlay
+ (overlay-put context-overlay 'face 'highlight))
+ (setq highlight-overlay context-overlay))))))
+
+(defun gptel-context-visit ()
+ "Display the location of this gptel context chunk in its original buffer."
+ (interactive)
+ (let ((ov-here (car (overlays-at (point)))))
+ (if-let* ((source (overlay-get ov-here 'gptel-context))
+ (buf (if (overlayp source)
+ (overlay-buffer source)
+ (find-file-noselect source)))
+ (offset (- (point) (overlay-start ov-here))))
+ (with-selected-window (display-buffer buf)
+ (goto-char (if (overlayp source)
+ (overlay-start source)
+ (point-min)))
+ (forward-char offset)
+ (recenter))
+ (message "No source location for this gptel context chunk."))))
+
+(defun gptel-context-next ()
+ "Move to next gptel context chunk."
+ (interactive)
+ (let ((ov-here (car (overlays-at (point))))
+ (next-start (next-overlay-change (point))))
+ (when (and (/= (point-max) next-start) ov-here)
+ ;; We were inside the overlay, so we want the next overlay change, which
+ ;; would be the start of the next overlay.
+ (setq next-start (next-overlay-change next-start)))
+ (when (/= next-start (point-max))
+ (setq gptel-context--buffer-reverse nil)
+ (goto-char next-start)
+ (recenter (floor (window-height) 4)))))
+
+(defun gptel-context-previous ()
+ "Move to previous gptel context chunk."
+ (interactive)
+ (let ((ov-here (car (overlays-at (point)))))
+ (when ov-here (goto-char (overlay-start ov-here)))
+ (let ((previous-context-pos (previous-overlay-change
+ (previous-overlay-change (point)))))
+ ;; Prevent point from jumping to the start of the buffer.
+ (unless (= previous-context-pos (point-min))
+ (goto-char previous-context-pos)
+ (recenter (floor (window-height) 4))
+ (setq gptel-context--buffer-reverse t)))))
+
+(defun gptel-context-flag-deletion ()
+ "Mark gptel context chunk at point for removal."
+ (interactive)
+ (let* ((overlays (if (use-region-p)
+ (overlays-in (region-beginning) (region-end))
+ (overlays-at (point))))
+ (deletion-ov)
+ (marked-ovs (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context-deletion-mark))
+ overlays)))
+ (if marked-ovs
+ (mapc #'delete-overlay marked-ovs)
+ (save-excursion
+ (dolist (ov overlays)
+ (when (overlay-get ov 'gptel-context)
+ (goto-char (overlay-start ov))
+ (setq deletion-ov (make-overlay (overlay-start ov) (overlay-end ov)))
+ (overlay-put deletion-ov 'gptel-context (overlay-get ov 'gptel-context))
+ (overlay-put deletion-ov 'priority -80)
+ (overlay-put deletion-ov 'face 'gptel-context-deletion-face)
+ (overlay-put deletion-ov 'gptel-context-deletion-mark t)))))
+ (if (use-region-p)
+ (deactivate-mark)
+ (if gptel-context--buffer-reverse
+ (gptel-context-previous)
+ (gptel-context-next)))))
+
+(defun gptel-context-quit ()
+ "Cancel pending operations and return to gptel's menu."
+ (interactive)
+ (quit-window)
+ (call-interactively #'gptel-menu))
+
+(defun gptel-context-confirm ()
+ "Confirm pending operations and return to gptel's menu."
+ (interactive)
+ ;; Delete all the context overlays that have been marked for deletion.
+ (when-let* ((deletion-marks
+ (delq nil (mapcar
+ (lambda (ov)
+ (and
+ (overlay-get ov 'gptel-context-deletion-mark)
+ (overlay-get ov 'gptel-context)))
+ (overlays-in (point-min) (point-max))))))
+ (mapc #'gptel-context-remove deletion-marks)
+ (revert-buffer))
+ ;; 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 (nreverse (gptel-context--collect)))
+ (gptel-context-quit))
+
+(provide 'gptel-context)
+;;; gptel-context.el ends here.
--- /dev/null
+;;; gptel-gemini.el --- Gemini suppport for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for the Gemini API to gptel
+
+;;; Code:
+(require 'cl-generic)
+(require 'map)
+(require 'cl-lib)
+(eval-and-compile (require 'gptel-request))
+
+(declare-function prop-match-value "text-property-search")
+(declare-function text-property-search-backward "text-property-search")
+(declare-function json-read "json")
+(declare-function gptel-context--wrap "gptel-context")
+(declare-function gptel-context--collect-media "gptel-context")
+
+(defvar json-object-type)
+
+;;; Gemini
+(cl-defstruct
+ (gptel-gemini (:constructor gptel--make-gemini)
+ (:copier nil)
+ (:include gptel-backend)))
+
+(defun gptel--gemini-update-tokens (usage info)
+ "Update token usage information from USAGE.
+USAGE is part of the response, INFO is the request plist."
+ (when usage
+ (let* ((tokens (plist-get info :tokens))
+ (input (+ (plist-get usage :promptTokenCount)
+ (or (plist-get tokens :input) 0)))
+ (output (+ (- (plist-get usage :totalTokenCount)
+ (plist-get usage :promptTokenCount))
+ (or (plist-get tokens :output) 0))))
+ (list :input input :output output))))
+
+;; TODO: Using alt=sse in the query url generates an OpenAI style streaming
+;; response, with more immediate updates. Maybe we should switch to that and
+;; rewrite the stream parser?
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-gemini) info)
+ "Parse a Gemini data stream.
+
+Return the text response accumulated since the last call to this
+function. Additionally, mutate state INFO to add tool-use
+information if the stream contains it."
+ (let* ((content-strs))
+ (condition-case nil
+ (while (prog1 (search-forward "{" nil t) ; while-let is Emacs 29.1+ only
+ (backward-char 1))
+ (save-match-data
+ (when-let* ((response (gptel--json-read))
+ (text (gptel--parse-response
+ (plist-get info :backend)
+ response info 'include)))
+ (push text content-strs))))
+ (error
+ (goto-char (match-beginning 0))))
+ (apply #'concat (nreverse content-strs))))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-gemini) response info
+ &optional include-text)
+ "Parse an Gemini (non-streaming) RESPONSE and return response text.
+
+Mutate state INFO with response metadata.
+
+If INCLUDE-TEXT is non-nil, include response text in the prompts
+list."
+ (let* ((cand0 (map-nested-elt response '(:candidates 0)))
+ (parts (map-nested-elt cand0 '(:content :parts)))
+ (stop-reason (plist-get cand0 :finishReason)))
+ (when stop-reason
+ (plist-put info :stop-reason stop-reason)
+ (when (string= stop-reason "STOP")
+ (plist-put info :tokens (gptel--gemini-update-tokens
+ (plist-get response :usageMetadata) info))))
+ (cl-loop
+ for part across parts
+ for tx = (plist-get part :text)
+ if (and tx (not (eq tx :null)))
+ if (plist-get part :thought)
+ do (unless (plist-get info :reasoning-block)
+ (plist-put info :reasoning-block 'in))
+ (plist-put info :reasoning (concat (plist-get info :reasoning) tx))
+ else do
+ (if (eq (plist-get info :reasoning-block) 'in)
+ (plist-put info :reasoning-block t))
+ and collect tx into content-strs end
+ else if (plist-get part :functionCall)
+ collect (copy-sequence it) into tool-use
+ finally do ;Add text and tool-calls to prompts list
+ (when (or tool-use include-text)
+ (let* ((data (plist-get info :data))
+ (prompts (plist-get data :contents))
+ (last-prompt (aref prompts (1- (length prompts)))))
+ (if (equal (plist-get last-prompt :role) "model")
+ ;; When streaming, the last prompt may already have the role
+ ;; "model" from prior calls to this function. Append to its parts
+ ;; instead of adding a new model role then.
+ (plist-put last-prompt :parts
+ (vconcat (plist-get last-prompt :parts) parts))
+ (plist-put ;otherwise create a new "model" role
+ data :contents
+ (vconcat prompts `((:role "model" :parts ,parts)))))))
+ (when tool-use ;Capture tool call data for running tools
+ (plist-put info :tool-use
+ (nconc (plist-get info :tool-use) tool-use)))
+ finally return
+ (and content-strs (apply #'concat content-strs)))))
+
+(cl-defmethod gptel--request-data ((backend gptel-gemini) prompts)
+ "JSON encode PROMPTS for sending to Gemini."
+ (let ((prompts-plist
+ (list :contents (vconcat prompts)
+ :safetySettings [(:category "HARM_CATEGORY_HARASSMENT"
+ :threshold "BLOCK_NONE")
+ (:category "HARM_CATEGORY_SEXUALLY_EXPLICIT"
+ :threshold "BLOCK_NONE")
+ (:category "HARM_CATEGORY_DANGEROUS_CONTENT"
+ :threshold "BLOCK_NONE")
+ (:category "HARM_CATEGORY_HATE_SPEECH"
+ :threshold "BLOCK_NONE")]))
+ params)
+ (if gptel--system-message
+ (plist-put prompts-plist :systemInstruction
+ `(:parts [(:text ,gptel--system-message)])))
+ (when gptel-use-tools
+ (when (eq gptel-use-tools 'force)
+ (plist-put prompts-plist :toolConfig
+ '(:functionCallingConfig (:mode "ANY"))))
+ (when gptel-tools
+ (plist-put prompts-plist :tools
+ (gptel--parse-tools backend gptel-tools))))
+ (when gptel-temperature
+ (setq params
+ (plist-put params
+ :temperature (max 0.0 gptel-temperature))))
+ (when gptel-max-tokens
+ (setq params
+ (plist-put params
+ :maxOutputTokens gptel-max-tokens)))
+ (when gptel-include-reasoning
+ (setq params
+ (plist-put params :thinkingConfig '(:includeThoughts t))))
+ (when gptel--schema
+ (setq params (nconc params (gptel--gemini-filter-schema
+ (gptel--parse-schema backend gptel--schema)))))
+ (when params
+ (plist-put prompts-plist
+ :generationConfig params))
+ ;; Merge request params with model and backend params.
+ (gptel--merge-plists
+ prompts-plist
+ gptel--request-params
+ (gptel-backend-request-params gptel-backend)
+ (gptel--model-request-params gptel-model))))
+
+(cl-defmethod gptel--parse-schema ((_backend gptel-gemini) schema)
+ (list :responseMimeType "application/json"
+ :responseSchema (gptel--preprocess-schema
+ (gptel--dispatch-schema-type schema))))
+
+(defun gptel--gemini-filter-schema (schema)
+ "Destructively filter unsupported attributes from SCHEMA.
+
+Gemini's API does not support `additionalProperties'."
+ (cl-remf schema :additionalProperties)
+ (when (plistp schema)
+ (cl-loop for (key val) on schema by #'cddr
+ do (cond
+ ;; Recursively modify schemas within vectors (anyOf/allOf)
+ ((memq key '(:anyOf :allOf))
+ (dotimes (i (length val))
+ (aset val i (gptel--gemini-filter-schema (aref val i)))))
+ ;; Recursively modify plist values, which may contain sub-schemas
+ ((plistp val)
+ (when (cl-remf val :additionalProperties)
+ (cl-remf (plist-get schema key) :additionalProperties))
+ (gptel--gemini-filter-schema val))
+ ;; Default: do nothing to other key-value pairs yet.
+ (t nil))))
+ schema)
+
+(cl-defmethod gptel--parse-tools ((_backend gptel-gemini) tools)
+ "Parse TOOLS to the Gemini API tool definition spec.
+
+TOOLS is a list of `gptel-tool' structs, which see."
+ (cl-loop
+ for tool in (ensure-list tools)
+ collect
+ (list
+ :name (gptel-tool-name tool)
+ :description (gptel-tool-description tool)
+ :parameters
+ (if (not (gptel-tool-args tool))
+ :null ;NOTE: Gemini wants :null if the function takes no args
+ (list :type "object"
+ ;; See the generic implementation for an explanation of this
+ ;; transformation.
+ :properties
+ (cl-loop
+ for arg in (gptel-tool-args tool)
+ for argspec = (copy-sequence arg)
+ for name = (plist-get arg :name) ;handled differently
+ for newname = (or (and (keywordp name) name)
+ (make-symbol (concat ":" name)))
+ do ;ARGSPEC is ARG without unrecognized keys
+ (cl-remf argspec :name)
+ (cl-remf argspec :optional)
+ if (equal (plist-get arg :type) "object")
+ do (unless (plist-member argspec :required)
+ (plist-put argspec :required []))
+ if (equal (plist-get arg :type) "string")
+ do (cl-remf argspec :format)
+ append (list newname (gptel--gemini-filter-schema argspec)))
+ :required
+ (vconcat
+ (delq nil (mapcar
+ (lambda (arg) (and (not (plist-get arg :optional))
+ (plist-get arg :name)))
+ (gptel-tool-args tool)))))))
+ into tool-specs
+ finally return `[(:functionDeclarations ,(vconcat tool-specs))]))
+
+(cl-defmethod gptel--parse-tool-results ((_backend gptel-gemini) tool-use)
+ "Return a prompt containing tool call results in TOOL-USE."
+ (list
+ :role "user"
+ :parts
+ (vconcat
+ (mapcar
+ (lambda (tool-call)
+ (let ((result (plist-get tool-call :result))
+ (name (plist-get tool-call :name)))
+ `(:functionResponse
+ (:name ,name :response
+ (:name ,name :content ,result)))))
+ tool-use))))
+
+(cl-defmethod gptel--inject-prompt ((_backend gptel-gemini) data new-prompt &optional position)
+ "Inject NEW-PROMPT into existing prompts in query DATA.
+
+See generic implementation for full documentation."
+ (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many?
+ (setq new-prompt (list new-prompt)))
+ (let ((prompts (plist-get data :contents)))
+ (pcase position
+ ('nil (plist-put data :contents (vconcat prompts new-prompt)))
+ ((pred integerp)
+ (when (< position 0) (setq position (+ (length prompts) position)))
+ (plist-put data :contents (vconcat (substring prompts 0 position)
+ new-prompt
+ (substring prompts position)))))))
+
+(cl-defmethod gptel--inject-tool-call ((_backend gptel-gemini) data tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+BACKEND is the `gptel-backend'. See the generic function documentation
+for details. This implementation handles the Gemini API."
+ ;; FIXME: We currently assume that the tool call being modified is in the last
+ ;; position in the messages array.
+ (if-let* ((messages (plist-get data :contents))
+ (entry (aref messages (1- (length messages))))
+ (parts (plist-get entry :parts))
+ (indexed-call
+ (cl-loop with name = (plist-get tool-call :name)
+ with old-args = (plist-get tool-call :args)
+ for chunk across parts
+ for i upfrom 0
+ if (plist-get chunk :functionCall)
+ if (and (equal (plist-get it :name) name)
+ (equal (plist-get it :args) old-args))
+ return (cons i (plist-get chunk :functionCall)) end
+ finally return nil))
+ (index (car indexed-call))
+ (call (cdr indexed-call)))
+ (if (null new-call)
+ (if (= (length parts) 1)
+ (plist-put data :contents (substring messages nil -1))
+ (plist-put entry :parts
+ (vconcat (substring parts 0 index)
+ (substring parts (1+ index)))))
+ (when-let* ((args (plist-get new-call :args)))
+ (plist-put call :args args))
+ (when-let* ((name (plist-get new-call :name)))
+ (plist-put call :name name)))
+ (display-warning
+ '(gptel tool-call)
+ (format "Could not inject updated tool-call arguments for tool call %s, %s"
+ (plist-get tool-call :name)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))))
+
+(cl-defmethod gptel--parse-list ((backend gptel-gemini) prompt-list)
+ (if (consp (car prompt-list))
+ (let ((full-prompt)) ; Advanced format, list of lists
+ (dolist (entry prompt-list)
+ (pcase entry
+ (`(prompt . ,msg)
+ (push (list :role "user"
+ :parts `[(:text ,(or (car-safe msg) msg))])
+ full-prompt))
+ (`(response . ,msg)
+ (push (list :role "model"
+ :parts `[(:text ,(or (car-safe msg) msg))])
+ full-prompt))
+ (`(tool . ,call)
+ (push (list :role "model"
+ :parts (vector `(:functionCall ( :name ,(plist-get call :name)
+ :args ,(plist-get call :args)))))
+ full-prompt)
+ (push (gptel--parse-tool-results backend (list (cdr entry))) full-prompt))))
+ (nreverse full-prompt))
+ (cl-loop for text in prompt-list ; Simple format, list of strings
+ for role = t then (not role)
+ if text
+ if role
+ collect (list :role "user" :parts `[(:text ,text)]) into prompts
+ else collect (list :role "model" :parts `[(:text ,text)]) into prompts
+ finally return prompts)))
+
+(cl-defmethod gptel--parse-buffer ((backend gptel-gemini) &optional max-entries)
+ (let ((prompts) (prev-pt (point)))
+ (if (or gptel-mode gptel-track-response)
+ (while (and (or (not max-entries) (>= max-entries 0))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min)))
+ (not (= (point) prev-pt)))
+ (pcase (get-char-property (point) 'gptel)
+ ('response
+ (when-let* ((content (gptel--trim-prefixes
+ (buffer-substring-no-properties (point) prev-pt))))
+ (push (list :role "model" :parts `[(:text ,content)]) prompts)))
+ (`(tool . ,_id)
+ (save-excursion
+ (condition-case nil
+ (let* ((tool-call (read (current-buffer)))
+ (name (plist-get tool-call :name))
+ (arguments (plist-get tool-call :args)))
+ (plist-put tool-call :result
+ (string-trim (buffer-substring-no-properties
+ (point) prev-pt)))
+ (push (gptel--parse-tool-results backend (list tool-call))
+ prompts)
+ (push (list :role "model"
+ :parts
+ (vector `(:functionCall ( :name ,name
+ :args ,arguments))))
+ prompts))
+ ((end-of-file invalid-read-syntax)
+ (message (format "Could not parse tool-call on line %s"
+ (line-number-at-pos (point))))))))
+ ('ignore)
+ ('nil
+ (if gptel-track-media
+ (when-let* ((content (gptel--gemini-parse-multipart
+ (gptel--parse-media-links major-mode (point) prev-pt))))
+ (when (> (length content) 0)
+ (push (list :role "user" :parts content) prompts)))
+ (when-let* ((content (gptel--trim-prefixes
+ (buffer-substring-no-properties
+ (point) prev-pt))))
+ (push (list :role "user" :parts `[(:text ,content)]) prompts)))))
+ (setq prev-pt (point))
+ (and max-entries (cl-decf max-entries)))
+ (let ((content (string-trim (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (push (list :role "user" :parts `[(:text ,content)]) prompts)))
+ prompts))
+
+(defun gptel--gemini-parse-multipart (parts)
+ "Convert a multipart prompt PARTS to the Gemini API format.
+
+The input is an alist of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\")).
+
+The output is a vector of entries in a backend-appropriate
+format."
+ (cl-loop
+ for part in parts
+ for n upfrom 1
+ with last = (length parts)
+ for text = (plist-get part :text)
+ for media = (plist-get part :media)
+ if text do
+ (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and
+ if text
+ collect (list :text text) into parts-array end
+ else if media
+ collect
+ `(:inline_data
+ (:mime_type ,(plist-get part :mime)
+ :data ,(gptel--base64-encode media)))
+ into parts-array
+ else if (plist-get part :textfile)
+ collect
+ (list :text (with-temp-buffer
+ (gptel--insert-file-string (plist-get part :textfile))
+ (buffer-string)))
+ into parts-array
+ finally return (vconcat parts-array)))
+
+(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)
+ (vconcat (gptel--gemini-parse-multipart media-list)
+ current))
+ (plist-get (car prompts) :parts))))
+
+(defconst gptel--gemini-models
+ '((gemini-pro-latest
+ :description "Most powerful Gemini thinking model, always points to latest version"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 1.25 ; 2.50 for >200k tokens
+ :output-cost 10.00 ; 15 for >200k tokens
+ :cutoff-date "2025-01")
+ (gemini-flash-latest
+ :description "Best price / performance, always points to latest version"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 0.3
+ :output-cost 2.50
+ :cutoff-date "2025-01")
+ (gemini-flash-lite-latest
+ :description "Fastest, cheapest Gemini model, always points to latest version"
+ :capabilities (tool-use json media)
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain"
+ "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg"
+ "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm"
+ "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4"
+ "video/webm" "video/wmv" "video/3gpp")
+ :context-window 1048 ; 64000 output token limit
+ :input-cost 0.10
+ :output-cost 0.40
+ :cutoff-date "2025-01")
+ (gemini-3.1-pro-preview
+ :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 2.0 ; 4.0 for >200k tokens
+ :output-cost 12.00 ; 18.0 for >200k tokens
+ :cutoff-date "2025-01")
+ (gemini-3.1-flash-lite-preview
+ :description "Nost cost-efficient multimodal Gemini model, offering the fastest performance for high-frequency, lightweight tasks"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048
+ :input-cost 0.25
+ :output-cost 1.50
+ :cutoff-date "2025-01")
+ (gemini-3-pro-preview
+ :description "DEPRECATED: The model will be shut down on March 9, 2026. Please use gemini-3.1-pro-preview instead"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 2.0 ; 4.0 for >200k tokens
+ :output-cost 12.00 ; 18.0 for >200k tokens
+ :cutoff-date "2025-01")
+ (gemini-3-flash-preview
+ :description "Most intelligent Gemini model built for speed"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 0.50
+ :output-cost 3.00
+ :cutoff-date "2025-01")
+ (gemini-2.5-pro
+ :description "Most powerful Gemini thinking model with state-of-the-art performance"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 1.25 ; 2.50 for >200k tokens
+ :output-cost 10.00 ; 15 for >200k tokens
+ :cutoff-date "2025-01")
+ (gemini-2.5-pro-preview-06-05
+ :description "Most powerful thinking model with state-of-the-art performance"
+ :capabilities (tool-use json media)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 1.25 ; 2.50 for >200k tokens
+ :output-cost 10.00 ; 15 for >200k tokens
+ :cutoff-date "2025-01")
+ (gemini-2.5-flash
+ :description "Best in terms of price-performance, with well-rounded capabilities"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 0.3
+ :output-cost 2.50
+ :cutoff-date "2025-01")
+ (gemini-2.5-flash-preview-09-2025
+ :description "DEPRECATED: Please use gemini-2.5-flash instead"
+ :capabilities (tool-use json media)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 0.15
+ :output-cost 0.60 ; 3.50 for thinking
+ :cutoff-date "2025-01")
+ (gemini-2.5-flash-lite
+ :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks"
+ :capabilities (tool-use json media)
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain"
+ "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg"
+ "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm"
+ "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4"
+ "video/webm" "video/wmv" "video/3gpp")
+ :context-window 1048 ; 64000 output token limit
+ :input-cost 0.10
+ :output-cost 0.40
+ :cutoff-date "2025-01")
+ (gemini-2.5-flash-lite-preview-09-2025
+ :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain"
+ "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg"
+ "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm"
+ "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4"
+ "video/webm" "video/wmv" "video/3gpp")
+ :context-window 1048 ; 65536 output token limit
+ :input-cost 0.10
+ :output-cost 0.40
+ :cutoff-date "2025-01")
+ (gemini-2.0-flash
+ :description "Next gen, high speed, multimodal for a diverse variety of tasks"
+ :capabilities (tool-use json media)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html")
+ :context-window 1000
+ :input-cost 0.10
+ :output-cost 0.40
+ :cutoff-date "2024-08")
+ (gemini-2.0-flash-exp
+ :description "Next generation features, superior speed, native tool use"
+ :capabilities (tool-use json media)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html")
+ :context-window 1000
+ :input-cost 0.00
+ :output-cost 0.00)
+ (gemini-2.0-flash-thinking-exp
+ :description "DEPRECATED: Please use gemini-2.0-flash-thinking-exp-01-21 instead"
+ :capabilities (tool-use media)
+ :context-window 32
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "text/plain" "text/csv" "text/html")
+ :input-cost 0.00
+ :output-cost 0.00))
+ "List of available Gemini models and associated properties.
+Keys:
+
+- `:description': a brief description of the model.
+
+- `:capabilities': a list of capabilities supported by the model.
+
+- `:mime-types': a list of supported MIME types for media files.
+
+- `:context-window': the context window size, in thousands of tokens.
+
+- `:input-cost': the input cost, in US dollars per million tokens.
+
+- `:output-cost': the output cost, in US dollars per million tokens.
+
+- `:cutoff-date': the knowledge cutoff date.
+
+- `:request-params': a plist of additional request parameters to
+ include when using this model.
+
+Information about the Gemini models was obtained from the following
+source:
+
+- <https://ai.google.dev/pricing>
+- <https://ai.google.dev/gemini-api/docs/models>")
+
+;;;###autoload
+(cl-defun gptel-make-gemini
+ (name &key curl-args key request-params
+ (stream nil)
+ (header
+ (lambda (_info) (when-let* ((key (gptel--get-api-key)))
+ `(("X-goog-api-key" . ,key)))))
+ (host "generativelanguage.googleapis.com")
+ (protocol "https")
+ (models gptel--gemini-models)
+ (endpoint "/v1beta/models"))
+
+ "Register a Gemini backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, defaults to
+\"generativelanguage.googleapis.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--gemini-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(gemini-2.0-flash-lite ;Simple specs
+ gemini-1.5-flash
+ (gemini-1.5-pro-latest ;Full spec
+ :description
+ \"Complex reasoning tasks, problem solving and data extraction\"
+ :capabilities (tool json)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\")))
+
+
+STREAM is a boolean to enable streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, \"https\" by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1beta/models\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for."
+ (declare (indent 1))
+ (let ((backend (gptel--make-gemini
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :key key
+ :url (lambda (_info)
+ (let ((method
+ (if (and stream gptel-use-curl gptel-stream)
+ "streamGenerateContent"
+ "generateContent")))
+ (format "%s://%s%s/%s:%s"
+ protocol
+ host
+ endpoint
+ gptel-model
+ method))))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+(provide 'gptel-gemini)
+;;; gptel-gemini.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-gh.el --- Github Copilot AI suppport for gptel -*- lexical-binding: t; -*-
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for Github Copilot API to gptel
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'map)
+(eval-and-compile
+ (require 'gptel-request)
+ (require 'gptel-openai)
+ (require 'gptel-openai-responses))
+(require 'browse-url)
+
+;;; Github Copilot
+(defconst gptel--gh-models
+ '((gpt-4.1
+ :description "Flagship model for complex tasks"
+ :capabilities (media tool-use json url)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 111
+ :input-cost 0
+ :output-cost 0
+ :cutoff-date "2024-04")
+ (gpt-4o
+ :description
+ "Advanced model for complex tasks; cheaper & faster than GPT-Turbo"
+ :capabilities (media tool-use json url)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 64
+ :input-cost 0
+ :output-cost 0
+ :cutoff-date "2023-09")
+ (gpt-5-mini
+ :description "Faster, more cost-efficient version of GPT-5"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 0
+ :output-cost 0
+ :cutoff-date "2024-06")
+ (gpt-5.1
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2024-09")
+ (gpt-5.1-codex
+ :description "Flagship model for coding, reasoning, and agentic tasks across domains"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2024-09")
+ (gpt-5.1-codex-max
+ :description "Flagship model for coding, reasoning, and agentic tasks across domains"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2024-09")
+ (gpt-5.1-codex-mini
+ :description "Flagship model for coding, reasoning, and agentic tasks across domains"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2024-09")
+ (gpt-5.2
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-08")
+ (gpt-5.2-codex
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 272
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-08")
+ (gpt-5.3-codex
+ :description "The most capable agentic coding model to date"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-08")
+ (gpt-5.4
+ :description "Best intelligence at scale for agentic, coding, and professional workflows"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-08")
+ (gpt-5.4-mini
+ :description "Strongest mini model yet for coding, computer use, and subagent"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 0.33
+ :output-cost 0.33
+ :cutoff-date "2025-08")
+ (claude-haiku-4.5
+ :description "Near-frontier intelligence at blazing speeds with extended thinking"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 0.33
+ :output-cost 0.33
+ :cutoff-date "2025-02")
+ (claude-opus-4.5
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 3
+ :output-cost 3
+ :cutoff-date "2025-03")
+ (claude-opus-4.6
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 3
+ :output-cost 3
+ :cutoff-date "2025-03")
+ (claude-opus-4.7
+ :description "Most capable model for complex reasoning and advanced coding"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 3
+ :output-cost 3
+ :cutoff-date "2025-03")
+ (claude-sonnet-4
+ :description "High-performance model with exceptional reasoning and efficiency"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-03")
+ (claude-sonnet-4.5
+ :description "High-performance model with exceptional reasoning and efficiency"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-03")
+ (claude-sonnet-4.6
+ :description "High-performance model with exceptional reasoning and efficiency"
+ :capabilities (media tool-use cache)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf")
+ :context-window 128
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-03")
+ (gemini-2.5-pro
+ :description "Next gen, high speed, multimodal for a diverse variety of tasks"
+ :capabilities (tool-use json media)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html")
+ :context-window 109
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-01")
+ (gemini-3-flash-preview
+ :description "Most intelligent Gemini model built for speed"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 109
+ :input-cost 0.33
+ :output-cost 0.33
+ :cutoff-date "2025-01")
+ (gemini-3-pro-preview
+ :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 109
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-01")
+ (gemini-3.1-pro-preview
+ :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding"
+ :capabilities (tool-use json media audio video)
+ :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif"
+ "application/pdf" "text/plain" "text/csv" "text/html"
+ "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3"
+ "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm")
+ :context-window 109
+ :input-cost 1
+ :output-cost 1
+ :cutoff-date "2025-01")
+ (grok-code-fast-1
+ :description "Fast reasoning model for agentic coding"
+ :capabilities '(tool-use json reasoning)
+ :context-window 109
+ :input-cost 0.25
+ :output-cost 1.5
+ :cutoff-date "2025-08")))
+
+(cl-defstruct (gptel--gh (:include gptel-openai)
+ (:copier nil)
+ (:constructor gptel--make-gh))
+ token github-token sessionid machineid responses-backend)
+
+(defcustom gptel-gh-github-token-file (expand-file-name ".cache/copilot-chat/github-token"
+ user-emacs-directory)
+ "File where the GitHub token is stored."
+ :type 'string
+ :group 'gptel)
+
+(defcustom gptel-gh-token-file (expand-file-name ".cache/copilot-chat/token"
+ user-emacs-directory)
+ "File where the chat token is cached."
+ :type 'string
+ :group 'gptel)
+
+(defconst gptel--gh-auth-common-headers
+ `(("editor-plugin-version" . "gptel/*")
+ ("editor-version" . ,(concat "emacs/" emacs-version))))
+
+(defconst gptel--gh-client-id "Iv1.b507a08c87ecfe98")
+
+;; https://en.wikipedia.org/wiki/Universally_unique_identifier#Version_4_(random)
+(defun gptel--gh-uuid ()
+ "Generate a UUID v4-1."
+ (format "%04x%04x-%04x-4%03x-8%03x-%04x%04x%04x"
+ (random #x10000) (random #x10000)
+ (random #x10000)
+ (random #x1000)
+ (random #x1000)
+ (random #x10000) (random #x10000) (random #x10000)))
+
+(defun gptel--gh-machine-id ()
+ "Generate a machine ID."
+ (let ((hex-chars "0123456789abcdef")
+ (length 65)
+ hex)
+ (dotimes (_ length)
+ (setq hex (nconc hex (list (aref hex-chars (random 16))))))
+ (apply #'string hex)))
+
+(defun gptel--gh-restore (file)
+ "Restore saved object from FILE."
+ (when (file-exists-p file)
+ ;; We set the coding system to `utf-8-auto-dos' when reading so that
+ ;; files with CR EOL can still be read properly
+ (let ((coding-system-for-read 'utf-8-auto-dos))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (goto-char (point-min))
+ (read (current-buffer))))))
+
+(defun gptel--gh-save (file obj)
+ "Save OBJ to FILE."
+ (let ((print-length nil)
+ (print-level nil)
+ (coding-system-for-write 'utf-8-unix))
+ (make-directory (file-name-directory file) t)
+ (write-region (prin1-to-string obj) nil file nil :silent)
+ obj))
+
+(defun gptel-gh-login ()
+ "Login to GitHub Copilot API.
+
+This will prompt you to authorize in a browser and store the token.
+
+In SSH sessions, the URL and code will be displayed for manual entry
+instead of attempting to open a browser automatically."
+ (interactive)
+ ;; Determine which GitHub backend to use
+ (let ((gh-backend
+ (cond
+ ;; If current backend is GitHub, use it
+ ((and (boundp 'gptel-backend)
+ gptel-backend
+ (gptel--gh-p gptel-backend))
+ gptel-backend)
+ ;; Otherwise, find any GitHub backend
+ ((cl-find-if (lambda (b) (gptel--gh-p b))
+ (mapcar #'cdr gptel--known-backends)))
+ ;; No GitHub backend found
+ (t (user-error "No GitHub Copilot backend found. \
+Please set one up with `gptel-make-gh-copilot' first"))))
+ ;; Detect SSH sessions
+ (in-ssh-session (or (getenv "SSH_CLIENT")
+ (getenv "SSH_CONNECTION")
+ (getenv "SSH_TTY"))))
+ (pcase-let (((map :device_code :user_code :verification_uri)
+ (gptel--url-retrieve
+ "https://github.com/login/device/code"
+ :method 'post
+ :headers gptel--gh-auth-common-headers
+ :data `( :client_id ,gptel--gh-client-id
+ :scope "read:user"))))
+ (gui-set-selection 'CLIPBOARD user_code)
+ (if in-ssh-session
+ ;; SSH session: display URL and code, don't auto-open browser
+ (progn
+ (message "GitHub Device Code: %s (copied to clipboard)" user_code)
+ (read-from-minibuffer
+ (format "Code %s is copied. Visit https://github.com/login/device \
+in your local browser, enter the code, and authorize. Press ENTER after authorizing. "
+ user_code)))
+ ;; Local session: auto-open browser
+ (read-from-minibuffer
+ (format "Your one-time code %s is copied. \
+Press ENTER to open GitHub in your browser. \
+If your browser does not open automatically, browse to %s."
+ user_code verification_uri))
+ (browse-url verification_uri)
+ (read-from-minibuffer "Press ENTER after authorizing. "))
+ ;; Use gh-backend for token storage
+ (thread-last
+ (plist-get
+ (gptel--url-retrieve
+ "https://github.com/login/oauth/access_token"
+ :method 'post
+ :headers gptel--gh-auth-common-headers
+ :data `( :client_id ,gptel--gh-client-id
+ :device_code ,device_code
+ :grant_type "urn:ietf:params:oauth:grant-type:device_code"))
+ :access_token)
+ (gptel--gh-save gptel-gh-github-token-file)
+ (setf (gptel--gh-github-token gh-backend))))
+ ;; Check gh-backend for success
+ (if (and (gptel--gh-github-token gh-backend)
+ (not (string-empty-p
+ (gptel--gh-github-token gh-backend))))
+ (message "Successfully logged in to GitHub Copilot.")
+ (user-error "Error: You might not have access to GitHub Copilot Chat!"))))
+
+(defun gptel--gh-renew-token ()
+ "Renew session token."
+ (let ((token
+ (gptel--url-retrieve
+ "https://api.github.com/copilot_internal/v2/token"
+ :method 'get
+ :headers `(("authorization"
+ . ,(format "token %s" (gptel--gh-github-token gptel-backend)))
+ ,@gptel--gh-auth-common-headers))))
+ (if (not (plist-get token :token))
+ (progn
+ (setf (gptel--gh-github-token gptel-backend) nil)
+ (user-error "Error: You might not have access to GitHub Copilot Chat!"))
+ (thread-last
+ (gptel--gh-save gptel-gh-token-file token)
+ (setf (gptel--gh-token gptel-backend))))))
+
+(defun gptel--gh-auth ()
+ "Authenticate with GitHub Copilot API.
+
+We first need github authorization (github token).
+Then we need a session token."
+ (unless (gptel--gh-github-token gptel-backend)
+ (let ((token (gptel--gh-restore gptel-gh-github-token-file)))
+ (if token
+ (setf (gptel--gh-github-token gptel-backend) token)
+ (gptel-gh-login))))
+
+ (when (null (gptel--gh-token gptel-backend))
+ ;; try to load token from `gptel-gh-token-file'
+ (setf (gptel--gh-token gptel-backend)
+ (gptel--gh-restore gptel-gh-token-file)))
+
+ (pcase-let (((map :token :expires_at)
+ (gptel--gh-token gptel-backend)))
+ (when (or (null token)
+ (and expires_at
+ (> (round (float-time (current-time)))
+ expires_at)))
+ (gptel--gh-renew-token))))
+
+(cl-defmethod gptel-curl--parse-stream ((backend gptel--gh) info)
+ (let ((model (plist-get info :model)))
+ (if (gptel--model-capable-p 'responses-api model)
+ ;; Defer to gptel-openai-responses backend
+ (gptel-curl--parse-stream
+ (gptel--gh-responses-backend backend) info)
+ (cl-call-next-method))))
+
+(cl-defmethod gptel--parse-response ((backend gptel--gh) response info)
+ (let ((model (plist-get info :model)))
+ (if (gptel--model-capable-p 'responses-api model)
+ ;; Defer to gptel-openai-responses backend
+ (gptel--parse-response
+ (gptel--gh-responses-backend backend) response info)
+ (cl-call-next-method))))
+
+(cl-defmethod gptel--request-data ((backend gptel--gh) prompts)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--request-data (gptel--gh-responses-backend backend) prompts)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--parse-schema ((backend gptel--gh) schema)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--parse-schema (gptel--gh-responses-backend backend) schema)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--parse-tools ((backend gptel--gh) tools)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--parse-tools (gptel--gh-responses-backend backend) tools)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--inject-tool-call ((backend gptel--gh) data tool-call new-call)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--inject-tool-call (gptel--gh-responses-backend backend) data tool-call new-call)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--parse-tool-results ((backend gptel--gh) tool-use)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--parse-tool-results (gptel--gh-responses-backend backend) tool-use)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--inject-prompt ((backend gptel--gh) data new-prompt &optional position)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--inject-prompt (gptel--gh-responses-backend backend) data new-prompt position)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--parse-list ((backend gptel--gh) prompt-list)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--parse-list (gptel--gh-responses-backend backend) prompt-list)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--parse-buffer ((backend gptel--gh) &optional max-entries)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--parse-buffer (gptel--gh-responses-backend backend) max-entries)
+ (cl-call-next-method)))
+
+(cl-defmethod gptel--inject-media ((backend gptel--gh) prompts)
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ (gptel--inject-media (gptel--gh-responses-backend backend) prompts)
+ (cl-call-next-method)))
+
+;;;###autoload
+(cl-defun gptel-make-gh-copilot
+ (name &key curl-args request-params
+ (header
+ (lambda (info) (gptel--gh-auth)
+ `(("openai-intent" . "conversation-panel")
+ ("authorization" . ,( concat "Bearer "
+ (plist-get (gptel--gh-token gptel-backend) :token)))
+ ("x-initiator" . ,(or (plist-get info :gh-initiator) ;tool call return turn
+ (prog1 "user" ;user turn
+ (plist-put info :gh-initiator "agent"))))
+ ("x-request-id" . ,(gptel--gh-uuid))
+ ("vscode-sessionid" . ,(or (gptel--gh-sessionid gptel-backend) ""))
+ ("vscode-machineid" . ,(or (gptel--gh-machineid gptel-backend) ""))
+ ,@(when (and gptel-track-media
+ (gptel--model-capable-p 'media))
+ `(("copilot-vision-request" . "true")))
+ ("copilot-integration-id" . "vscode-chat"))))
+ (host "api.githubcopilot.com")
+ (protocol "https")
+ (endpoint "/chat/completions")
+ (stream t)
+ (models gptel--gh-models))
+ "Register a Github Copilot chat backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, typically \"api.githubcopilot.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--openai-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(gpt-3.5-turbo ;Simple specs
+ gpt-4-turbo
+ (gpt-4o-mini ;Full spec
+ :description
+ \"Affordable and intelligent small model for lightweight tasks\"
+ :capabilities (media tool json url)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
+
+Defaults to a list of models supported by GitHub Copilot.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/chat/completions\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+Defaults to headers required by GitHub Copilot.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for."
+ (declare (indent 1))
+ (let* ((url (lambda (_info)
+ (concat protocol "://" host
+ (if (gptel--model-capable-p 'responses-api gptel-model)
+ "/v1/responses" endpoint))))
+ (backend (gptel--make-gh
+ :name name
+ :host host
+ :header header
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :curl-args curl-args
+ :url url
+ :machineid (gptel--gh-machine-id)
+ :responses-backend
+ (gptel--make-openai-responses
+ :name name
+ :host host
+ :header header
+ :protocol protocol
+ :endpoint "/v1/responses"
+ :stream stream
+ :request-params request-params
+ :curl-args curl-args
+ :url url))))
+ (setf (alist-get name gptel--known-backends nil nil #'equal) backend)
+ backend))
+
+(provide 'gptel-gh)
+;;; gptel-gh.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-transient.el --- Integrations for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: convenience
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Integrations with related packages for gptel. To use these, run
+;;
+;; (require 'gptel-integrations)
+;;
+;; For MCP integration:
+;; - Run M-x `gptel-mcp-connect' and M-x `gptel-mcp-disconnect', OR
+;; - Use gptel's tools menu, M-x `gptel-tools', OR
+;; - Access tools from `gptel-menu'
+
+;;; Code:
+(require 'gptel)
+(require 'cl-lib)
+(eval-when-compile (require 'transient))
+
+;;;;; Vterm integration
+;; Insertion and deletion is tricky in Vterm buffers. Try to ensure that
+;; gptel-send still works there. TODO: Insertion works, but insertion-in-place
+;; is flaky and fails depending on how well Vterm's prompt tracking works, as
+;; well as on the presence of "virtual text" in the prompt.
+(declare-function vterm-copy-mode "vterm")
+(declare-function vterm-delete-region "vterm")
+(declare-function vterm-goto-char "vterm")
+(declare-function vterm-reset-cursor-point "vterm")
+(declare-function vterm-cursor-in-command-buffer-p "vterm")
+(declare-function vterm-send-key "vterm")
+(declare-function vterm-insert "vterm")
+(defvar vterm-copy-mode)
+
+(defun gptel--vterm-delete ()
+ "Try to delete the region or Vterm prompt text.
+
+Intended for use in Vterm buffers with the \"respond-in-place\" option
+of `gptel-send'."
+ (if (use-region-p)
+ (let ((beg (region-beginning)) ; Clear region
+ (end (region-end)))
+ (vterm-copy-mode -1)
+ (condition-case nil
+ ;; Preferred solution, fails if the prompt is part of region
+ (vterm-delete-region beg end)
+ (buffer-read-only
+ (when (vterm-goto-char end) ;HACK Try to clear characters one by one
+ (let ((prev-pt (1- end)))
+ (while (and (>= (vterm-reset-cursor-point) beg)
+ (/= (point) prev-pt)
+ (vterm-cursor-in-command-buffer-p))
+ (setq prev-pt (point))
+ (vterm-send-key "<backspace>" nil t nil t)))))))
+ (let ((prev-pt 0)) ; Clear to prompt
+ (while (and (/= (vterm-reset-cursor-point) prev-pt)
+ (vterm-cursor-in-command-buffer-p))
+ (setq prev-pt (point))
+ (vterm-send-key "<backspace>" nil t nil t)))))
+
+(defun gptel--vterm-pre-insert (info)
+ "Set up insertion into Vterm buffers for `gptel-send'.
+
+INFO is the query information for the active request."
+ (let ((start-marker (plist-get info :position))
+ (hold-buffer (gptel--temp-buffer " *gptel-vterm-redirect*")))
+ (plist-put info :vterm-marker (copy-marker start-marker t))
+ (with-current-buffer hold-buffer
+ (move-marker start-marker (point-min) hold-buffer)
+ ;; We collect text elsewhere and copy it into the Vterm buffer at the end
+ (add-hook 'gptel-post-response-functions
+ (lambda (beg end)
+ (let ((response (buffer-substring-no-properties beg end)))
+ (with-current-buffer (plist-get info :buffer)
+ (goto-char (plist-get info :vterm-marker))
+ (when vterm-copy-mode (vterm-copy-mode -1))
+ (vterm-insert response)))
+ (kill-buffer (current-buffer)))
+ 90 t))))
+
+;;;; MCP integration - requires the mcp package
+(declare-function mcp-hub-get-all-tool "mcp-hub")
+(declare-function mcp-hub-get-servers "mcp-hub")
+(declare-function mcp-hub-start-all-server "mcp-hub")
+(declare-function mcp-stop-server "mcp")
+(declare-function mcp-hub "mcp-hub")
+(declare-function mcp--status "mcp-hub")
+(declare-function mcp--tools "mcp-hub")
+(declare-function mcp-make-text-tool "mcp-hub")
+(defvar mcp-hub-servers)
+(defvar mcp-server-connections)
+
+(defun gptel-mcp-connect (&optional servers server-callback interactive)
+ "Add gptel tools from MCP servers using the mcp package.
+
+MCP servers are started if required. SERVERS is a list of server
+names (strings) to connect to. If nil, all known servers are
+considered.
+
+If INTERACTIVE is non-nil (or called interactively), guide the user
+through setting up mcp, and query for servers to retrieve tools from.
+
+Call SERVER-CALLBACK after starting MCP servers. If SERVER-CALLBACK is
+not a function and non-nil, start SERVERS synchronously."
+ (interactive (list nil nil t))
+ (if (locate-library "mcp-hub")
+ (unless (require 'mcp-hub nil t)
+ (user-error "Could not load `mcp-hub'! Please install\
+ or configure the mcp package"))
+ (user-error "Could not find mcp! Please install or configure the mcp package"))
+ (if (null mcp-hub-servers)
+ (user-error "No MCP servers available! Please configure `mcp-hub-servers'")
+ (setq servers
+ (if servers
+ (mapcar (lambda (s) (assoc s mcp-hub-servers)) servers)
+ mcp-hub-servers))
+ (let ((unregistered-servers ;Available servers minus servers already registered with gptel
+ (cl-loop for server in servers
+ with registered-names =
+ (cl-loop for (cat . _tools) in gptel--known-tools
+ if (string-prefix-p "mcp-" cat)
+ collect (substring cat 4))
+ unless (member (car server) registered-names)
+ collect server)))
+ (if unregistered-servers
+ (let* ((servers
+ (if interactive
+ (let ((picks
+ (completing-read-multiple
+ "Add tools from MCP servers (separate with \",\"): "
+ (cons '("ALL") unregistered-servers) nil t)))
+ (if (member "ALL" picks)
+ unregistered-servers
+ (mapcar (lambda (s) (assoc s mcp-hub-servers)) picks)))
+ unregistered-servers))
+ (server-active-p
+ (lambda (server)
+ (when-let* ((server (gethash (car server) mcp-server-connections)))
+ (equal (mcp--status server) 'connected))))
+ (inactive-servers (cl-remove-if server-active-p servers))
+ (add-all-tools
+ (lambda (&optional server-names)
+ "Register and add tools from servers. Report failures."
+ (let ((tools (gptel-mcp--get-tools
+ (or server-names (mapcar #'car servers))))
+ (now-active (cl-remove-if-not server-active-p mcp-hub-servers)))
+ (mapc (lambda (tool) (apply #'gptel-make-tool tool)) tools)
+ (when tools (gptel-mcp--activate-tools tools))
+ (if-let* ((failed (cl-set-difference inactive-servers now-active
+ :test #'equal)))
+ (progn
+ (message "Inactive-before: %S, Now-Active: %S" inactive-servers now-active)
+ (message (substitute-command-keys
+ "%d/%d server%s failed to start: %s. Run \\[mcp-hub] to investigate.")
+ (length failed) (length inactive-servers)
+ (if (= (length failed) 1) "" "s")
+ (mapconcat #'car failed ", ")))
+ (let ((added (or server-names (mapcar #'car now-active))))
+ (message "Added %d tools from %d MCP server%s: %s"
+ (length tools) (length added)
+ (if (= (length added) 1) "" "s")
+ (mapconcat #'identity added ", "))))
+ (when (functionp server-callback) (funcall server-callback))))))
+
+ (if inactive-servers ;start servers
+ (let ((syncp (and server-callback (not (functionp server-callback)) t)))
+ (mcp-hub-start-all-server
+ add-all-tools (mapcar #'car inactive-servers) syncp))
+ (funcall add-all-tools (mapcar #'car servers))))
+ (when interactive (message "All MCP tools are already available to gptel!"))
+ (when (functionp server-callback) (funcall server-callback))))))
+
+(defun gptel-mcp-disconnect (&optional servers interactive)
+ "Unregister gptel tools provided by MCP servers using the mcp package.
+
+SERVERS is a list of server names (strings) to disconnect from.
+
+If INTERACTIVE is non-nil, query the user about which tools to remove."
+ (interactive (list nil t))
+ (if-let* ((names-alist
+ (cl-loop
+ for (category . _tools) in gptel--known-tools
+ if (and (string-match "^mcp-\\(.*\\)" category)
+ (or (null servers) ;Consider all if nil
+ (member (match-string 1 category) servers)))
+ collect (cons (match-string 1 category) category))))
+ (let ((remove-fn (lambda (cat-names)
+ (setq gptel-tools ;Remove from gptel-tools
+ (cl-delete-if (lambda (tool) (member (gptel-tool-category tool)
+ cat-names))
+ gptel-tools))
+ (mapc (lambda (category) ;Remove from registry
+ (setf (alist-get category gptel--known-tools
+ nil t #'equal)
+ nil))
+ cat-names))))
+ (if interactive
+ (when-let* ((server-names
+ (completing-read-multiple
+ "Remove MCP server tools for (separate with \",\"): "
+ (cons '("ALL" . nil) names-alist)
+ nil t)))
+ (when (member "ALL" server-names)
+ (setq server-names (mapcar #'car names-alist)))
+ (funcall remove-fn ;remove selected tool categories
+ (mapcar (lambda (s) (cdr (assoc s names-alist))) server-names))
+ (if (y-or-n-p
+ (format "Removed MCP tools from %d server%s. Also shut down MCP servers?"
+ (length server-names)
+ (if (= (length server-names) 1) "" "s")))
+ (progn (mapc #'mcp-stop-server server-names)
+ (message "Shut down MCP servers: %S" server-names))
+ (message "Removed MCP tools for: %S" server-names)))
+ (funcall remove-fn (mapcar #'cdr names-alist))))
+ ;; No MCP tools, ask to shut down servers
+ (if (cl-loop
+ for v being the hash-values of mcp-server-connections
+ never v)
+ (when interactive (message "No MCP servers active!"))
+ (when (or (not interactive)
+ (y-or-n-p "No MCP tools in gptel! Shut down all MCP servers? "))
+ (dolist (server mcp-hub-servers)
+ (when (gethash (car server) mcp-server-connections)
+ (mcp-stop-server (car server))))))))
+
+(defun gptel-mcp--get-tools (&optional server-names)
+ "Return tools from running MCP servers.
+
+SERVER-NAMES is a list of server names to add tools from. Add tools
+from all connected servers if it is nil."
+ (unless server-names
+ (setq server-names (hash-table-keys mcp-server-connections)))
+ (let ((servers (mapcar (lambda (n) (gethash n mcp-server-connections))
+ server-names)))
+ (cl-mapcan
+ (lambda (name server)
+ (when (and server (equal (mcp--status server) 'connected))
+ (when-let* ((tools (mcp--tools server))
+ (tool-names (mapcar #'(lambda (tool) (plist-get tool :name)) tools)))
+ (mapcar (lambda (tool-name)
+ (plist-put (mcp-make-text-tool name tool-name t)
+ :category (format "mcp-%s" name)))
+ tool-names))))
+ server-names servers)))
+
+(defun gptel-mcp--activate-tools (&optional tools)
+ "Activate TOOLS or all MCP tools in current gptel session."
+ (unless tools (setq tools (gptel-mcp--get-tools)))
+ (dolist (tool tools)
+ (cl-pushnew (gptel-get-tool (list (plist-get tool :category)
+ (plist-get tool :name)))
+ gptel-tools)))
+
+(with-eval-after-load 'gptel-transient
+ (transient-define-suffix gptel--suffix-mcp-connect ()
+ "Register tools provided by MCP servers."
+ :key "M+"
+ :description "Add MCP server tools"
+ :transient t
+ (interactive)
+ ;; gptel-tools stores its state in its scope slot. Retain the scope but
+ ;; update it with the newly selected tools. Then set up gptel-tools.
+ (condition-case err
+ (gptel-mcp-connect
+ nil (lambda () (when-let* ((transient--prefix)
+ ((eq (oref transient--prefix command)
+ 'gptel-tools)))
+ (let ((state (transient-scope 'gptel-tools)))
+ (plist-put state :tools
+ (delete-dups
+ (nconc (mapcar (lambda (tool)
+ (list (gptel-tool-category tool)
+ (gptel-tool-name tool)))
+ gptel-tools)
+ (plist-get state :tools))))
+ (transient-setup 'gptel-tools nil nil :scope state))))
+ t)
+ (user-error (message "%s" (cadr err)))))
+
+ (transient-define-suffix gptel--suffix-mcp-disconnect ()
+ "Remove tools provided by MCP servers from gptel."
+ :key "M-"
+ :description (lambda () (if (cl-some (lambda (cat) (string-match-p "^mcp-" cat))
+ (map-keys gptel--known-tools))
+ "Remove MCP server tools"
+ "Shut down MCP servers"))
+ :transient t
+ :inapt-if
+ (lambda () (or (not (boundp 'mcp-hub-servers))
+ (null mcp-hub-servers)
+ (cl-loop
+ for v being the hash-values of mcp-server-connections
+ never v)))
+ (interactive)
+ (call-interactively #'gptel-mcp-disconnect)
+ ;; gptel-tools stores its state in its scope slot. Retain the scope but
+ ;; remove tools from it that no longer exist, then set up gptel-tools
+ (cl-loop with state = (transient-scope 'gptel-tools)
+ with tools = (plist-get state :tools)
+ for tool-spec in tools
+ if (map-nested-elt gptel--known-tools tool-spec)
+ collect tool-spec into valid-tools
+ finally do (plist-put state :tools valid-tools)
+ (transient-setup 'gptel-tools nil nil :scope state)))
+
+ (transient-remove-suffix 'gptel-tools '(0 2))
+ (transient-append-suffix 'gptel-tools '(0 -1)
+ [""
+ (gptel--suffix-mcp-connect)
+ (gptel--suffix-mcp-disconnect)]))
+
+(provide 'gptel-integrations)
+;;; gptel-integrations.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not noruntime)
+;; End:
--- /dev/null
+;;; gptel-kagi.el --- Kagi support for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: hypermedia
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for the Kagi FastGPT LLM API to gptel
+
+;;; Code:
+(require 'cl-generic)
+(eval-when-compile (require 'cl-lib))
+(eval-and-compile (require 'gptel-request))
+
+(declare-function gptel-context--wrap "gptel-context")
+
+;;; Kagi
+(cl-defstruct (gptel-kagi (:constructor gptel--make-kagi)
+ (:copier nil)
+ (:include gptel-backend)))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-kagi) response info)
+ (let* ((data (plist-get response :data))
+ (output (plist-get data :output))
+ (references (plist-get data :references))
+ (tokens (plist-get data :tokens)))
+ (when tokens
+ (plist-put info :tokens (list :input tokens :output tokens)))
+ (if (eq references :null) (setq references nil))
+ (if (eq output :null) (setq output nil))
+ (when references
+ (setq references
+ (cl-loop with linker =
+ (pcase (buffer-local-value 'major-mode
+ (plist-get info :buffer))
+ ('org-mode
+ (lambda (text url)
+ (format "[[%s][%s]]" url text)))
+ ('markdown-mode
+ (lambda (text url)
+ (format "[%s](%s)" text url)))
+ (_ (lambda (text url)
+ (buttonize
+ text (lambda (data) (browse-url data))
+ url))))
+ for ref across references
+ for title = (plist-get ref :title)
+ for snippet = (plist-get ref :snippet)
+ for url = (plist-get ref :url)
+ for n upfrom 1
+ collect
+ (concat (format "[%d] " n)
+ (funcall linker title url) ": "
+ (replace-regexp-in-string
+ "</?b>" "*" snippet))
+ into ref-strings
+ finally return
+ (concat "\n\n" (mapconcat #'identity ref-strings "\n")))))
+ (concat output references)))
+
+;; TODO: Add support for model/backend-specific request-params and
+;; gptel--request-params
+(cl-defmethod gptel--request-data ((_backend gptel-kagi) prompts)
+ "JSON encode PROMPTS for Kagi."
+ (pcase-exhaustive (gptel--model-name gptel-model)
+ ("fastgpt"
+ `(,@prompts :web_search t :cache t))
+ ((and model (guard (string-prefix-p "summarize" model)))
+ `(,@prompts :engine ,(substring model 10)))))
+
+(cl-defmethod gptel--parse-buffer ((_backend gptel-kagi) &optional _max-entries)
+ (let ((url (or (thing-at-point 'url)
+ (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url)))
+ ;; (filename (thing-at-point 'existing-filename)) ;no file upload support yet
+ (prop (text-property-search-backward
+ 'gptel 'response
+ (when (get-char-property (max (point-min) (1- (point)))
+ 'gptel)
+ t))))
+ (if (and url (string-prefix-p "summarize" (gptel--model-name gptel-model)))
+ (list :url url)
+ (if (and (or gptel-mode gptel-track-response)
+ (prop-match-p prop)
+ (prop-match-value prop))
+ (user-error "No user prompt found!")
+ (let ((prompts
+ (if (or gptel-mode gptel-track-response)
+ (or (gptel--trim-prefixes
+ (buffer-substring-no-properties (prop-match-beginning prop)
+ (prop-match-end prop)))
+ "")
+ (string-trim (buffer-substring-no-properties (point-min) (point-max))))))
+ (pcase-exhaustive (gptel--model-name gptel-model)
+ ("fastgpt" (setq prompts (list :query (if (prop-match-p prop) prompts ""))))
+ ((and model (guard (string-prefix-p "summarize" model)))
+ ;; If the entire contents of the prompt looks like a url, send the url
+ ;; Else send the text of the region
+ (setq prompts
+ (if-let* (((prop-match-p prop))
+ (engine (substring model 10)))
+ ;; It's a region of text
+ (list :text prompts)
+ ""))))
+ prompts)))))
+
+;;;###autoload
+(cl-defun gptel-make-kagi
+ (name &key curl-args stream key
+ (host "kagi.com")
+ (header (lambda (_info)
+ `(("Authorization" . ,(concat "Bot " (gptel--get-api-key))))))
+ (models '((fastgpt :capabilities (nosystem))
+ (summarize:cecil :capabilities (nosystem))
+ (summarize:agnes :capabilities (nosystem))
+ (summarize:daphne :capabilities (nosystem))
+ (summarize:muriel :capabilities (nosystem))))
+ (protocol "https")
+ (endpoint "/api/v0/"))
+ "Register a Kagi FastGPT backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is the Kagi host (with port), defaults to \"kagi.com\".
+
+MODELS is a list of available Kagi models: only fastgpt is supported.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false. Kagi does not support a streaming API yet.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/api/v0/fastgpt\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+Example:
+-------
+
+ (gptel-make-kagi \"Kagi\" :key my-kagi-key)"
+ (declare (indent 1))
+ stream ;Silence byte-compiler
+ (let ((backend (gptel--make-kagi
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :url
+ (lambda (_info)
+ (concat protocol "://" host endpoint
+ (if (equal gptel-model 'fastgpt)
+ "fastgpt" "summarize"))))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+(provide 'gptel-kagi)
+;;; gptel-kagi.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-ollama.el --- Ollama support for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: hypermedia
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for the Ollama LLM API to gptel
+
+;;; Code:
+(require 'cl-generic)
+(eval-and-compile (require 'gptel-request))
+
+(declare-function json-read "json" ())
+(declare-function gptel-context--wrap "gptel-context")
+(declare-function gptel-context--collect-media "gptel-context")
+
+(defvar json-object-type)
+
+;;; Ollama
+(cl-defstruct (gptel-ollama (:constructor gptel--make-ollama)
+ (:copier nil)
+ (:include gptel-backend)))
+
+(defun gptel--ollama-update-tokens (usage info)
+ "Update token usage information from USAGE.
+USAGE is part of the response, INFO is the request plist.
+
+This function accumulates token counts across multiple turns in a
+multi-turn request (e.g., during tool use where results are fed
+back to the LLM)."
+ (when usage
+ (let* ((tokens (plist-get info :tokens))
+ (input (+ (or (plist-get usage :prompt_eval_count) 0)
+ (or (plist-get tokens :input) 0)))
+ (output (+ (or (plist-get usage :eval_count) 0)
+ (or (plist-get tokens :output) 0))))
+ (list :input input :output output))))
+
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-ollama) info)
+ "Parse response stream for the Ollama API."
+ (when (and (bobp) (re-search-forward "^{" nil t))
+ (forward-line 0))
+ (let* ((content-strs) (content) (pt (point)))
+ (condition-case nil
+ (while (setq content (gptel--json-read))
+ (setq pt (point))
+ (let ((done (map-elt content :done))
+ (reasoning (map-nested-elt content '(:message :thinking)))
+ (response (map-nested-elt content '(:message :content)))
+ (tool-calls (map-nested-elt content '(:message :tool_calls))))
+ (when (and response (not (eq response :null)))
+ (push response content-strs))
+ (when (and tool-calls (not (eq tool-calls :null)))
+ (gptel--inject-prompt
+ (plist-get info :backend) (plist-get info :data)
+ `(:role "assistant" :content :null :tool_calls ,(vconcat tool-calls)))
+ (cl-loop
+ for tool-call across tool-calls ;replace ":arguments" with ":args"
+ for call-spec = (copy-sequence (plist-get tool-call :function))
+ do (plist-put call-spec :args
+ (plist-get call-spec :arguments))
+ (plist-put call-spec :arguments nil)
+ collect call-spec into tool-use
+ finally (plist-put info :tool-use tool-use)))
+ (if (and reasoning (not (eq reasoning :null)))
+ (plist-put info :reasoning
+ (concat (plist-get info :reasoning) reasoning))
+ (if (eq 'in (plist-get info :reasoning-block))
+ (plist-put info :reasoning-block t)
+ (plist-put info :reasoning-block nil)))
+ (unless (eq done :json-false)
+ (plist-put info :tokens (gptel--ollama-update-tokens content info))
+ (goto-char (point-max)))))
+ (error (goto-char pt)))
+ (apply #'concat (nreverse content-strs))))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-ollama) response info)
+ "Parse a one-shot RESPONSE from the Ollama API and return text.
+
+Store response metadata in state INFO."
+ (plist-put info :stop-reason (plist-get response :done_reason))
+ (plist-put info :tokens (gptel--ollama-update-tokens response info))
+ (let* ((message (plist-get response :message))
+ (reasoning (plist-get message :thinking))
+ (content (plist-get message :content)))
+ (when reasoning
+ (plist-put info :reasoning reasoning))
+ (when-let* ((tool-calls (plist-get message :tool_calls)))
+ ;; First add the tool call to the prompts list
+ (let* ((data (plist-get info :data))
+ (prompts (plist-get data :messages)))
+ (plist-put data :messages (vconcat prompts `(,message))))
+ ;; Then capture the tool call data for running the tool
+ (cl-loop
+ for tool-call across tool-calls ;replace ":arguments" with ":args"
+ for call-spec = (copy-sequence (plist-get tool-call :function))
+ do (plist-put call-spec :args
+ (plist-get call-spec :arguments))
+ (plist-put call-spec :arguments nil)
+ collect call-spec into tool-use
+ finally (plist-put info :tool-use tool-use)))
+ (when (and content (not (or (eq content :null) (string-empty-p content))))
+ content)))
+
+(cl-defmethod gptel--request-data ((backend gptel-ollama) prompts)
+ "JSON encode PROMPTS for sending to Ollama."
+ (when gptel--system-message
+ (push (list :role "system"
+ :content gptel--system-message)
+ prompts))
+ (let* ((prompts-plist
+ (gptel--merge-plists
+ `(:model ,(gptel--model-name gptel-model)
+ :messages [,@prompts]
+ :stream ,(or gptel-stream :json-false)
+ ,@(and gptel--schema
+ `(:format ,(gptel--preprocess-schema
+ (gptel--dispatch-schema-type gptel--schema)))))
+ gptel--request-params
+ (gptel-backend-request-params gptel-backend)
+ (gptel--model-request-params gptel-model)))
+ ;; the initial options (if any) from request params
+ (options-plist (plist-get prompts-plist :options)))
+
+ (when (and gptel-use-tools gptel-tools)
+ ;; TODO(tool): Find out how to force tool use for Ollama
+ (plist-put prompts-plist :tools
+ (gptel--parse-tools backend gptel-tools)))
+ ;; if the temperature and max-tokens aren't set as
+ ;; backend/model-specific, use the global settings
+ (when (and gptel-temperature (not (plist-get options-plist :temperature)))
+ (setq options-plist
+ (plist-put options-plist :temperature gptel-temperature)))
+ (when (and gptel-max-tokens (not (plist-get options-plist :num_predict)))
+ (setq options-plist
+ (plist-put options-plist :num_predict gptel-max-tokens)))
+ (plist-put prompts-plist :options options-plist)))
+
+;; NOTE: No `gptel--parse-tools' method required for gptel-ollama, since this is
+;; handled by its defgeneric implementation
+
+(cl-defmethod gptel--parse-tool-results ((_backend gptel-ollama) tool-use)
+ "Return a prompt containing tool call results in TOOL-USE."
+ (mapcar (lambda (tool-call)
+ (list :role "tool" :content (plist-get tool-call :result)))
+ tool-use))
+
+;; NOTE: No `gptel--inject-prompt' method required for gptel-ollama, since this is
+;; handled by its defgeneric implementation
+
+(cl-defmethod gptel--inject-tool-call ((_backend gptel-ollama) data tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+BACKEND is the `gptel-backend'. See the generic function documentation
+for details. This implementation handles the Ollama API."
+ ;; FIXME: We currently assume that the tool call being modified is in the last
+ ;; position in the messages array.
+ (if-let* ((messages (plist-get data :messages))
+ (entry (aref messages (1- (length messages))))
+ (calls (plist-get entry :tool_calls))
+ (indexed-call
+ (cl-loop with name = (plist-get tool-call :name)
+ with old-args = (plist-get tool-call :args)
+ for chunk across calls
+ for i upfrom 0
+ for function = (plist-get chunk :function)
+ if (and (equal (plist-get function :name) name)
+ (equal (plist-get function :arguments) old-args))
+ return (cons i function) end
+ finally return nil))
+ (index (car indexed-call))
+ (call (cdr indexed-call)))
+ (if (null new-call)
+ (if (= (length calls) 1)
+ (plist-put data :messages (substring messages nil -1))
+ (plist-put entry :tool_calls
+ (vconcat (substring calls 0 index)
+ (substring calls (1+ index)))))
+ (when-let* ((args (plist-get new-call :args)))
+ (plist-put call :arguments args))
+ (when-let* ((name (plist-get new-call :name)))
+ (plist-put call :name name)))
+ (display-warning
+ '(gptel tool-call)
+ (format "Could not inject updated tool-call arguments for tool call %s, %s"
+ (plist-get tool-call :name)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))))
+
+(cl-defmethod gptel--parse-list ((backend gptel-ollama) prompt-list)
+ (if (consp (car prompt-list))
+ (let ((full-prompt)) ; Advanced format, list of lists
+ (dolist (entry prompt-list)
+ (pcase entry
+ (`(prompt . ,msg)
+ (push (list :role "user" :content (or (car-safe msg) msg))
+ full-prompt))
+ (`(response . ,msg)
+ (push (list :role "assistant" :content (or (car-safe msg) msg))
+ full-prompt))
+ (`(tool . ,call)
+ (push (list :role "assistant"
+ :content ""
+ :tool_calls `[(:function (:name ,(plist-get call :name)
+ :arguments ,(plist-get call :args)))])
+ full-prompt)
+ (push (car (gptel--parse-tool-results backend (list (cdr entry))))
+ full-prompt))))
+ (nreverse full-prompt))
+ (cl-loop for text in prompt-list ; Simple format, list of strings
+ for role = t then (not role)
+ if text collect
+ (list :role (if role "user" "assistant") :content text))))
+
+(cl-defmethod gptel--parse-buffer ((backend gptel-ollama) &optional max-entries)
+ (let ((prompts) (prev-pt (point)))
+ (if (or gptel-mode gptel-track-response)
+ (while (and (or (not max-entries) (>= max-entries 0))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min)))
+ (not (= (point) prev-pt)))
+ (pcase (get-char-property (point) 'gptel)
+ ('response
+ (when-let* ((content (gptel--trim-prefixes
+ (buffer-substring-no-properties (point) prev-pt))))
+ (push (list :role "assistant" :content content) prompts)))
+ (`(tool . ,_id)
+ (save-excursion
+ (condition-case nil
+ (let* ((tool-call (read (current-buffer)))
+ (name (plist-get tool-call :name))
+ (arguments (plist-get tool-call :args)))
+ (plist-put tool-call :result
+ (string-trim (buffer-substring-no-properties
+ (point) prev-pt)))
+ (push (car (gptel--parse-tool-results backend (list tool-call)))
+ prompts)
+ (push (list :role "assistant"
+ :content ""
+ :tool_calls `[(:function (:name ,name :arguments ,arguments))])
+ prompts))
+ ((end-of-file invalid-read-syntax)
+ (message (format "Could not parse tool-call on line %s"
+ (line-number-at-pos (point))))))))
+ ('ignore)
+ ('nil
+ (if gptel-track-media
+ (when-let* ((content (gptel--ollama-parse-multipart
+ (gptel--parse-media-links major-mode (point) prev-pt))))
+ (when (> (length content) 0)
+ (push (append '(:role "user") content) prompts)))
+ (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties
+ (point) prev-pt))))
+ (push (list :role "user" :content content) prompts)))))
+ (setq prev-pt (point))
+ (and max-entries (cl-decf max-entries)))
+ (let ((content (string-trim (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (push (list :role "user" :content content) prompts)))
+ prompts))
+
+(defun gptel--ollama-parse-multipart (parts)
+ "Convert a multipart prompt PARTS to the Ollama API format.
+
+The input is an alist of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\")).
+
+The output is a vector of entries in a backend-appropriate
+format."
+ (cl-loop
+ for part in parts
+ for n upfrom 1
+ with last = (length parts)
+ for text = (plist-get part :text)
+ for media = (plist-get part :media)
+ if text do
+ (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and
+ if text
+ collect text into text-array end
+ else if media
+ collect (gptel--base64-encode media) into media-array
+ else if (plist-get part :textfile)
+ collect
+ (with-temp-buffer
+ (gptel--insert-file-string (plist-get part :textfile))
+ (buffer-string))
+ into text-array
+ finally return
+ `(,@(and text-array (list :content (mapconcat #'identity text-array " ")))
+ ,@(and media-array (list :images (vconcat media-array))))))
+
+(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
+ (name &key curl-args header key models stream request-params
+ (host "localhost:11434")
+ (protocol "http")
+ (endpoint "/api/chat"))
+ "Register an Ollama backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is where Ollama runs (with port), defaults to localhost:11434
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+Currently recognized plist keys are :description, :capabilities
+and :mime-types. An example of a model specification including
+both kinds of specs:
+
+:models
+\\='(mistral:latest ;Simple specs
+ openhermes:latest
+ (llava:13b ;Full spec
+ :description
+ \"Llava 1.6: Large Lanuage and Vision Assistant\"
+ :capabilities (media)
+ :mime-types (\"image/jpeg\" \"image/png\")))
+
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, http by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/api/generate\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key. This is typically not required
+for local models like Ollama.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+ (gptel-make-ollama
+ \"Ollama\"
+ :host \"localhost:11434\"
+ :models \\='(mistral:latest)
+ :stream t)"
+ (declare (indent 1))
+ (let ((backend (gptel--make-ollama
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint)))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+(provide 'gptel-ollama)
+;;; gptel-ollama.el ends here
+
+
--- /dev/null
+;;; gptel-openai-extras.el --- Extensions to the OpenAI API -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Authors: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com> and pirminj
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for Privategpt's Messages API and
+;; Perplexity's Citations feature to gptel
+
+;;; Code:
+(require 'cl-generic)
+(eval-when-compile (require 'cl-lib))
+(require 'map)
+(eval-and-compile
+ (require 'gptel-request)
+ (require 'gptel-openai))
+
+(defvar json-object-type)
+
+(declare-function prop-match-value "text-property-search")
+(declare-function text-property-search-backward "text-property-search")
+(declare-function json-read "json" ())
+
+
+
+;;; Privategpt (Messages API)
+(cl-defstruct (gptel-privategpt (:constructor gptel--make-privategpt)
+ (:copier nil)
+ (:include gptel-openai))
+ context sources)
+
+(defun gptel--privategpt-parse-sources (response)
+ (cl-loop with source-alist
+ for source across (map-nested-elt response '(:choices 0 :sources))
+ for name = (map-nested-elt source '(:document :doc_metadata :file_name))
+ for page = (map-nested-elt source '(:document :doc_metadata :page_label))
+ do (push page (alist-get name source-alist nil nil #'equal))
+ finally return
+ (cl-loop for (file-name . file-pages) in source-alist
+ for pages = (delete-dups (delq nil file-pages))
+ if pages
+ collect (format "- %s (page %s)" file-name (mapconcat #'identity pages ", "))
+ into source-items
+ else collect (format "- %s" file-name) into source-items
+ finally return (mapconcat #'identity (cons "\n\nSources:" source-items) "\n"))))
+
+;; FIXME(tool) add tool use
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-privategpt) info)
+ (let* ((content-strs))
+ (condition-case nil
+ (while (re-search-forward "^data:" nil t)
+ (save-match-data
+ (if (looking-at " *\\[DONE\\]")
+ (when-let* ((sources-string (plist-get info :sources)))
+ (push sources-string content-strs))
+ (let ((response (gptel--json-read)))
+ (unless (or (plist-get info :sources)
+ (not (gptel-privategpt-sources (plist-get info :backend))))
+ (plist-put info :sources (gptel--privategpt-parse-sources response)))
+ (let* ((delta (map-nested-elt response '(:choices 0 :delta)))
+ (content (plist-get delta :content)))
+ (push content content-strs))))))
+ (error
+ (goto-char (match-beginning 0))))
+ (apply #'concat (nreverse content-strs))))
+
+;; FIXME(tool) add tool use
+(cl-defmethod gptel--parse-response ((_backend gptel-privategpt) response info)
+ (let ((response-string (map-nested-elt response '(:choices 0 :message :content)))
+ (sources-string (and (gptel-privategpt-sources (plist-get info :backend))
+ (gptel--privategpt-parse-sources response))))
+ (concat response-string sources-string)))
+
+(cl-defmethod gptel--request-data ((_backend gptel-privategpt) prompts)
+ "JSON encode PROMPTS for sending to ChatGPT."
+ (let ((prompts-plist
+ `(:model ,(gptel--model-name gptel-model)
+ :messages [,@prompts]
+ :use_context ,(or (gptel-privategpt-context gptel-backend) :json-false)
+ :include_sources ,(or (gptel-privategpt-sources gptel-backend) :json-false)
+ :stream ,(or gptel-stream :json-false))))
+ (when (and gptel--system-message
+ (not (gptel--model-capable-p 'nosystem)))
+ (plist-put prompts-plist :system gptel--system-message))
+ (when gptel-temperature
+ (plist-put prompts-plist :temperature gptel-temperature))
+ (when gptel-max-tokens
+ (plist-put prompts-plist :max_tokens gptel-max-tokens))
+ ;; Merge request params with model and backend params.
+ (gptel--merge-plists
+ prompts-plist
+ (gptel-backend-request-params gptel-backend)
+ (gptel--model-request-params gptel-model))))
+
+
+;;;###autoload
+(cl-defun gptel-make-privategpt
+ (name &key curl-args stream key request-params
+ (header
+ (lambda (_info)
+ (when-let* ((key (gptel--get-api-key)))
+ `(("Authorization" . ,(concat "Bearer " key))))))
+ (host "localhost:8001")
+ (protocol "http")
+ (models '(private-gpt))
+ (endpoint "/v1/chat/completions")
+ (context t) (sources t))
+ "Register an Privategpt API-compatible backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, \"api.privategpt.com\" by default.
+
+MODELS is a list of available model names.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/messages\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+((\"Content-Type\" . \"application/json\"))
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+CONTEXT and SOURCES: if true (the default), use available context
+and provide sources used by the model to generate the response.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for."
+ (declare (indent 1))
+ (let ((backend (gptel--make-privategpt
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models models
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint))
+ :context context
+ :sources sources)))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+
+;;; Perplexity
+(cl-defstruct (gptel-perplexity (:constructor gptel--make-perplexity)
+ (:copier nil)
+ (:include gptel-openai)))
+
+(defsubst gptel--perplexity-parse-citations (citations)
+ (let ((counter 0))
+ (concat "\n\nCitations:\n"
+ (mapconcat (lambda (url)
+ (setq counter (1+ counter))
+ (format "[%d] %s" counter url))
+ citations "\n"))))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-perplexity) response _info)
+ "Parse Perplexity response RESPONSE."
+ (let ((response-string (cl-call-next-method))
+ (citations-string (when-let* ((citations (map-elt response :citations)))
+ (gptel--perplexity-parse-citations citations))))
+ (concat response-string citations-string)))
+
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-perplexity) info)
+ "Parse a Perplexity API data stream with INFO.
+
+If available, collect citations at the end and include them with
+the response."
+ (let ((resp (cl-call-next-method)))
+ (unless (plist-get info :citations)
+ (save-excursion
+ (goto-char (point-max))
+ (when (search-backward (plist-get info :uuid)
+ (line-beginning-position) t)
+ (forward-line 0)
+ (when (re-search-backward "^data: " nil t)
+ (goto-char (match-end 0))
+ (ignore-errors
+ (when-let* ((chunk (gptel--json-read))
+ (citations (map-elt chunk :citations)))
+ (plist-put info :citations t)
+ (setq resp (concat resp (gptel--perplexity-parse-citations
+ citations)))))))))
+ resp))
+
+;;;###autoload
+(cl-defun gptel-make-perplexity
+ (name &key curl-args stream key
+ (header
+ (lambda (_info)
+ (when-let* ((key (gptel--get-api-key)))
+ `(("Authorization" . ,(concat "Bearer " key))))))
+ (host "api.perplexity.ai")
+ (protocol "https")
+ ;; https://docs.perplexity.ai/guides/model-cards
+ (models '(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research))
+ (endpoint "/chat/completions")
+ request-params)
+ "Register a Perplexity backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, \"api.perplexity.ai\" by default.
+
+MODELS is a list of available model names.
+
+STREAM is a boolean to toggle streaming responses.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions.
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist.
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters."
+ (declare (indent 1))
+ (let ((backend (gptel--make-perplexity
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models models
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint)))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+;;; Deepseek
+(cl-defstruct (gptel-deepseek (:include gptel-openai)
+ (:copier nil)
+ (:constructor gptel--make-deepseek)))
+
+(cl-defmethod gptel--parse-buffer :around ((_backend gptel-deepseek) _max-entries)
+ "Merge successive prompts in the prompts list that have the same role.
+
+The Deepseek API requires strictly alternating roles (user/assistant) in messages."
+ (let* ((prompts (cl-call-next-method))
+ (index prompts))
+ (prog1 prompts
+ (while index
+ (let ((p1 (car index))
+ (p2 (cadr index))
+ (rest (cdr index)))
+ (when (and p2 (equal (plist-get p1 :role)
+ (plist-get p2 :role)))
+ ;; Blocks to be merged must both be text blocks
+ ;; and not tool calls
+ (when-let* ((content1 (plist-get p1 :content))
+ (content2 (plist-get p2 :content)))
+ (plist-put p1 :content
+ (concat content1 "\n" content2))
+ (setcdr index (cdr rest))))
+ (setq index (cdr index)))))))
+
+;;;###autoload
+(cl-defun gptel-make-deepseek
+ (name &key curl-args stream key request-params
+ (header (lambda (_info)
+ (when-let* ((key (gptel--get-api-key)))
+ `(("Authorization" . ,(concat "Bearer " key))))))
+ (host "api.deepseek.com")
+ (protocol "https")
+ (endpoint "/v1/chat/completions")
+ (models '((deepseek-reasoner
+ :capabilities (tool reasoning)
+ :context-window 128
+ :input-cost 0.28
+ :output-cost 0.42)
+ (deepseek-chat
+ :capabilities (tool)
+ :context-window 128
+ :input-cost 0.28
+ :output-cost 0.42))))
+ "Register a DeepSeek backend for gptel with NAME.
+
+For the meanings of the keyword arguments, see `gptel-make-openai'."
+ (declare (indent 1))
+ (let ((backend (gptel--make-deepseek
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :curl-args curl-args
+ :url (concat protocol "://" host endpoint))))
+ (setf (alist-get name gptel--known-backends nil nil #'equal) backend)
+ backend))
+
+;;; xAI
+;;;###autoload
+(cl-defun gptel-make-xai
+ (name &key curl-args stream key request-params
+ (header (lambda (_info)
+ (when-let* ((key (gptel--get-api-key)))
+ `(("Authorization" . ,(concat "Bearer " key))))))
+ (host "api.x.ai")
+ (protocol "https")
+ (endpoint "/v1/chat/completions")
+ (models
+ '((grok-4-1-fast-reasoning
+ :description "Fast tool-calling model"
+ :capabilities (tool-use json reasoning)
+ :context-window 2000
+ :input-cost 0.2
+ :output-cost 0.5)
+
+ (grok-4-1-fast-non-reasoning
+ :description "Fast tool-calling model (non-reasoning)"
+ :capabilities (tool-use json)
+ :context-window 2000
+ :input-cost 0.2
+ :output-cost 0.5)
+
+ (grok-code-fast-1
+ :description "Fast reasoning model for agentic coding"
+ :capabilities (tool-use json reasoning)
+ :context-window 256
+ :input-cost 0.2
+ :output-cost 1.5)
+
+ (grok-4-fast-reasoning
+ :description "Fast tool-calling model"
+ :capabilities (tool-use json reasoning)
+ :context-window 2000
+ :input-cost 0.2
+ :output-cost 0.5)
+
+ (grok-4-fast-non-reasoning
+ :description "Fast tool-calling model (non-reasoning)"
+ :capabilities (tool-use json)
+ :context-window 2000
+ :input-cost 0.2
+ :output-cost 0.5)
+
+ (grok-4
+ :description "Grok Flagship model"
+ :capabilities (tool-use json reasoning)
+ :context-window 256
+ :input-cost 3
+ :output-cost 15)
+
+ (grok-3-mini
+ :description "Mini Grok 3"
+ :capabilities (tool-use json reasoning)
+ :context-window 131
+ :input-cost 0.3
+ :output-cost 0.5)
+
+ (grok-3
+ :description "Grok 3"
+ :capabilities (tool-use json reasoning)
+ :context-window 131
+ :input-cost 3
+ :output-cost 15)
+
+ (grok-2-vision-1212
+ :description "Grok 2 Vision"
+ :capabilities (tool-use json media)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 32
+ :input-cost 2
+ :output-cost 10))))
+ "Register an xAI backend for gptel with NAME.
+
+Keyword arguments:
+
+KEY is a variable whose value is the API key, or function that
+returns the key.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+The other keyword arguments are all optional. For their meanings
+see `gptel-make-openai'."
+ (declare (indent 1))
+ (let ((backend (gptel--make-deepseek
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :curl-args curl-args
+ :url (concat protocol "://" host endpoint))))
+ (setf (alist-get name gptel--known-backends nil nil #'equal) backend)
+ backend))
+
+
+(provide 'gptel-openai-extras)
+;;; gptel-openai-extras.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-openai-responses.el --- Responses API support for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: comm
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+(require 'cl-generic)
+(require 'cl-lib)
+(require 'map)
+(require 'gptel-request)
+(require 'gptel-openai)
+
+(defvar gptel-mode)
+(declare-function gptel-context--collect-media "gptel-context")
+
+;;; OpenAI Responses
+(defun gptel--openai-responses-update-tokens (usage info)
+ "Update token usage information from USAGE.
+USAGE is part of the response, INFO is the request plist."
+ (when usage
+ (let* ((tokens (plist-get info :tokens))
+ (input (+ (or (plist-get usage :input_tokens) 0)
+ (or (plist-get tokens :input) 0)))
+ (output (+ (or (plist-get usage :output_tokens) 0)
+ (or (plist-get tokens :output) 0)))
+ (cached (+ (or (map-nested-elt
+ usage '(:input_tokens_details :cached_tokens))
+ 0)
+ (or (plist-get tokens :cached) 0))))
+ (list :input input :output output :cached cached))))
+
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-openai-responses) info)
+ "Parse an OpenAI Responses API data stream.
+
+Return the text response accumulated since the last call to this
+function. Additionally, mutate state INFO to add tool-use
+information if the stream contains it."
+ (let ((content-strs) wait)
+ (condition-case nil
+ (while (and (not wait) (re-search-forward "^event: *\\(.+\\)" nil t))
+ (let ((event-type (match-string 1)) data)
+ (forward-line 1)
+ (if (not (looking-at "data:" t))
+ (progn (goto-char (match-beginning 0)) ;not enough data, reset
+ (setq wait t))
+ (forward-char 5)
+ (setq data (gptel--json-read))
+ (pcase event-type
+ ;; Text content delta
+ ("response.output_text.delta"
+ (when-let* ((delta (plist-get data :delta))
+ ((not (string-empty-p delta))))
+ (push delta content-strs)))
+ ;; Function call arguments delta
+ ("response.function_call_arguments.delta"
+ (when-let* ((delta (plist-get data :delta)))
+ (plist-put info :partial_json
+ (cons delta (plist-get info :partial_json)))))
+ ;; Function call completed (user-defined tools)
+ ("response.output_item.done"
+ (when-let* ((item (plist-get data :item))
+ ((equal (plist-get item :type) "function_call"))
+ (tool-call
+ (list :id (plist-get item :call_id)
+ :name (plist-get item :name)
+ :args (ignore-errors
+ (gptel--json-read-string
+ (plist-get item :arguments))))))
+ (plist-put info :tool-use
+ (cons tool-call (plist-get info :tool-use)))
+ (plist-put info :partial_json nil)))
+ ;; Reasoning content
+ ((or "response.reasoning_summary_text.delta"
+ "response.reasoning.delta")
+ (when-let* ((delta (plist-get data :delta)))
+ (plist-put info :reasoning
+ (concat (plist-get info :reasoning) delta))))
+ ((or "response.reasoning_summary_text.done"
+ "response.reasoning.done")
+ (plist-put info :reasoning-block t))
+ ;; NOTE: backend tools are not supported in gptel yet, this
+ ;; parsing is for the future
+ ;; Web search completed (server-side tool)
+ ("response.web_search_call.completed"
+ (push "\n[Web search completed]" content-strs))
+ ;; Code interpreter output (server-side tool)
+ ("response.code_interpreter_call.completed"
+ (when-let* ((item (plist-get data :item))
+ (results (plist-get item :results)))
+ (cl-loop
+ for result across results
+ if (equal (plist-get result :type) "logs")
+ do (push (format "\n```\n%s\n```" (plist-get result :logs))
+ content-strs))))
+ ;; Response completed
+ ("response.completed"
+ (when-let* ((tool-use (plist-get info :tool-use)))
+ ;; Inject tool calls into prompt data for continuation
+ ;; TODO(responses-api) Avoid re-encoding these tool calls,
+ ;; especially :arguments
+ (gptel--inject-prompt
+ (plist-get info :backend) (plist-get info :data)
+ (mapcar (lambda (tc)
+ (list :type "function_call"
+ :call_id (plist-get tc :id)
+ :name (plist-get tc :name)
+ :arguments
+ (gptel--json-encode (plist-get tc :args))))
+ tool-use)))
+ (when-let* ((resp (plist-get data :response)))
+ (plist-put info :stop-reason (plist-get resp :status))
+ (plist-put info :tokens (gptel--openai-responses-update-tokens
+ (plist-get resp :usage) info))))))))
+ (error (goto-char (match-beginning 0))))
+ (apply #'concat (nreverse content-strs))))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-openai-responses) response info)
+ "Parse an OpenAI Responses API RESPONSE and return response text.
+Mutate state INFO with response metadata."
+ (let ((output-items (plist-get response :output))
+ (content-strs) (tool-use) (tool-calls))
+ ;; Store usage info
+ (plist-put info :stop-reason (plist-get response :status))
+ (plist-put info :tokens (gptel--openai-responses-update-tokens
+ (plist-get response :usage) info))
+ ;; Process output items
+ (cl-loop
+ for item across output-items
+ for item-type = (plist-get item :type)
+ do
+ (pcase item-type
+ ;; Text message output
+ ("message"
+ (when-let* ((content (plist-get item :content)))
+ (cl-loop
+ for part across content
+ for part-type = (plist-get part :type)
+ if (equal part-type "output_text")
+ do (push (plist-get part :text) content-strs)
+ else if (equal part-type "refusal")
+ do (push (format "[Refused: %s]" (plist-get part :refusal))
+ content-strs))))
+ ;; Function call from model (user-defined tools)
+ ("function_call"
+ (push item tool-calls)
+ (push (list :id (plist-get item :call_id)
+ :name (plist-get item :name)
+ :args (ignore-errors
+ (gptel--json-read-string
+ (plist-get item :arguments))))
+ tool-use))
+ ;; Reasoning summary
+ ("reasoning"
+ (cl-loop with summary = (plist-get item :summary)
+ with content = (plist-get item :content)
+ for s across
+ (if (length= content 0) summary content)
+ collect (plist-get s :text) into reasoning
+ finally do
+ (plist-put info :reasoning (apply #'concat reasoning))))
+ ;; Web search results (server-side tool)
+ ("web_search_call"
+ (when-let* ((status (plist-get item :status))
+ ((equal status "completed")))
+ ;; Results are inline, just note that search was done
+ (push "\n[Web search completed]" content-strs)))
+ ;; Code interpreter output (server-side tool)
+ ("code_interpreter_call"
+ (when-let* ((status (plist-get item :status))
+ ((equal status "completed"))
+ (results (plist-get item :results)))
+ (cl-loop
+ for result across results
+ for result-type = (plist-get result :type)
+ if (equal result-type "logs")
+ do (push (format "\n```\n%s\n```" (plist-get result :logs))
+ content-strs))))
+ ;; File search results (server-side tool)
+ ("file_search_call"
+ (when-let* ((status (plist-get item :status))
+ ((equal status "completed"))
+ (results (plist-get item :results)))
+ (push (format "\n[File search: %d results]" (length results))
+ content-strs)))))
+ ;; Store tool calls for user-defined function tools
+ (when tool-use
+ (plist-put info :tool-use (nreverse tool-use))
+ ;; Inject into prompts for conversation continuity
+ (gptel--inject-prompt
+ (plist-get info :backend) (plist-get info :data)
+ (nreverse tool-calls)))
+ ;; Return concatenated content
+ (when content-strs
+ (apply #'concat (nreverse content-strs)))))
+
+(cl-defmethod gptel--request-data ((backend gptel-openai-responses) prompts)
+ "JSON encode PROMPTS for sending to OpenAI Responses API."
+ (let ((prompts-plist
+ `( :model ,(gptel--model-name gptel-model)
+ :input ,(vconcat prompts)
+ ;; Stateless: don't store responses server-side, don't use
+ ;; previous_response_id. Each request contains full context.
+ :store :json-false
+ :stream ,(or gptel-stream :json-false)))
+ (o-model-p (memq gptel-model '(o1 o1-preview o1-mini o3-mini o3 o4-mini))))
+ ;; System message becomes instructions
+ (when gptel--system-message
+ (plist-put prompts-plist :instructions gptel--system-message))
+ ;; Temperature
+ (when (and gptel-temperature (not o-model-p))
+ (plist-put prompts-plist :temperature gptel-temperature))
+ ;; Max tokens
+ (when gptel-max-tokens
+ (plist-put prompts-plist :max_output_tokens gptel-max-tokens))
+ (when gptel-use-tools
+ (let ((tools-array
+ (vconcat
+ (when gptel-tools
+ (gptel--parse-tools backend gptel-tools)))))
+ (when (> (length tools-array) 0)
+ (plist-put prompts-plist :tools tools-array))
+ (when (eq gptel-use-tools 'force)
+ (plist-put prompts-plist :tool_choice "required"))))
+ ;; Structured output via text format
+ (when gptel--schema
+ (plist-put prompts-plist :text
+ (list :format
+ (list :type "json_schema"
+ :name (md5 (format "%s" (random)))
+ :schema (gptel--preprocess-schema
+ (gptel--dispatch-schema-type gptel--schema))
+ :strict t))))
+ ;; Merge request params
+ (gptel--merge-plists
+ prompts-plist
+ gptel--request-params
+ (gptel-backend-request-params gptel-backend)
+ (gptel--model-request-params gptel-model))))
+
+;; Helper functions for Responses API format conversion
+
+(cl-defmethod gptel--parse-schema ((_backend gptel-openai-responses) schema)
+ "Parse SCHEMA for Responses API structured output.
+In Responses API, the schema format uses text.format instead of response_format."
+ (list :type "json_schema"
+ :name (md5 (format "%s" (random)))
+ :schema (gptel--preprocess-schema
+ (gptel--dispatch-schema-type schema))
+ :strict t))
+
+(cl-defmethod gptel--parse-tools ((_backend gptel-openai-responses) tools)
+ "Parse TOOLS and return a list of prompts.
+
+TOOLS is a list of `gptel-tool' structs, which see.
+
+_BACKEND is the LLM backend in use. This is the default
+implementation, used by OpenAI-compatible APIs and Ollama."
+ (vconcat
+ (mapcar
+ (lambda (tool)
+ (nconc
+ (list
+ :type "function"
+ :name (gptel-tool-name tool)
+ :description (gptel-tool-description tool))
+ (if (gptel-tool-args tool)
+ (list
+ :parameters
+ (list :type "object"
+ ;; gptel's tool args spec is close to the JSON schema, except
+ ;; that we use (:name "argname" ...)
+ ;; instead of (:argname (...)), and
+ ;; (:optional t) for each arg instead of (:required [...])
+ ;; for all args at once. Handle this difference by
+ ;; modifying a copy of the gptel tool arg spec.
+ :properties
+ (cl-loop
+ for arg in (gptel-tool-args tool)
+ for argspec = (copy-sequence arg)
+ for name = (plist-get arg :name) ;handled differently
+ for newname = (or (and (keywordp name) name)
+ (make-symbol (concat ":" name)))
+ do ;ARGSPEC is ARG without unrecognized keys
+ (cl-remf argspec :name)
+ (cl-remf argspec :optional)
+ if (equal (plist-get arg :type) "object")
+ do (unless (plist-member argspec :required)
+ (plist-put argspec :required []))
+ (plist-put argspec :additionalProperties :json-false)
+ append (list newname argspec))
+ :required
+ (vconcat
+ (delq nil (mapcar
+ (lambda (arg) (and (not (plist-get arg :optional))
+ (plist-get arg :name)))
+ (gptel-tool-args tool))))
+ :additionalProperties :json-false))
+ (list :parameters (list :type "object" :properties nil)))))
+ (ensure-list tools))))
+
+(cl-defmethod gptel--inject-tool-call ((_backend gptel-openai-responses) data tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+BACKEND is the `gptel-backend'. See the generic function documentation
+for details. This implementation handles the OpenAI Responses API."
+ (if-let* ((input (plist-get data :input))
+ (indexed-call
+ (cl-loop for item across input
+ for i upfrom 0
+ if (and (equal (plist-get item :type) "function_call")
+ (equal (plist-get item :call_id) (plist-get tool-call :id)))
+ return (cons i item)))
+ (index (car indexed-call))
+ (call (cdr indexed-call)))
+ (if (null new-call) ;delete tool call if new-call is nil
+ (plist-put data :input (vconcat (substring input 0 index)
+ (substring input (1+ index))))
+ (progn
+ (when-let* ((args (plist-get new-call :args)))
+ (plist-put call :arguments (gptel--json-encode args)))
+ (when-let* ((name (plist-get new-call :name)))
+ (plist-put call :name name))))
+ (display-warning
+ '(gptel tool-call)
+ (format "Could not inject updated tool-call arguments for tool call %s, %s"
+ (plist-get tool-call :name)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))))
+
+(cl-defmethod gptel--parse-tool-results ((_backend gptel-openai-responses) tool-use)
+ "Format TOOL-USE results for Responses API.
+Returns prompts in Responses API format with function_call_output items."
+ (mapcar
+ (lambda (tool-call)
+ (list
+ :type "function_call_output"
+ :call_id (plist-get tool-call :id)
+ :output (plist-get tool-call :result)))
+ tool-use))
+
+(cl-defmethod gptel--inject-prompt
+ ((_backend gptel-openai-responses) data new-prompt &optional position)
+ "Inject NEW-PROMPT into existing prompts in query DATA.
+
+NEW-PROMPT can be a single message or a list of messages.
+
+If POSITION is
+- nil, append NEW-PROMPT at the end of DATA
+- a non-negative integer, insert it at that position in DATA.
+- a negative integer, insert it there counting from the end."
+ (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many?
+ (setq new-prompt (list new-prompt)))
+ (let ((prompts (plist-get data :input)))
+ (pcase position
+ ('nil (plist-put data :input (vconcat prompts new-prompt)))
+ ((pred integerp)
+ (when (< position 0) (setq position (+ (length prompts) position)))
+ (plist-put data :input (vconcat (substring prompts 0 position)
+ new-prompt
+ (substring prompts position)))))))
+
+(cl-defmethod gptel--parse-list ((backend gptel-openai-responses) prompt-list)
+ (if (consp (car prompt-list))
+ (let ((full-prompt)) ; Advanced format, list of lists
+ (dolist (entry prompt-list)
+ (pcase entry
+ (`(prompt . ,msg)
+ (push (list :role "user" :content (or (car-safe msg) msg)) full-prompt))
+ (`(response . ,msg)
+ (push (list :role "assistant" :content (or (car-safe msg) msg)) full-prompt))
+ (`(tool . ,call)
+ (unless (plist-get call :id)
+ (plist-put call :id (gptel--openai-format-tool-id nil)))
+ (push
+ (list :type "function_call"
+ :call_id (plist-get call :id)
+ :name (plist-get call :name)
+ :arguments (decode-coding-string
+ (gptel--json-encode (plist-get call :args))
+ 'utf-8 t))
+ full-prompt)
+ (push (car (gptel--parse-tool-results backend (list (cdr entry)))) full-prompt))))
+ (nreverse full-prompt))
+ (cl-loop for text in prompt-list ; Simple format, list of strings
+ for role = t then (not role)
+ if text collect
+ (list :role (if role "user" "assistant") :content text))))
+
+(cl-defmethod gptel--parse-buffer ((backend gptel-openai-responses) &optional max-entries)
+ (let ((prompts) (prev-pt (point)))
+ (if (or gptel-mode gptel-track-response)
+ (while (and (or (not max-entries) (>= max-entries 0))
+ (/= prev-pt (point-min))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min))))
+ (pcase (get-char-property (point) 'gptel)
+ ('response
+ (when-let* ((content (gptel--trim-prefixes
+ (buffer-substring-no-properties (point) prev-pt))))
+ (push (list :role "assistant" :content content) prompts)))
+ (`(tool . ,id)
+ (save-excursion
+ (condition-case nil
+ (let* ((tool-call (read (current-buffer)))
+ (name (plist-get tool-call :name))
+ (arguments (decode-coding-string
+ (gptel--json-encode (plist-get tool-call :args))
+ 'utf-8 t)))
+ (setq id (gptel--openai-format-tool-id id))
+ (plist-put tool-call :id id)
+ (plist-put tool-call :result
+ (string-trim (buffer-substring-no-properties
+ (point) prev-pt)))
+ (push (car (gptel--parse-tool-results backend (list tool-call)))
+ prompts)
+ (push (list :type "function_call"
+ :call_id id
+ :name name
+ :arguments arguments)
+ prompts))
+ ((end-of-file invalid-read-syntax)
+ (message (format "Could not parse tool-call %s on line %s"
+ id (line-number-at-pos (point))))))))
+ ('ignore)
+ ('nil
+ (and max-entries (cl-decf max-entries))
+ (if gptel-track-media
+ (when-let* ((content (gptel--openai-responses-parse-multipart
+ (gptel--parse-media-links major-mode
+ (point) prev-pt))))
+ (when (> (length content) 0)
+ (push (list :role "user" :content content) prompts)))
+ (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties
+ (point) prev-pt))))
+ (push (list :role "user" :content content) prompts)))))
+ (setq prev-pt (point)))
+ (let ((content (string-trim (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (push (list :role "user" :content content) prompts)))
+ prompts))
+
+(defun gptel--openai-responses-parse-multipart (parts)
+ "Convert a multipart prompt PARTS to the OpenAI API format.
+
+The input is an alist of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\")).
+
+The output is a vector of entries in a backend-appropriate
+format."
+ (cl-loop
+ for part in parts
+ for n upfrom 1
+ with last = (length parts)
+ for text = (plist-get part :text)
+ for media = (plist-get part :media)
+ if text do
+ (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text)))
+ and if text
+ collect `(:type "input_text" :text ,text) into parts-array end
+ else if media collect
+ `(:type "input_image"
+ :image_url ,(concat "data:" (plist-get part :mime)
+ ";base64," (gptel--base64-encode media)))
+ into parts-array
+ else if (plist-get part :textfile) collect
+ `(:type "input_text"
+ :text ,(with-temp-buffer
+ (gptel--insert-file-string (plist-get part :textfile))
+ (buffer-string)))
+ into parts-array end and
+ if (plist-get part :url)
+ collect
+ `(:type "input_image"
+ :image_url ,(plist-get part :url))
+ into parts-array
+ finally return (vconcat parts-array)))
+
+(cl-defmethod gptel--inject-media ((_backend gptel-openai-responses) 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)
+ (vconcat
+ (gptel--openai-responses-parse-multipart media-list)
+ (cl-typecase current
+ (string `((:type "input_text" :text ,current)))
+ (vector current)
+ (t current))))
+ (plist-get (car prompts) :content))))
+
+;;;###autoload
+(cl-defun gptel-make-openai-responses
+ (name &key curl-args (models gptel--openai-models)
+ stream key request-params
+ (header
+ (lambda (_info) (when-let* ((key (gptel--get-api-key)))
+ `(("Authorization" . ,(concat "Bearer " key))))))
+ (host "api.openai.com")
+ (protocol "https")
+ (endpoint "/v1/responses"))
+ "Register an OpenAI Responses API backend for gptel with NAME.
+
+The Responses API is OpenAI's new API for agentic applications that
+provides built-in tools like web search, code interpreter, and file
+search.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, typically \"api.openai.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--openai-models'.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/responses\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+ (gptel-make-openai-responses
+ \"OpenAI-Responses\"
+ :stream t
+ :models '((gpt-4o
+ :capabilities (media tool-use json url responses-api)
+ :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))
+ (gpt-4o-mini
+ :capabilities (media tool-use json url responses-api)
+ :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))))"
+ (declare (indent 1))
+ (let ((backend (gptel--make-openai-responses
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint)))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+(provide 'gptel-openai-responses)
+;;; gptel-openai-responses.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-openai.el --- ChatGPT suppport for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds support for the ChatGPT API to gptel
+
+;;; Code:
+(require 'cl-generic)
+(eval-when-compile (require 'cl-lib))
+(require 'map)
+(eval-and-compile (require 'gptel-request))
+
+(defvar json-object-type)
+(defvar gptel-mode)
+(declare-function gptel-context--collect-media "gptel-context")
+(declare-function json-read "json")
+(declare-function gptel-context--wrap "gptel-context")
+
+;; OpenAI Completions Backend
+(cl-defstruct (gptel-openai (:constructor gptel--make-openai)
+ (:copier nil)
+ (:include gptel-backend)))
+
+;; OpenAI Responses Backend
+(cl-defstruct (gptel-openai-responses (:constructor gptel--make-openai-responses)
+ (:copier nil)
+ (:include gptel-backend)))
+
+
+(defun gptel--openai-update-tokens (usage info)
+ "Update token usage information from USAGE.
+USAGE is part of the response, INFO is the request plist.
+
+This function accumulates token counts across multiple turns in a
+multi-turn request (e.g., during tool use where results are fed
+back to the LLM)."
+ (when usage
+ (let* ((tokens (plist-get info :tokens))
+ (input (+ (or (plist-get usage :prompt_tokens) 0)
+ (or (plist-get tokens :input) 0)))
+ (output (+ (or (plist-get usage :completion_tokens) 0)
+ (or (plist-get tokens :output) 0)))
+ (cached (+ (or (map-nested-elt
+ usage '(:prompt_tokens_details :cached_tokens))
+ 0)
+ (or (plist-get tokens :cached) 0)))
+ (cache (+ (or (plist-get usage :prompt_cache_hit_tokens) 0)
+ (or (plist-get tokens :cache) 0))))
+ (list :input input :output output
+ :cache cache :cached cached))))
+
+;; How the following function works:
+;;
+;; The OpenAI API returns a stream of data chunks. Each data chunk has a
+;; component that can be parsed as JSON. Besides metadata, each chunk has
+;; either some text or part of a tool call.
+;;
+;; If we find text, we collect it in a list, concat them at the end and return
+;; it.
+;;
+;; If we find part of a tool call, we begin collecting the pieces in
+;; INFO -> :tool-use.
+;;
+;; Tool call arguments are themselves JSON encoded strings can be spread across
+;; chunks. We collect them in INFO -> :partial_json. The end of a tool call
+;; chunk is marked by the beginning of another, or by the end of the stream. In
+;; either case we flaten the :partial_json we have thus far, add it to the tool
+;; call spec in :tool-use and reset it.
+;;
+;; If we find reasoning text, collect it in INFO -> :reasoning, to be consumed
+;; by the stream filter (and eventually the callback). We also collect it in
+;; INFO -> :reasoning-chunks, in case we need to send it back along with tool
+;; call results.
+;;
+;; Finally we append any tool calls and accumulated reasoning text (from
+;; :reasoning-chunks) to the (INFO -> :data -> :messages) list of prompts.
+
+(cl-defmethod gptel-curl--parse-stream ((_backend gptel-openai) info)
+ "Parse an OpenAI API data stream.
+
+Return the text response accumulated since the last call to this
+function. Additionally, mutate state INFO to add tool-use
+information if the stream contains it."
+ (let* ((content-strs))
+ (condition-case nil
+ (while (re-search-forward "^data:" nil t)
+ (save-match-data
+ (if (looking-at " *\\[DONE\\]")
+ ;; The stream has ended, so we do the following thing (if we found tool calls)
+ ;; - pack tool calls into the messages prompts list to send (INFO -> :data -> :messages)
+ ;; - collect tool calls (formatted differently) into (INFO -> :tool-use)
+ ;; - Clear any reasoning content chunks we've captured
+ (progn
+ (when-let* ((tool-use (plist-get info :tool-use))
+ (args (apply #'concat (nreverse (plist-get info :partial_json))))
+ (func (plist-get (car tool-use) :function)))
+ (plist-put func :arguments args) ;Update arguments for last recorded tool
+ (gptel--inject-prompt
+ (plist-get info :backend) (plist-get info :data)
+ `( :role "assistant" :content :null :tool_calls ,(vconcat tool-use) ; :refusal :null
+ ;; Return reasoning if available
+ ,@(and-let* ((chunks (nreverse (plist-get info :reasoning-chunks)))
+ (reasoning-field (pop chunks))) ;chunks is (:reasoning.* "chunk1" "chunk2" ...)
+ (list reasoning-field (apply #'concat chunks)))))
+ (cl-loop
+ for tool-call in tool-use ; Construct the call specs for running the function calls
+ for spec = (plist-get tool-call :function)
+ collect (list :id (plist-get tool-call :id)
+ :name (plist-get spec :name)
+ :args (ignore-errors (gptel--json-read-string
+ (plist-get spec :arguments))))
+ into call-specs
+ finally (plist-put info :tool-use call-specs)))
+ ;; Update token usage if present
+ (when-let* ((last-resp (save-excursion
+ (forward-line -1)
+ (and (re-search-backward "^data:" nil t)
+ (goto-char (match-end 0))
+ (ignore-errors (gptel--json-read)))))
+ (usage (plist-get last-resp :usage)))
+ (plist-put info :tokens (gptel--openai-update-tokens usage info)))
+ (when (plist-member info :reasoning-chunks) (plist-put info :reasoning-chunks nil)))
+ (when-let* ((response (gptel--json-read))
+ (delta (map-nested-elt response '(:choices 0 :delta))))
+ (if-let* ((content (plist-get delta :content))
+ ((not (or (eq content :null) (string-empty-p content)))))
+ (push content content-strs)
+ ;; No text content, so look for tool calls
+ (when-let* ((tool-call (map-nested-elt delta '(:tool_calls 0)))
+ (func (plist-get tool-call :function)))
+ (if (and-let* ((func-name (plist-get func :name)) ((not (eq func-name :null))))
+ ;; TEMP: This check is for litellm compatibility, should be removed
+ (not (equal func-name "null"))) ; new tool block begins
+ (progn
+ (when-let* ((partial (plist-get info :partial_json)))
+ (let* ((prev-tool-call (car (plist-get info :tool-use)))
+ (prev-func (plist-get prev-tool-call :function)))
+ (plist-put prev-func :arguments ;update args for old tool block
+ (apply #'concat (nreverse (plist-get info :partial_json)))))
+ (plist-put info :partial_json nil)) ;clear out finished chain of partial args
+ ;; Start new chain of partial argument strings
+ (plist-put info :partial_json (list (plist-get func :arguments)))
+ ;; NOTE: Do NOT use `push' for this, it prepends and we lose the reference
+ (plist-put info :tool-use (cons tool-call (plist-get info :tool-use))))
+ ;; old tool block continues, so continue collecting arguments in :partial_json
+ (push (plist-get func :arguments) (plist-get info :partial_json)))))
+ ;; Check for reasoning blocks, currently only used by Openrouter
+ (unless (eq (plist-get info :reasoning-block) 'done)
+ (if-let* ((reasoning-plist ;reasoning-plist is (:reasoning.* "chunk" ...) or nil
+ (or (plist-member delta :reasoning) ;for Openrouter and co
+ (plist-member delta :reasoning_content))) ;for Deepseek, Llama.cpp
+ (reasoning-chunk (cadr reasoning-plist))
+ ((not (or (eq reasoning-chunk :null) (string-empty-p reasoning-chunk)))))
+ (progn (plist-put info :reasoning ;For stream filter consumption
+ (concat (plist-get info :reasoning) reasoning-chunk))
+ (plist-put info :reasoning-chunks ;To include with tool call results, if any
+ (cons reasoning-chunk (or (plist-get info :reasoning-chunks)
+ (list (car reasoning-plist))))))
+ ;; Done with reasoning if we get non-empty content
+ (if-let* (((plist-member info :reasoning)) ;Is this a reasoning model?
+ (c (plist-get delta :content)) ;Started receiving text content?
+ ((not (or (eq c :null) (string-blank-p c)))))
+ (plist-put info :reasoning-block t)))))))) ;Signal end of reasoning block
+ (error (goto-char (match-beginning 0))))
+ (apply #'concat (nreverse content-strs))))
+
+(cl-defmethod gptel--parse-response ((_backend gptel-openai) response info)
+ "Parse an OpenAI (non-streaming) RESPONSE and return response text.
+
+Mutate state INFO with response metadata."
+ (let* ((choice0 (map-nested-elt response '(:choices 0)))
+ (message (plist-get choice0 :message))
+ (content (plist-get message :content)))
+ (plist-put info :stop-reason
+ (plist-get choice0 :finish_reason))
+ (plist-put info :tokens (gptel--openai-update-tokens
+ (map-nested-elt response '(:usage)) info))
+ ;; OpenAI returns either non-blank text content or a tool call, not both.
+ ;; However OpenAI-compatible APIs like llama.cpp can include both (#819), so
+ ;; we check for both tool calls and responses independently.
+ (when-let* ((tool-calls (plist-get message :tool_calls))
+ ((not (eq tool-calls :null))))
+ (gptel--inject-prompt ; First add the tool call to the prompts list
+ (plist-get info :backend) (plist-get info :data) message)
+ (cl-loop ;Then capture the tool call data for running the tool
+ for tool-call across tool-calls ;replace ":arguments" with ":args"
+ for call-spec = (copy-sequence (plist-get tool-call :function))
+ do (ignore-errors (plist-put call-spec :args
+ (gptel--json-read-string
+ (plist-get call-spec :arguments))))
+ (plist-put call-spec :arguments nil)
+ (plist-put call-spec :id (plist-get tool-call :id))
+ collect call-spec into tool-use
+ finally (plist-put info :tool-use tool-use)))
+ (when-let* ((reasoning (or (plist-get message :reasoning) ;for Openrouter and co
+ (plist-get message :reasoning_content))) ;for Deepseek, Llama.cpp
+ ((and (stringp reasoning) (not (string-empty-p reasoning)))))
+ (plist-put info :reasoning reasoning))
+ (when (and content (not (or (eq content :null) (string-empty-p content))))
+ content)))
+
+(cl-defmethod gptel--request-data ((backend gptel-openai) prompts)
+ "JSON encode PROMPTS for sending to ChatGPT."
+ (when gptel--system-message
+ (push (list :role "system"
+ :content gptel--system-message)
+ prompts))
+ (let ((prompts-plist
+ (list :model (gptel--model-name gptel-model)
+ :messages (vconcat prompts)
+ :stream (or gptel-stream :json-false))))
+ (when gptel-stream
+ (plist-put prompts-plist :stream_options '(:include_usage t)))
+ (when gptel-temperature
+ (plist-put prompts-plist :temperature gptel-temperature))
+ (when gptel-use-tools
+ (when (eq gptel-use-tools 'force)
+ (plist-put prompts-plist :tool_choice "required"))
+ (when gptel-tools
+ (plist-put prompts-plist :tools
+ (gptel--parse-tools backend gptel-tools))
+ (plist-put prompts-plist :parallel_tool_calls t)))
+ (when gptel-max-tokens
+ ;; HACK: The OpenAI API has deprecated max_tokens, but we still need it
+ ;; for OpenAI-compatible APIs like GPT4All (#485)
+ (plist-put prompts-plist :max_tokens gptel-max-tokens))
+ (when gptel--schema
+ (plist-put prompts-plist
+ :response_format (gptel--parse-schema backend gptel--schema)))
+ ;; Merge request params with model and backend params.
+ (gptel--merge-plists
+ prompts-plist
+ gptel--request-params
+ (gptel-backend-request-params gptel-backend)
+ (gptel--model-request-params gptel-model))))
+
+(cl-defmethod gptel--parse-schema ((_backend gptel-openai) schema)
+ (list :type "json_schema"
+ :json_schema
+ (list :name (md5 (format "%s" (random)))
+ :schema (gptel--preprocess-schema
+ (gptel--dispatch-schema-type schema))
+ :strict t)))
+
+;; NOTE: No `gptel--parse-tools' method required for gptel-openai, since this is
+;; handled by its defgeneric implementation
+
+(cl-defmethod gptel--inject-tool-call ((_backend gptel-openai) data tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+BACKEND is the `gptel-backend'. See the generic function documentation
+for details. This implementation handles the OpenAI-compatible
+Completions API."
+ ;; FIXME: We currently assume that the tool call being modified is in the last
+ ;; position in the messages array.
+ (if-let* ((messages (plist-get data :messages))
+ (entry (aref messages (1- (length messages))))
+ (calls (plist-get entry :tool_calls))
+ (id (plist-get tool-call :id))
+ (indexed-call
+ (cl-loop for chunk across calls
+ for i upfrom 0
+ if (equal (plist-get chunk :id) id)
+ return (cons i (plist-get chunk :function))
+ finally return nil))
+ (index (car indexed-call))
+ (call (cdr indexed-call)))
+ (if (null new-call) ;delete tool call if new-call is nil
+ (if (= (length calls) 1) ;only tool call, delete message entirely
+ (plist-put data :messages (substring messages nil -1))
+ ;; delete new-call selectively from parallel tool calls
+ (plist-put entry :tool_calls
+ (vconcat (substring calls 0 index)
+ (substring calls (1+ index)))))
+ (when-let* ((args (plist-get new-call :args)))
+ (plist-put call :arguments (gptel--json-encode args)))
+ (when-let* ((name (plist-get new-call :name)))
+ (plist-put call :name name)))
+ (display-warning
+ '(gptel tool-call)
+ (format "Could not inject updated tool-call arguments for tool call %s, %s"
+ (plist-get tool-call :name)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))))
+
+(cl-defmethod gptel--parse-tool-results ((_backend gptel-openai) tool-use)
+ "Return a prompt containing tool call results in TOOL-USE."
+ ;; (declare (side-effect-free t))
+ (mapcar
+ (lambda (tool-call)
+ (list
+ :role "tool"
+ :tool_call_id (plist-get tool-call :id)
+ :content (plist-get tool-call :result)))
+ tool-use))
+
+;; TODO: Remove these functions (#792)
+(defun gptel--openai-format-tool-id (tool-id)
+ "Format TOOL-ID for OpenAI.
+
+If the ID has the format used by a different backend, use as-is."
+ (unless tool-id
+ (setq tool-id (substring
+ (md5 (format "%s%s" (random) (float-time)))
+ nil 24)))
+ (if (or (string-prefix-p "toolu_" tool-id) ;#747
+ (string-prefix-p "call_" tool-id))
+ tool-id
+ (format "call_%s" tool-id)))
+
+(defun gptel--openai-unformat-tool-id (tool-id)
+ "Return the raw tool ID for TOOL-ID."
+ (or (and (string-match "call_\\(.+\\)" tool-id)
+ (match-string 1 tool-id))
+ tool-id))
+
+;; NOTE: No `gptel--inject-prompt' method required for gptel-openai, since this
+;; is handled by its defgeneric implementation
+
+(cl-defmethod gptel--parse-list ((backend gptel-openai) prompt-list)
+ (if (consp (car prompt-list))
+ (let ((full-prompt)) ; Advanced format, list of lists
+ (dolist (entry prompt-list)
+ (pcase entry
+ (`(prompt . ,msg)
+ (push (list :role "user" :content (or (car-safe msg) msg)) full-prompt))
+ (`(response . ,msg)
+ (push (list :role "assistant" :content (or (car-safe msg) msg)) full-prompt))
+ (`(tool . ,call)
+ (unless (plist-get call :id)
+ (plist-put call :id (gptel--openai-format-tool-id nil)))
+ (push
+ (list
+ :role "assistant"
+ :tool_calls
+ (vector
+ (list :type "function"
+ :id (plist-get call :id)
+ :function `( :name ,(plist-get call :name)
+ :arguments ,(decode-coding-string
+ (gptel--json-encode (plist-get call :args))
+ 'utf-8 t)))))
+ full-prompt)
+ (push (car (gptel--parse-tool-results backend (list (cdr entry)))) full-prompt))))
+ (nreverse full-prompt))
+ (cl-loop for text in prompt-list ; Simple format, list of strings
+ for role = t then (not role)
+ if text collect
+ (list :role (if role "user" "assistant") :content text))))
+
+(cl-defmethod gptel--parse-buffer ((backend gptel-openai) &optional max-entries)
+ (let ((prompts) (prev-pt (point)))
+ (if (or gptel-mode gptel-track-response)
+ (while (and (or (not max-entries) (>= max-entries 0))
+ (/= prev-pt (point-min))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min))))
+ (pcase (get-char-property (point) 'gptel)
+ ('response
+ (when-let* ((content (gptel--trim-prefixes
+ (buffer-substring-no-properties (point) prev-pt))))
+ (push (list :role "assistant" :content content) prompts)))
+ (`(tool . ,id)
+ (save-excursion
+ (condition-case nil
+ (let* ((tool-call (read (current-buffer)))
+ (name (plist-get tool-call :name))
+ (arguments (decode-coding-string
+ (gptel--json-encode (plist-get tool-call :args))
+ 'utf-8 t)))
+ (setq id (gptel--openai-format-tool-id id))
+ (plist-put tool-call :id id)
+ (plist-put tool-call :result
+ (string-trim (buffer-substring-no-properties
+ (point) prev-pt)))
+ (push (car (gptel--parse-tool-results backend (list tool-call)))
+ prompts)
+ (push (list :role "assistant"
+ :tool_calls
+ (vector (list :type "function"
+ :id id
+ :function `( :name ,name
+ :arguments ,arguments))))
+ prompts))
+ ((end-of-file invalid-read-syntax)
+ (message (format "Could not parse tool-call %s on line %s"
+ id (line-number-at-pos (point))))))))
+ ('ignore)
+ ('nil
+ (and max-entries (cl-decf max-entries))
+ (if gptel-track-media
+ (when-let* ((content (gptel--openai-parse-multipart
+ (gptel--parse-media-links major-mode
+ (point) prev-pt))))
+ (when (> (length content) 0)
+ (push (list :role "user" :content content) prompts)))
+ (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties
+ (point) prev-pt))))
+ (push (list :role "user" :content content) prompts)))))
+ (setq prev-pt (point)))
+ (let ((content (string-trim (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (push (list :role "user" :content content) prompts)))
+ prompts))
+
+;; TODO This could be a generic function
+(defun gptel--openai-parse-multipart (parts)
+ "Convert a multipart prompt PARTS to the OpenAI API format.
+
+The input is an alist of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\")).
+
+The output is a vector of entries in a backend-appropriate
+format."
+ (cl-loop
+ for part in parts
+ for n upfrom 1
+ with last = (length parts)
+ for text = (plist-get part :text)
+ for media = (plist-get part :media)
+ if text do
+ (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text)))
+ and if text
+ collect `(:type "text" :text ,text) into parts-array end
+ else if media collect
+ `(:type "image_url"
+ :image_url (:url ,(concat "data:" (plist-get part :mime)
+ ";base64," (gptel--base64-encode media))))
+ into parts-array
+ else if (plist-get part :textfile) collect
+ `(:type "text"
+ :text ,(with-temp-buffer
+ (gptel--insert-file-string (plist-get part :textfile))
+ (buffer-string)))
+ into parts-array end and
+ if (plist-get part :url)
+ collect
+ `(:type "image_url"
+ :image_url (:url ,(plist-get part :url)))
+ into parts-array
+ finally return (vconcat parts-array)))
+
+(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)
+ (vconcat
+ (gptel--openai-parse-multipart media-list)
+ (cl-typecase current
+ (string `((:type "text" :text ,current)))
+ (vector current)
+ (t current))))
+ (plist-get (car prompts) :content))))
+
+(defconst gptel--openai-models
+ '((gpt-5.4-mini
+ :description "Faster, more cost-efficient version of GPT-5.4"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 0.75
+ :output-cost 4.50
+ :cutoff-date "2025-08")
+ (gpt-5.4-nano
+ :description "Fastest, cheapest version of GPT-5.4"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 0.20
+ :output-cost 1.25
+ :cutoff-date "2025-08")
+ (gpt-5.4
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1050
+ :input-cost 2.50
+ :output-cost 15
+ :cutoff-date "2025-08")
+ (gpt-5.4-pro
+ :description "Maximum performance model for reasoning tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1050
+ :input-cost 30
+ :output-cost 180
+ :cutoff-date "2025-08")
+ (gpt-5.5
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1050
+ :input-cost 5
+ :output-cost 30
+ :cutoff-date "2025-12")
+ (gpt-5.5-pro
+ :description "Maximum performance model for reasoning tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1050
+ :input-cost 30
+ :output-cost 180
+ :cutoff-date "2025-12")
+ (gpt-5.3-chat-latest
+ :description "Answers right away"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 1.75
+ :output-cost 14
+ :cutoff-date "2025-08")
+ (gpt-5.2
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 1.75
+ :output-cost 14
+ :cutoff-date "2025-08")
+ (gpt-5.1
+ :description "The best model for coding and agentic tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 1.25
+ :output-cost 10
+ :cutoff-date "2024-09")
+ (gpt-5-mini
+ :description "Faster, more cost-efficient version of GPT-5"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 0.25
+ :output-cost 2.0
+ :cutoff-date "2024-09")
+ (gpt-5-nano
+ :description "Fastest, cheapest version of GPT-5"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 0.05
+ :output-cost 0.40
+ :cutoff-date "2024-09")
+ (gpt-5
+ :description "Flagship model for coding, reasoning, and agentic tasks across domains"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 400
+ :input-cost 1.25
+ :output-cost 10
+ :cutoff-date "2024-09")
+ (gpt-4.1-mini
+ :description "Balance between intelligence, speed and cost"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1024
+ :input-cost 0.4
+ :output-cost 1.6)
+ (gpt-4.1-nano
+ :description "Fastest, most cost-effective GPT-4.1 model"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1024
+ :input-cost 0.10
+ :output-cost 0.40
+ :cutoff-date "2024-05")
+ (gpt-4.1
+ :description "Flagship model for complex tasks"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 1024
+ :input-cost 2.0
+ :output-cost 8.0
+ :cutoff-date "2024-05")
+ (gpt-4o-mini
+ :description "Cheap model for fast tasks; cheaper & more capable than GPT-3.5 Turbo"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 0.15
+ :output-cost 0.60
+ :cutoff-date "2023-10")
+ (gpt-4o
+ :description "Advanced model for complex tasks; cheaper & faster than GPT-Turbo"
+ :capabilities (media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 2.50
+ :output-cost 10
+ :cutoff-date "2023-10")
+ (gpt-4.5-preview
+ :description "DEPRECATED: Use gpt-4.1 instead"
+ :capabilities (media tool-use url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 75
+ :output-cost 150
+ :cutoff-date "2023-10")
+ (gpt-4-turbo
+ :description "Previous high-intelligence model"
+ :capabilities (media tool-use url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 128
+ :input-cost 10
+ :output-cost 30
+ :cutoff-date "2023-11")
+ (gpt-4
+ :description "GPT-4 snapshot from June 2023 with improved function calling support"
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :capabilities (media url responses-api)
+ :context-window 8.192
+ :input-cost 30
+ :output-cost 60
+ :cutoff-date "2023-11")
+ (o4-mini
+ :description "Fast, effective reasoning with efficient performance in coding and visual tasks"
+ :capabilities (reasoning media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 200
+ :input-cost 1.10
+ :output-cost 4.40
+ :cutoff-date "2024-05")
+ (o3-mini
+ :description "High intelligence at the same cost and latency targets of o1-mini"
+ :context-window 200
+ :input-cost 1.10
+ :output-cost 4.40
+ :cutoff-date "2023-10"
+ :capabilities (reasoning tool-use json responses-api))
+ (o3
+ :description "Well-rounded and powerful model across domains"
+ :capabilities (reasoning media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 200
+ :input-cost 2
+ :output-cost 8
+ :cutoff-date "2024-05")
+ (o3-pro
+ :description "Maximum performance model for reasoning tasks"
+ :capabilities (reasoning media tool-use json url responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 200
+ :input-cost 20
+ :output-cost 80
+ :cutoff-date "2024-05")
+ (o1-mini
+ :description "Faster and cheaper reasoning model good at coding, math, and science"
+ :context-window 128
+ :input-cost 1.10
+ :output-cost 4.40
+ :cutoff-date "2023-10"
+ :capabilities (nosystem reasoning responses-api))
+ (o1
+ :description "Reasoning model designed to solve hard problems across domains"
+ :capabilities (media reasoning responses-api)
+ :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp")
+ :context-window 200
+ :input-cost 15
+ :output-cost 60
+ :cutoff-date "2023-10"))
+ "List of available OpenAI models and associated properties.
+
+Each model symbol is associated with the following keys, all optional:
+
+- `:description': a brief description of the model.
+
+- `:capabilities': a list of capabilities supporte responses-apid by the model.
+
+- `:mime-types': a list of supported MIME types for media files.
+
+- `:context-window': the context window size, in thousands of tokens.
+
+- `:input-cost': the input cost, in US dollars per million tokens.
+
+- `:output-cost': the output cost, in US dollars per million tokens.
+
+- `:cutoff-date': the knowledge cutoff date.
+
+- `:request-params': a plist of additional request parameters to
+ include when using this model.
+
+Information about the OpenAI models was obtained from the following
+sources:
+
+- <https://platform.openai.com/docs/pricing>
+- <https://platform.openai.com/docs/models>")
+
+;;;###autoload
+(cl-defun gptel-make-openai
+ (name &key curl-args (models gptel--openai-models)
+ stream key request-params
+ (header
+ (lambda (_info)
+ (when-let* ((key (gptel--get-api-key)))
+ `(("Authorization" . ,(concat "Bearer " key))))))
+ (host "api.openai.com")
+ (protocol "https")
+ endpoint)
+ "Register an OpenAI API-compatible backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST (optional) is the API host, typically \"api.openai.com\".
+
+MODELS is a list of available model names, as symbols.
+Additionally, you can specify supported LLM capabilities like
+vision or tool-use by appending a plist to the model with more
+information, in the form
+
+ (model-name . plist)
+
+For a list of currently recognized plist keys, see
+`gptel--openai-models'. An example of a model specification
+including both kinds of specs:
+
+:models
+\\='(gpt-3.5-turbo ;Simple specs
+ gpt-4-turbo
+ (gpt-4o-mini ;Full spec
+ :description
+ \"Affordable and intelligent small model for lightweight tasks\"
+ :capabilities (media tool json url)
+ :mime-types
+ (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/v1/chat/completions\".
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that returns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for."
+ (declare (indent 1))
+ (let* ((responses-api (string-match-p "api\\.openai\\.com" host))
+ ;; Use the OpenAI Responses API if required
+ ;; TODO: Find a more reliable way to dispatch. Checking the host isn't
+ ;; reliable. For example, it won't work when using the Responses API
+ ;; via a proxy.
+ (constructor (if (not responses-api)
+ #'gptel--make-openai
+ (require 'gptel-openai-responses)
+ #'gptel--make-openai-responses))
+ (endpoint (or endpoint
+ (if responses-api "/v1/responses" "/v1/chat/completions")))
+ (backend (funcall constructor
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint)))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+;;; Azure
+;;;###autoload
+(cl-defun gptel-make-azure
+ (name &key curl-args host
+ (protocol "https")
+ (header (lambda (_info) `(("api-key" . ,(gptel--get-api-key)))))
+ (key 'gptel-api-key)
+ models stream endpoint request-params)
+ "Register an Azure backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is the API host.
+
+MODELS is a list of available model names, as symbols.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL (optional) specifies the protocol, https by default.
+
+ENDPOINT is the API endpoint for completions.
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+ ((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+ (gptel-make-azure
+ \"Azure-1\"
+ :protocol \"https\"
+ :host \"RESOURCE_NAME.openai.azure.com\"
+ :endpoint
+ \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\"
+ :stream t
+ :models \\='(gpt-3.5-turbo gpt-4))"
+ (declare (indent 1))
+ (let ((backend (gptel--make-openai
+ :curl-args curl-args
+ :name name
+ :host host
+ :header header
+ :key key
+ :models (gptel--process-models models)
+ :protocol protocol
+ :endpoint endpoint
+ :stream stream
+ :request-params request-params
+ :url (if protocol
+ (concat protocol "://" host endpoint)
+ (concat host endpoint)))))
+ (prog1 backend
+ (setf (alist-get name gptel--known-backends
+ nil nil #'equal)
+ backend))))
+
+;; GPT4All
+;;;###autoload
+(defalias 'gptel-make-gpt4all 'gptel-make-openai
+ "Register a GPT4All backend for gptel with NAME.
+
+Keyword arguments:
+
+CURL-ARGS (optional) is a list of additional Curl arguments.
+
+HOST is where GPT4All runs (with port), typically localhost:4891
+
+MODELS is a list of available model names, as symbols.
+
+STREAM is a boolean to toggle streaming responses, defaults to
+false.
+
+PROTOCOL specifies the protocol, https by default.
+
+ENDPOINT (optional) is the API endpoint for completions, defaults to
+\"/api/v1/completions\"
+
+HEADER (optional) is for additional headers to send with each
+request. It should be an alist or a function that retuns an
+alist, like:
+((\"Content-Type\" . \"application/json\"))
+
+KEY (optional) is a variable whose value is the API key, or
+function that returns the key. This is typically not required for
+local models like GPT4All.
+
+REQUEST-PARAMS (optional) is a plist of additional HTTP request
+parameters (as plist keys) and values supported by the API. Use
+these to set parameters that gptel does not provide user options
+for.
+
+Example:
+-------
+
+(gptel-make-gpt4all
+ \"GPT4All\"
+ :protocol \"http\"
+ :host \"localhost:4891\"
+ :models \\='(mistral-7b-openorca.Q4_0.gguf))")
+
+(provide 'gptel-openai)
+;;; gptel-openai.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not docstrings)
+;; End:
--- /dev/null
+;;; gptel-org.el --- Org functions for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+(require 'cl-lib)
+(require 'org-element)
+(require 'outline)
+(require 'mailcap) ;FIXME Avoid this somehow
+(eval-when-compile (require 'gptel-request))
+
+;; Functions used for saving/restoring gptel state in Org buffers
+(defvar gptel--num-messages-to-send)
+(defvar org-entry-property-inherited-from)
+(defvar gptel-backend)
+(defvar gptel--known-backends)
+(defvar gptel--system-message)
+(defvar gptel-model)
+(defvar gptel-temperature)
+(defvar gptel-max-tokens)
+(defvar gptel--link-type-cache)
+(defvar gptel--preset)
+
+(defvar org-link-angle-re)
+(defvar org-link-bracket-re)
+(declare-function mailcap-file-name-to-mime-type "mailcap")
+(declare-function gptel--model-capable-p "gptel-request")
+(declare-function gptel--model-mime-capable-p "gptel-request")
+(declare-function gptel--model-name "gptel-request")
+(declare-function gptel--to-string "gptel-request")
+(declare-function gptel--to-number "gptel-request")
+(declare-function gptel--intern "gptel-request")
+(declare-function gptel-backend-name "gptel-request")
+(declare-function gptel--parse-buffer "gptel-request")
+(declare-function gptel--parse-directive "gptel-request")
+(declare-function gptel--with-buffer-copy "gptel-request")
+(declare-function gptel--file-binary-p "gptel-request")
+(declare-function gptel--get-buffer-bounds "gptel")
+(declare-function gptel--restore-props "gptel")
+(declare-function org-entry-get "org")
+(declare-function org-entry-put "org")
+(declare-function org-with-wide-buffer "org-macs")
+(declare-function org-set-property "org")
+(declare-function org-property-values "org")
+(declare-function org-open-line "org")
+(declare-function org-at-heading-p "org")
+(declare-function org-get-heading "org")
+(declare-function org-at-heading-p "org")
+
+;; Bundle `org-element-lineage-map' if it's not available (for Org 9.67 or older)
+(eval-and-compile
+ (if (fboundp 'org-element-lineage-map)
+ (progn (declare-function org-element-lineage-map "org-element-ast")
+ (defalias 'gptel-org--element-lineage-map 'org-element-lineage-map))
+ (defun gptel-org--element-lineage-map (datum fun &optional types with-self first-match)
+ "Map FUN across ancestors of DATUM, from closest to furthest.
+
+DATUM is an object or element. For TYPES, WITH-SELF and
+FIRST-MATCH see `org-element-lineage-map'.
+
+This function is provided for compatibility with older versions
+of Org."
+ (declare (indent 2))
+ (setq fun (if (functionp fun) fun `(lambda (node) ,fun)))
+ (let ((up (if with-self datum (org-element-parent datum)))
+ acc rtn)
+ (catch :--first-match
+ (while up
+ (when (or (not types) (org-element-type-p up types))
+ (setq rtn (funcall fun up))
+ (if (and first-match rtn)
+ (throw :--first-match rtn)
+ (when rtn (push rtn acc))))
+ (setq up (org-element-parent up)))
+ (nreverse acc)))))
+ (if (fboundp 'org-element-begin)
+ (progn (declare-function org-element-begin "org-element")
+ (declare-function org-element-end "org-element")
+ (declare-function org-element-parent "org-element")
+ (defalias 'gptel-org--element-begin 'org-element-begin)
+ (defalias 'gptel-org--element-end 'org-element-end)
+ (defalias 'gptel-org--element-parent 'org-element-parent))
+ (defsubst gptel-org--element-begin (node)
+ "Get `:begin' property of NODE."
+ (org-element-property :begin node))
+ (defsubst gptel-org--element-end (node)
+ "Get `:end' property of NODE."
+ (org-element-property :end node))
+ (defsubst gptel-org--element-parent (node)
+ "Return `:parent' property of NODE."
+ (org-element-property :parent node))))
+
+\f
+;;; User options
+(defcustom gptel-org-branching-context nil
+ "Use the lineage of the current heading as the context for gptel in Org buffers.
+
+This makes each same level heading a separate conversation
+branch.
+
+By default, gptel uses a linear context: all the text up to the
+cursor is sent to the LLM. Enabling this option makes the
+context the hierarchical lineage of the current Org heading. In
+this example:
+
+-----
+Top level text
+
+* Heading 1
+heading 1 text
+
+* Heading 2
+heading 2 text
+
+** Heading 2.1
+heading 2.1 text
+** Heading 2.2
+heading 2.2 text
+-----
+
+With the cursor at the end of the buffer, the text sent to the
+LLM will be limited to
+
+-----
+Top level text
+
+* Heading 2
+heading 2 text
+
+** Heading 2.2
+heading 2.2 text
+-----
+
+This makes it feasible to have multiple conversation branches."
+ :type 'boolean
+ :group 'gptel)
+
+(defcustom gptel-org-ignore-elements '(property-drawer)
+ "Types of Org elements to be stripped from the prompt before sending.
+
+By default gptel will remove Org property drawers from the
+prompt. For the full list of available elements, please see
+`org-element-all-elements'.
+
+Please note: Removing property-drawer elements is fast, but
+adding elements to this list can significantly slow down
+`gptel-send'."
+ :group 'gptel
+ :type '(repeat symbol))
+
+(defcustom gptel-org-validate-link #'always
+ "Validate links to be sent as context with gptel queries.
+
+When `gptel-track-media' is enabled, this option determines if a
+supported link will be followed and its source included with gptel
+queries from Org buffers. Currently only \"file\" and \"attachment\"
+link types are supported (along with web URLs if the model supports
+them).
+
+It should be a function that accepts an Org link object and return
+non-nil if the link should be followed.
+
+By default, all links are considered valid.
+
+Set this to `gptel-org--link-standalone-p' to only follow links placed
+on a line by themselves, separated from surrounding text."
+ :group 'gptel
+ :type '(choice
+ (const :tag "All links" always)
+ (const :tag "Standalone links" gptel-org--link-standalone-p)
+ (function :tag "Function")))
+
+(defconst gptel-org--link-regex
+ (concat "\\(?:" org-link-bracket-re "\\|" org-link-angle-re "\\)")
+ "Link regex for `gptel-mode' in Org mode.")
+
+\f
+;;; Setting context and creating queries
+(defun gptel-org--get-topic-start ()
+ "If a conversation topic is set, return it."
+ (when (org-entry-get (point) "GPTEL_TOPIC" 'inherit)
+ (marker-position org-entry-property-inherited-from)))
+
+(defun gptel-org-set-topic (topic)
+ "Set a TOPIC and limit this conversation to the current heading.
+
+This limits the context sent to the LLM to the text between the current
+heading (i.e. the heading with the topic set) and the cursor position."
+ (interactive
+ (list
+ (progn
+ (or (derived-mode-p 'org-mode)
+ (user-error "Support for multiple topics per buffer is only implemented for `org-mode'"))
+ (completing-read "Set topic as: "
+ (org-property-values "GPTEL_TOPIC")
+ nil nil (downcase
+ (truncate-string-to-width
+ (substring-no-properties
+ (replace-regexp-in-string
+ "\\s-+" "-"
+ (org-entry-get nil "ITEM")))
+ 50))))))
+ (when (stringp topic) (org-set-property "GPTEL_TOPIC" topic)))
+
+;; NOTE: This can be converted to a cl-defmethod for
+;; `gptel--create-prompt-buffer' (conceptually cleaner), but will cause
+;; load-order issues in gptel.el and might be harder to debug.
+(defun gptel-org--create-prompt-buffer (&optional prompt-end)
+ "Return a buffer with the conversation prompt to be sent.
+
+If the region is active limit the prompt text to the region contents.
+Otherwise the prompt text is constructed from the contents of the
+current buffer up to point, or PROMPT-END if provided. Its contents
+depend on the value of `gptel-org-branching-context', which see."
+ (when (use-region-p)
+ (narrow-to-region (region-beginning) (region-end))
+ (setq prompt-end (point-max)))
+ (goto-char (or prompt-end (setq prompt-end (point))))
+ (let ((topic-start (gptel-org--get-topic-start)))
+ (when topic-start
+ ;; narrow to GPTEL_TOPIC property scope
+ (narrow-to-region topic-start prompt-end))
+ (if (and gptel-org-branching-context
+ (or (fboundp 'org-element-lineage-map)
+ (prog1 nil
+ (display-warning
+ '(gptel org)
+ "Using `gptel-org-branching-context' requires Org version 9.7 or higher, it will be ignored."))))
+ ;; Create prompt from direct ancestors of point
+ (save-excursion
+ (let* ((org-buf (current-buffer))
+ ;; Collect all heading start positions in the lineage
+ (full-bounds (gptel-org--element-lineage-map
+ (org-element-at-point) #'gptel-org--element-begin
+ '(headline) 'with-self) )
+ ;; lineage-map returns the full lineage in the unnarrowed
+ ;; buffer. Remove heading start positions before (point-min)
+ ;; that are invalid due to narrowing, and add (point-min) if
+ ;; it's not already included in the lineage
+ (start-bounds
+ (nconc (cl-delete-if (lambda (p) (< p (point-min)))
+ full-bounds)
+ (unless (save-excursion (goto-char (point-min))
+ (looking-at-p outline-regexp))
+ (list (point-min)))))
+ (end-bounds
+ (cl-loop
+ ;; (car start-bounds) is the begining of the current element,
+ ;; not relevant
+ for pos in (cdr start-bounds)
+ do (goto-char pos) (outline-next-heading)
+ collect (point) into ends
+ finally return (cons prompt-end ends))))
+ (gptel--with-buffer-copy org-buf nil nil
+ (cl-loop for start in start-bounds
+ for end in end-bounds
+ do (insert-buffer-substring org-buf start end)
+ (goto-char (point-min)))
+ (goto-char (point-max))
+ (gptel-org--unescape-tool-results)
+ (gptel-org--strip-block-headers)
+ (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy
+ (buffer-local-value 'gptel-org-ignore-elements
+ org-buf)))
+ (gptel-org--strip-elements))
+ (setq org-complex-heading-regexp ;For org-element-context to run
+ (buffer-local-value 'org-complex-heading-regexp org-buf))
+ (current-buffer))))
+ ;; Create prompt the usual way
+ (let ((org-buf (current-buffer))
+ (beg (point-min)))
+ (gptel--with-buffer-copy org-buf beg prompt-end
+ (gptel-org--unescape-tool-results)
+ (gptel-org--strip-block-headers)
+ (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy
+ (buffer-local-value 'gptel-org-ignore-elements
+ org-buf)))
+ (gptel-org--strip-elements))
+ (setq org-complex-heading-regexp ;For org-element-context to run
+ (buffer-local-value 'org-complex-heading-regexp org-buf))
+ (current-buffer))))))
+
+(defun gptel-org--strip-elements ()
+ "Remove all elements in `gptel-org-ignore-elements' from the prompt."
+ (let ((major-mode 'org-mode) element-markers)
+ (if (equal '(property-drawer) gptel-org-ignore-elements)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-property-drawer-re nil t)
+ ;; ;; Slower but accurate
+ ;; (let ((drawer (org-element-at-point)))
+ ;; (when (org-element-type-p drawer 'property-drawer)
+ ;; (delete-region (org-element-begin drawer) (org-element-end drawer))))
+
+ ;; Fast but inexact, can have false positives
+ (delete-region (match-beginning 0) (match-end 0))))
+ ;; NOTE: Parsing the buffer is extremely slow. Avoid this path unless
+ ;; required.
+ ;; NOTE: `org-element-map' takes a third KEEP-DEFERRED argument in newer
+ ;; Org versions
+ (org-element-map (org-element-parse-buffer 'element nil)
+ gptel-org-ignore-elements
+ (lambda (node)
+ (push (list (gptel-org--element-begin node)
+ (gptel-org--element-end node))
+ element-markers)))
+ (dolist (bounds element-markers)
+ (apply #'delete-region bounds)))))
+
+(defun gptel-org--strip-block-headers ()
+ "Remove all gptel-specific block headers and footers.
+Every line that matches will be removed entirely.
+
+This removal is necessary to avoid auto-mimicry by LLMs."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ (rx line-start (literal "#+")
+ (or (literal "begin") (literal "end"))
+ (or (literal "_tool") (literal "_reasoning")))
+ nil t)
+ (delete-region (match-beginning 0)
+ (min (point-max) (1+ (line-end-position)))))))
+
+(defun gptel-org--unescape-tool-results ()
+ "Undo escapes done to keep results from escaping blocks.
+Scans backward for gptel tool text property, then unescapes the block
+contents."
+ (save-excursion
+ (goto-char (point-max))
+ (let ((prev-pt (point)))
+ (while (> prev-pt (point-min))
+ (goto-char
+ (previous-single-char-property-change (point) 'gptel))
+ (let ((prop (get-text-property (point) 'gptel))
+ (backward-progress (point)))
+ (when (eq (car-safe prop) 'tool)
+ ;; User edits to clean up can potentially insert a tool-call header
+ ;; that is propertized. Tool call headers should not be
+ ;; propertized.
+ (when (looking-at-p "[[:space:]]*#\\+begin_tool")
+ (goto-char (match-end 0)))
+ ;; TODO this code is able to put the point behind prev-pt, which
+ ;; makes the region inverted. The `max' catches this, but really
+ ;; `read' and `looking-at' are the culprits. Badly formed tool
+ ;; blocks can lead to this being necessary.
+ (org-unescape-code-in-region
+ (min prev-pt (point)) prev-pt))
+ (goto-char (setq prev-pt backward-progress)))))))
+
+(defun gptel-org--link-standalone-p (object)
+ "Check if link OBJECT is on a line by itself."
+ (when-let* ((par (gptel-org--element-parent object))
+ ((eq (org-element-type par) 'paragraph)))
+ (and (= (gptel-org--element-begin object)
+ (save-excursion
+ (goto-char (org-element-property :contents-begin par))
+ (skip-chars-forward "\t ")
+ (point))) ;account for leading space before object
+ (<= (- (org-element-property :contents-end par)
+ (org-element-property :end object))
+ 1))))
+
+(defsubst gptel-org--validate-link (link)
+ "Validate an Org LINK as sendable under the current gptel settings.
+
+Return a form (validp link-type path . REST), where REST is a list
+explaining why sending the link is not supported by gptel. Only the
+first nil value in REST is guaranteed to be correct."
+ (let ((mime))
+ (if-let* ((link-type (org-element-property :type link))
+ (resource-type
+ (or (and (member link-type '("attachment" "file")) 'file)
+ (and (gptel--model-capable-p 'url)
+ (member link-type '("http" "https" "ftp")) 'url)))
+ (path (org-element-property :path link))
+ (user-check (funcall gptel-org-validate-link link))
+ (readablep (or (eq resource-type 'url) (file-remote-p path)
+ (file-readable-p path)))
+ (mime-valid
+ (or (eq resource-type 'url)
+ (and (with-memoization
+ (alist-get (expand-file-name path)
+ gptel--link-type-cache
+ nil nil #'string=)
+ (if (gptel--file-binary-p path) t))
+ (setq mime (mailcap-file-name-to-mime-type path))
+ (gptel--model-mime-capable-p mime))
+ t)))
+ (list t link-type path resource-type user-check readablep mime-valid mime)
+ (list nil link-type path resource-type user-check readablep mime-valid mime))))
+
+(cl-defmethod gptel--parse-media-links ((_mode (eql 'org-mode)) beg end)
+ "Parse text and actionable links between BEG and END.
+
+Return a list of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\"))
+for inclusion into the user prompt for the gptel request."
+ (let ((parts) (from-pt))
+ (save-excursion
+ (setq from-pt (goto-char beg))
+ (while (re-search-forward gptel-org--link-regex end t)
+ (let* ((link (org-element-context))
+ (link-status (gptel-org--validate-link link)))
+ (cl-destructuring-bind
+ (valid type path resource-type user-check readablep mime-valid mime)
+ link-status
+ (cond
+ ((and valid (member type '("file" "attachment")))
+ ;; Text file or supported binary file: collect text up to link
+ (when-let* ((text (buffer-substring-no-properties
+ from-pt (gptel-org--element-begin link))))
+ (unless (string-blank-p text) (push (list :text text) parts)))
+ ;; collect link
+ (push (if mime (list :media path :mime mime) (list :textfile path))
+ parts)
+ (setq from-pt (point)))
+ ((and valid (member type '("http" "https" "ftp")))
+ ;; Collect text up to this image, and collect this image url
+ (when-let* ((text (buffer-substring-no-properties
+ from-pt (gptel-org--element-begin link))))
+ (unless (string-blank-p text) (push (list :text text) parts)))
+ (push (list :url (org-element-property :raw-link link) :mime mime) parts)
+ (setq from-pt (point)))
+ ((not resource-type)
+ (message "Link source not followed for unsupported link type \"%s\"." type))
+ ((not user-check)
+ (message (if (eq gptel-org-validate-link 'gptel--link-standalone-p)
+ "Ignoring non-standalone link \"%s\"."
+ "Link %s failed to validate, see `gptel-org-validate-link'.")
+ path))
+ ((not readablep)
+ (message "Ignoring inaccessible file \"%s\"." path))
+ ((and (not mime-valid) (eq resource-type 'file))
+ (message "Ignoring unsupported binary file \"%s\"." path))))))
+ (unless (= from-pt end)
+ (push (list :text (buffer-substring-no-properties from-pt end)) parts)))
+ (nreverse parts)))
+
+(defun gptel-org--annotate-links (beg end)
+ "Annotate Org links whose sources will be sent with `gptel-send'.
+
+Search between BEG and END."
+ (when gptel-track-media
+ (save-excursion
+ (goto-char beg) (forward-line -1)
+ (let ((link-ovs (cl-loop for o in (overlays-in (point) end)
+ if (overlay-get o 'gptel-track-media)
+ collect o into os finally return os)))
+ (while (re-search-forward gptel-org--link-regex end t)
+ (unless (gptel--in-response-p (1- (point)))
+ (let* ((link (org-element-context))
+ (from (org-element-begin link))
+ (to (org-element-end link))
+ (link-status (gptel-org--validate-link link))
+ (ov (cl-loop for o in (overlays-in from to)
+ if (overlay-get o 'gptel-track-media)
+ return o)))
+ (if ov ; Ensure overlay over each link
+ (progn (move-overlay ov from to)
+ (setq link-ovs (delq ov link-ovs)))
+ (setq ov (make-overlay from to nil t))
+ (overlay-put ov 'gptel-track-media t)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'priority -80))
+ ;; Check if link will be sent, and annotate accordingly
+ (gptel--annotate-link ov link-status))))
+ (and link-ovs (mapc #'delete-overlay link-ovs))))
+ `(jit-lock-bounds ,beg . ,end)))
+
+(defun gptel-org--send-with-props (send-fun &rest args)
+ "Conditionally modify SEND-FUN's calling environment.
+
+If in an Org buffer under a heading containing a stored gptel
+configuration, use that for requests instead. This includes the
+system message, model and provider (backend), among other
+parameters.
+
+ARGS are the original function call arguments."
+ (if (derived-mode-p 'org-mode)
+ (pcase-let ((`( ,gptel--preset ,gptel--system-message ,gptel-backend
+ ,gptel-model ,gptel-temperature ,gptel-max-tokens
+ ,gptel--num-messages-to-send ,gptel-tools)
+ (seq-mapn (lambda (a b) (or a b))
+ (gptel-org--entry-properties)
+ (list gptel--preset gptel--system-message gptel-backend
+ gptel-model gptel-temperature gptel-max-tokens
+ gptel--num-messages-to-send gptel-tools))))
+ (apply send-fun args))
+ (apply send-fun args)))
+
+(advice-add 'gptel-send :around #'gptel-org--send-with-props)
+(advice-add 'gptel--suffix-send :around #'gptel-org--send-with-props)
+
+;; ;; NOTE: Basic uses in org-mode are covered by advising gptel-send and
+;; ;; gptel--suffix-send. For custom commands it might be necessary to advise
+;; ;; gptel-request instead.
+;; (advice-add 'gptel-request :around #'gptel-org--send-with-props)
+
+\f
+;;; Saving and restoring state
+(defun gptel-org--entry-properties (&optional pt)
+ "Find gptel configuration properties stored at PT."
+ (pcase-let
+ ((`(,preset ,system ,backend ,model ,temperature ,tokens ,num ,tools)
+ (mapcar
+ (lambda (prop) (org-entry-get (or pt (point)) prop 'selective))
+ '("GPTEL_PRESET" "GPTEL_SYSTEM" "GPTEL_BACKEND"
+ "GPTEL_MODEL" "GPTEL_TEMPERATURE" "GPTEL_MAX_TOKENS"
+ "GPTEL_NUM_MESSAGES_TO_SEND" "GPTEL_TOOLS"))))
+ (when preset (setq preset (gptel--intern preset)))
+ (when system
+ (setq system (string-replace "\\n" "\n" system)))
+ (when backend
+ (setq backend (alist-get backend gptel--known-backends
+ nil nil #'equal)))
+ (when model (setq model (gptel--intern model)))
+ (when temperature
+ (setq temperature (gptel--to-number temperature)))
+ (when tokens (setq tokens (gptel--to-number tokens)))
+ (when num (setq num (gptel--to-number num)))
+ (when tools
+ (setq tools (cl-loop
+ for tname in (split-string tools)
+ for tool = (with-demoted-errors "gptel: %S"
+ (gptel-get-tool tname))
+ if tool collect tool else do
+ (display-warning
+ '(gptel org tools)
+ (format "Tool %s not found, ignoring" tname)))))
+ (list preset system backend model temperature tokens num tools)))
+
+(defun gptel-org--restore-state ()
+ "Restore gptel state for Org buffers when turning on `gptel-mode'."
+ (save-restriction
+ (widen)
+ (condition-case status
+ (progn
+ (when-let* ((bounds (org-entry-get (point-min) "GPTEL_BOUNDS")))
+ (gptel--restore-props (read bounds)))
+ (pcase-let ((`(,preset ,system ,backend ,model ,temperature ,tokens ,num ,tools)
+ (gptel-org--entry-properties (point-min))))
+ (when preset
+ (if (gptel-get-preset preset)
+ (progn (gptel--apply-preset
+ preset (lambda (sym val) (set (make-local-variable sym) val)))
+ (setq gptel--preset preset))
+ (display-warning
+ '(gptel presets)
+ (format "Could not activate gptel preset `%s' in buffer \"%s\""
+ preset (buffer-name)))))
+ (when system (setq-local gptel--system-message system))
+ (if backend (setq-local gptel-backend backend)
+ (message
+ (substitute-command-keys
+ (concat
+ "Could not activate gptel backend \"%s\"! "
+ "Switch backends with \\[universal-argument] \\[gptel-send]"
+ " before using gptel."))
+ backend))
+ (when model (setq-local gptel-model model))
+ (when temperature (setq-local gptel-temperature temperature))
+ (when tokens (setq-local gptel-max-tokens tokens))
+ (when num (setq-local gptel--num-messages-to-send num))
+ (when tools (setq-local gptel-tools tools))))
+ (:success (message "gptel chat restored."))
+ (error (message "Could not restore gptel state, sorry! Error: %s" status)))))
+
+(defun gptel-org-set-properties (pt &optional msg)
+ "Store the active gptel configuration under the current heading.
+
+PT is the cursor position by default. If MSG is non-nil (default),
+display a message afterwards.
+
+If a gptel preset has been applied in this buffer, a reference to it is
+saved.
+
+Additional metadata is stored only if no preset was applied or if it
+differs from the preset specification. This is limited to the active
+gptel model and backend names, the system message, active tools, the
+response temperature, max tokens and number of conversation turns to
+send in queries. (See `gptel--num-messages-to-send' for the last one.)"
+ (interactive (list (point) t))
+ (let ((preset-spec (and gptel--preset (gptel-get-preset gptel--preset))))
+ (if preset-spec
+ (org-entry-put pt "GPTEL_PRESET" (gptel--to-string gptel--preset))
+ (org-entry-delete pt "GPTEL_PRESET"))
+
+ ;; FIXME: nil can mean "no value was explicitly set by the user" as well as
+ ;; "this setting has been set to nil". We are not yet distinguishing
+ ;; between the two when saving Org properties. This is particularly
+ ;; relevant for the system message, whose explicit nil value will not be
+ ;; captured when saving Org buffers.
+
+ ;; Model and backend
+ (if (gptel--preset-mismatch-value preset-spec :model gptel-model)
+ (org-entry-put pt "GPTEL_MODEL" (gptel--model-name gptel-model)))
+ (if (gptel--preset-mismatch-value preset-spec :backend gptel-backend)
+ (org-entry-put pt "GPTEL_BACKEND" (gptel-backend-name gptel-backend)))
+ ;; System message
+ (let ((parsed (car-safe (gptel--parse-directive gptel--system-message))))
+ (if (gptel--preset-mismatch-value preset-spec :system parsed)
+ (when parsed
+ (org-entry-put pt "GPTEL_SYSTEM" (string-replace "\n" "\\n" parsed)))
+ (org-entry-delete pt "GPTEL_SYSTEM")))
+ ;; Tools
+ (let ((tool-names (mapcar #'gptel-tool-name gptel-tools)))
+ (if (gptel--preset-mismatch-value preset-spec :tools tool-names)
+ (org-entry-put pt "GPTEL_TOOLS" (string-join tool-names " "))
+ (org-entry-delete pt "GPTEL_TOOLS")))
+ ;; Temperature, max tokens and cutoff
+ (if (and (gptel--preset-mismatch-value preset-spec :temperature gptel-temperature)
+ (not (equal (default-value 'gptel-temperature) gptel-temperature)))
+ (org-entry-put pt "GPTEL_TEMPERATURE" (number-to-string gptel-temperature))
+ (org-entry-delete pt "GPTEL_TEMPERATURE"))
+ (if (and (gptel--preset-mismatch-value preset-spec :max-tokens gptel-max-tokens)
+ gptel-max-tokens)
+ (org-entry-put pt "GPTEL_MAX_TOKENS" (number-to-string gptel-max-tokens))
+ (org-entry-delete pt "GPTEL_MAX_TOKENS"))
+ (if (and (gptel--preset-mismatch-value
+ preset-spec :num-messages-to-send gptel--num-messages-to-send)
+ (natnump gptel--num-messages-to-send))
+ (org-entry-put pt "GPTEL_NUM_MESSAGES_TO_SEND"
+ (number-to-string gptel--num-messages-to-send))
+ (org-entry-delete pt "GPTEL_NUM_MESSAGES_TO_SEND")))
+ (when msg
+ (message "Added gptel configuration to current headline.")))
+
+(defun gptel-org--save-state ()
+ "Write the gptel state to the Org buffer as Org properties."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (when (org-at-heading-p)
+ (org-open-line 1))
+ (gptel-org-set-properties (point-min))
+ ;; Save response boundaries
+ (letrec ((write-bounds
+ (lambda (attempts)
+ (when-let* ((bounds (gptel--get-buffer-bounds))
+ ;; first value of ((prop . ((beg end val)...))...)
+ (offset (caadar bounds))
+ (offset-marker (set-marker (make-marker) offset)))
+ (org-entry-put (point-min) "GPTEL_BOUNDS"
+ (prin1-to-string (gptel--get-buffer-bounds)))
+ (when (and (not (= (marker-position offset-marker) offset))
+ (> attempts 0))
+ (funcall write-bounds (1- attempts)))))))
+ (funcall write-bounds 6))))
+
+\f
+;;; Transforming responses
+;;;###autoload
+(defun gptel--convert-markdown->org (str)
+ "Convert string STR from markdown to org markup.
+
+This is a very basic converter that handles only a few markup
+elements."
+ (with-temp-buffer
+ (insert str)
+ (goto-char (point-min))
+ (while (re-search-forward "`+\\|\\*\\{1,2\\}\\|_\\|^#+" nil t)
+ (pcase (match-string 0)
+ ;; Handle backticks
+ ((and (guard (eq (char-before) ?`)) ticks)
+ (gptel--replace-source-marker (length ticks))
+ (save-match-data
+ (catch 'block-end
+ (while (search-forward ticks nil t)
+ (unless (or (eq (char-before (match-beginning 0)) ?`)
+ (eq (char-after) ?`))
+ (gptel--replace-source-marker (length ticks) 'end)
+ (throw 'block-end nil))))))
+ ;; Handle headings
+ ((and (guard (eq (char-before) ?#)) heading)
+ (cond
+ ((looking-at "[[:space:]]") ;Handle headings
+ (delete-region (line-beginning-position) (point))
+ (insert (make-string (length heading) ?*)))
+ ((looking-at "\\+begin_src") ;Overeager LLM switched to using Org src blocks
+ (save-match-data (re-search-forward "^#\\+end_src" nil t)))))
+ ;; Handle emphasis
+ ("**" (cond
+ ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)")
+ ;; (delete-char 1))
+ ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}"
+ (max (- (point) 3) (point-min)))
+ (delete-char -1))))
+ ("*"
+ (cond
+ ((save-match-data
+ (and (or (= (point) 2)
+ (looking-back "\\(?:[[:space:]]\\|\s\\)\\(?:_\\|\\*\\)"
+ (max (- (point) 2) (point-min))))
+ (not (looking-at "[[:space:]]\\|\s"))))
+ ;; Possible beginning of emphasis
+ (and
+ (save-excursion
+ (when (and (re-search-forward (regexp-quote (match-string 0))
+ (line-end-position) t)
+ (looking-at "[[:space:][:punct:]]\\|\s")
+ (not (looking-back "\\(?:[[:space]]\\|\s\\)\\(?:_\\|\\*\\)"
+ (max (- (point) 2) (point-min)))))
+ (delete-char -1) (insert "/") t))
+ (progn (delete-char -1) (insert "/"))))
+ ((save-excursion
+ (ignore-errors (backward-char 2))
+ (or (and (bobp) (looking-at "\\*[[:space:]]"))
+ (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]")))
+ ;; Bullet point, replace with hyphen
+ (delete-char -1) (insert "-"))))))
+ (buffer-string)))
+
+(defun gptel--replace-source-marker (num-ticks &optional end)
+ "Replace markdown style backticks with Org equivalents.
+
+NUM-TICKS is the number of backticks being replaced. If END is
+true these are \"ending\" backticks.
+
+This is intended for use in the markdown to org stream converter."
+ (let ((from (match-beginning 0)))
+ (delete-region from (point))
+ (if (and (= num-ticks 3)
+ (save-excursion (beginning-of-line)
+ (skip-chars-forward " \t")
+ (eq (point) from)))
+ (insert (if end "#+end_src" "#+begin_src "))
+ (insert "="))))
+
+;;;###autoload
+(defun gptel--stream-convert-markdown->org (start-marker)
+ "Return a Markdown to Org converter.
+
+This function parses a stream of Markdown text to Org
+continuously when it is called with successive chunks of the
+text stream.
+
+START-MARKER is used to identify the corresponding process when
+cleaning up after."
+ (letrec ((in-src-block nil) ;explicit nil to address BUG #183
+ (in-org-src-block nil)
+ (temp-buf ; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1
+ (gptel--temp-buffer " *gptel-temp*"))
+ (start-pt (make-marker))
+ (ticks-total 0) ;MAYBE should we let-bind case-fold-search here?
+ (cleanup-fn
+ (lambda (beg _)
+ (when (and (equal beg (marker-position start-marker))
+ (eq (current-buffer) (marker-buffer start-marker)))
+ (when (buffer-live-p (get-buffer temp-buf))
+ (set-marker start-pt nil)
+ (kill-buffer temp-buf))
+ (remove-hook 'gptel-post-response-functions cleanup-fn)))))
+ (add-hook 'gptel-post-response-functions cleanup-fn)
+ (lambda (str)
+ (let ((noop-p) (ticks 0))
+ (with-current-buffer (get-buffer temp-buf)
+ (save-excursion (goto-char (point-max)) (insert str))
+ (when (marker-position start-pt) (goto-char start-pt))
+ (when in-src-block (setq ticks ticks-total))
+ (save-excursion
+ (while (re-search-forward "`\\|\\*\\{1,2\\}\\|_\\|^#+" nil t)
+ (pcase (match-string 0)
+ ("`"
+ ;; Count number of consecutive backticks
+ (backward-char)
+ (while (and (char-after) (eq (char-after) ?`))
+ (forward-char)
+ (if in-src-block (cl-decf ticks) (cl-incf ticks)))
+ ;; Set the verbatim state of the parser
+ (if (and (eobp)
+ ;; Special case heuristic: If the response ends with
+ ;; ^``` we don't wait for more input.
+ ;; FIXME: This can have false positives.
+ (not (save-excursion (beginning-of-line)
+ (looking-at "^```$"))))
+ ;; End of input => there could be more backticks coming,
+ ;; so we wait for more input
+ (progn (setq noop-p t) (set-marker start-pt (match-beginning 0)))
+ ;; We reached a character other than a backtick
+ (cond
+ ;; Ticks balanced, end src block
+ ((= ticks 0)
+ (progn (setq in-src-block nil)
+ (gptel--replace-source-marker ticks-total 'end)))
+ ;; Positive number of ticks, start an src block
+ ((and (> ticks 0) (not in-src-block))
+ (setq ticks-total ticks
+ in-src-block t)
+ (gptel--replace-source-marker ticks-total))
+ ;; Negative number of ticks or in a src block already,
+ ;; reset ticks
+ (t (setq ticks ticks-total)))))
+ ;; Handle headings and misguided #+begin_src text
+ ((and (guard (and (eq (char-before) ?#) (or (not in-src-block) in-org-src-block)))
+ heading)
+ (if in-org-src-block
+ ;; If we are inside an Org-style src block, look for #+end_src
+ (cond
+ ((< (- (point-max) (point)) 8) ;not enough information to close Org src block
+ (setq noop-p t) (set-marker start-pt (match-beginning 0)))
+ ((looking-at "\\+end_src") ;Close Org src block
+ (setq in-src-block nil in-org-src-block nil)))
+ ;; Otherwise check for Markdown headings, or for #+begin_src
+ (cond
+ ((eobp) ; Not enough information about the heading yet
+ (setq noop-p t) (set-marker start-pt (match-beginning 0)))
+ ((looking-at "[[:space:]]") ; Convert markdown heading to Org heading
+ (delete-region (line-beginning-position) (point))
+ (insert (make-string (length heading) ?*)))
+ ((< (- (point-max) (point)) 11) ;Not enough information to check if Org src block
+ (setq noop-p t) (set-marker start-pt (match-beginning 0)))
+ ((looking-at "\\+begin_src ") ;Overeager LLM switched to using Org src blocks
+ (setq in-src-block t in-org-src-block t)))))
+ ;; Handle other chars: emphasis, bold and bullet items
+ ((and "**" (guard (not in-src-block)))
+ (cond
+ ;; TODO Not sure why this branch was needed
+ ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)") (delete-char 1))
+
+ ;; Looking back at "w**" or " **"
+ ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}"
+ (max (- (point) 3) (point-min)))
+ (delete-char -1))))
+ ((and "*" (guard (not in-src-block)))
+ (if (eobp)
+ ;; Not enough information about the "*" yet
+ (progn (setq noop-p t) (set-marker start-pt (match-beginning 0)))
+ ;; "*" is either emphasis or a bullet point
+ (save-match-data
+ (save-excursion
+ (ignore-errors (backward-char 2))
+ (cond
+ ((and ; At bob, underscore/asterisk followed by word
+ (or (and (bobp) (looking-at "\\(?:_\\|\\*\\)\\([^[:space:][:punct:]]\\|$\\)"))
+ (looking-at ; word followed by underscore/asterisk
+ "[^[:space:]\n]\\(?:_\\|\\*\\)\\(?:[[:space:][:punct:]]\\|$\\)")
+ (looking-at ; underscore/asterisk followed by word
+ "\\(?:[[:space:]]\\)\\(?:_\\|\\*\\)\\([^[:space:]]\\|$\\)"))
+ (not (looking-at "[[:punct:]]\\(?:_\\|\\*\\)[[:punct:]]")))
+ ;; Emphasis, replace with slashes
+ (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "/"))
+ ((or (and (bobp) (looking-at "\\*[[:space:]]"))
+ (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]"))
+ ;; Bullet point, replace with hyphen
+ (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "-"))))))))))
+ (if noop-p
+ (buffer-substring (point) start-pt)
+ (prog1 (buffer-substring (point) (point-max))
+ (set-marker start-pt (point-max)))))))))
+
+(provide 'gptel-org)
+;;; gptel-org.el ends here
+
+;; Silence warnings about `org-element-type-p' and `org-element-parent', see #294.
+;; Local Variables:
+;; byte-compile-warnings: (not unresolved)
+;; End:
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "gptel" "20260425.846"
+ "Interact with ChatGPT or other LLMs."
+ '((emacs "27.1")
+ (transient "0.7.4")
+ (compat "30.1.0.0"))
+ :url "https://github.com/karthink/gptel"
+ :commit "101904a1a8568fe42df49f0f1acd4ddab39ae1f8"
+ :revdesc "101904a1a856"
+ :keywords '("convenience" "tools")
+ :authors '(("Karthik Chikmagalur" . "karthik.chikmagalurNOSPAMgmail.com"))
+ :maintainers '(("Karthik Chikmagalur" . "karthik.chikmagalurNOSPAMgmail.com")))
--- /dev/null
+;;; gptel-request.el --- LLM request library for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur;; <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: convenience
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; LLM querying library used by gptel. This file provides the basic data
+;; structures (models, backends) and prompt construction functions used by
+;; gptel, along with the `gptel-request' API.
+;;
+;; This is everything required to use `gptel-request' to write custom commands,
+;; UIs or packages that use gptel to implement custom workflows. To use gptel's
+;; LLM querying API, you can
+;;
+;; (require 'gptel-request)
+;;
+;; and make calls to `gptel-request'.
+;;
+;; Note that this file does not provide any of the UI components used by gptel
+;; (chat buffers, tool use prompts, transient menus), nor does it provide the
+;; default response callbacks used by `gptel-request'. You will need to provide
+;; your own callback to `gptel-request' to act on the LLM response, or require
+;; the larger `gptel' feature.
+
+;;; Code:
+
+(eval-when-compile (require 'subr-x))
+(require 'compat nil t)
+(require 'cl-lib)
+(require 'url)
+(require 'text-property-search)
+(require 'cl-generic)
+(require 'map)
+(require 'mailcap) ;FIXME Avoid this somehow
+
+(declare-function json-read "json" ())
+(defvar json-object-type)
+
+(declare-function gptel--stream-convert-markdown->org "gptel-org")
+(declare-function gptel--convert-markdown->org "gptel-org")
+(declare-function gptel-org--create-prompt-buffer "gptel-org")
+(declare-function gptel-context--wrap "gptel-context")
+(declare-function gptel--transform-apply-preset "gptel")
+(declare-function gptel--insert-response "gptel")
+(declare-function gptel-curl--stream-insert-response "gptel")
+(declare-function gptel-make-openai "gptel-openai")
+
+\f
+;;; User options
+(defgroup gptel nil
+ "Interact with LLMs from anywhere in Emacs."
+ :group 'hypermedia)
+
+(defcustom gptel-proxy ""
+ "Path to a proxy to use for gptel interactions.
+Passed to curl via --proxy arg, for example \"proxy.yourorg.com:80\"
+Leave it empty if you don't use a proxy."
+ :type 'string)
+
+(defcustom gptel-api-key #'gptel-api-key-from-auth-source
+ "An API key (string) for the default LLM backend.
+
+OpenAI by default.
+
+Can also be a function of no arguments that returns an API
+key (more secure) for the active backend."
+ :type '(choice
+ (string :tag "API key")
+ (function :tag "Function that returns the API key")))
+
+(defcustom gptel-stream t
+ "Stream responses from the LLM as they are received.
+
+This option is ignored unless
+- the LLM backend supports streaming, and
+- Curl is in use (see `gptel-use-curl')
+
+When set to nil, Emacs waits for the full response and inserts it
+all at once. This wait is asynchronous.
+
+\='tis a bit silly."
+ :type 'boolean)
+
+(defcustom gptel-use-curl (and (executable-find "curl") t)
+ "Whether gptel should prefer Curl when available.
+
+Can be set to t, nil, or a string path to the curl executable."
+ :type '(choice
+ (const :tag "Do not use Curl" nil)
+ (const :tag "Use Curl" t)
+ (string :tag "Specify path to the Curl executable")))
+
+(defcustom gptel-org-convert-response t
+ "Whether gptel should convert Markdown responses to Org markup.
+
+This only affects requests originating from Org mode buffers."
+ :type 'boolean)
+
+(defcustom gptel-curl-file-size-threshold
+ (if (memq system-type '(windows-nt ms-dos)) #x6ffe 130000)
+ "Size threshold for using file input with Curl.
+
+Specifies the size threshold for when to use a temporary file to pass data to
+Curl in gptel queries. If the size of the data to be sent exceeds this
+threshold, the data is written to a temporary file and passed to Curl using the
+`--data-binary' option with a file reference. Otherwise, the data is passed
+directly as a command-line argument.
+
+The value is an integer representing the number of bytes.
+
+Adjusting this value may be necessary depending on the environment
+and the typical size of the data being sent in gptel queries.
+A larger value may improve performance by avoiding the overhead of creating
+temporary files for small data payloads, while a smaller value may be needed
+if the command-line argument size is limited by the operating system.
+
+The default of #x8000 for windows comes from Microsoft documentation
+located here:
+https://learn.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-createprocessa
+
+It is set to (#x8000 - #x1000 - 2) to account for other (non-data) Curl
+command line arguments."
+ :type 'natnum)
+
+(define-obsolete-variable-alias 'gptel-prompt-filter-hook
+ 'gptel-prompt-transform-functions "0.9.9")
+
+(defcustom gptel-prompt-transform-functions
+ '(gptel--transform-apply-preset gptel--transform-add-context)
+ "Handlers to augment or transform a query before sending it.
+
+This hook is called in a temporary buffer containing the text to
+be sent, with the cursor at the end of the prompt. You can use
+it to modify the buffer or buffer-local variables as required.
+
+Since these functions modify the prompt construction buffer, the order
+in which they run is significant! In particular, you may want to add
+your function before (the default) or after
+`gptel--transform-add-context', which adds gptel's context (other
+buffers, files etc) to this buffer.
+
+Example: A typical use case might be to search for occurrences of $(cmd)
+and replace it with the output of the shell command cmd, making it easy
+to send the output of shell commands to the LLM.
+
+Transform functions can be synchronous or asynchronous.
+
+Synchronous hook functions must accept zero or one argument: the INFO
+plist for the current request.
+
+Asynchronous hook functions must accept two arguments: a callback to
+call after the transformation is complete, and the INFO plist for the
+current request.
+
+Note that while this set of handlers can certainly be set with a global
+value to be applied to all queries in all buffers, it meant to be set
+locally for a specific buffer, or chat topic, or only the context of a
+certain task."
+ :type 'hook)
+
+(defcustom gptel-post-request-hook nil
+ "Hook run after sending a gptel request.
+
+This runs (possibly) before any response is received."
+ :type 'hook)
+
+;; TODO(v1.0): Remove this.
+(defvar gptel-response-filter-functions nil)
+(make-obsolete-variable
+ 'gptel-response-filter-functions
+ "Response filtering is no longer supported in gptel. To toggle
+markdown to Org conversion, see `gptel-org-convert-response'. To
+filter LLM response text, either use `gptel-request' with a
+custom callback, or use `gptel-post-response-functions'."
+ "0.9.7")
+
+;; TODO: Handle `prog-mode' using the `comment-start' variable
+(defcustom gptel-prompt-prefix-alist
+ '((markdown-mode . "### ")
+ (org-mode . "*** ")
+ (text-mode . "### "))
+ "String used as a prefix to the query being sent to the LLM.
+
+This is meant for the user to distinguish between queries and
+responses, and is removed from the query before it is sent.
+
+This is an alist mapping major modes to the prefix strings. This
+is only inserted in dedicated gptel buffers."
+ :type '(alist :key-type symbol :value-type string))
+
+(defcustom gptel-response-prefix-alist
+ '((markdown-mode . "")
+ (org-mode . "")
+ (text-mode . ""))
+ "String inserted before the response from the LLM.
+
+This is meant for the user to distinguish between queries and
+responses.
+
+This is an alist mapping major modes to the reply prefix strings. This
+is only inserted in dedicated gptel buffers before the AI's response."
+ :type '(alist :key-type symbol :value-type string))
+
+(defcustom gptel-response-separator "\n\n"
+ "String inserted before responses.
+
+Also inserted before and after non-consecutive tool calls."
+ :type 'string)
+
+;; Model and interaction parameters
+(defcustom gptel-directives
+ '((default . "You are a large language model living in Emacs and a helpful assistant. Respond concisely.")
+ (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 or directives for the LLM.
+
+Each entry in this alist maps a symbol naming the directive to
+the directive itself. By default, gptel uses the directive with
+the key \\+`default'.
+
+To set the directive for a chat session interactively call
+`gptel-send' with a prefix argument, or call `gptel-menu'.
+
+A \"directive\" is typically the system message (also called
+system prompt or system instruction) sent at the beginning of
+each request to the LLM. It is used to set general instructions,
+expectations and the overall tone.
+
+gptel's idea of the directive is more general. A directive in
+`gptel-directives' 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 (possibly nil) alternating user prompts and LLM responses.
+ This can be used to template the initial 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. See the definition of
+ `gptel--rewrite-directive-default' for an example."
+ :safe #'always
+ :type '(alist :key-type symbol :value-type string))
+
+(defcustom gptel-max-tokens nil
+ "Max tokens per response.
+
+This is roughly the number of words in the response. 100-300 is a
+reasonable range for short answers, 400 or more for longer
+responses.
+
+To set the target token count for a chat session interactively
+call `gptel-send' with a prefix argument."
+ :safe #'always
+ :type '(choice (natnum :tag "Specify Token count")
+ (const :tag "Default" nil)))
+
+(defcustom gptel-temperature 1.0
+ "\"Temperature\" of the LLM response.
+
+This is a number between 0.0 and 2.0 that controls the randomness
+of the response, with 2.0 being the most random.
+
+To set the temperature for a chat session interactively call
+`gptel-send' with a prefix argument."
+ :safe (lambda (v) (or (null v) (numberp v)))
+ :type '(choice (number :tag "Temperature value")
+ (const :tag "Use default" nil)))
+
+(defcustom gptel-cache nil
+ "Whether the LLM should cache request content.
+
+Some LLM backends can cache content sent to it by gptel, so that
+only the newly included part of the text needs to be processed on
+subsequent conversation turns. This results in faster and
+significantly cheaper processing.
+
+NOTE: Manual or client-configurable caching is currently
+supported only by the Anthropic API and thus the
+`gptel-anthropic' backend. This variable has no effect on the
+behavior of other backends.
+
+This variable controls which parts of the query will be cached,
+and can be the symbols t or nil to cache everything or nothing
+respectively. It can also be a list of symbols:
+
+- message: Cache conversation messages
+- system: Cache the system message
+- tool: Cache tool definitions
+
+Examples:
+
+Setting it to (message system) will cache the system message and
+the conversation text.
+
+Setting it to (message system tool) will cache everything and is
+the same as t."
+ :type '(choice
+ (const :tag "Cache everything" t)
+ (const :tag "Do not cache" nil)
+ (repeat symbol))
+ :group 'gptel)
+
+(defvar gptel--known-backends nil
+ "Alist of LLM backends known to gptel.
+
+This is an alist mapping user-provided names to backend structs,
+see `gptel-backend'.
+
+You can have more than one backend pointing to the same resource
+with differing settings.")
+
+(defvar gptel--openai nil)
+(make-obsolete-variable 'gptel--openai "No longer used" "v0.9.9.5")
+
+(defcustom gptel-backend nil
+ "LLM backend to use.
+
+This is the default \"backend\" used by gptel, an object specifying
+connection, authentication and model information required to send LLM
+requests.
+
+There are two ways to set `gptel-backend':
+
+1. with `setopt' or the Customize interface,
+2. and via constructors (such as `gptel-make-openai') in Elisp code.
+
+When using `setopt' or the customize interface, a backend may be
+specified in a list such as
+
+ (BACKEND-TYPE NAME . PLIST)
+
+where:
+
+BACKEND-TYPE is one of `gptel-openai' (all OpenAI-compatible
+services), `gptel-anthropic', `gptel-gemini', `gptel-ollama',
+`gptel-kagi', `gptel--gh' (GitHub Copilot), `gptel-bedrock' (AWS
+Bedrock), `gptel-perplexity', `gptel-deepseek' or `gptel-privategpt'.
+
+NAME is a string, any backend name of your choosing.
+
+PLIST is an optional plist specifying connection and authentication
+information, with keys
+
+:protocol - \"http\" or \"https\"
+:host - Host, such as \"api.openai.com\" or \"localhost:1616\"
+:endpoint - connection endpoint, such as \"/v1/chat/completions\"
+:header - HTTP header to inclue with the request, a string
+ or function
+:key - API key, if required for authentication
+ String, symbol or function, see `gptel-api-key'
+:models - List of supported models (symbols, see
+ `gptel--openai-models' for an example)
+:stream - Whether to stream responses, boolean
+:request-params - Additional parameters to send with backend queries, as
+ a plist. This plist is converted to JSON when sending.
+ This is meant for request parameters that gptel does not
+ provide user options for.
+:curl-args - list of strings representing additional Curl arguments (if
+ `gptel-use-curl' is set)
+
+When using the OpenAI, Anthropic, Gemini, Kagi, Github Copilot,
+Perplexity or Deepseek backends, all plist keys are optional. For other
+services, specifying some fields may be required. Examples:
+
+ (setopt gptel-backend \\='(gptel-openai \"OpenAI\"
+ :key gptel-api-key-from-auth-source
+ :stream t))
+
+ (setopt gptel-backend \\='(gptel-anthropic \"Claude\" :key \"sk-...\"))
+
+ (setopt gptel-backend \\='(gptel-ollama \"Ollama\"
+ :host \"localhost:11434\"
+ :models (qwen3:4b llama3.1:8b)
+ :stream t))
+
+This list of keys is non-exhaustive. Some backends (such as
+`gptel-bedrock') recognize or require additional keys. To see what
+other keys are available, check the corresponding constructor (such as
+`gptel-make-bedrock').
+
+When not using `setopt', backends for LLM providers (local or remote)
+may be constructed and registered using one of the available backend
+constructor functions:
+
+- `gptel-make-openai'
+- `gptel-make-anthropic'
+- `gptel-make-gemini'
+- `gptel-make-ollama'
+- `gptel-make-azure'
+- `gptel-make-gpt4all'
+- `gptel-make-kagi'
+- `gptel-make-privategpt'
+- `gptel-make-perplexity'
+- `gptel-make-deepseek'
+- `gptel-make-xai'
+- `gptel-make-gh-copilot'
+- `gptel-make-bedrock'
+
+In addition, `gptel-backend' can be assigned to them. Examples:
+
+ (setq gptel-backend (gptel-make-openai \"llamacpp\"
+ :host \"localhost:8080\"
+ :protocol \"http\"
+ :models \\='(gpt-oss-120b glm-4.7-flash)))
+
+ (setq gptel-backend (gptel-make-gemini \"Gemini\"
+ :key gptel-api-key :stream t))
+
+ (setq gptel-backend (gptel-make-anthropic \"Claude-think\"
+ :key gptel-api-key
+ :request-params
+ \\='(:thinking (:type \"enabled\" :budget_tokens 1024)
+ :max_tokens 2048)))
+
+See their documentation for more information and the package README for
+examples. Once registered, backends may be retrieved using
+`gptel-get-backend' or switched to interactively from gptel's menu (see
+`gptel-menu')."
+ :safe #'always
+ :type
+ (let ((types '( choice :tag "Type"
+ (const :tag "OpenAI compatible" gptel-openai)
+ (const gptel-anthropic)
+ (const gptel-gemini)
+ (const gptel-ollama)
+ (const gptel-kagi)
+ (const :tag "GitHub Copilot" gptel-gh)
+ (const gptel-bedrock)
+ (const gptel-perplexity)
+ (const gptel-deepseek)
+ (const gptel-privategpt))))
+ `(choice
+ (restricted-sexp :match-alternatives (gptel-backend-p 'nil)
+ :tag "No backend")
+ (cons :tag "(BACKEND-TYPE NAME . PLIST)" ;accommodate (gptel-openai "chatgpt" . plist)
+ ,types (cons string
+ (plist :value-type (choice string symbol function
+ (repeat symbol)))))
+ (cons :tag "(BACKEND-TYPE . PLIST)" ;accommodate (gptel-openai :name "chatgpt" . plist)
+ ,types (plist :value-type (choice string symbol function
+ (repeat symbol))))))
+ :get
+ (lambda (sym)
+ (when-let* ((backend (default-toplevel-value sym))
+ (type (type-of backend))
+ (plist (list :protocol (gptel-backend-protocol backend)
+ :host (gptel-backend-host backend)
+ :endpoint (gptel-backend-endpoint backend)
+ :header (gptel-backend-header backend)
+ :key (gptel-backend-key backend)
+ :models (gptel-backend-models backend)
+ :stream (gptel-backend-stream backend)
+ :curl-args (gptel-backend-curl-args backend)
+ :request-params (gptel-backend-request-params backend))))
+ (apply #'list type (gptel-backend-name backend)
+ (cl-loop for (k v) on plist by #'cddr
+ if (and (readablep v) (not (null v)))
+ collect k and collect v))))
+ :set
+ (lambda (sym val)
+ (cond
+ ((null val) (set-default-toplevel-value sym val))
+ ((listp val)
+ (let* ((name (if (stringp (cadr val)) ;explicit and implicit :name specification
+ (cadr val) (plist-get (cdr val) :name)))
+ (args (if name (cddr val) (cdr val)))
+ type)
+ (cl-remf args :name)
+ (if (memq (car val) '(gptel-gh gptel--gh))
+ (setq type 'gptel-gh-copilot)
+ (setq type (car val)))
+ (set-default-toplevel-value
+ sym (apply (intern (concat "gptel-make-"
+ (substring (symbol-name type) 6)))
+ name args))))
+ ((gptel-backend-p val) (set-default-toplevel-value sym val)))))
+
+(defcustom gptel-model nil
+ (concat
+ "Model for gptel queries.
+
+The name of the model, as a symbol. This is the name as expected
+by the LLM provider's API.
+
+To set the model for a chat session interactively call
+`gptel-send' with a prefix argument.")
+ :safe #'always
+ :type `(choice
+ (symbol :tag "Specify model name")
+ ,@(cl-loop
+ for (_name . backend) in gptel--known-backends
+ append (mapcar
+ (lambda (model) (list 'const :tag (symbol-name model)
+ model))
+ (gptel-backend-models backend)))))
+
+(defvar gptel-expert-commands nil
+ "Whether experimental gptel options should be enabled.
+
+This opens up advanced options in `gptel-menu'.")
+
+(defvar gptel--num-messages-to-send nil)
+(put 'gptel--num-messages-to-send 'safe-local-variable #'integer-or-null-p)
+
+(defcustom gptel-log-level nil
+ "Logging level for gptel.
+
+This is one of nil or the symbols info and debug:
+
+nil: Don't log responses
+info: Log request and response bodies
+debug: Log request/response bodies, headers and all other
+ connection settings.
+
+When non-nil, information is logged to `gptel--log-buffer-name',
+which see."
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Limited" info)
+ (const :tag "Full" debug)))
+
+(defcustom gptel-track-response t
+ "Distinguish between user messages and LLM responses.
+
+When creating a prompt to send to the LLM, gptel distinguishes
+between text entered by the user and past LLM responses. This
+distinction is necessary for back-and-forth conversation with an
+LLM.
+
+In regular Emacs buffers you can turn this behavior off by
+setting `gptel-track-response' to nil. All text, including
+past LLM responses, is then treated as user input when sending
+queries.
+
+This variable has no effect in dedicated chat buffers (buffers
+with `gptel-mode' enabled), where user prompts and responses are
+always handled separately."
+ :type 'boolean)
+
+(defcustom gptel-track-media nil
+ "Whether links to supported media types should be followed.
+
+When this is non-nil, gptel will send text, images or other media from
+links in Org and Markdown buffers to the LLM.
+
+Sending images or other binary media from links requires the
+active `gptel-model' to support it. See `gptel-make-openai',
+`gptel-make-anthropic', `gptel-make-ollama' or `gptel-make-gemini' for
+details on how to specify media support for models.
+
+To include media (including binary formats like images) more generally,
+you can also use `gptel-add' or `gptel-add-file' instead."
+ :type 'boolean)
+
+(defcustom gptel-use-context 'system
+ "Where in the request to inject gptel's additional context.
+
+gptel always includes the active region or the buffer up to the
+cursor in the request to the LLM. Additionally, you can add
+other buffers or their regions to the context with
+`gptel-add-context', or from gptel's menu. This data will be
+sent with every request.
+
+This option controls whether and where this additional context is
+included in the request.
+
+Currently supported options are:
+
+ nil - Do not use the context.
+ system - Include the context with the system message.
+ user - Include the context with the user prompt."
+ :group 'gptel
+ :type '(choice
+ (const :tag "Don't include context" nil)
+ (const :tag "With system message" system)
+ (const :tag "With user prompt" user)))
+
+(defcustom gptel-include-reasoning 'ignore
+ "How to handle LLM reasoning or \"thinking\" text blocks.
+
+Some LLMs include in their response a \"thinking\" section. This
+text improves the quality of the LLM's final output, but may not
+be interesting to you by itself.
+
+Supported options are the symbols
+
+ ignore - Include in the response but ignore on subsequent
+ conversation turns (default)
+ t - Include in the response
+ nil - Do not include
+
+It can also be a string naming a buffer, in which case the
+reasoning text will be inserted at the end of that buffer."
+ :group 'gptel
+ :type '(choice
+ (const :tag "Include with response" t)
+ (const :tag "Don't include" nil)
+ (const :tag "Include but ignore" ignore)
+ (string :tag "Include in buffer")))
+
+(define-obsolete-variable-alias 'gptel-context--alist 'gptel-context
+ "0.9.9.3")
+
+(defcustom gptel-context nil
+ "List of gptel's context sources.
+
+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\"
+ #<buffer *scratch*>
+ ...)
+
+The above covers the most common cases. You can also specify context
+sources in a more targeted way, with entries of the form
+
+ (<buffer> . spec)
+ (\"/path/to/file\" . spec)
+
+where spec is a plist declaring specific parts of the buffer/file to
+include instead of the entire text.
+
+For buffers, you can specify regions to include using buffer spans and
+line number ranges as conses, and overlays as a list:
+
+ (<buffer> :bounds ((start1 . end1) (start2 . end2) ...)
+ :lines ((from1 . to1) (from2 . end2) ...)
+ :overlays (ov1 ov2 ...))
+
+For files, spec can include buffer spans and line number ranges, as well as
+the MIME type of the file:
+
+ (\"/path/to/file\" :bounds ((start1 . end1) (start2 . end2) ...)
+ :lines ((from1 . to1) (from2 . end2) ...)
+ :mime \"image/png\")
+
+gptel tries to guess file MIME types, but is not always successful, so
+it is recommended to provide it with non-text files.
+
+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 with the :context key."
+ :type '(repeat string))
+
+(defcustom gptel-markdown-validate-link #'always
+ "Validate links to be sent as context with gptel queries.
+
+When `gptel-track-media' is enabled, this option determines if a
+supported link will be followed and its source included with gptel
+queries from Markdown buffers. Currently only links to files are
+supported (along with web URLs if the model supports them).
+
+It should be a function that accepts a Markdown link and return non-nil
+if the link should be followed. See `markdown-link-at-pos' for the
+structure of a Markdown link object.
+
+By default, all links are considered valid.
+
+Set this to `gptel--link-standalone-p' to only follow links placed on a
+line by themselves, separated from surrounding text."
+ :type '(choice
+ (const :tag "All links" always)
+ (const :tag "Standalone links" gptel--link-standalone-p)
+ (function :tag "Function"))
+ :group 'gptel)
+
+(defvar gptel--request-alist nil
+ "Alist of active gptel requests.
+Each entry has the form (PROCESS . (FSM ABORT-CLOSURE))
+If the ABORT-CLOSURE is called, it must abort the PROCESS.")
+
+(defvar gptel--request-params nil
+ "Extra parameters sent with each gptel request.
+
+These parameters are combined with model-specific and backend-specific
+:request-params before sending a request, which see. Warning: values
+incompatible with the active backend can break gptel. Do not use this
+variable unless you know what you're doing!")
+
+(defconst gptel--ersatz-json-tool "response_json"
+ "Name of ersatz tool used to force JSON output.
+
+Some APIs, like Anthropic, use a tool to produce structured JSON output.")
+
+(defcustom gptel-curl-extra-args nil
+ "Extra arguments to pass to Curl when sending queries.
+
+This should be a list of strings, each one a Curl command line
+argument. Note that these should not conflict with the options
+in `gptel-curl--common-args', which gptel requires for correct
+functioning.
+
+If you want to specify extra arguments only when using a specific
+gptel backend, use the `:curl-args' slot of the backend instead.
+See `gptel-backend'."
+ :group 'gptel
+ :type '(repeat string))
+
+(defconst gptel-curl--common-args
+ (cond
+ ((memq system-type '(windows-nt ms-dos))
+ '("--disable" "--location" "--silent" "-XPOST"
+ "-y7200" "-Y1" "-N" "-D-"))
+ ((eq system-type 'darwin)
+ '("--disable" "--location" "--silent" "--compressed"
+ "-XPOST" "-y7200" "-Y1" "-N" "-D-"))
+ (t
+ '("--disable" "--location" "--silent" "--compressed"
+ "-XPOST" "-y7200" "-Y1" "-N" "-D-")))
+ "Arguments always passed to Curl for gptel queries.")
+
+(defvar gptel--link-type-cache nil
+ "Cache of checks for binary files.
+
+Each alist entry maps an absolute file path to a cons cell of the
+form (t . binaryp), where binaryp is non-nil if the file is
+binary-encoded.")
+
+;; The following is derived from:
+;;
+;; (concat "\\(?:" markdown-regex-link-inline "\\|" markdown-regex-angle-uri "\\)")
+;;
+;; Since we want this known at compile time, when markdown-mode is not
+;; guaranteed to be available, we have to hardcode it.
+(defconst gptel-markdown--link-regex
+ "\\(?:\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)\\|\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^] \n\r<>,;()]+\\)\\(>\\)\\)"
+ "Link regex for `gptel-mode' in Markdown mode.")
+
+(defvar gptel--mode-description-alist
+ '((js2-mode . "Javascript")
+ (sh-mode . "Shell")
+ (enh-ruby-mode . "Ruby")
+ (yaml-mode . "Yaml")
+ (yaml-ts-mode . "Yaml")
+ (rustic-mode . "Rust")
+ (tuareg-mode . "OCaml"))
+ "Mapping from unconventionally named major modes to languages.
+
+This is used when generating system prompts for rewriting and
+when including context from these major modes.")
+
+\f
+;;; Utility functions
+
+;;;; JSON parsing helpers
+;; JSON conversion semantics used by gptel
+;; empty object "{}" => empty list '() == nil
+;; null => :null
+;; false => :json-false
+
+;; TODO(tool) Except when reading JSON from a string, where null => nil
+
+(defmacro gptel--json-read ()
+ "Parse JSON at point in buffer."
+ (if (fboundp 'json-parse-buffer)
+ `(json-parse-buffer
+ :object-type 'plist
+ :null-object :null
+ :false-object :json-false)
+ (require 'json)
+ (defvar json-object-type)
+ (defvar json-null)
+ (declare-function json-read "json" ())
+ `(let ((json-object-type 'plist)
+ (json-null :null))
+ (json-read))))
+
+(defmacro gptel--json-read-string (str)
+ "Pasre JSON string STR."
+ (if (fboundp 'json-parse-string)
+ `(json-parse-string ,str
+ :object-type 'plist
+ :null-object nil
+ :false-object :json-false)
+ (require 'json)
+ (defvar json-object-type)
+ (declare-function json-read-from-string "json" ())
+ `(let ((json-object-type 'plist))
+ (json-read-from-string ,str))))
+
+(defmacro gptel--json-encode (object)
+ "Serialize OBJECT as JSON."
+ (if (fboundp 'json-serialize)
+ `(json-serialize ,object
+ :null-object :null
+ :false-object :json-false)
+ (require 'json)
+ (defvar json-false)
+ (defvar json-null)
+ (declare-function json-encode "json" (object))
+ `(let ((json-false :json-false)
+ (json-null :null))
+ (json-encode ,object))))
+
+(defmacro gptel--maybe-funcall (func-or-sym &rest args)
+ "If FUNC-OR-SYM is a function, call it with ARGS.
+
+Otherwise, evaluate it as a variable."
+ `(if (functionp ,func-or-sym)
+ ;; TODO(v1.0) Remove this condition-case. This arity check is for
+ ;; benefit of users who have personal customizations touching gptel's
+ ;; internal API re: backend header and url functions.
+ (condition-case nil
+ (apply ,func-or-sym (list ,@args))
+ (wrong-number-of-arguments
+ (message "Displaying warning")
+ (display-warning
+ 'gptel (format "%s calling convention has changed: \
+Called with %d arguments but accept %d. \
+Please update them, and see NEWS (0.9.9.5) for details."
+ (if (symbolp ,func-or-sym) (format "Function %s" ,func-or-sym)
+ "gptel-backend-header/gptel-backend-url function")
+ (length ',args) (car (func-arity ,func-or-sym))))
+ (funcall ,func-or-sym)))
+ ,func-or-sym))
+
+(defun gptel--process-models (models)
+ "Convert items in MODELS to symbols with appropriate properties."
+ (let ((models-processed))
+ (dolist (model models)
+ (cl-etypecase model
+ (string (push (intern model) models-processed))
+ (symbol (push model models-processed))
+ (cons
+ (cl-destructuring-bind (name . props) model
+ (setf (symbol-plist name)
+ ;; MAYBE: Merging existing symbol plists is safer, but makes it
+ ;; difficult to reset a symbol plist, since removing keys from
+ ;; it (as opposed to setting them to nil) is more work.
+ ;;
+ ;; (map-merge 'plist (symbol-plist name) props)
+ props)
+ (push name models-processed)))))
+ (nreverse models-processed)))
+
+;;;; Backend interface
+(defun gptel-get-backend (name)
+ "Return gptel backend with NAME.
+
+Throw an error if there is no match."
+ (or (alist-get name gptel--known-backends nil nil #'equal)
+ (user-error "Backend %s is not known to be defined"
+ name)))
+
+(gv-define-setter gptel-get-backend (val name)
+ `(setf (alist-get ,name gptel--known-backends
+ nil t #'equal)
+ ,val))
+
+(cl-defstruct
+ (gptel-backend (:constructor gptel--make-backend)
+ (:copier gptel--copy-backend))
+ name host header protocol stream
+ endpoint key models url request-params
+ curl-args
+ (coding-system
+ nil :documentation "Can be set to `binary' if the backend expects non UTF-8 output."))
+
+;;;; Misc utilities
+(defun gptel-api-key-from-auth-source (&optional host user)
+ "Lookup api key in the auth source.
+By default, the LLM host for the active backend is used as HOST,
+and \"apikey\" as USER."
+ (if-let* ((secret
+ (plist-get
+ (car (auth-source-search
+ :host (or host (gptel-backend-host gptel-backend))
+ :user (or user "apikey")
+ :require '(:secret)))
+ :secret)))
+ (if (functionp secret)
+ (encode-coding-string (funcall secret) 'utf-8)
+ secret)
+ (user-error "No `gptel-api-key' found in the auth source")))
+
+;; FIXME Should we utf-8 encode the api-key here?
+(defun gptel--get-api-key (&optional key)
+ "Get api key from KEY, or from `gptel-api-key'."
+ (when-let* ((key-sym (or key (gptel-backend-key gptel-backend))))
+ (cl-typecase key-sym
+ (function (string-trim-right (funcall key-sym) "[\n\r]+"))
+ (string (string-trim-right key-sym "[\n\r]+"))
+ (symbol (if-let* ((val (symbol-value key-sym)))
+ (gptel--get-api-key val)
+ (error "`gptel-api-key' is not valid")))
+ (t (error "`gptel-api-key' is not valid")))))
+
+(defsubst gptel--to-number (val)
+ "Ensure VAL is a number."
+ (cond
+ ((numberp val) val)
+ ((stringp val) (string-to-number val))
+ ((error "%S cannot be converted to a number" val))))
+
+(defsubst gptel--to-string (s)
+ "Convert S to a string, if possible."
+ (cl-typecase s
+ (symbol (symbol-name s))
+ (string s)
+ (otherwise (prin1-to-string s))))
+
+(defsubst gptel--intern (s)
+ "Intern S, if possible."
+ (cl-etypecase s
+ (symbol s)
+ (string (intern s))))
+
+(defun gptel--merge-plists (&rest plists)
+ "Merge PLISTS, altering the first one.
+
+Later plists in the sequence take precedence over earlier ones."
+ (let (;; (rtn (copy-sequence (pop plists)))
+ (rtn (pop plists))
+ p v ls)
+ (while plists
+ (setq ls (pop plists))
+ (while ls
+ (setq p (pop ls) v (pop ls))
+ (setq rtn (plist-put rtn p v))))
+ rtn))
+
+(defun gptel--file-binary-p (path)
+ "Check if file at PATH is readable and binary."
+ ;; HACK Image files with ICC color profiles are characterized as ASCII
+ ;; (#1223), so until we find a better solution we just match these files by
+ ;; extension.
+ (or (string-match-p "\\.\\(jpe?g\\|png\\|gif\\|webp\\)\\'" path)
+ (condition-case nil
+ (with-temp-buffer
+ (insert-file-contents path nil 1 512 'replace)
+ (memq buffer-file-coding-system
+ '(no-conversion no-conversion-multibyte)))
+ (file-missing (message "File \"%s\" is not readable." path)
+ nil))))
+
+(defun gptel--insert-file-string (path)
+ "Insert at point the contents of the file at PATH as context."
+ (insert (format "In file `%s`:" (abbreviate-file-name path))
+ "\n\n```\n")
+ (let ((pm (point-marker)))
+ (set-marker-insertion-type pm t)
+ (insert-file-contents path)
+ (goto-char pm))
+ (insert "\n```\n"))
+
+(defun gptel--strip-mode-suffix (mode-sym)
+ "Remove the -mode suffix from MODE-SYM.
+
+MODE-SYM is typically a major-mode symbol."
+ (or (alist-get mode-sym gptel--mode-description-alist)
+ (let ((mode-name (thread-last
+ (symbol-name mode-sym)
+ (string-remove-suffix "-mode")
+ (string-remove-suffix "-ts"))))
+ ;; NOTE: The advertised calling convention of provided-mode-derived-p
+ ;; has changed in Emacs 30, this needs to be updated eventually
+ (if (provided-mode-derived-p
+ mode-sym 'prog-mode 'text-mode 'tex-mode)
+ mode-name ""))))
+
+(defvar url-http-end-of-headers)
+(defvar url-http-response-status)
+(cl-defun gptel--url-retrieve (url &key method data headers)
+ "Retrieve URL synchronously with METHOD, DATA and HEADERS."
+ (declare (indent 1))
+ (let ((url-request-method (if (eq method 'post) "POST" "GET"))
+ (url-request-data (when (eq method 'post) (encode-coding-string (gptel--json-encode data) 'utf-8)))
+ (url-mime-accept-string "application/json")
+ (url-request-extra-headers
+ `(("content-type" . "application/json")
+ ,@headers)))
+ (with-current-buffer (url-retrieve-synchronously url 'silent)
+ (goto-char url-http-end-of-headers)
+ (gptel--json-read))))
+
+(defsubst gptel-prompt-prefix-string ()
+ "Prefix before user prompts in `gptel-mode'."
+ (declare (side-effect-free t))
+ (or (alist-get major-mode gptel-prompt-prefix-alist) ""))
+
+(defsubst gptel-response-prefix-string ()
+ "Prefix before LLM responses in `gptel-mode'."
+ (declare (side-effect-free t))
+ (or (alist-get major-mode gptel-response-prefix-alist) ""))
+
+(defmacro gptel--at-word-end (&rest body)
+ "Execute BODY at end of the current word or punctuation."
+ `(save-excursion
+ (skip-syntax-forward "w.")
+ ,(macroexp-progn body)))
+
+;; NOTE: Remove after we drop Emacs 27.1 (#724)
+(defmacro gptel--temp-buffer (buf)
+ "Generate a temp buffer BUF.
+
+Compatibility macro for Emacs 27.1."
+ (if (< emacs-major-version 28)
+ `(generate-new-buffer ,buf)
+ `(generate-new-buffer ,buf t)))
+
+;; This is defined in gptel, but we define it here as well as it's required by
+;; `gptel--with-buffer-copy'.
+(defvar gptel-mode nil)
+
+(defmacro gptel--with-buffer-copy (buf start end &rest body)
+ "Copy gptel's local variables from BUF to a temp buffer and run BODY.
+
+If positions START and END are provided, insert that part of BUF first."
+ (declare (indent 3))
+ `(gptel--with-buffer-copy-internal ,buf ,start ,end (lambda () ,@body)))
+
+(defun gptel--with-buffer-copy-internal (buf start end body-thunk)
+ "Prepare a temp buffer for a gptel request.
+
+For BUF, START, END and BODY-THUNK see `gptel--with-buffer-copy'."
+ (let ((temp-buffer (gptel--temp-buffer " *gptel-prompt*")))
+ (with-current-buffer temp-buffer
+ (dolist (sym '( gptel-backend gptel--system-message gptel-model
+ gptel-mode gptel-track-response gptel-track-media
+ gptel-use-tools gptel-tools gptel-use-curl gptel--schema
+ gptel-use-context gptel-context gptel--num-messages-to-send
+ gptel-stream gptel-include-reasoning gptel--request-params
+ gptel-temperature gptel-max-tokens gptel-cache))
+ (set (make-local-variable sym) (buffer-local-value sym buf)))
+ (when (and start end) (insert-buffer-substring buf start end))
+ (setq major-mode (buffer-local-value 'major-mode buf))
+ (funcall body-thunk))))
+
+(defsubst gptel--trim-prefixes (s)
+ "Remove prompt/response prefixes from string S.
+
+Return nil if string collapses to empty string."
+ (let* ((trimmed (string-trim-left
+ s (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
+ (regexp-quote
+ (gptel-prompt-prefix-string)))))
+ (trimmed (string-trim-right
+ trimmed (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
+ (regexp-quote
+ (gptel-response-prefix-string))))))
+ (unless (string-empty-p trimmed)
+ trimmed)))
+
+(defun gptel--link-standalone-p (link)
+ "Return non-nil if Markdown LINK is isolated.
+
+This means the extent from the link beginning to end is the only
+non-whitespace content on its line."
+ (let ((beg (car link)) (end (cadr link)))
+ (save-excursion
+ (and (= beg (progn (goto-char beg) (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (point)))
+ (= end (progn (goto-char end) (end-of-line)
+ (skip-chars-backward "\t ")
+ (point)))))))
+
+(defsubst gptel--curl-path ()
+ "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)
+ (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
+;; another map from these symbols to the actual model structs.
+
+(defsubst gptel--model-name (model)
+ "Get name of gptel MODEL."
+ (gptel--to-string model))
+
+(defsubst gptel--model-capabilities (model)
+ "Get MODEL capabilities."
+ (get model :capabilities))
+
+(defsubst gptel--model-mimes (model)
+ "Get supported mime-types for MODEL."
+ (get model :mime-types))
+
+(defsubst gptel--model-capable-p (cap &optional model)
+ "Return non-nil if MODEL supports capability CAP."
+ (memq cap (gptel--model-capabilities
+ (or model gptel-model))))
+
+;; TODO Handle model mime specifications like "image/*"
+(defsubst gptel--model-mime-capable-p (mime &optional model)
+ "Return non nil if MODEL can understand MIME type."
+ (car-safe (member mime (gptel--model-mimes
+ (or model gptel-model)))))
+
+(defsubst gptel--model-request-params (model)
+ "Get model-specific request parameters for MODEL."
+ (get model :request-params))
+
+;;;; File handling
+(defun gptel--base64-encode (file)
+ "Encode FILE as a base64 string.
+
+FILE is assumed to exist and be a regular file."
+ (with-temp-buffer
+ (insert-file-contents-literally file)
+ (base64-encode-region (point-min) (point-max)
+ :no-line-break)
+ (buffer-string)))
+
+;;;; Directive handling
+
+(defvar gptel--system-message
+ (or (alist-get 'default gptel-directives)
+ "You are a large language model living in Emacs and a helpful assistant. Respond concisely.")
+ "The system message used by gptel.")
+(put 'gptel--system-message 'safe-local-variable
+ #'(lambda (v) (or (string-or-null-p v)
+ (and (listp v)
+ (cl-every #'string-or-null-p v)))))
+
+(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
+ (string-replace
+ "\n" (or replacement " ")
+ (substring directive 0 (min width (length directive)))))
+ (function
+ (concat
+ "λ: "
+ (string-replace
+ "\n" (or replacement " ")
+ (truncate-string-to-width
+ (or (and-let* ((doc (documentation directive)))
+ (substring doc nil (string-match-p "\n" doc)))
+ "[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 &optional raw)
+ "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/LLM
+records (a list of strings or nil).
+
+If RAW is non-nil, the user/LLM records are not processed and are
+returned as a list of strings."
+ (and directive
+ (cl-etypecase directive
+ (string (list directive))
+ (function (gptel--parse-directive (funcall directive) raw))
+ (cons (if raw directive
+ (cons (car directive)
+ ;; FIXME(augment) do this elsewhere
+ (gptel--parse-list
+ gptel-backend (cdr directive))))))))
+
+\f
+;;; Logging
+
+(defconst gptel--log-buffer-name "*gptel-log*"
+ "Log buffer for gptel.")
+
+(declare-function json-pretty-print "json")
+
+(defun gptel--log (data &optional type no-json)
+ "Log DATA to `gptel--log-buffer-name'.
+
+TYPE is a label for data being logged. DATA is assumed to be
+Valid JSON unless NO-JSON is t."
+ (with-current-buffer (get-buffer-create gptel--log-buffer-name)
+ (let ((p (goto-char (point-max))))
+ (unless (bobp) (insert "\n"))
+ (insert (format "{\"gptel\": \"%s\", " (or type "none"))
+ (format-time-string "\"timestamp\": \"%Y-%m-%d %H:%M:%S\"}\n")
+ data)
+ (unless no-json (ignore-errors (json-pretty-print p (point)))))))
+
+\f
+;;; Structured output
+(defvar gptel--schema nil
+ "Response output schema for backends that support it.")
+
+(cl-defgeneric gptel--parse-schema (_backend _schema)
+ "Parse JSON schema in a backend-appropriate way.")
+
+(defun gptel--dispatch-schema-type (schema)
+ "Convert SCHEMA to a valid elisp representation.
+
+SCHEMA can be specified in several ways:
+- As a plist readable by `gptel--json-encode'
+ Ex: (:type object :properties (:key1 (:type number :description \"...\")
+ :key2 (:type string)))
+
+- As a serialized JSON string, which will be passed as-is.
+
+- In shorthand form #1, a single-line comma-separated string with object
+ keys and (optionally) types:
+ Ex: \"key1, key2 number\"
+ Ex: \"key1 string, key2 int\"
+ The default type is string, and types can be shortened (integer -> int) as
+ long as they match a JSON schema type uniquely.
+
+- In shorthand form #2, a multi-line string with keys, (optionally) types and
+ (optionally) descriptions
+ Ex: \"key1: description 1 here
+ key2 integer: description 2 here\"
+
+- Shorthand forms can be placed inside [ and ] to specify an array of
+ objects:
+ Ex: \"[key1, key2 number]\"
+ Ex: \"[key1: description 1 here
+ key2 int: description 2 here]\""
+ (when (stringp schema) ;Two possibilities: serialized JSON, or shorthand form
+ (let (wrap-in-array) ;Flag to wrap the object type in an array
+ (with-temp-buffer ;Parser for (possibly) shorthand forms
+ (insert schema)
+ (goto-char (point-min)) (skip-chars-forward " \n\r\t")
+ (if (= (char-after) ?{)
+ (setq schema (gptel--json-read)) ;Assume serialized JSON schema, we're done
+ (when (= (char-after) ?\[) ;Shorthand: assume array top-level type
+ (save-excursion
+ (goto-char (point-max)) (skip-chars-backward " \n\r\t") (delete-char -1))
+ (delete-char 1) ;Delete array markers [ and ]
+ (setq wrap-in-array t))
+ (let ( props types descriptions ;Nested object and array types are disallowed in shorthand
+ (all-types '("number" "string" "integer" "boolean" "null")))
+ (if (= (point-max) (line-end-position)) ; Single or multi-line?
+ ;; Single line format (type optional): "key1 type, key2, ..."
+ (while (re-search-forward ",?\\([^ ,]+\\) *\\([^ ,]*\\]?\\)" nil t)
+ (push (match-string 1) props)
+ (push (if (string-empty-p (match-string 2))
+ "string" (car (all-completions (match-string 2) all-types)))
+ types)
+ (push nil descriptions))
+ ;; Multi-line format (type, description optional):
+ ;; "key1 type: description1 \n key2: description2..."
+ (while (re-search-forward "\\([^ :]+\\) *\\([^ :]*\\):?"
+ (line-end-position) t)
+ (push (match-string 1) props)
+ (push (if (string-empty-p (match-string 2))
+ "string" (car (all-completions (match-string 2) all-types)))
+ types)
+ (skip-chars-forward " \t")
+ (push (if (eolp) nil (buffer-substring-no-properties
+ (point) (line-end-position)))
+ descriptions)
+ (forward-line 1)))
+ (let ((object
+ (list :type "object"
+ :properties
+ (cl-mapcan
+ (lambda (prop type desc)
+ `(,(intern (concat ":" prop))
+ (:type ,type ,@(when desc
+ (list :description (string-trim desc))))))
+ (nreverse props) (nreverse types) (nreverse descriptions)))))
+ (setq schema
+ (if wrap-in-array (list :type "array" :items object) object))))))))
+ ;; The OpenAI and Anthropic APIs don't allow arrays at the root of the schema.
+ ;; Work around this by wrapping it in an object with the field "items".
+ ;; TODO(schema): Find some way to strip this extra layer from the response.
+ (if (member (plist-get schema :type) '("array" array))
+ (list :type "object"
+ :properties (list :items schema)
+ :required ["items"]
+ :additionalProperties :json-false)
+ schema))
+
+(defun gptel--preprocess-schema (spec)
+ "Set additionalProperties for objects in SPEC destructively.
+
+Convert symbol :types to strings."
+ ;; NOTE: Do not use `sequencep' here, as that covers strings too and breaks
+ ;; things.
+ (when (or (listp spec) (vectorp spec))
+ (cond
+ ((vectorp spec)
+ (cl-loop for element across spec
+ for idx upfrom 0
+ do (aset spec idx (gptel--preprocess-schema element))))
+ ((keywordp (car spec))
+ (let ((tail spec))
+ (while tail
+ (when (eq (car tail) :type)
+ (when (symbolp (cadr tail)) ;Convert symbol :type to string
+ (setcar (cdr tail) (symbol-name (cadr tail))))
+ (when (equal (cadr tail) "object") ;Add additional object fields
+ (plist-put tail :additionalProperties :json-false)
+ (let ((vprops (vconcat
+ (cl-loop
+ for prop in (plist-get tail :properties) by #'cddr
+ collect (substring (symbol-name prop) 1)))))
+ (plist-put tail :required vprops)
+ (plist-put tail :propertyOrdering vprops))))
+ (when (or (listp (cadr tail)) (vectorp (cadr tail)))
+ (gptel--preprocess-schema (cadr tail)))
+ (setq tail (cddr tail)))))
+ ((listp spec) (dolist (element spec)
+ (when (listp element)
+ (gptel--preprocess-schema element))))))
+ spec)
+
+\f
+;;; Tool use
+
+(defcustom gptel-use-tools t
+ "Whether gptel should use tools.
+
+Tools are capabilities provided by you to the LLM as functions an
+LLM can choose to call. gptel runs the function call on your
+machine.
+
+If set to t, any tools selected in variable `gptel-tools' will be made
+available to the LLM. This is the default. It has no effect if no
+tools are selected.
+
+If set to force, gptel will try to force the LLM to call one or
+more of the provided tools. Support for this feature depends on
+the backend/API, and gptel will fall back to the default behavior
+when forcing tool use is unsupported.
+
+If nil, tool use is turned off."
+ :type '(choice
+ (const :tag "Enable" t)
+ (const :tag "Force tool use" force)
+ (const :tag "Turn Off" nil)))
+
+(defcustom gptel-confirm-tool-calls 'auto
+ "Whether tool calls should wait for the user to run them.
+
+If set to t or nil, tool calls always or never seek confirmation
+from the user before running.
+
+If set to the symbol auto (the default), a tool call will seek
+confirmation only when the corresponding tool spec has a non-nil
+:confirm slot. See `gptel-make-tool'."
+ :type '(choice
+ (const :tag "Tool decides" auto)
+ (const :tag "Always" t)
+ (const :tag "Never" nil)))
+
+(defcustom gptel-include-tool-results 'auto
+ "Whether tool call results should be included in the buffer.
+
+If set to t or nil, results of tool calls are always or never
+included in the LLM response, respectively.
+
+If set to the symbol auto (the default), a tool call result is
+included only when the corresponding tool spec has a non-nil
+:include slot. See `gptel-make-tool'."
+ :type '(choice
+ (const :tag "Tool decides" auto)
+ (const :tag "Always" t)
+ (const :tag "Never" nil)))
+
+(defcustom gptel-tools nil
+ "A list of tools to include with gptel requests.
+
+Each tool should be a `gptel-tool' struct, which see. To specify
+a tool, use `gptel-make-tool', which see."
+ :group 'gptel
+ :type '(repeat gptel-tool))
+
+(cl-defstruct (gptel-tool (:constructor nil)
+ (:constructor gptel--make-tool-internal
+ (&key function name description args
+ async category confirm include
+ &allow-other-keys))
+ (:copier gptel--copy-tool))
+ "Struct to specify tools for LLMs to run.
+
+A tool is a function specification sent to the LLM along with
+a (plain language) task. If the LLM decides to use the tool to
+accomplish the task, gptel will run the tool and (optionally)
+feed the LLM the results. You can add tools via
+`gptel-make-tool', which see."
+ (function nil :type function :documentation "Function that runs the tool")
+ (name nil :type string :documentation "Tool name, snake_case recommended")
+ (description nil :type string :documentation "What the tool does, intended for the LLM")
+ (args nil :type list :documentation "List of plists specifying function arguments")
+ (async nil :type boolean :documentation "Whether the function runs asynchronously")
+ (category nil :type string :documentation "Use to group tools by purpose")
+ (confirm nil :type boolean :documentation "Seek confirmation before running tool?")
+ (include t :type boolean :documentation "Include tool results in buffer?"))
+
+(defun gptel--preprocess-tool-args (spec)
+ "Convert symbol :type values in tool SPEC to strings destructively."
+ ;; NOTE: Do not use `sequencep' here, as that covers strings too and breaks
+ ;; things.
+ (when (or (listp spec) (vectorp spec))
+ (cond
+ ((vectorp spec)
+ (cl-loop for element across spec
+ for idx upfrom 0
+ do (aset spec idx (gptel--preprocess-tool-args element))))
+ ((keywordp (car spec))
+ (let ((tail spec))
+ (while tail
+ (when (and (eq (car tail) :type) (symbolp (cadr tail)))
+ (setcar (cdr tail) (symbol-name (cadr tail))))
+ ;; TODO: Handle :enum ("provided" "as" "list") here, convert to
+ ;; :enum ["provided" "as" "array"]
+ (when (or (listp (cadr tail)) (vectorp (cadr tail)))
+ (gptel--preprocess-tool-args (cadr tail)))
+ (setq tail (cddr tail)))))
+ ((listp spec) (dolist (element spec)
+ (when (listp element)
+ (gptel--preprocess-tool-args element))))))
+ spec)
+
+(defun gptel--make-tool (&rest spec)
+ "Construct a gptel-tool according to SPEC."
+ (gptel--preprocess-tool-args (plist-get spec :args))
+ (apply #'gptel--make-tool-internal spec))
+
+(defvar gptel--known-tools nil
+ "Alist of gptel tools arranged by category.
+
+A \"tool\" is a function spec (definition and description)
+provided by gptel to an LLM. See `gptel-tool'. Each tool is
+assigned a category when it is created, with a category of
+\"misc\" if none is specified.
+
+This is a two-level alist mapping categories and tool names to
+the tool itself. It is used as a global register of available
+tools and in gptel's UI, see variable `gptel-tools'.
+
+In this example structure, cat-tool and the rest are cl-structs
+of type `gptel-tool':
+
+ CATEGORY TOOL NAME TOOL
+ ((\"filesystem\" . ((\"read_file\" . cat-tool)
+ (\"list_directory\" . ls-tool)))
+ (\"emacs\" . ((\"read_buffer\" . buffer-substring-tool)
+ (\"send_message\" . message-tool))))
+
+This variable is for internal use only, to define a tool use
+`gptel-make-tool'.")
+
+(defun gptel-get-tool (path)
+ "Find tool in gptel's tool registry at PATH.
+
+PATH can be specified
+- as a string representing the tool name, like \"search_db\",
+- or as a list representing a category and tool name,
+ like \\='(\"emacs\" \"read_buffer\").
+In both cases, the first matching gptel-tool is returned.
+
+- as a string representing a category, like \"filesystem\".
+In this case a list of all gptel-tools with this category is
+returned."
+ (or (cl-etypecase path
+ (cons (let ((tc (map-nested-elt gptel--known-tools path)))
+ (if (consp tc) (map-values tc) tc)))
+ (string (if-let* ((category (assoc path gptel--known-tools)))
+ (map-values (cdr category))
+ (cl-loop for (_ . tools) in gptel--known-tools
+ if (assoc path tools)
+ return (cdr it)))))
+ (error "No tool matches for %S" path)))
+
+(defun gptel-make-tool (&rest slots)
+ "Make a gptel tool for LLM use.
+
+The following keyword arguments are available, of which the first
+four SLOTS are required.
+
+NAME: The name of the tool, recommended to be in Javascript style snake_case.
+
+FUNCTION: The function itself (lambda or symbol) that runs the tool.
+
+DESCRIPTION: A verbose description of what the tool does, how to
+call it and what it returns.
+
+ARGS: A list of plists specifying the arguments, or nil for a function that
+takes no arguments. Each plist in ARGS requires the following keys:
+- argument :name and :description, as strings.
+- argument :type, as a symbol. Allowed types are those understood by the JSON
+ schema: string, number, integer, boolean, array, object or null
+
+The following plist keys are conditional/optional:
+- :optional, boolean indicating if argument is optional
+- :enum for enumerated types, whose value is a vector of strings representing
+ allowed values. Note that :type is still required for enums.
+- :items, if the :type is array. Its value must be a plist including at least
+ the item's :type.
+- :properties, if the type is object. Its value must be a plist that can be
+ serialized into a JSON object specification by `json-serialize'.
+
+ASYNC: boolean indicating if the elisp function is asynchronous.
+If ASYNC is t, the function should take a callback as its first
+argument, along with the arguments specified in ARGS, and run the
+callback with the tool call result when it's ready. The callback
+itself is an implementation detail and must not be included in
+ARGS.
+
+The following keys are optional
+
+CATEGORY: A string indicating a category for the tool. This is
+used only for grouping in gptel's UI. Defaults to \"misc\".
+
+CONFIRM: Whether the tool call should wait for the user to run it. If
+true, the user will be prompted with the proposed tool call, which can
+be examined, accepted, deferred or canceled. It can also be a function
+that receives the same arguments as FUNCTION and returns true if the
+user should be prompted.
+
+INCLUDE: Whether the tool results should be included as part of
+the LLM output. This is useful for logging and as context for
+subsequent requests in the same buffer. This is primarily useful
+in chat buffers.
+
+Here is an example definition:
+
+ (gptel-make-tool
+ :function (lambda (location unit)
+ (url-retrieve-synchronously \"api.weather.com/...\"
+ location unit))
+ :name \"get_weather\"
+ :description \"Get the current weather in a given location\"
+ :args (list \\='(:name \"location\"
+ :type string
+ :description \"The city and state, e.g. San Francisco, CA\")
+ \\='(:name \"unit\"
+ :type string
+ :enum [\"celsius\" \"farenheit\"]
+ :description
+ \"The unit of temperature, either \\='celsius\\=' or \\='fahrenheit\\='\"
+ :optional t)))
+
+If the tool is asynchronous, the function is modified to take a
+callback as its first argument, which it runs with the result:
+
+ (lambda (callback location unit)
+ (url-retrieve \"api.weather.com/...\"
+ (lambda (_)
+ (let ((result (parse-this-buffer)))
+ (funcall callback result)))))"
+ (let* ((tool (apply #'gptel--make-tool slots))
+ (category (or (gptel-tool-category tool) "misc")))
+ (setf (alist-get
+ (gptel-tool-name tool)
+ (alist-get category gptel--known-tools nil nil #'equal)
+ nil nil #'equal)
+ tool)))
+
+(cl-defgeneric gptel--parse-tools (_backend tools)
+ "Parse TOOLS and return a list of prompts.
+
+TOOLS is a list of `gptel-tool' structs, which see.
+
+_BACKEND is the LLM backend in use. This is the default
+implementation, used by OpenAI-compatible APIs and Ollama."
+ (vconcat
+ (mapcar
+ (lambda (tool)
+ (list
+ :type "function"
+ :function
+ (append
+ (list
+ :name (gptel-tool-name tool)
+ :description (gptel-tool-description tool))
+ (if (gptel-tool-args tool)
+ (list
+ :parameters
+ (list :type "object"
+ ;; gptel's tool args spec is close to the JSON schema, except
+ ;; that we use (:name "argname" ...)
+ ;; instead of (:argname (...)), and
+ ;; (:optional t) for each arg instead of (:required [...])
+ ;; for all args at once. Handle this difference by
+ ;; modifying a copy of the gptel tool arg spec.
+ :properties
+ (cl-loop
+ for arg in (gptel-tool-args tool)
+ for argspec = (copy-sequence arg)
+ for name = (plist-get arg :name) ;handled differently
+ for newname = (or (and (keywordp name) name)
+ (make-symbol (concat ":" name)))
+ do ;ARGSPEC is ARG without unrecognized keys
+ (cl-remf argspec :name)
+ (cl-remf argspec :optional)
+ if (equal (plist-get arg :type) "object")
+ do (unless (plist-member argspec :required)
+ (plist-put argspec :required []))
+ (plist-put argspec :additionalProperties :json-false)
+ append (list newname argspec))
+ :required
+ (vconcat
+ (delq nil (mapcar
+ (lambda (arg) (and (not (plist-get arg :optional))
+ (plist-get arg :name)))
+ (gptel-tool-args tool))))
+ :additionalProperties :json-false))
+ (list :parameters (list :type "object" :properties nil))))))
+ (ensure-list tools))))
+
+(cl-defgeneric gptel--parse-tool-results (backend results)
+ "Return a BACKEND appropriate prompt containing tool call RESULTS.
+
+This will be injected into the messages list in the prompt to
+send to the LLM.")
+
+;; FIXME(fsm) unify this with `gptel--inject-media', which is a mess
+(cl-defgeneric gptel--inject-prompt
+ (_backend data new-prompt &optional position)
+ "Inject NEW-PROMPT into existing prompts in query DATA.
+
+NEW-PROMPT can be a single message or a list of messages.
+
+If POSITION is
+- nil, append NEW-PROMPT at the end of DATA
+- a non-negative integer, insert it at that position in DATA.
+- a negative integer, insert it there counting from the end.
+
+- Not implemented: a list of accessors, inject it at that position.
+
+This generic implementation handles the Anthropic,
+OpenAI-compatible and Ollama message formats."
+ (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many?
+ (setq new-prompt (list new-prompt)))
+ (let ((prompts (plist-get data :messages)))
+ (pcase position
+ ('nil (plist-put data :messages (vconcat prompts new-prompt)))
+ ((pred integerp)
+ (when (< position 0) (setq position (+ (length prompts) position)))
+ (plist-put data :messages (vconcat (substring prompts 0 position)
+ new-prompt
+ (substring prompts position)))))))
+
+(cl-defgeneric gptel--inject-tool-call (backend _data _tool-call new-call)
+ "Replace TOOL-CALL in query DATA with NEW-CALL.
+
+DATA is the request payload containing the array of user and assistant
+messages, typically available as (plist-get INFO :data). TOOL-CALL is
+the call plist as recorded by gptel's response parser(s). NEW-CALL is
+the replacement plist containing the new tool name and arguments, in the
+form
+
+ (:name \"newName\" :args (:arg1 \"newArg\" :arg2 ...))
+
+:name and :args are both optional.
+
+If NEW-CALL is nil, the tool call is removed from DATA and thus the turn
+history.
+
+BACKEND is the `gptel-backend'."
+ (display-warning
+ '(gptel tool-call)
+ (format "Editing tool call arguments is not implemented for %s.\
+ Ignoring new arguments %s"
+ (type-of backend)
+ (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))
+
+\f
+;;; State machine for driving requests
+(defvar gptel-request--transitions
+ `((INIT . ((t . WAIT)))
+ (WAIT . ((t . TYPE)))
+ (TYPE . ((,#'gptel--error-p . ERRS)
+ (,#'gptel--tool-use-p . TOOL)
+ (t . DONE)))
+ (TOOL . ((t . TRET)))
+ (TRET . ((,#'gptel--error-p . ERRS)
+ (,#'gptel--tool-result-p . WAIT)
+ (t . DONE))))
+ "Alist specifying gptel's default state transition table for requests.
+
+Each entry is a list whose car is a request state (any symbol)
+and whose cdr is an alist listing possible next states. Each key
+is either a predicate function or t. When `gptel--fsm-next' is
+called, the predicates are called in the order they appear here
+to find the next state. Each predicate is called with the state
+machine's INFO, see `gptel-fsm'. A predicate of t is
+considered a success and acts as a default.")
+
+(defvar gptel-request--handlers
+ `((WAIT ,#'gptel--handle-wait)
+ (TOOL ,#'gptel--handle-tool-use)
+ (TRET ,#'gptel--handle-tool-result)
+ (DONE ,#'gptel--handle-post)
+ (ERRS ,#'gptel--handle-post)
+ (ABRT ,#'gptel--handle-post))
+ "Alist specifying handlers for gptel's default state transitions.
+
+Each entry is a list whose car is a request state (a symbol) and
+whose cdr is a list of handler functions called when
+transitioning to that state. The handlers are called in the
+sequence that they appear in the list, and each function receives
+the state machine as its only argument. Information about the
+request state can be retrieved via the machine's INFO slot, see
+`gptel-fsm'.
+
+Handlers are responsible for doing state-related tasks (like
+logging errors or inserting responses) and transitioning to the
+next state by calling `gptel--fsm-transition'.
+
+Handlers can be asynchronous, in which case the transition call
+should typically be placed in its callback.")
+
+(cl-defstruct (gptel-fsm (:constructor gptel-make-fsm)
+ (:copier gptel-copy-fsm))
+ "State machine for gptel requests.
+
+STATE: The current state of the machine, can be any symbol.
+
+TABLE: Alist mapping states to possible next states
+along with predicates to determine the next state. See
+`gptel-request--transitions' for an example.
+
+HANDLERS: Alist mapping states to state handler functions.
+Handlers are called when entering each state. See
+`gptel-request--handlers' for an example
+
+INFO: The state machine's current context. This is a plist
+holding all the information required for the ongoing request, and
+can be used to tweak and resume a paused request. This should be
+called \"context\", but context means too many things already in
+gptel's code!
+
+Each gptel request is passed an instance of this
+state machine and driven by it."
+ (state 'INIT)
+ (table gptel-request--transitions)
+ (handlers gptel-request--handlers) info)
+
+(defun gptel--fsm-transition (machine &optional new-state)
+ "Move MACHINE to its next state.
+
+MACHINE is an instance of `gptel-fsm'.
+
+The next state is NEW-STATE if given. Otherwise it is determined
+automatically from MACHINE's transition table."
+ (unless new-state (setq new-state (gptel--fsm-next machine)))
+ (push (gptel-fsm-state machine)
+ (plist-get (gptel-fsm-info machine) :history))
+ (setf (gptel-fsm-state machine) new-state)
+ (when-let* ((handlers (alist-get new-state (gptel-fsm-handlers machine))))
+ (mapc (lambda (h) (funcall h machine)) handlers)))
+
+(defun gptel--fsm-next (machine)
+ "Determine MACHINE's next state according to its transition table.
+
+MACHINE is an instance of `gptel-fsm'"
+ (let* ((current (gptel-fsm-state machine))
+ (transitions (alist-get current (gptel-fsm-table machine))))
+ (cl-loop
+ with info = (gptel-fsm-info machine)
+ for (pred . next) in transitions
+ when (or (eq pred t) (funcall pred info))
+ return next)))
+
+;;;; State machine handlers
+;; The next few functions are default state handlers for gptel's state machine,
+;; see `gptel-request--handlers'.
+
+(defun gptel--handle-wait (fsm)
+ "Fire the request contained in state machine FSM's info."
+ ;; Reset some flags in info. This is necessary when reusing fsm's context for
+ ;; a second network request: gptel tests for the presence of these flags to
+ ;; handle state transitions. (NOTE: Don't add :uuid to this.)
+ (let ((info (gptel-fsm-info fsm)))
+ (dolist (key '(:tool-result :tool-use :error :http-status :reasoning))
+ (when (plist-get info key)
+ (plist-put info key nil))))
+ (funcall
+ (if gptel-use-curl
+ #'gptel-curl-get-response
+ #'gptel--url-get-response)
+ fsm)
+ (run-hooks 'gptel-post-request-hook))
+
+(defun gptel--process-tool-call (fsm tool-spec tool-call result)
+ "Add tool RESULT to a TOOL-CALL and transition FSM if required.
+
+TOOL-CALL is a plist with the tool :name, :args and other metadata.
+TOOL-SPEC is the `gptel-tool' object, and FSM is the request state.
+
+If all pending tool calls in the current request have finished, it
+injects the results into the prompt data and transitions the FSM."
+ (let* ((info (gptel-fsm-info fsm))
+ (tool-result-alist (plist-get info :tool-result))
+ ;; MAYBE(tool-hooks): Use plist-member for valid nil :result?
+ (remaining (cl-loop for call in (plist-get info :tool-use)
+ count (not (plist-get call :result)))))
+ (let ((result (gptel--to-string result)))
+ ;; FIXME(tool-hooks): If a hook has changed the tool that was called
+ ;; tool-spec needs to be updated.
+ (push (list tool-spec (plist-get tool-call :args) result)
+ tool-result-alist)
+ (plist-put info :tool-result tool-result-alist) ;for the callback
+ ;; NOTE: tool-call is a member of (plist-get info :tool-use), so :tool-use
+ ;; is modified by side effect.
+ ;; FIXME: Make the implicit addition to :tool-use explicit
+ (plist-put tool-call :result result)) ;for the LLM
+ ;; All tools have run
+ (when (<= (cl-decf remaining) 0) (gptel--fsm-transition fsm))))
+
+(defun gptel--handle-tool-use (fsm)
+ "Run tool calls captured in FSM, and advance the state machine with the results."
+ (when-let* ((info (gptel-fsm-info fsm))
+ (backend (plist-get info :backend))
+ ;; This function might run many times, so only act on the remaining tool calls.
+ (tool-use (cl-remove-if (lambda (tc) (plist-get tc :result))
+ (plist-get info :tool-use))))
+ (with-current-buffer (plist-get info :buffer)
+ (let ((pending-calls))
+ (mapc ; Construct function calls
+ (lambda (tool-call)
+ (letrec ((args (plist-get tool-call :args))
+ (name (plist-get tool-call :name))
+ (tool-spec (cl-find-if (lambda (ts) (equal (gptel-tool-name ts) name))
+ (plist-get info :tools)))
+ (process-tool-result (apply-partially #'gptel--process-tool-call
+ fsm tool-spec tool-call)))
+ (if (null tool-spec)
+ (if (equal name gptel--ersatz-json-tool) ;Could be a JSON response
+ ;; Handle structured JSON output supplied as tool call
+ (funcall (plist-get info :callback)
+ (gptel--json-encode (plist-get tool-call :args))
+ info)
+ (message "Unknown tool called by model: %s" name))
+ (let ((confirm)) ;Check if tool requires confirmation
+ (cond ;:confirm in tool-call (from hooks) takes precedence
+ ((and-let* ((call-confirm (plist-member tool-call :confirm)))
+ (setq confirm (cadr call-confirm))))
+ ((and gptel-confirm-tool-calls ;global and tool-specific setting
+ (or (eq gptel-confirm-tool-calls t) ;always confirm, or
+ (and-let* ((confirm (gptel-tool-confirm tool-spec)))
+ (or (not (functionp confirm))
+ (apply confirm (gptel--map-tool-args tool-spec args))))))
+ (setq confirm t)))
+ (if confirm ;To send to callback for confirmation
+ (push (list tool-spec args process-tool-result) pending-calls)
+ (let ((arg-values (gptel--map-tool-args tool-spec args)))
+ (if (gptel-tool-async tool-spec) ;If not, run the tool
+ (apply (gptel-tool-function tool-spec)
+ process-tool-result arg-values)
+ (let ((result (condition-case errdata
+ (apply (gptel-tool-function tool-spec) arg-values)
+ (error (mapconcat #'gptel--to-string errdata " ")))))
+ (funcall process-tool-result result)))))))))
+ tool-use)
+ (when pending-calls
+ (plist-put info :tool-pending t)
+ (funcall (plist-get info :callback)
+ (cons 'tool-call pending-calls) info))))))
+
+(defun gptel--map-tool-args (tool-spec args)
+ "Create a tool call argument list from TOOL-SPEC and ARGS.
+
+TOOL-SPEC is a `gptel-tool' and ARGS is a plist of arguments for a tool
+call. The argument list is suitable for supplying to the tool function."
+ (mapcar
+ (lambda (arg)
+ (let ((key (intern (concat ":" (plist-get arg :name)))))
+ (plist-get args key)))
+ (gptel-tool-args tool-spec)))
+
+(defun gptel--handle-tool-result (fsm)
+ "Handle the results of tool execution in FSM.
+
+Inject tool results into into the prompt data (for the LLM), run the
+callback (for the user), and transition the request state."
+ (let ((info (gptel-fsm-info fsm)))
+ (gptel--inject-prompt
+ (plist-get info :backend) (plist-get info :data)
+ (gptel--parse-tool-results (plist-get info :backend)
+ (plist-get info :tool-use)))
+ (funcall (plist-get info :callback)
+ (cons 'tool-result (plist-get info :tool-result)) info))
+ (gptel--fsm-transition fsm))
+
+(defun gptel--handle-post (fsm)
+ "Run cleanup for `gptel-request' with FSM."
+ (when-let* ((info (gptel-fsm-info fsm))
+ (post (plist-get info :post)))
+ (mapc (lambda (f) (funcall f info)) post)))
+
+;;;; State machine predicates
+;; Predicates used to find the next state to transition to, see
+;; `gptel-request--transitions'.
+
+(defun gptel--error-p (info) (plist-get info :error))
+
+(defun gptel--tool-use-p (info) (plist-get info :tool-use))
+
+(defun gptel--tool-result-p (info) (plist-get info :tool-result))
+
+\f
+;;; Send gptel requests
+(cl-defun gptel-request
+ (&optional prompt &key callback
+ (buffer (current-buffer))
+ position context dry-run
+ (stream nil) (in-place nil)
+ (system gptel--system-message)
+ schema transforms (fsm (gptel-make-fsm)))
+ "Request a response from the `gptel-backend' for PROMPT.
+
+The request is asynchronous, this function returns immediately.
+
+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.
+ (\"user msg 1\" \"llm msg 1\" \"user msg 2\" \"llm msg 2\" ...)
+- 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.
+
+Keyword arguments:
+
+CALLBACK, if supplied, is a function of two arguments, called
+with the RESPONSE (usually a string) and INFO (a plist):
+
+ (funcall CALLBACK RESPONSE INFO)
+
+RESPONSE is
+
+- A string if the request was successful
+- nil if there was no response or an error.
+
+These are the only two cases you typically need to consider,
+unless you need to clean up after aborted requests, use LLM
+tools, handle \"reasoning\" content specially or stream
+responses (see STREAM). In these cases, RESPONSE can be
+
+- The symbol `abort' if the request is aborted, see `gptel-abort'.
+
+- A cons cell of the form
+
+ (tool-call . ((TOOL ARGS CB) ...))
+
+ where TOOL is a gptel-tool struct, ARGS is a plist of
+ arguments, and CB is a function for handling the results. You
+ can call CB with the result of calling the tool to continue the
+ request.
+
+- A cons cell of the form
+
+ (tool-result . ((TOOL ARGS RESULT) ...))
+
+ where TOOL is a gptel-tool struct, ARGS is a plist of
+ arguments, and RESULT was returned from calling the tool
+ function.
+
+- A cons cell of the form
+
+ (reasoning . text)
+
+ where text is the contents of the reasoning block. (Also see
+ STREAM if you are using streaming.)
+
+See `gptel--insert-response' for an example callback handling all
+cases.
+
+The INFO plist has (at least) the following keys:
+:data - The request data included with the query
+:position - marker where the response will (nominally) be inserted.
+ Of course, the insertion is left to the CALLBACK.
+:buffer - The buffer current when the request was sent,
+ unless BUFFER is specified.
+:status - Short string describing the result of the request,
+ including possible HTTP errors.
+
+Example of a callback that messages the user with the response
+and info:
+
+ (lambda (response info)
+ (if (stringp response)
+ (let ((posn (marker-position (plist-get info :position)))
+ (buf (buffer-name (plist-get info :buffer))))
+ (message \"Response for request from %S at %d: %s\"
+ buf posn response))
+ (message \"gptel-request failed with message: %s\"
+ (plist-get info :status))))
+
+Or, for just the response:
+
+ (lambda (response _)
+ ;; Do something with response
+ (message (rot13-string response)))
+
+If CALLBACK is omitted, the response is inserted at the point the
+request was sent.
+
+STREAM is a boolean that determines if the response should be
+streamed, as in `gptel-stream'. If the model or the backend does
+not support streaming, this will be ignored.
+
+When streaming responses
+
+- CALLBACK will be called repeatedly with each RESPONSE text
+ chunk (a string) as it is received.
+- When the HTTP request ends successfully, CALLBACK will be
+ called with a RESPONSE argument of t to indicate success.
+- Similarly, CALLBACK will be called with
+ (reasoning . text-chunk) for each reasoning chunk, and
+ (reasoning . t) to indicate the end of the reasoning block.
+
+BUFFER and POSITION are the buffer and position (integer or
+marker) at which the response is inserted. If a CALLBACK is
+specified, no response is inserted and these arguments are
+ignored, but they are still available in the INFO plist passed
+to CALLBACK for you to use.
+
+BUFFER defaults to the current buffer, and POSITION to the value
+of (point) or (region-end), depending on whether the region is
+active.
+
+CONTEXT is any additional data needed for the callback to run. It
+is included in the INFO argument to the callback.
+Note: This is intended for storing Emacs state to be used by
+CALLBACK, and unrelated to the context supplied to the LLM.
+
+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:
+
+IN-PLACE is a boolean used by the default callback when inserting
+the response to determine if delimiters are needed between the
+prompt and the response.
+
+If DRY-RUN is non-nil, do not send the request. Construct and
+return a state machine object that can be introspected and
+resumed.
+
+TRANSFORMS is a list of functions used to transform the prompt or query
+parameters dynamically. Each function is called in a temporary buffer
+containing the prompt to be sent, and can conditionally modify this
+buffer. This can include changing the (buffer-local) values of the
+model, backend or system prompt, or augmenting the prompt with
+additional information (such as from a RAG engine).
+
+- Synchronous transformers are called with zero or one argument, the
+ state machine for the request.
+
+- Asynchronous transformers are called with two arguments, a callback
+ and the state machine. It should run the callback after finishing its
+ transformation.
+
+See `gptel-prompt-transform-functions' for more.
+
+If provided, SCHEMA forces the LLM to generate JSON output. Its value
+is a JSON schema, which can be provided as
+- an elisp object, a nested plist structure.
+- A JSON schema serialized to a string
+- A shorthand object/array description, see `gptel--dispatch-schema-type'.
+See the manual or the wiki for examples.
+
+Note: SCHEMA is presently experimental and subject to change, and not
+all providers support structured output.
+
+FSM is the state machine driving the request. This can be used
+to define a custom request control flow, see `gptel-fsm' for
+details. You can safely ignore this -- FSM is an unstable
+feature and subject to change.
+
+Note:
+
+1. This function is not fully self-contained. Consider
+let-binding the parameters `gptel-backend', `gptel-model',
+`gptel-use-tools' and `gptel-use-context' around calls to it as
+required.
+
+2. The return value of this function is a state machine that may
+be used to rerun or continue the request at a later time."
+ (declare (indent 1))
+ ;; TODO Remove this check in version 1.0
+ (gptel--sanitize-model)
+ (let* ((start-marker
+ (cond
+ ((null position)
+ (if (use-region-p)
+ (set-marker (make-marker) (region-end))
+ (gptel--at-word-end (point-marker))))
+ ((markerp position) position)
+ ((integerp position)
+ (set-marker (make-marker) position buffer))))
+ (gptel--schema schema)
+ (prompt-buffer
+ (cond ;prompt from buffer or explicitly supplied
+ ((null prompt) ;Send text up to end of word (for evil-mode users)
+ (gptel--create-prompt-buffer (gptel--at-word-end (point))))
+ ((stringp prompt)
+ (gptel--with-buffer-copy buffer nil nil
+ (insert prompt)
+ (setq major-mode 'fundamental-mode) ;Avoid mode-specific behavior
+ (current-buffer)))
+ ((consp prompt)
+ ;; (gptel--parse-list gptel-backend prompt)
+ (gptel--with-buffer-copy buffer nil nil
+ ;; TEMP Decide on the annoated prompt-list format
+ (gptel--parse-list-and-insert prompt)
+ (setq major-mode 'fundamental-mode) ;Avoid mode-specific behavior
+ (current-buffer)))))
+ (system-list (gptel--parse-directive system 'raw)) ;eval function-valued system prompts
+ (info (list :data prompt-buffer
+ :buffer buffer
+ :position start-marker)))
+ (when transforms (plist-put info :transforms transforms))
+ (with-current-buffer prompt-buffer
+ (setq gptel--system-message ;guaranteed to be buffer-local
+ ;; Retain single-part system messages as strings to avoid surprises
+ ;; when applying presets
+ (if (cdr system-list) system-list (car system-list))))
+ (when stream (plist-put info :stream stream))
+ ;; This context should not be confused with the context aggregation context!
+ (when callback (plist-put info :callback callback))
+ (when context (plist-put info :context context))
+ (when in-place (plist-put info :in-place in-place))
+ ;; Add info to state machine context
+ (when dry-run (plist-put info :dry-run dry-run))
+ (setf (gptel-fsm-info fsm) info))
+
+ ;; TEMP: Augment in separate let block for now. Are we overcapturing?
+ ;; FIXME(augment): Call augmentors with INFO, not FSM
+ (let ((info (gptel-fsm-info fsm)))
+ (with-current-buffer (plist-get info :data)
+ (setq-local gptel-prompt-transform-functions (plist-get info :transforms))
+ ;; Preset has highest priority because it can change prompt-transform-functions
+ (when (memq 'gptel--transform-apply-preset gptel-prompt-transform-functions)
+ (gptel--transform-apply-preset fsm)
+ (setq gptel-prompt-transform-functions ;avoid mutation, copy transforms
+ (remq 'gptel--transform-apply-preset gptel-prompt-transform-functions)))
+ (let ((augment-total ;act like a hook, count total
+ (if (memq t gptel-prompt-transform-functions)
+ (length
+ (setq gptel-prompt-transform-functions
+ (nconc (remq t gptel-prompt-transform-functions)
+ (default-value 'gptel-prompt-transform-functions))))
+ (length gptel-prompt-transform-functions)))
+ (augment-idx 0))
+ (if (null gptel-prompt-transform-functions)
+ (gptel--realize-query fsm)
+ ;; FIXME(request-lib): Cannot use gptel--update-status from this file
+ ;; (with-current-buffer (plist-get info :buffer) ;Apply prompt transformations
+ ;; (gptel--update-status " Augmenting..." 'mode-line-emphasis))
+
+ ;; FIXME(augment): This needs to be converted into a linear callback
+ ;; chain to avoid race conditions with multiple async augmentors.
+ (run-hook-wrapped
+ 'gptel-prompt-transform-functions
+ (lambda (func fsm-arg)
+ (with-current-buffer (plist-get info :data)
+ (goto-char (point-max))
+ (if (= (car (func-arity func)) 2) ;async augmentor
+ (funcall func (lambda ()
+ (cl-incf augment-idx)
+ (when (>= augment-idx augment-total) ;All augmentors have run
+ (gptel--realize-query fsm-arg)))
+ fsm-arg)
+ (if (= (car (func-arity func)) 0)
+ (funcall func)
+ (funcall func fsm-arg)) ;sync augmentor
+ (cl-incf augment-idx)
+ (when (>= augment-idx augment-total) ;All augmentors have run
+ (gptel--realize-query fsm-arg))))
+ nil) ;always return nil so run-hook-wrapped doesn't abort
+ fsm)))))
+ fsm)
+
+(defun gptel--realize-query (fsm)
+ "Realize the query payload for FSM from its prompt buffer.
+
+Initiate the request when done."
+ (let ((info (gptel-fsm-info fsm)))
+ (with-current-buffer (plist-get info :data)
+ (let* ((directive (gptel--parse-directive gptel--system-message 'raw))
+ ;; DIRECTIVE contains both the system message and the template prompts
+ (gptel--system-message
+ (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
+ ;; Check model-specific request-params for streaming preference
+ (let* ((model-params (gptel--model-request-params gptel-model))
+ (stream-spec (plist-get model-params :stream)))
+ ;; If not present, there is no model-specific preference
+ (or (not (memq :stream model-params))
+ ;; If present, it must not be :json-false or nil
+ (and stream-spec (not (eq stream-spec :json-false)))))
+ ;; Check backend-specific streaming settings
+ (gptel-backend-stream gptel-backend)))
+ (gptel-stream stream)
+ (full-prompt))
+ (when (cdr directive) ; prompt constructed from directive/template
+ (save-excursion (goto-char (point-min))
+ (gptel--parse-list-and-insert (cdr directive))))
+ (goto-char (point-max))
+ (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))))
+ ;; 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 gptel-use-context (gptel--model-capable-p 'media))
+ (gptel--inject-media gptel-backend full-prompt))
+ (unless stream (cl-remf info :stream))
+ (plist-put info :backend gptel-backend)
+ (plist-put info :model gptel-model)
+ (when gptel-include-reasoning ;Required for next-request-only scope
+ (plist-put info :include-reasoning gptel-include-reasoning))
+ (when (and gptel-use-tools gptel-tools)
+ (plist-put info :tools gptel-tools))
+ (plist-put info :data
+ (gptel--request-data gptel-backend full-prompt)))
+ (kill-buffer (current-buffer)))
+ ;; INIT -> WAIT
+ (unless (plist-get info :dry-run) (gptel--fsm-transition fsm))
+ fsm))
+
+(defun gptel-abort (buf)
+ "Stop any active gptel process associated with buffer BUF.
+
+BUF defaults to the current buffer."
+ (interactive (list (current-buffer)))
+ (when-let* ((proc-attrs
+ (cl-find-if
+ (lambda (entry)
+ ;; each entry has the form (PROC . (FSM ABORT-FN))
+ (eq (thread-first (cadr entry) ; FSM
+ (gptel-fsm-info)
+ (plist-get :buffer))
+ buf))
+ gptel--request-alist))
+ (proc (car proc-attrs))
+ (fsm (cadr proc-attrs))
+ (info (gptel-fsm-info fsm))
+ (abort-fn (cddr proc-attrs)))
+ ;; Run :callback with abort signal
+ (with-demoted-errors "Callback error: %S"
+ (and-let* ((cb (plist-get info :callback))
+ ((functionp cb)))
+ (funcall cb 'abort info)))
+ (funcall abort-fn)
+ (setf (alist-get proc gptel--request-alist nil 'remove) nil)
+ (gptel--fsm-transition fsm 'ABRT)
+ (message "Stopped gptel request in buffer %S" (buffer-name buf))))
+
+\f
+;;; Prompt creation
+(defun gptel--create-prompt-buffer (&optional prompt-end)
+ "Return a buffer with the conversation prompt to be sent.
+
+If the region is active limit the prompt text to the region contents.
+Otherwise the prompt text is constructed from the contents of the
+current buffer up to point, or PROMPT-END if provided."
+ (save-excursion
+ (save-restriction
+ (let ((buf (current-buffer)))
+ (cond
+ ((derived-mode-p 'org-mode)
+ (require 'gptel-org)
+ ;; Also handles regions in Org mode
+ (gptel-org--create-prompt-buffer prompt-end))
+ ((use-region-p)
+ (let ((rb (region-beginning)) (re (region-end)))
+ (gptel--with-buffer-copy buf rb re
+ (current-buffer))))
+ (t (unless prompt-end (setq prompt-end (point)))
+ (gptel--with-buffer-copy buf (point-min) prompt-end
+ (current-buffer))))))))
+
+(defun gptel--create-prompt (&optional prompt-end)
+ "Return a full conversation prompt from the contents of this buffer.
+
+If `gptel--num-messages-to-send' is set, limit to that many
+recent exchanges.
+
+If PROMPT-END (a marker) is provided, end the prompt contents
+there. This defaults to (point)."
+ (with-current-buffer (gptel--create-prompt-buffer prompt-end)
+ (unwind-protect
+ (gptel--parse-buffer
+ gptel-backend (and gptel--num-messages-to-send
+ (* 2 gptel--num-messages-to-send)))
+ (kill-buffer (current-buffer)))))
+
+(make-obsolete 'gptel--create-prompt 'gptel--create-prompt-buffer
+ "0.9.9")
+
+(cl-defgeneric gptel--parse-buffer (backend max-entries)
+ "Parse current buffer backwards from point and return a list of prompts.
+
+BACKEND is the LLM backend in use.
+
+MAX-ENTRIES is the number of queries/responses to include for
+contexbt.")
+
+(defun gptel--parse-list-and-insert (prompts)
+ "Insert PROMPTS, a list of messages into the current buffer.
+
+Propertize the insertions in a format gptel can parse into a
+conversation.
+
+PROMPTS is typically the input to `gptel-request', either a list of strings
+representing a conversation with alternate prompt/response turns, or a list of
+lists with explicit roles (prompt/response/tool). See the documentation of
+`gptel-request' for the latter."
+ (if (stringp (car prompts)) ; Simple format, list of strings
+ (cl-loop for text in prompts
+ for response = nil then (not response)
+ when text
+ if response
+ do (insert gptel-response-separator
+ (propertize text 'gptel 'response)
+ gptel-response-separator)
+ else do (insert text))
+ (dolist (entry prompts) ; Advanced format, list of lists
+ (pcase entry
+ (`(prompt . ,msg) (insert (or (car-safe msg) msg)))
+ (`(response . ,msg)
+ (insert gptel-response-separator
+ (propertize (or (car-safe msg) msg) 'gptel 'response)))
+ (`(tool . ,call)
+ (insert gptel-response-separator
+ (propertize
+ (concat
+ "(:name " (plist-get call :name) " :args "
+ (prin1-to-string (plist-get call :args)) ")\n\n"
+ (plist-get call :result))
+ 'gptel `(tool . ,(plist-get call :id)))))))))
+
+(cl-defgeneric gptel--parse-list (backend prompt-list)
+ "Parse PROMPT-LIST and return a list of prompts for BACKEND.
+
+PROMPT-LIST is interpreted as a conversation, i.e. an alternating
+series of user prompts and LLM responses. The returned structure
+is suitable for including in the request payload.
+
+BACKEND is the LLM backend in use.")
+
+(cl-defgeneric gptel--parse-media-links (mode beg end)
+ "Find media links between BEG and END.
+
+MODE is the major-mode of the buffer.
+
+Returns a plist where each entry is of the form
+ (:text \"some text\")
+or
+ (:media \"media uri or file path\")."
+ (ignore mode) ;byte-compiler
+ (list `(:text ,(buffer-substring-no-properties
+ beg end))))
+
+(declare-function markdown-link-at-pos "markdown-mode")
+(declare-function mailcap-file-name-to-mime-type "mailcap")
+
+(defsubst gptel-markdown--validate-link (link)
+ "Validate a Markdown LINK as sendable under the current gptel settings.
+
+Return a form (validp link-type path . REST), where REST is a list
+explaining why sending the link is not supported by gptel. Only the
+first nil value in REST is guaranteed to be correct."
+ (let ((mime))
+ (if-let* ((path (nth 3 link))
+ (prefix (or (string-search "://" path) 0))
+ (link-type (if (= prefix 0) "file" (substring path 0 prefix)))
+ (path (if (and (equal link-type "file") (> prefix 0))
+ (substring path (+ prefix 3)) path))
+ (resource-type
+ (or (and (equal link-type "file") 'file)
+ (and (gptel--model-capable-p 'url)
+ (member link-type '("http" "https" "ftp")) 'url)))
+ (user-check (funcall gptel-markdown-validate-link link))
+ (readablep (or (member link-type '("http" "https" "ftp"))
+ (file-remote-p path)
+ (file-readable-p path)))
+ (mime-valid
+ (or (eq resource-type 'url)
+ (and (with-memoization
+ (alist-get (expand-file-name path)
+ gptel--link-type-cache
+ nil nil #'string=)
+ (if (gptel--file-binary-p path) t))
+ (setq mime (mailcap-file-name-to-mime-type path))
+ (gptel--model-mime-capable-p mime))
+ t)))
+ (list t link-type path resource-type user-check readablep mime-valid mime)
+ (list nil link-type path resource-type user-check readablep mime-valid mime))))
+
+(cl-defmethod gptel--parse-media-links ((_mode (eql 'markdown-mode)) beg end)
+ "Parse text and actionable links between BEG and END.
+
+Return a list of the form
+ ((:text \"some text\")
+ (:media \"/path/to/media.png\" :mime \"image/png\")
+ (:text \"More text\"))
+for inclusion into the user prompt for the gptel request."
+ (let ((parts) (from-pt))
+ (save-excursion
+ (setq from-pt (goto-char beg))
+ (while (re-search-forward gptel-markdown--link-regex end t)
+ (let* ((link-at-pt (markdown-link-at-pos (point)))
+ (link-status (gptel-markdown--validate-link link-at-pt)))
+ (cl-destructuring-bind
+ (valid type path resource-type user-check readablep mime-valid mime)
+ link-status
+ (cond
+ ((and valid (member type '("http" "https" "ftp")))
+ ;; Collect text up to this image, and collect this image url
+ (let ((text (buffer-substring-no-properties from-pt (car link-at-pt))))
+ (unless (string-blank-p text) (push (list :text text) parts))
+ (push (list :url path :mime mime) parts)
+ (setq from-pt (cadr link-at-pt))))
+ (valid ; Collect text up to this link, and collect this link data
+ (let ((text (buffer-substring-no-properties from-pt (car link-at-pt))))
+ (unless (string-blank-p text) (push (list :text text) parts))
+ (push (if mime (list :media path :mime mime) (list :textfile path)) parts)
+ (setq from-pt (cadr link-at-pt))))
+ ((not resource-type)
+ (message "Link source not followed for unsupported link type \"%s\"." type))
+ ((not user-check)
+ (message
+ (if (eq gptel-markdown-validate-link 'gptel--link-standalone-p)
+ "Ignoring non-standalone link \"%s\"."
+ "Link %s failed to validate, see `gptel-markdown-validate-link'.")
+ path))
+ ((not readablep) (message "Ignoring inaccessible file \"%s\"." path))
+ ((and (not mime-valid) (eq resource-type 'file))
+ (message "Ignoring unsupported binary file \"%s\"." path)))))))
+ (unless (= from-pt end)
+ (push (list :text (buffer-substring-no-properties from-pt end)) parts))
+ (nreverse parts)))
+
+(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'.
+Typically this is a list of plists.
+
+BACKEND is the gptel backend in use."
+ (display-warning
+ '(gptel context)
+ (format "Context support not implemented for backend %s, ignoring context"
+ (gptel-backend-name backend))))
+
+(cl-defgeneric gptel--request-data (backend prompts)
+ "Generate a plist of all data for an LLM query.
+
+BACKEND is the LLM backend in use.
+
+PROMPTS is the plist of previous user queries and LLM responses.")
+
+(cl-defun gptel--sanitize-model (&key (backend gptel-backend)
+ (model gptel-model)
+ (shoosh t))
+ "Check if MODEL is available in BACKEND, adjust accordingly.
+
+If SHOOSH is true, don't issue a warning."
+ (unless backend
+ (unless shoosh
+ (display-warning
+ 'gptel "No gptel-backend defined: defaulting to ChatGPT"))
+ (setq gptel-backend
+ (gptel-make-openai "ChatGPT" :key 'gptel-api-key :stream t)
+ backend gptel-backend))
+ (let ((available (gptel-backend-models backend)))
+ (when (stringp model)
+ (unless shoosh
+ (display-warning
+ 'gptel
+ (format "`gptel-model' expects a symbol, found string \"%s\"
+ Resetting `gptel-model' to %s"
+ model model)))
+ (setq gptel-model (gptel--intern model)
+ model gptel-model))
+ (unless (member model available)
+ (let ((fallback (car available)))
+ (unless shoosh
+ (display-warning
+ 'gptel
+ (format (concat "Preferred `gptel-model' \"%s\" not"
+ "supported in \"%s\", using \"%s\" instead")
+ model (gptel-backend-name backend) fallback)))
+ (setq-local gptel-model fallback)))))
+
+\f
+;;; url-retrieve response handling
+(defun gptel--url-get-response (fsm)
+ "Fetch response to prompt in state FSM from the LLM.
+
+FSM is the state machine driving this request. Its INFO slot
+contains the data required for setting up the request. INFO is a
+plist with the following keys, among others:
+- :data (the data being sent)
+- :buffer (the gptel buffer)
+- :position (marker at which to insert the response).
+- :callback (optional, the request callback)
+
+Call CALLBACK with the response and INFO afterwards. If omitted
+the response is inserted into the current buffer after point."
+ (let* ((inhibit-message t)
+ (message-log-max nil)
+ (url-request-method "POST")
+ (info (gptel-fsm-info fsm))
+ ;; We have to let-bind the following two since their dynamic
+ ;; values are used for key lookup and url resolution
+ (gptel-backend (plist-get info :backend))
+ (gptel-model (plist-get info :model))
+ (url-request-extra-headers
+ (append '(("Content-Type" . "application/json"))
+ (when-let* ((header (gptel-backend-header gptel-backend)))
+ (gptel--maybe-funcall header info))))
+ (callback (or (plist-get info :callback) ;if not the first run
+ #'gptel--insert-response)) ;default callback
+ ;; NOTE: We don't need the decode-coding-string dance here since we
+ ;; don't pass it to the OS environment and Curl.
+ (url-request-data
+ (gptel--json-encode (plist-get info :data))))
+ (when (with-current-buffer (plist-get info :buffer)
+ (and (derived-mode-p 'org-mode)
+ gptel-org-convert-response))
+ (plist-put info :transformer #'gptel--convert-markdown->org))
+ (plist-put info :callback callback)
+ (when gptel-log-level ;logging
+ (when (eq gptel-log-level 'debug)
+ (gptel--log (gptel--json-encode
+ (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair)))
+ url-request-extra-headers))
+ "request headers"))
+ (gptel--log url-request-data "request body"))
+ (let ((proc-buf
+ (url-retrieve (let ((backend-url (gptel-backend-url gptel-backend)))
+ (gptel--maybe-funcall backend-url info))
+ (lambda (_)
+ (set-buffer-multibyte t)
+ (set-buffer-file-coding-system 'utf-8-unix)
+ (pcase-let ((`(,response ,http-status ,http-msg ,error)
+ (gptel--url-parse-response
+ (plist-get info :backend) info))
+ (buf (current-buffer)))
+ (plist-put info :http-status http-status)
+ (plist-put info :status http-msg)
+ (gptel--fsm-transition fsm) ;WAIT -> TYPE
+ (when error (plist-put info :error error))
+ (when response ;Look for a reasoning block
+ (if (string-match-p "^\\s-*<think>" response)
+ (when-let* ((idx (string-search "</think>" response)))
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall callback
+ (cons 'reasoning
+ (substring response nil (+ idx 8)))
+ info))
+ (setq response (string-trim-left
+ (substring response (+ idx 8)))))
+ (when-let* ((reasoning (plist-get info :reasoning))
+ ((stringp reasoning)))
+ (funcall callback (cons 'reasoning reasoning) info))))
+ (when (or response (not (member http-status '("200" "100"))))
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall callback response info)))
+ (gptel--fsm-transition fsm) ;TYPE -> next
+ (setf (alist-get buf gptel--request-alist nil 'remove) nil)
+ (kill-buffer buf)))
+ nil t nil)))
+ ;; TODO: Add transformer here.
+ (setf (alist-get proc-buf gptel--request-alist)
+ (cons fsm
+ #'(lambda ()
+ (plist-put info :callback #'ignore)
+ (let (kill-buffer-query-functions)
+ ;;Can't stop url-retrieve process
+ (kill-buffer proc-buf))))))))
+
+(cl-defgeneric gptel--parse-response (backend response proc-info)
+ "Response extractor for LLM requests.
+
+BACKEND is the LLM backend in use.
+
+RESPONSE is the parsed JSON of the response, as a plist.
+
+PROC-INFO is a plist with process information and other context.
+See `gptel-curl--get-response' for its contents.")
+
+(defun gptel--url-parse-response (backend proc-info)
+ "Parse response from BACKEND with PROC-INFO."
+ (when gptel-log-level ;logging
+ (save-excursion
+ (goto-char url-http-end-of-headers)
+ (when (eq gptel-log-level 'debug)
+ (gptel--log (gptel--json-encode (buffer-substring-no-properties (point-min) (point)))
+ "response headers"))
+ (gptel--log (buffer-substring-no-properties (point) (point-max))
+ "response body")))
+ (if-let* ((http-msg (string-trim (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (http-status
+ (save-match-data
+ (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
+ (match-string 1 http-msg))))
+ (response (progn (goto-char url-http-end-of-headers)
+ (condition-case nil
+ (gptel--json-read)
+ (error 'json-read-error)))))
+ (cond
+ ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194
+ ((or (memq url-http-response-status '(200 100))
+ (string-match-p "\\(?:1\\|2\\)00 OK" http-msg))
+ (list (and-let* ((resp (gptel--parse-response backend response proc-info))
+ ((not (string-blank-p resp))))
+ (string-trim resp))
+ http-status http-msg))
+ ((and-let* ((error-data
+ (cond ((plistp response) (plist-get response :error))
+ ((arrayp response)
+ (cl-some (lambda (el) (plist-get el :error)) response)))))
+ (list nil http-status http-msg error-data)))
+ ((eq response 'json-read-error)
+ (list nil http-status (concat "(" http-msg ") Malformed JSON in response.") "json-read-error"))
+ (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.")
+ "Could not parse HTTP response.")))
+ (list nil (concat "(" http-msg ") Could not parse HTTP response.")
+ "Could not parse HTTP response.")))
+
+\f
+;;; Curl request response handling
+
+(defun gptel-curl--get-args (info uuid include-headers)
+ "Produce list of arguments for calling Curl.
+
+INFO contains the request data, UUID is a unique identifier.
+
+If INCLUDE-HEADERS is non-nil, include headers with the -H option."
+ (let* ((data (plist-get info :data))
+ ;; We have to let-bind the following three since their dynamic
+ ;; values are used for key lookup and url resolution
+ (gptel-backend (plist-get info :backend))
+ (gptel-model (plist-get info :model))
+ (gptel-stream (plist-get info :stream))
+ (url (let ((backend-url (gptel-backend-url gptel-backend)))
+ (gptel--maybe-funcall backend-url info)))
+ (data-json (decode-coding-string (gptel--json-encode data) 'utf-8 t)))
+ (when gptel-log-level (gptel--log data-json "request body"))
+ (append
+ gptel-curl--common-args
+ gptel-curl-extra-args
+ (if include-headers
+ (cl-loop
+ for (key . val) in
+ (append '(("Content-Type" . "application/json"))
+ (when-let* ((header (gptel-backend-header gptel-backend)))
+ (gptel--maybe-funcall header info)))
+ collect (format "-H%s: %s" key val))
+ (list "-H@-"))
+ (and-let* ((curl-args (gptel-backend-curl-args gptel-backend)))
+ (gptel--maybe-funcall curl-args))
+ (list (format "-w(%s . %%{size_header})" uuid))
+ (if (< (string-bytes data-json) gptel-curl-file-size-threshold)
+ (list (format "-d%s" data-json))
+ (let* ((write-region-inhibit-fsync t)
+ (file-name-handler-alist nil)
+ (inhibit-message t)
+ (temp-filename (make-temp-file "gptel-curl-data" nil ".json" data-json))
+ (cleanup-fn (lambda (&rest _) (when (file-exists-p temp-filename)
+ (delete-file temp-filename)))))
+ (plist-put info :post (cons cleanup-fn (plist-get info :post)))
+ (list "--data-binary" (format "@%s" temp-filename))))
+ (when (not (string-empty-p gptel-proxy))
+ (list "--proxy" gptel-proxy
+ "--proxy-negotiate"
+ "--proxy-user" ":"))
+ (list url))))
+
+;;;###autoload
+(defun gptel-curl-get-response (fsm)
+ "Fetch response to prompt in state FSM from the LLM using Curl.
+
+FSM is the state machine driving this request.
+
+FSM is the state machine driving this request. Its INFO slot
+contains the data required for setting up the request. INFO is a
+plist with the following keys, among others:
+- :data (the data being sent)
+- :buffer (the gptel buffer)
+- :position (marker at which to insert the response).
+- :callback (optional, the request callback)
+
+Call CALLBACK with the response and INFO afterwards. If omitted
+the response is inserted into the current buffer after point."
+ (let* ((uuid (md5 (format "%s%s%s%s"
+ (random) (emacs-pid) (user-full-name)
+ (recent-keys))))
+ (info (gptel-fsm-info fsm))
+ (backend (plist-get info :backend))
+ (args (gptel-curl--get-args info uuid nil))
+ (stream (plist-get info :stream))
+ (process (make-process
+ :name "gptel-curl"
+ :buffer (gptel--temp-buffer " *gptel-curl*")
+ :command (cons (gptel--curl-path) args)
+ :connection-type 'pipe)))
+ (with-current-buffer (process-buffer process)
+ (cond
+ ((eq (gptel-backend-coding-system backend) 'binary)
+ ;; set-buffer-file-coding-system is not needed since we don't save this buffer
+ (set-buffer-multibyte nil)
+ (set-process-coding-system process 'binary 'binary))
+ (t
+ ;; Don't try to convert cr-lf to cr on Windows so that curl's "header size
+ ;; in bytes" stays correct. Explicitly set utf-8 for non-win systems too,
+ ;; for cases when buffer coding system is not set to utf-8.
+ (set-process-coding-system process 'utf-8-unix 'utf-8-unix)))
+ (set-process-query-on-exit-flag process nil)
+ (let* ((gptel-backend backend) ;Required for header function's environment
+ (gptel-model (plist-get info :model))
+ (headers
+ (append '(("Content-Type" . "application/json"))
+ (when-let* ((header (gptel-backend-header backend)))
+ (gptel--maybe-funcall header info)))))
+ (when (eq gptel-log-level 'debug)
+ (gptel--log (gptel--json-encode
+ (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair)))
+ headers))
+ "request headers")
+ (gptel--log (mapconcat #'shell-quote-argument
+ (cons (gptel--curl-path) args) " \\\n")
+ "request Curl command" 'no-json))
+ (dolist (header headers)
+ (process-send-string process (concat (car header) ": " (cdr header) "\n"))))
+ (process-send-eof process)
+ (if (plist-get info :uuid) ;not the first run, set only the uuid
+ (plist-put info :uuid uuid)
+ (setf (gptel-fsm-info fsm) ;fist run, set all process parameters
+ (nconc (list :uuid uuid
+ :transformer
+ (when (with-current-buffer (plist-get info :buffer)
+ (and (derived-mode-p 'org-mode)
+ gptel-org-convert-response))
+ (gptel--stream-convert-markdown->org
+ (plist-get info :position))))
+ (unless (plist-get info :callback)
+ (list :callback (if stream
+ #'gptel-curl--stream-insert-response
+ #'gptel--insert-response)))
+ info)))
+ (if stream
+ (progn (set-process-sentinel process #'gptel-curl--stream-cleanup)
+ (set-process-filter process #'gptel-curl--stream-filter))
+ (set-process-sentinel process #'gptel-curl--sentinel))
+ (setf (alist-get process gptel--request-alist)
+ (cons fsm
+ #'(lambda ()
+ ;; Clean up Curl process
+ (set-process-sentinel process #'ignore)
+ (delete-process process)
+ (kill-buffer (process-buffer process))))))))
+
+;; ;; Ahead-Of-Time dispatch code for the parsers
+;; :parser ; FIXME `cl--generic-*' are internal functions
+;; (cl--generic-method-function
+;; (if stream
+;; (cl-loop
+;; for type in
+;; (cl--class-allparents (get (type-of backend) 'cl--class))
+;; with methods = (cl--generic-method-table
+;; (cl--generic 'gptel-curl--parse-stream))
+;; when (cl--generic-member-method `(,type t) nil methods)
+;; return (car it))
+;; (cl-loop
+;; for type in
+;; (cl--class-allparents (get (type-of backend) 'cl--class))
+;; with methods = (cl--generic-method-table
+;; (cl--generic 'gptel--parse-response))
+;; when (cl--generic-member-method `(,type t t) nil methods)
+;; return (car it))))
+
+(defun gptel-curl--log-response (proc-buf proc-info)
+ "Parse response buffer PROC-BUF and log response.
+
+PROC-INFO is the plist containing process metadata."
+ (with-current-buffer proc-buf
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "\r?\n\r?\n" nil t)
+ (when (eq gptel-log-level 'debug)
+ (gptel--log (gptel--json-encode
+ (buffer-substring-no-properties
+ (point-min) (1- (point))))
+ "response headers"))
+ (let ((p (point)))
+ (when (search-forward (plist-get proc-info :uuid) nil t)
+ (goto-char (1- (match-beginning 0)))
+ (gptel--log (buffer-substring-no-properties p (point))
+ "response body")))))))
+
+;; TODO: Separate user-messaging from this function
+(defun gptel-curl--stream-cleanup (process _status)
+ "Process sentinel for gptel curl requests.
+
+PROCESS and _STATUS are process parameters."
+ (let ((proc-buf (process-buffer process))
+ (exit-status (process-exit-status process)))
+ (let* ((fsm (car (alist-get process gptel--request-alist)))
+ (info (gptel-fsm-info fsm))
+ (http-status (plist-get info :http-status)))
+ (when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging
+ (cond
+ ;; Curl exited with a non-zero status: connection-level failure
+ ((not (zerop exit-status))
+ ;; MAYBE: This transition should happen in the process filter, but it's
+ ;; not clear how to reliably detect Curl failure there.
+ (gptel--fsm-transition fsm) ;Curl failed, WAIT -> TYPE
+ (plist-put info :error
+ (format "Curl failed with exit code %d. See Curl manpage for details."
+ exit-status))
+ (plist-put info :status "Curl failure")
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall (plist-get info :callback) nil info)))
+ ;; Finish handling a successful streaming response
+ ((member http-status '("200" "100"))
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall (plist-get info :callback) t info)))
+ ;; Capture error message from HTTP error response
+ (t
+ (with-current-buffer proc-buf
+ (goto-char (point-max))
+ (if (not (search-backward (plist-get info :uuid) nil t))
+ (plist-put info :error "Could not parse Curl response")
+ (backward-char)
+ (pcase-let* ((`(,_ . ,header-size) (read (current-buffer)))
+ (response (progn (goto-char header-size)
+ (condition-case nil (gptel--json-read)
+ (error 'json-read-error))))
+ (error-data
+ (cond ((plistp response) (plist-get response :error))
+ ((arrayp response)
+ (cl-some (lambda (el) (plist-get el :error)) response)))))
+ (cond
+ (error-data
+ (plist-put info :error error-data))
+ ((eq response 'json-read-error)
+ (plist-put info :error "Malformed JSON in response."))
+ (t (plist-put info :error "Could not parse HTTP response."))))))
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall (plist-get info :callback) nil info))))
+ (gptel--fsm-transition fsm)) ; Move to next state
+ (setf (alist-get process gptel--request-alist nil 'remove) nil)
+ (kill-buffer proc-buf)))
+
+(defun gptel-curl--stream-filter (process output)
+ (let* ((fsm (car (alist-get process gptel--request-alist)))
+ (proc-info (gptel-fsm-info fsm))
+ (callback (or (plist-get proc-info :callback)
+ #'gptel-curl--stream-insert-response)))
+ (with-current-buffer (process-buffer process)
+ ;; Insert output
+ (save-excursion
+ (goto-char (process-mark process))
+ (insert output)
+ (set-marker (process-mark process) (point)))
+
+ ;; Find HTTP status
+ (unless (plist-get proc-info :http-status)
+ (save-excursion
+ (goto-char (point-min))
+ (when-let* (((not (= (line-end-position) (point-max))))
+ (http-msg (buffer-substring (line-beginning-position)
+ (line-end-position)))
+ (http-status
+ (save-match-data
+ (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
+ (match-string 1 http-msg)))))
+ (plist-put proc-info :http-status http-status)
+ (plist-put proc-info :status (string-trim http-msg))
+ (gptel--fsm-transition fsm)))) ;Response started, WAIT -> TYPE
+
+ (when-let* ((http-msg (plist-get proc-info :status))
+ (http-status (plist-get proc-info :http-status)))
+ ;; Find data chunk(s) and run callback
+ ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194
+ (when (member http-status '("200" "100"))
+ (let ((response (gptel-curl--parse-stream
+ (plist-get proc-info :backend) proc-info))
+ (reasoning-block (plist-get proc-info :reasoning-block)))
+ ;; Depending on the API, there are two modes that reasoning or
+ ;; chain-of-thought content appears: as part of the main response
+ ;; but surrounded by <think>...</think> tags, or as a separate
+ ;; JSON field in the response stream.
+ ;;
+ ;; These cases are handled using two PROC-INFO keys:
+ ;;
+ ;; :reasoning-block is nil before checking for reasoning, 'in when
+ ;; in a reasoning block, t when we reach the end of the block, and
+ ;; 'done afterwards or if no reasoning block is found. This
+ ;; applies to both the modes above.
+ ;;
+ ;; :reasoning contains the reasoning text parsed from the separate
+ ;; JSON field.
+ ;;
+ ;; NOTE: We assume here that the reasoning block always
+ ;; precedes the main response block.
+ (unless (eq reasoning-block 'done)
+ (let ((reasoning (plist-get proc-info :reasoning)))
+ (cond
+ ((stringp reasoning)
+ ;; Obtained from separate JSON field in response
+ (funcall callback (cons 'reasoning reasoning) proc-info)
+ (unless reasoning-block ;Record that we're in a reasoning block (#709)
+ (plist-put proc-info :reasoning-block 'in))
+ (plist-put proc-info :reasoning nil)) ;Reset for next parsing round
+ ((and (string-blank-p response) ;Defer checking if response is blank
+ (not reasoning-block))) ;unless we're in a reasoning block already
+ ((and (null reasoning-block) (length> response 0))
+ ;; Obtained from main response stream: reasoning block start
+ (if-let* ((idx (string-match-p "<think>" response)))
+ (progn
+ (when (> idx 0) ;Collect leading whitespace before <think>
+ (funcall callback (substring response 0 idx) proc-info)
+ (setq response (substring response idx)))
+ (setq response (cons 'reasoning response))
+ (plist-put proc-info :reasoning-block 'in))
+ (plist-put proc-info :reasoning-block 'done)))
+ ((and (not (eq reasoning-block t)) (length> response 0))
+ (if-let* ((idx (string-match-p "</think>" response)))
+ (progn
+ (funcall callback
+ (cons 'reasoning (substring response nil (+ idx 8)))
+ proc-info)
+ (setq reasoning-block t) ;Signal end of reasoning stream
+ (plist-put proc-info :reasoning-block t)
+ (setq response (substring response (+ idx 8))))
+ (setq response (cons 'reasoning response)))))
+ (when (eq reasoning-block t) ;End of reasoning block
+ (funcall callback '(reasoning . t) proc-info)
+ (plist-put proc-info :reasoning-block 'done))))
+ (unless (equal response "") ;Response callback
+ (funcall callback response proc-info))))))))
+
+(cl-defgeneric gptel-curl--parse-stream (backend proc-info)
+ "Stream parser for gptel-curl.
+
+Implementations of this function run as part of the process
+filter for the active query, and return partial responses from
+the LLM.
+
+BACKEND is the LLM backend in use.
+
+PROC-INFO is a plist with process information and other context.
+See `gptel-curl--get-response' for its contents.")
+
+(defun gptel-curl--sentinel (process _status)
+ "Process sentinel for gptel curl requests.
+
+PROCESS and _STATUS are process parameters."
+ (let ((proc-buf (process-buffer process)))
+ (when-let* (((eq (process-status process) 'exit))
+ (fsm (car (alist-get process gptel--request-alist)))
+ (proc-info (gptel-fsm-info fsm))
+ (proc-callback (plist-get proc-info :callback)))
+ (when gptel-log-level (gptel-curl--log-response proc-buf proc-info)) ;logging
+ (let ((exit-status (process-exit-status process)))
+ (if (zerop exit-status)
+ (pcase-let ((`(,response ,http-status ,http-msg ,error)
+ (with-current-buffer proc-buf
+ (gptel-curl--parse-response proc-info))))
+ (plist-put proc-info :http-status http-status)
+ (plist-put proc-info :status http-msg)
+ (gptel--fsm-transition fsm) ;WAIT -> TYPE
+ (when error (plist-put proc-info :error error))
+ ;; Look for a reasoning block
+ (if (and (stringp response) (string-match-p "^\\s-*<think>" response))
+ (when-let* ((idx (string-search "</think>" response)))
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall proc-callback
+ (cons 'reasoning (substring response nil (+ idx 8)))
+ proc-info))
+ (setq response
+ (string-trim-left (substring response (+ idx 8)))))
+ (when-let* ((reasoning (plist-get proc-info :reasoning))
+ ((stringp reasoning)))
+ (funcall proc-callback (cons 'reasoning reasoning) proc-info)))
+ ;; Call callback with response text
+ (when (or response (not (member http-status '("200" "100"))))
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall proc-callback response proc-info))))
+ ;; Curl exited with a non-zero status: connection-level failure
+ (plist-put proc-info :error
+ (format "Curl failed with exit code %d. See Curl manpage for details."
+ exit-status))
+ (plist-put proc-info :status "Curl failure")
+ (gptel--fsm-transition fsm) ;WAIT -> TYPE
+ (with-demoted-errors "gptel callback error: %S"
+ (funcall proc-callback nil proc-info))))
+ (gptel--fsm-transition fsm)) ;TYPE -> next
+ (setf (alist-get process gptel--request-alist nil 'remove) nil)
+ (kill-buffer proc-buf)))
+
+(defun gptel-curl--parse-response (proc-info)
+ "Parse the buffer BUF with curl's response.
+
+PROC-INFO is a plist with contextual information."
+ (let ((uuid (plist-get proc-info :uuid)))
+ (goto-char (point-max))
+ (if (not (search-backward uuid nil t))
+ (list nil nil nil "Could not parse curl response.")
+ (backward-char)
+ (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))))
+ (goto-char (point-min))
+ (if-let* ((http-msg (string-trim
+ (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (http-status
+ (save-match-data
+ (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg)
+ (match-string 1 http-msg))))
+ (response (progn (goto-char header-size)
+ (condition-case nil
+ (gptel--json-read)
+ (error 'json-read-error)))))
+ (cond
+ ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194
+ ((member http-status '("200" "100"))
+ (list (and-let* ((resp (gptel--parse-response
+ (plist-get proc-info :backend) response proc-info))
+ ((not (string-blank-p resp))))
+ (string-trim resp))
+ http-status http-msg))
+ ((and-let* ((error-data
+ (cond ((plistp response) (plist-get response :error))
+ ((arrayp response)
+ (cl-some (lambda (el) (plist-get el :error)) response)))))
+ (list nil http-status http-msg error-data)))
+ ((eq response 'json-read-error)
+ (list nil http-status (concat "(" http-msg ") Malformed JSON in response.")
+ "Malformed JSON in response"))
+ (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.")
+ "Could not parse HTTP response.")))
+ (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.")
+ "Could not parse HTTP response."))))))
+
+(provide 'gptel-request)
+;;; gptel-request.el ends here
--- /dev/null
+;;; gptel-rewrite.el --- Refactoring functions for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: hypermedia, convenience, tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+(require 'gptel-transient)
+(require 'cl-lib)
+
+(defvar eldoc-documentation-functions)
+(defvar diff-entire-buffers)
+(defvar ediff-window-setup-function)
+(defvar ediff-split-window-function)
+
+(declare-function diff-no-select "diff")
+(declare-function rmc--add-key-description "rmc")
+(declare-function ediff-setup-windows-plain "ediff-wind")
+
+;; * User options
+
+(defcustom gptel-rewrite-directives-hook nil
+ "Hook run to generate gptel's default rewrite directives.
+
+Each function in this hook is called with no arguments until one
+returns a non-nil value, the base string to use as the
+rewrite instruction.
+
+Use this hook to tailor context-specific rewrite directives.
+For example, you can specialize the default rewrite directive
+for a particular major-mode or project."
+ :group 'gptel
+ :type 'hook)
+
+(defcustom gptel-post-rewrite-functions nil
+ "Abnormal hook run after a `gptel-rewrite' action.
+
+This hook is called after the LLM response for the rewrite action
+has been fully received in a temporary buffer. Each function is
+called with two arguments: the response beginning and end
+positions.
+
+Note: this hook only runs if the rewrite request succeeds."
+ :type 'hook
+ :group 'gptel)
+
+(defcustom gptel-rewrite-default-action nil
+ "Action to take when rewriting a text region using gptel.
+
+When the LLM response with the rewritten text is received, you can
+- merge it with the current region, possibly creating a merge conflict,
+- diff or ediff against the original region,
+- or accept it in place, replacing the original region.
+- display a dispatch menu with the above choices.
+
+If this option is nil (the default), gptel waits for an explicit
+command. Set it to the symbol `merge', `diff', `ediff', `accept'
+or `dispatch' to automatically do one of these things instead.
+
+You can also set it to a function of your choosing for a custom
+action. This function receives one argument, the rewrite
+overlay."
+ :group 'gptel
+ :type '(choice
+ (const :tag "Wait" nil)
+ (const :tag "Merge with current region" merge)
+ (const :tag "Diff against current region" diff)
+ (const :tag "Ediff against current region" ediff)
+ (const :tag "Accept rewrite" accept)
+ (const :tag "Dispatch" dispatch)
+ (function :tag "Custom action")))
+
+(defface gptel-rewrite-highlight-face
+ '((((class color) (min-colors 88) (background dark))
+ :background "#041714" :extend t :inherit default)
+ (((class color) (min-colors 88) (background light))
+ :background "light goldenrod yellow" :extend t :inherit default)
+ (t :inherit secondary-selection))
+ "Face for highlighting regions with pending rewrites."
+ :group 'gptel)
+
+;; * Variables
+
+(defvar-keymap gptel-rewrite-actions-map
+ :doc "Keymap for gptel rewrite actions at point."
+ "RET" #'gptel--rewrite-dispatch
+ "<mouse-1>" #'gptel--rewrite-dispatch
+ "C-c C-a" #'gptel--rewrite-accept
+ "C-c C-r" #'gptel--rewrite-iterate
+ "C-c C-k" #'gptel--rewrite-reject
+ "C-c C-d" #'gptel--rewrite-diff
+ "C-c C-e" #'gptel--rewrite-ediff
+ "C-c C-n" #'gptel--rewrite-next
+ "C-c C-p" #'gptel--rewrite-previous
+ "C-c C-m" #'gptel--rewrite-merge)
+
+(defvar-local gptel--rewrite-overlays nil
+ "List of active rewrite overlays in the buffer.")
+
+(defvar-local gptel--rewrite-message nil
+ "Request-specific instructions for a `gptel-rewrite' action.")
+
+;; Add the rewrite directive to `gptel-directives'
+(unless (alist-get 'rewrite gptel-directives)
+ (add-to-list 'gptel-directives `(rewrite . ,#'gptel--rewrite-directive-default)))
+
+(defvar gptel--rewrite-directive
+ (or (alist-get 'rewrite gptel-directives)
+ #'gptel--rewrite-directive-default)
+ "Active system message for rewrite actions.
+
+This variable is for internal use only. To customize the rewrite
+system message, set a system message (or function that generates
+the system message) as the value of the `rewrite' key in
+`gptel-directives':
+
+ (setf (alist-get \\='rewrite gptel-directives)
+ #\\='my-rewrite-message-generator)
+
+You can also customize `gptel-rewrite-directives-hook' to
+dynamically inject a rewrite-specific system message.")
+
+(defun gptel--rewrite-directive-default ()
+ "Generic directive for rewriting or refactoring.
+
+These are instructions not specific to any particular required
+change.
+
+The returned string is interpreted as the system message for the
+rewrite request. To use your own, add a different directive to
+`gptel-directives', or add to `gptel-rewrite-directives-hook',
+which see."
+ (or (save-mark-and-excursion
+ (run-hook-with-args-until-success
+ 'gptel-rewrite-directives-hook))
+ (let* ((lang (downcase (gptel--strip-mode-suffix major-mode)))
+ (article (if (and lang (not (string-empty-p lang))
+ (memq (aref lang 0) '(?a ?e ?i ?o ?u)))
+ "an" "a")))
+ (if (derived-mode-p 'prog-mode)
+ (format (concat "You are %s %s programmer. "
+ "Follow my instructions and refactor %s code I provide.\n"
+ "- Generate ONLY %s code as output, without "
+ "any explanation or markdown code fences.\n"
+ "- Generate code in full, do not abbreviate or omit code.\n"
+ "- Do not produce intermediate text or report on your progress.\n"
+ "- Do not ask for further clarification, and make "
+ "any assumptions you need to follow instructions.")
+ article lang lang lang)
+ (concat
+ (if (string-empty-p lang)
+ "You are an editor."
+ (format "You are %s %s editor." article lang))
+ " Follow my instructions and improve or rewrite the text I provide."
+ " Do not produce intermediate text or report on your progress."
+ " Generate ONLY the replacement text,"
+ " without any explanation or markdown code fences.")))))
+
+;; MAYBE: Save FSM to `gptel--fsm-last' on request end?
+(defvar gptel--rewrite-handlers
+ `((WAIT ,#'gptel--handle-wait ,#'gptel--rewrite-update-wait)
+ (TPRE ,#'gptel--handle-pre-tool ,#'gptel--fsm-transition)
+ (TOOL ,#'gptel--rewrite-update-tool-call ,#'gptel--handle-tool-use)
+ (TRET ,#'gptel--handle-post-tool ,#'gptel--rewrite-update-tool-call
+ ,#'gptel--handle-tool-result))
+ "Alist specifying FSM handlers for `gptel-rewrite' state transitions.")
+
+;; * Helper functions
+
+;; ** UI Indicators
+(defun gptel--rewrite-update-tool-call (fsm)
+ "Update the rewrite overlay to indicate tool call progress for FSM."
+ (when-let* ((info (gptel-fsm-info fsm))
+ (ov (car-safe (plist-get info :context)))
+ (names (cl-loop for call in (plist-get info :tool-use)
+ collect (plist-get call :name))))
+ (with-current-buffer (plist-get info :buffer)
+ (setq gptel--fsm-last fsm)
+ (gptel--rewrite-update-status
+ ov (concat
+ (propertize
+ (if (length> names 1) " Calling tools (" " Calling tool (")
+ 'face '(mode-line-emphasis default))
+ (mapconcat (lambda (name) (propertize name 'face '(font-lock-keyword-face default)))
+ names (propertize ", " 'face '(mode-line-emphasis default)))
+ (propertize ")" 'face '(mode-line-emphasis default)))))))
+
+(defun gptel--rewrite-update-wait (fsm)
+ "Update the rewrite overlay status for FSM to indicate a waiting state."
+ (when-let* ((info (gptel-fsm-info fsm))
+ (ov (car-safe (plist-get info :context)))
+ (model (gptel--model-name
+ (or (plist-get info :model) gptel-model)))
+ (hint-str (concat "[" model "]\n")))
+ (overlay-put
+ ov 'status
+ (list (propertize "REWRITE" 'face '(warning default)) ;status element 0
+ (propertize " Waiting..." 'face '(warning default)) ;status element 1
+ (propertize ;status element 2
+ " " 'display
+ (if (fboundp 'string-pixel-width)
+ `(space :align-to (- right (,(string-pixel-width hint-str))))
+ `(space :align-to (- right ,(+ 1 (string-width hint-str))))))
+ (propertize hint-str 'face '(warning default)))) ;status element 3
+ (overlay-put ov 'before-string (apply #'concat (overlay-get ov 'status)))))
+
+(defun gptel--rewrite-update-status (ov msg &optional face)
+ "Update overlay OV's status with MSG and refresh its before-string.
+If FACE is non-nil, apply that face to MSG when storing the status."
+ (setq msg (or msg ""))
+ (setf (cadr (overlay-get ov 'status))
+ (if face (propertize msg 'face face) msg))
+ (overlay-put ov 'before-string (apply #'concat (overlay-get ov 'status))))
+
+(defun gptel--rewrite-key-help (callback)
+ "Eldoc documentation function for gptel rewrite actions.
+
+CALLBACK is supplied by Eldoc, see
+`eldoc-documentation-functions'."
+ (when (and gptel--rewrite-overlays
+ (get-char-property (point) 'gptel-rewrite))
+ (funcall callback
+ (format (substitute-command-keys "%s rewrite available: accept \\[gptel--rewrite-accept], iterate \\[gptel--rewrite-iterate], clear \\[gptel--rewrite-reject], merge \\[gptel--rewrite-merge], diff \\[gptel--rewrite-diff] or ediff \\[gptel--rewrite-ediff]")
+ (propertize (gptel--model-name gptel-model) 'face 'mode-line-emphasis)))))
+
+;; ** Navigation across rewrite regions
+
+(defun gptel--rewrite-move (search-func)
+ "Move directionally to a gptel rewrite location using SEARCH-FUNC."
+ (let* ((ov (cdr (get-char-property-and-overlay (point) 'gptel-rewrite)))
+ (pt (save-excursion
+ (if ov
+ (goto-char
+ (funcall search-func (overlay-start ov) 'gptel-rewrite))
+ (goto-char
+ (max (1- (funcall search-func (point) 'gptel-rewrite))
+ (point-min))))
+ (funcall search-func (point) 'gptel-rewrite))))
+ (if (get-char-property pt 'gptel-rewrite)
+ (goto-char pt)
+ (user-error "No further rewrite regions!"))))
+
+(defun gptel--rewrite-next ()
+ "Go to next pending LLM rewrite in buffer, if one exists."
+ (interactive)
+ (gptel--rewrite-move #'next-single-char-property-change))
+
+(defun gptel--rewrite-previous ()
+ "Go to previous pending LLM rewrite in buffer, if one exists."
+ (interactive)
+ (gptel--rewrite-move #'previous-single-char-property-change))
+
+;; ** Rewrite actions helpers
+
+(defun gptel--rewrite-overlay-at (&optional pt)
+ "Check for a gptel rewrite overlay at PT and return it.
+
+If no suitable overlay is found, raise an error."
+ (pcase-let ((`(,response . ,ov)
+ (get-char-property-and-overlay (or pt (point)) 'gptel-rewrite))
+ (diff-entire-buffers nil))
+ (unless ov (user-error "Could not find region being rewritten"))
+ (unless response (user-error "No LLM output available for this rewrite"))
+ ov))
+
+(defun gptel--rewrite-prepare-buffer (ovs &optional buf)
+ "Prepare new buffer with LLM changes applied and return it.
+
+This is used for (e)diff purposes.
+
+RESPONSE is the LLM response. OVS are the overlays specifying
+the changed regions. BUF is the (current) buffer."
+ (setq buf (or buf (overlay-buffer (or (car-safe ovs) ovs))))
+ (with-current-buffer buf
+ (let ((pmin (point-min))
+ (pmax (point-max))
+ (pt (point))
+ ;; (mode major-mode)
+ (newbuf (get-buffer-create "*gptel-diff*"))
+ (inhibit-read-only t)
+ (inhibit-message t))
+ (save-restriction
+ (widen)
+ (with-current-buffer newbuf
+ (erase-buffer)
+ (insert-buffer-substring buf)))
+ (with-current-buffer newbuf
+ (narrow-to-region pmin pmax)
+ (goto-char pt)
+ ;; We mostly just want font-locking
+ ;; (delay-mode-hooks (funcall mode))
+ ;; Apply the changes to the new buffer
+ (save-excursion
+ (gptel--rewrite-accept ovs newbuf)))
+ newbuf)))
+
+(defun gptel--rewrite-read-message (prompt &optional _ history)
+ "Read a rewrite message from the minibuffer.
+
+Provide custom keybindings for cycling, editing, and submitting the
+`gptel-rewrite' action directly from this prompt.
+
+PROMPT is the prompt string to display. HISTORY, if provided, is the
+input history list."
+ (let* ((rewrite-directive
+ (car-safe (gptel--parse-directive gptel--rewrite-directive 'raw)))
+ (cb (current-buffer))
+ (cycle-prefix (lambda () (interactive)
+ (gptel--read-with-prefix rewrite-directive)
+ (push-mark) (goto-char (point-max))
+ (activate-mark)))
+ (set-rewrite-message
+ (lambda ()
+ (let ((message (buffer-substring-no-properties
+ (minibuffer-prompt-end) (point-max))))
+ (with-current-buffer cb (setq gptel--rewrite-message message))
+ (setf (alist-get 'gptel--infix-rewrite-extra transient-history)
+ (delete-dups (cons message transient--history))))))
+ (start-rewrite-maybe
+ (lambda () (interactive)
+ (when (minibufferp) (funcall set-rewrite-message))
+ (if transient--prefix ;Called from transient? Don't start rewrite
+ (run-at-time 0 nil #'transient-setup 'gptel-rewrite)
+ (with-current-buffer cb
+ (gptel--suffix-rewrite gptel--rewrite-message)))
+ (when (minibufferp) (exit-minibuffer))))
+ (start-transient
+ (lambda () (interactive)
+ (run-at-time 0 nil #'transient-setup 'gptel-rewrite)
+ (when (minibufferp)
+ (funcall set-rewrite-message)
+ (exit-minibuffer))))
+ (edit-in-buffer
+ (lambda () (interactive)
+ (let ((offset (- (point) (minibuffer-prompt-end))))
+ (gptel--edit-directive 'gptel--rewrite-message
+ :prompt rewrite-directive :initial (minibuffer-contents)
+ :buffer cb :setup (lambda () (ignore-errors (forward-char offset)))
+ :callback
+ (lambda (msg)
+ (when msg
+ (push (buffer-local-value 'gptel--rewrite-message cb)
+ (alist-get 'gptel--infix-rewrite-extra transient-history))
+ (with-current-buffer cb (gptel--suffix-rewrite)))
+ (when (minibufferp) (exit-minibuffer)))))))
+ (minibuffer-local-map
+ (make-composed-keymap (define-keymap
+ "TAB" cycle-prefix "<tab>" cycle-prefix
+ "C-c C-e" edit-in-buffer
+ "<remap> <exit-minibuffer>" start-rewrite-maybe
+ "M-RET" start-transient)
+ minibuffer-local-map)))
+ (minibuffer-with-setup-hook cycle-prefix
+ (read-string
+ prompt (or gptel--rewrite-message "Rewrite: ")
+ history))))
+
+;; * Rewrite action functions
+
+(defun gptel--rewrite-reject (&optional ovs)
+ "Clear pending LLM responses in OVS or at point."
+ (interactive (list (gptel--rewrite-overlay-at)))
+ (dolist (ov (ensure-list ovs))
+ (setq gptel--rewrite-overlays (delq ov gptel--rewrite-overlays))
+ (delete-overlay ov))
+ (unless gptel--rewrite-overlays
+ (remove-hook 'eldoc-documentation-functions 'gptel--rewrite-key-help 'local))
+ (message "Cleared pending LLM response(s)."))
+
+(defun gptel--rewrite-accept (&optional ovs buf)
+ "Apply pending LLM responses in OVS or at point.
+
+BUF is the buffer to modify, defaults to the overlay buffer."
+ (interactive (list (gptel--rewrite-overlay-at)))
+ (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
+ (buf (or buf ov-buf))
+ ((buffer-live-p buf)))
+ (with-current-buffer ov-buf
+ (cl-loop for ov in (ensure-list ovs)
+ for ov-beg = (overlay-start ov)
+ for ov-end = (overlay-end ov)
+ for response = (overlay-get ov 'gptel-rewrite)
+ do (with-current-buffer buf
+ (goto-char ov-beg)
+ (delete-region ov-beg ov-end)
+ (insert response))))
+ (message "Replaced region(s) with LLM output in buffer: %s."
+ (buffer-name ov-buf))))
+
+(defalias 'gptel--rewrite-iterate 'gptel-rewrite
+ "Iterate on pending LLM response at point.")
+
+(defun gptel--rewrite-diff (&optional ovs switches)
+ "Diff pending LLM responses in OVS or at point.
+
+SWITCHES are diff arguments."
+ (interactive (list (gptel--rewrite-overlay-at)))
+ (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
+ ((buffer-live-p ov-buf)))
+ (require 'diff)
+ (let* ((newbuf (gptel--rewrite-prepare-buffer ovs))
+ (diff-buf (diff-no-select ov-buf newbuf switches)))
+ (with-current-buffer diff-buf
+ (setq-local diff-jump-to-old-file t))
+ (display-buffer diff-buf))))
+
+(defun gptel--rewrite-ediff (&optional ovs)
+ "Ediff pending LLM responses in OVS or at point."
+ (interactive (list (gptel--rewrite-overlay-at)))
+ (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
+ ((buffer-live-p ov-buf)))
+ (letrec ((newbuf (gptel--rewrite-prepare-buffer ovs))
+ (cwc (current-window-configuration))
+ (hideshow
+ (lambda (&optional restore)
+ (dolist (ov (ensure-list ovs))
+ (when-let* ((overlay-buffer ov))
+ (let ((disp (overlay-get ov 'display))
+ (stored (overlay-get ov 'gptel--ediff)))
+ (overlay-put ov 'face (and restore 'gptel-rewrite-highlight-face))
+ (overlay-put ov 'display (and restore stored))
+ (overlay-put ov 'gptel--ediff (unless restore disp)))))))
+ (gptel--ediff-restore
+ (lambda ()
+ (when (window-configuration-p cwc)
+ (set-window-configuration cwc))
+ (funcall hideshow 'restore)
+ (remove-hook 'ediff-quit-hook gptel--ediff-restore))))
+ (funcall hideshow)
+ (add-hook 'ediff-quit-hook gptel--ediff-restore 50)
+ (let ((ediff-window-setup-function #'ediff-setup-windows-plain)
+ (ediff-split-window-function #'split-window-horizontally))
+ (ediff-buffers ov-buf newbuf)))))
+
+(defun gptel--rewrite-merge-git (beg end new-str)
+ "Produce a merge conflict region between BEG and END.
+
+Merge the region with NEW-STR using git merge-file."
+ (let ((original-temp-file (make-temp-file "gptel-merge-"))
+ (empty-temp-file (make-temp-file "gptel-merge-")) ; use /dev/null? (windows?)
+ (new-temp-file (make-temp-file "gptel-merge-")))
+ (unwind-protect
+ (progn (write-region beg end original-temp-file)
+ (with-temp-file empty-temp-file (insert ""))
+ (with-temp-file new-temp-file (insert new-str))
+ (goto-char beg)
+ (delete-region beg end)
+ (call-process
+ "git" nil (list (current-buffer) nil) nil
+ "merge-file" "--no-diff3" "-L" "original" "-L" "Empty" "-L"
+ (gptel-backend-name gptel-backend) "-p"
+ original-temp-file empty-temp-file new-temp-file)
+ ;; Make merge marker active if required
+ (goto-char beg) (unless (bolp) (insert "\n")))
+ (delete-file original-temp-file)
+ (delete-file empty-temp-file)
+ (delete-file new-temp-file))))
+
+(defun gptel--rewrite-merge-simple (beg end new-str)
+ "Produce a merge conflict region between BEG and END.
+
+NEW-STR is the new string intended to replace the region."
+ (goto-char end) ;End first to preserve ordering
+ (unless (bolp) (insert "\n"))
+ (insert "=======\n" new-str "\n>>>>>>> "
+ (gptel-backend-name gptel-backend) "\n")
+ (goto-char beg)
+ (unless (bolp) (insert "\n"))
+ (insert-before-markers "<<<<<<< original\n"))
+
+(defun gptel--rewrite-merge (&optional ovs)
+ "Insert pending LLM responses in OVS as merge conflicts."
+ (interactive (list (gptel--rewrite-overlay-at)))
+ (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs)))
+ ((buffer-live-p ov-buf)))
+ (with-current-buffer ov-buf
+ (let ((changed))
+ (dolist (ov (ensure-list ovs))
+ (save-excursion
+ (when-let* ((new-str (overlay-get ov 'gptel-rewrite)))
+ (if (executable-find "git") ;Replace overlay content with merge result
+ (gptel--rewrite-merge-git (overlay-start ov) (overlay-end ov) new-str)
+ (gptel--rewrite-merge-simple (overlay-start ov) (overlay-end ov) new-str))
+ (setq changed t))))
+ (when changed (smerge-mode 1)))
+ (gptel--rewrite-reject ovs))))
+
+(defun gptel--rewrite-dispatch (&optional ov ci)
+ "Dispatch actions for gptel rewrites.
+
+OV is the rewrite overlay, CI is true for interactive calls."
+ (interactive (list (gptel--rewrite-overlay-at) t))
+ (let ((choice)
+ (orig-status (copy-sequence (overlay-get ov 'status))))
+ (unwind-protect
+ (pcase-let ((choices '((?a "accept") (?k "reject") (?r "iterate")
+ (?m "merge") (?d "diff") (?e "ediff"))))
+ (gptel--rewrite-update-status
+ ov (when (fboundp #'rmc--add-key-description) ; introduced in Emacs 29
+ (concat " " (mapconcat (lambda (e) (cdr e))
+ (mapcar #'rmc--add-key-description choices) ", "))))
+ (setq choice (read-multiple-choice "Action: " choices)))
+ (overlay-put ov 'status orig-status)
+ (overlay-put ov 'before-string (apply #'concat orig-status)))
+ (if ci
+ (call-interactively (intern (concat "gptel--rewrite-" (cadr choice))))
+ (funcall (intern (concat "gptel--rewrite-" (cadr choice))) ov))))
+
+(defun gptel--rewrite-callback (response info)
+ "Callback for gptel rewrite actions.
+
+Show the rewrite result in an overlay over the original text, and
+set up dispatch actions.
+
+RESPONSE is the response received. It may also be t (to indicate
+success) nil (to indicate failure), or the symbol `abort'.
+
+INFO is the async communication channel for the rewrite request."
+ (when-let* ((ov-and-buf (plist-get info :context))
+ (ov (car ov-and-buf))
+ (proc-buf (cdr ov-and-buf))
+ (buf (overlay-buffer ov)))
+ (cond
+ ((stringp response) ;partial or fully successful result
+ (with-current-buffer proc-buf ;auxiliary buffer, insert text here and copy to overlay
+ (let ((inhibit-modification-hooks nil)
+ (inhibit-read-only t))
+ (when (= (buffer-size) 0)
+ (buffer-disable-undo)
+ (overlay-put ov 'gptel-rewrite nil)
+ (gptel--rewrite-update-status ov " Typing..." '(success default))
+ (insert-buffer-substring buf (overlay-start ov) (overlay-end ov))
+ (when (eq (char-before (point-max)) ?\n)
+ (plist-put info :newline t))
+ (setq major-mode (buffer-local-value 'major-mode buf)) ;Don't turn on major-mode (#730, #722)
+ (add-text-properties (point-min) (point-max) '(face shadow font-lock-face shadow))
+ (goto-char (point-min)))
+ (insert response)
+ (unless (eobp) (ignore-errors (delete-char (length response))))
+ (font-lock-ensure)
+ (overlay-put ov 'display (propertize (buffer-string) 'face 'default))))
+ (unless (plist-get info :stream) (gptel--rewrite-callback t info)))
+
+ ((eq response 'abort) ;request aborted
+ (when-let* ((proc-buf (cdr-safe (plist-get info :context))))
+ (kill-buffer proc-buf))
+ (delete-overlay ov))
+
+ ((eq (car-safe response) 'tool-call) ;tool call confirmation
+ (gptel--rewrite-update-status ov " Run tools?" '(mode-line-emphasis default))
+ (gptel--display-tool-calls ;use minibuffer
+ (cdr response) info ;; (buffer-local-value 'buffer-read-only buf)
+ t))
+
+ ((null response) ;finished with error
+ (message (concat "LLM response error: %s. Rewrite in buffer %s canceled.")
+ (plist-get info :status) (plist-get info :buffer))
+ (gptel--rewrite-callback 'abort info))
+
+ ((consp response)) ;reasoning or tool call result -- don't care
+
+ (t
+ (if (plist-get info :tool-use) ;stopped to use tools
+ ;; Clear text inserted so far
+ (with-current-buffer proc-buf (delete-region (point-min) (point)))
+ (let ((mkb (propertize "<mouse-1>" 'face 'help-key-binding))) ;or finished successfully
+ (with-current-buffer proc-buf
+ (let ((inhibit-read-only t))
+ (delete-region (point) (point-max))
+ ;; Run post-rewrite-functions on rewritten text in its buffer
+ (setq-local gptel-post-rewrite-functions
+ (buffer-local-value 'gptel-post-rewrite-functions buf))
+ (with-demoted-errors "gptel-post-rewrite-functions: %S"
+ (run-hook-with-args 'gptel-post-rewrite-functions (point-min) (point-max)))
+ (when (and (plist-get info :newline)
+ (not (eq (char-before (point-max)) ?\n)))
+ (insert "\n"))
+ (font-lock-ensure))
+ (overlay-put ov 'display (buffer-string))
+ (overlay-put ov 'gptel-rewrite (buffer-string))
+ (kill-buffer proc-buf))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (pulse-momentary-highlight-region (overlay-start ov) (overlay-end ov))
+ (add-hook 'eldoc-documentation-functions #'gptel--rewrite-key-help nil 'local)
+ ;; (overlay-put ov 'gptel-rewrite response)
+ (overlay-put ov 'face 'gptel-rewrite-highlight-face)
+ (overlay-put ov 'priority 2000)
+ (overlay-put ov 'keymap gptel-rewrite-actions-map)
+ (overlay-put ov 'mouse-face 'highlight)
+ (let ((status (overlay-get ov 'status)))
+ (dolist (idx '(0 1 3))
+ (setf (nth idx status)
+ (propertize (nth idx status) 'face '(success default))))
+ (gptel--rewrite-update-status ov " Ready" '(success default)))
+ (overlay-put
+ ov 'help-echo
+ (format (concat "%s rewrite available: %s or \\[gptel--rewrite-dispatch] for options")
+ (concat (gptel-backend-name gptel-backend) ":" (gptel--model-name gptel-model))
+ mkb))
+ (push ov gptel--rewrite-overlays))
+ (if-let* ((sym gptel-rewrite-default-action))
+ (if-let* ((action (intern (concat "gptel--rewrite-" (symbol-name sym))))
+ ((functionp action)))
+ (funcall action ov) (funcall sym ov))
+ (message (concat
+ "LLM rewrite output"
+ (unless (eq (current-buffer) buf)
+ (format " in buffer %s " (buffer-name buf)))
+ (concat " ready: " mkb ", " (propertize "RET" 'face 'help-key-binding)
+ " or " (substitute-command-keys "\\[gptel-rewrite] to continue."))))))))))))
+
+;; * Transient Prefixes for rewriting
+
+(transient-define-prefix gptel--rewrite-directive-menu ()
+ "Set the directive (system message) for rewrite actions.
+
+By default, gptel uses the directive associated with the `rewrite'
+ key in `gptel-directives'. You can add more rewrite-specific
+ directives to `gptel-directives' and pick one from here."
+ [:description gptel-system-prompt--format
+ [(gptel--suffix-rewrite-directive)]
+ [(gptel--infix-variable-scope)]]
+ [:class transient-column
+ :setup-children
+ (lambda (_) (transient-parse-suffixes
+ 'gptel--rewrite-directive-menu
+ (gptel--setup-directive-menu
+ 'gptel--rewrite-directive "Rewrite directive")))
+ :pad-keys t])
+
+;;;###autoload (autoload 'gptel-rewrite "gptel-rewrite" nil t)
+(transient-define-prefix gptel-rewrite ()
+ "Rewrite or refactor text region using an LLM."
+ [:description
+ (lambda ()
+ (gptel--describe-directive
+ gptel--rewrite-directive (max (- (window-width) 14) 20) " "))
+ [""
+ (gptel-preset
+ :transient t
+ :if (lambda () (or (get-char-property (point) 'gptel-rewrite)
+ (use-region-p)))
+ :key "@" :format "%d"
+ :description
+ (lambda ()
+ (concat (propertize "Instructions" 'face 'transient-heading)
+ (gptel--format-preset-string))))
+ ("s" "Set full directive" gptel--rewrite-directive-menu)
+ (gptel--infix-rewrite-extra)]]
+ ;; FIXME: We are requiring `gptel-transient' because of this suffix, perhaps
+ ;; we can get find some way around that?
+ [:description "Context for rewrite"
+ :if use-region-p
+ (gptel--infix-context-remove-all :key "-d")
+ (gptel--suffix-context-buffer :key "C" :format " %k %d")]
+ [[:description "Diff Options"
+ :if (lambda () gptel--rewrite-overlays)
+ ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change"))
+ ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space"))
+ ("-i" "Ignore case" ("-i" "--ignore-case"))
+ (gptel--infix-rewrite-diff:-U)]
+ [:description "Accept all"
+ :if (lambda () gptel--rewrite-overlays)
+ (gptel--suffix-rewrite-merge)
+ (gptel--suffix-rewrite-accept)
+ "Reject all"
+ (gptel--suffix-rewrite-reject)]]
+ [[:description "Diff rewrite regions"
+ :if (lambda () gptel--rewrite-overlays)
+ (gptel--suffix-rewrite-diff)
+ (gptel--suffix-rewrite-ediff)]]
+ [[:description "Rewrite"
+ :if (lambda () (or (get-char-property (point) 'gptel-rewrite)
+ (use-region-p)))
+ (gptel--suffix-rewrite)]
+ ["Dry Run"
+ :if (lambda () (and (or gptel-log-level gptel-expert-commands)
+ (or (get-char-property (point) 'gptel-rewrite)
+ (use-region-p))))
+ ("I" "Inspect query (Lisp)"
+ (lambda ()
+ "Inspect the query that will be sent as a lisp object."
+ (interactive)
+ (gptel--sanitize-model)
+ (gptel--inspect-query
+ (gptel--suffix-rewrite gptel--rewrite-message t))))
+ ("J" "Inspect query (JSON)"
+ (lambda ()
+ "Inspect the query that will be sent as a JSON object."
+ (interactive)
+ (gptel--sanitize-model)
+ (gptel--inspect-query
+ (gptel--suffix-rewrite gptel--rewrite-message t)
+ 'json)))]]
+ (interactive)
+ (gptel--rewrite-sanitize-overlays)
+ (cond
+ ((use-region-p) ;Start a/another rewrite
+ (let ((transient--history ;No transient reader, so We manage history ourselves
+ (alist-get 'gptel--infix-rewrite-extra transient-history)))
+ (gptel--rewrite-read-message
+ (concat "Instructions (" gptel--read-with-prefix-help
+ (format " %s%s) "
+ (propertize "M-RET" 'face 'help-key-binding)
+ (propertize ": More options" 'face 'default)))
+ nil (cons 'transient--history 1))))
+ (gptel--rewrite-overlays ;Rewrite actions pending, show options
+ (transient-setup 'gptel-rewrite))
+ (t (user-error
+ "`gptel-rewrite' requires an active region or rewrite in progress"))))
+
+;; * Transient infixes for rewriting
+
+(transient-define-infix gptel--infix-rewrite-extra ()
+ "Chat directive (system message) to use for rewriting or refactoring."
+ :description "Rewrite instruction"
+ :class 'gptel-lisp-variable
+ :variable 'gptel--rewrite-message
+ :set-value #'gptel--set-with-scope
+ :display-nil "(None)"
+ :key "d"
+ :format " %k %d %v"
+ :prompt (concat "Instructions (" gptel--read-with-prefix-help ") ")
+ :reader #'gptel--rewrite-read-message)
+
+(transient-define-argument gptel--infix-rewrite-diff:-U ()
+ :description "Context lines"
+ :class 'transient-option
+ :argument "-U"
+ :reader #'transient-read-number-N0)
+
+;; * Transient suffixes for rewriting
+
+(transient-define-suffix gptel--suffix-rewrite-directive (&optional cancel)
+ "Edit Rewrite directive.
+
+CANCEL is used to avoid touching dynamic rewrite directives,
+generated from functions."
+ :transient 'transient--do-exit
+ :description "Edit full rewrite directive"
+ :key "s"
+ (interactive
+ (list (and
+ (functionp gptel--rewrite-directive)
+ (not (y-or-n-p
+ "Rewrite directive is dynamically generated: Edit its current value instead?")))))
+ (if cancel (progn (message "Edit canceled")
+ (call-interactively #'gptel-rewrite))
+ (gptel--edit-directive 'gptel--rewrite-directive
+ :callback (lambda (_) (call-interactively #'gptel-rewrite))
+ :setup #'activate-mark)))
+
+(transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message dry-run)
+ "Rewrite or refactor region contents."
+ :key "r"
+ :description (lambda () (if (get-char-property (point) 'gptel-rewrite) "Iterate" "Rewrite"))
+ (interactive (list gptel--rewrite-message))
+ (let* ((nosystem (gptel--model-capable-p 'nosystem))
+ ;; Try to send context with system message
+ (gptel-use-context
+ (and gptel-use-context (if nosystem 'user 'system)))
+ (prompt (list (or (get-char-property (point) 'gptel-rewrite)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ "What is the required change? I will generate only the final replacement."
+ (or rewrite-message gptel--rewrite-message))))
+ (when nosystem
+ (setcar prompt (concat (car-safe (gptel--parse-directive
+ gptel--rewrite-directive 'raw))
+ "\n\n" (car prompt))))
+ (prog1 (gptel-request prompt
+ :dry-run dry-run
+ :system gptel--rewrite-directive
+ :stream gptel-stream
+ :context
+ (let ((ov (or (cdr-safe (get-char-property-and-overlay (point) 'gptel-rewrite))
+ (make-overlay (region-beginning) (region-end) nil t))))
+ (overlay-put ov 'evaporate t)
+ ;; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 (#724)
+ (cons ov (gptel--temp-buffer " *gptel-rewrite*")))
+ :transforms gptel-prompt-transform-functions
+ :fsm (gptel-make-fsm :handlers gptel--rewrite-handlers)
+ :callback #'gptel--rewrite-callback)
+ ;; Move back so that the cursor is on the overlay when done.
+ (unless (get-char-property (point) 'gptel-rewrite)
+ (when (= (point) (region-end)) (run-at-time 0 nil #'backward-char 1)))
+ (setq deactivate-mark t))))
+
+;; Allow this to be called non-interactively for dry runs
+(put 'gptel--suffix-rewrite 'interactive-only nil)
+
+(transient-define-suffix gptel--suffix-rewrite-diff (&optional switches)
+ "Diff LLM output against buffer."
+ :if (lambda () gptel--rewrite-overlays)
+ :key "D"
+ :description "Diff LLM rewrites"
+ (interactive (list (transient-args transient-current-command)))
+ (gptel--rewrite-diff gptel--rewrite-overlays switches))
+
+(transient-define-suffix gptel--suffix-rewrite-ediff ()
+ "Ediff LLM output against buffer."
+ :if (lambda () gptel--rewrite-overlays)
+ :key "E"
+ :description "Ediff LLM rewrites"
+ (interactive)
+ (gptel--rewrite-ediff gptel--rewrite-overlays))
+
+(transient-define-suffix gptel--suffix-rewrite-merge ()
+ "Insert LLM output as merge conflicts."
+ :if (lambda () gptel--rewrite-overlays)
+ :key "M"
+ :description "Merge with conflicts"
+ (interactive)
+ (gptel--rewrite-merge gptel--rewrite-overlays))
+
+(transient-define-suffix gptel--suffix-rewrite-accept ()
+ "Accept pending LLM rewrites."
+ :if (lambda () gptel--rewrite-overlays)
+ :key "A"
+ :description "Accept and replace"
+ (interactive)
+ (gptel--rewrite-accept gptel--rewrite-overlays))
+
+(transient-define-suffix gptel--suffix-rewrite-reject ()
+ "Clear pending LLM rewrites."
+ :if (lambda () gptel--rewrite-overlays)
+ :key "K"
+ :description "Clear pending rewrites"
+ (interactive)
+ (gptel--rewrite-reject gptel--rewrite-overlays))
+
+(provide 'gptel-rewrite)
+;;; gptel-rewrite.el ends here
+
+;; Local Variables:
+;; outline-regexp: "^;; \\*+"
+;; End:
--- /dev/null
+;;; gptel-transient.el --- Transient menu for gptel -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthikchikmagalurNOSPAMgmail.com>
+;; Keywords: convenience
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+(require 'cl-lib)
+(require 'gptel)
+(require 'transient)
+
+(declare-function ediff-regions-internal "ediff")
+(declare-function ediff-make-cloned-buffer "ediff-utils")
+(declare-function org-escape-code-in-string "org-src")
+(declare-function gptel--vterm-delete "gptel-integrations")
+
+\f
+;; * Helper functions and vars
+
+(defvar-local gptel--rewrite-overlays nil
+ "List of active rewrite overlays in the buffer.")
+
+(defun gptel--rewrite-sanitize-overlays ()
+ "Ensure gptel's rewrite overlays in buffer are consistent."
+ (setq gptel--rewrite-overlays
+ (cl-delete-if-not #'overlay-buffer
+ gptel--rewrite-overlays)))
+
+(defvar gptel--set-buffer-locally nil
+ "Set model parameters from `gptel-menu' buffer-locally.
+
+Affects the system message too.")
+
+(defun gptel--set-with-scope (sym value &optional scope)
+ "Set SYM's symbol value to VALUE with SCOPE.
+
+If SCOPE is t, set it buffer-locally.
+If SCOPE is 1, reset it after the next gptel request. (oneshot)
+Otherwise, clear any buffer-local value and set its default
+global value."
+ (pcase scope
+ (1 (unless (get sym 'gptel-history)
+ (put sym 'gptel-history (symbol-value sym))
+ (letrec ((restore-value
+ (lambda ()
+ (remove-hook 'gptel-post-request-hook restore-value)
+ (run-at-time ; Required to work around let bindings
+ 0 nil (lambda (s) ; otherwise this change is overwritten!
+ (set s (get s 'gptel-history))
+ (put s 'gptel-history nil))
+ sym))))
+ (add-hook 'gptel-post-request-hook restore-value)))
+ (set sym value))
+ ('t (set (make-local-variable sym) value))
+ (_ (kill-local-variable sym)
+ (set sym value))))
+
+(defun gptel--preset-mismatch-p (name)
+ "Check if gptel preset with NAME is in effect.
+
+This is intended to be fast but imperfect. See
+`gptel--preset-mismatch-value' for more granular checking."
+ (let ((elm (or (gptel-get-preset name)
+ (gptel-get-preset (intern-soft name))))
+ key val)
+ (catch 'mismatch
+ (while elm
+ (setq key (pop elm) val (pop elm))
+ (cond
+ ((memq key '(:description :parents)) 'nil)
+ ((eq key :system)
+ (or (equal gptel--system-message val)
+ (functionp val) ; Ignore functions, modify-specs for speed here
+ (and (consp val) (keywordp (car val)))
+ (and-let* (((symbolp val))
+ (p (assq val gptel-directives)))
+ (equal gptel--system-message (cdr p)))
+ (throw 'mismatch t)))
+ ((eq key :backend)
+ (or (if (stringp val)
+ (equal (gptel-backend-name gptel-backend) val)
+ (eq gptel-backend val))
+ (throw 'mismatch t)))
+ ((eq key :tools)
+ (setq val (cl-loop ; Check against tool names, not tools (faster with sorting)
+ for tool in (ensure-list (gptel--modify-value gptel-tools val))
+ for tool-name = (or (and (stringp tool) tool)
+ (ignore-errors (gptel-tool-name tool)))
+ if (not (member tool-name uniq-tool-names))
+ collect tool-name into uniq-tool-names
+ finally return uniq-tool-names))
+ (or (equal (sort val #'string-lessp) ;preset tools same as gptel-tools?
+ (sort (mapcar #'gptel-tool-name gptel-tools)
+ #'string-lessp))
+ (throw 'mismatch t)))
+ (t (let* ((suffix (substring
+ (if (symbolp key) (symbol-name key) key) 1))
+ (sym (or (intern-soft (concat "gptel-" suffix))
+ (intern-soft (concat "gptel--" suffix)))))
+ ;; FIXME(modify-list): Fix for values specified with a spec, like :eval
+ (or (null sym)
+ (and (boundp sym) (equal (eval sym) val))
+ (throw 'mismatch t)))))))))
+
+(defun gptel--get-directive (args)
+ "Find the additional directive in the transient ARGS.
+
+Meant to be called when `gptel-menu' is active."
+ (cl-some (lambda (s) (and (stringp s) (string-prefix-p ":" s)
+ (substring s 1)))
+ args))
+
+(defun gptel--instructions-make-overlay (text &optional ov)
+ "Make or move overlay OV with TEXT."
+ (save-excursion
+ ;; Move point to overlay position
+ (cond
+ ((use-region-p)
+ (if (pos-visible-in-window-p (region-beginning))
+ (goto-char (region-beginning))))
+ ((gptel--in-response-p)
+ (gptel-beginning-of-response)
+ (skip-chars-forward "\n \t"))
+ (t (text-property-search-backward 'gptel 'response)
+ (skip-chars-forward "\n \t")))
+ ;; Make overlay
+ (if (and ov (overlayp ov))
+ (move-overlay ov (point) (point) (current-buffer))
+ (setq ov (make-overlay (point) (point) nil t)))
+ (overlay-put ov 'before-string nil)
+ ;; (unless (or (bobp) (eq (char-before) "\n"))
+ ;; (overlay-put ov 'before-string (propertize "\n" 'font-lock-face 'shadow)))
+ (overlay-put ov 'category 'gptel)
+ (overlay-put
+ ov 'after-string
+ (concat (propertize (concat "DIRECTIVE: " text)
+ 'font-lock-face '(:inherit shadow :weight bold :box t))
+ "\n"))
+ ov))
+
+(defconst gptel--read-with-prefix-help
+ (concat
+ (propertize "TAB" 'face 'help-key-binding)
+ (propertize ": expand, " 'face 'default)
+ (propertize "M-n" 'face 'help-key-binding)
+ (propertize "/" 'face 'default)
+ (propertize "M-p" 'face 'help-key-binding)
+ (propertize ": next/previous" 'face 'default))
+ "Help string (TODO).")
+
+(defun gptel--read-with-prefix (prefix)
+ "Show string PREFIX in the minibuffer after the minibuffer prompt.
+
+PREFIX is shown in an overlay. Repeated calls to this function
+will toggle its visibility state."
+ (unless (minibufferp)
+ (user-error "This command is intended to be used in the minibuffer"))
+ (let* ((update
+ (lambda (ov s)
+ (overlay-put
+ ov 'after-string
+ (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow)
+ (make-separator-line))))))
+ (max-width (- (window-width) (minibuffer-prompt-end)))
+ (max (or max-mini-window-height 0.4))
+ (max-height (- (or (and (natnump max) max)
+ (floor (* max (frame-height))))
+ 5)))
+ (if (and prefix (not (string-empty-p prefix)) (> max-height 1))
+ (progn
+ (unless visual-line-mode (visual-line-mode 1))
+ (goto-char (minibuffer-prompt-end))
+ (pcase-let ((`(,prop . ,ov)
+ (get-char-property-and-overlay
+ (point-min) 'gptel)))
+ (unless ov
+ (setq ov (make-overlay
+ (point-min) (minibuffer-prompt-end) nil t)))
+ (pcase prop
+ ('partial
+ (if (> (length prefix) max-width)
+ (progn
+ (overlay-put ov 'gptel 'prefix)
+ (let ((disp-size
+ (cl-loop for char across prefix
+ for idx upfrom 0
+ with n = 0 with max-length = (* max-height max-width)
+ if (eq char ?\n) do (cl-incf n)
+ if (> n max-height) return idx
+ if (> idx max-length)
+ return idx
+ finally return nil)))
+ (funcall update ov
+ (if disp-size
+ (truncate-string-to-width
+ prefix disp-size nil nil 'ellipsis)
+ prefix))))
+ (overlay-put ov 'gptel 'hide)
+ (funcall update ov nil)))
+ ('prefix (overlay-put ov 'gptel 'hide)
+ (funcall update ov nil))
+ (_ (overlay-put ov 'gptel 'partial)
+ (funcall update ov (truncate-string-to-width
+ prefix max-width nil nil
+ 'ellipsis))))))
+ (when-let* ((prop-ov (get-char-property-and-overlay (point-min) 'gptel)))
+ (when (overlayp (cdr prop-ov)) (delete-overlay (cdr prop-ov)))))))
+
+(defvar gptel--minibuffer-prompt-history nil
+ "History of prompts read from the minibuffer by gptel.")
+
+(defun gptel--read-minibuffer-prompt (&optional read-prompt)
+ "Read a user prompt from the minibuffer.
+
+Prompt with READ-PROMPT if supplied. Return a cons cell of the buffer
+region (if included) and the provided instructions."
+ (let* ((include-region (use-region-p))
+ (cb (current-buffer))
+ (get-region (lambda () (with-current-buffer cb
+ (and include-region
+ (buffer-substring-no-properties
+ (region-beginning) (region-end))))))
+ (cycle-prefix (lambda () (interactive)
+ (let ((p (point)))
+ (gptel--read-with-prefix (funcall get-region))
+ (goto-char p))))
+ (toggle-region (lambda () (interactive)
+ (if include-region
+ (progn (setq include-region nil)
+ (gptel--read-with-prefix nil))
+ (setq include-region t)
+ (funcall cycle-prefix))))
+ (edit-in-buffer
+ (lambda () (interactive)
+ (gptel--edit-directive nil
+ :initial (minibuffer-contents)
+ :prompt (if include-region
+ (with-current-buffer cb (buffer-substring-no-properties
+ (region-beginning) (region-end)))
+ "# Edit prompt below")
+ :setup (lambda () (goto-char (point-max)) (run-at-time 0 nil #'recenter))
+ :callback (lambda (msg)
+ (if (not msg)
+ (minibuffer-quit-recursive-edit)
+ (delete-region (minibuffer-prompt-end) (point-max))
+ (insert msg) (exit-minibuffer))))))
+ (minibuffer-local-map
+ (make-composed-keymap (define-keymap
+ "M-RET" toggle-region "C-c C-e" edit-in-buffer)
+ minibuffer-local-map)))
+ (let ((user-prompt
+ (minibuffer-with-setup-hook
+ (lambda () (add-hook 'completion-at-point-functions
+ #'gptel-preset-capf nil t)
+ (funcall cycle-prefix)
+ ;; HACK for lucid Emacs, where `make-separator-line' is wonky. The
+ ;; minibuffer prompt gets cut off -- force redisplay to fix:
+ (insert " ") (redisplay) (delete-char -1))
+ (read-string
+ (or read-prompt
+ (concat (format "Ask %s" (gptel-backend-name gptel-backend))
+ (if (use-region-p) ;NOTE: not "include-region" as this is only read once
+ (concat " (" (propertize "M-RET" 'face 'help-key-binding)
+ (propertize ": Include/Ignore selection" 'face 'default)
+ "): ")
+ ": ")))
+ nil 'gptel--minibuffer-prompt-history))))
+ (cons (funcall get-region) user-prompt))))
+
+(defun gptel--transient-read-number (prompt _initial-input history)
+ "Read a numeric value from the minibuffer.
+
+PROMPT, _INITIAL-INPUT and HISTORY are as in the transient reader
+documention. Return nil if user does not provide a number, for default."
+ ;; Workaround for buggy transient behaviour when dealing with
+ ;; non-string values. See: https://github.com/magit/transient/issues/172
+ (when-let* ((history-symbol (or (car-safe history) history))
+ (val (and (symbolp history-symbol) (symbol-value history-symbol))))
+ (unless (stringp (car val))
+ (setcar val (number-to-string (car val)))))
+ (let* ((minibuffer-default-prompt-format "")
+ (num (read-number prompt -1 history)))
+ (if (= num -1) nil num)))
+
+(defun gptel-system-prompt--format ()
+ "Format the system prompt for display in gptel's transient menus.
+
+Handle formatting for system messages when the active `gptel-model' does
+not support system messages."
+ (if (gptel--model-capable-p 'nosystem)
+ (concat (propertize "[No system message support for model "
+ 'face 'transient-heading)
+ (propertize (gptel--model-name gptel-model)
+ 'face 'warning)
+ (propertize "]" 'face 'transient-heading))
+ (if gptel--system-message
+ (gptel--describe-directive
+ gptel--system-message (max (- (window-width) 12) 14) "⮐ ")
+ "[No system message set]")))
+
+(defun gptel--tools-init-value (obj)
+ "Set the initial state of a tool OBJ in variable `gptel-tools'.
+
+OBJ is a tool-infix of type `gptel--switch'."
+ (when-let* ((name (car (member (oref obj argument)
+ (mapcar #'cadr
+ (plist-get (transient-scope) :tools))))))
+ (oset obj value (list (oref obj category) name))))
+
+(defvar gptel--crowdsourced-prompts-url
+ "https://raw.githubusercontent.com/f/prompts.chat/main/prompts.csv"
+ "URL for crowdsourced LLM system prompts.")
+
+(defvar gptel--crowdsourced-prompts
+ (make-hash-table :test #'equal)
+ "Crowdsourced LLM system prompts.")
+
+(defun gptel--read-csv-column ()
+ "Read the next CSV column in the current buffer.
+
+Supports RFC 4180 quoted and unquoted fields, including embedded
+newlines and escaped quotes in quoted fields."
+ (cond
+ ((eobp) nil)
+ ((eq (char-after) ?,)
+ (forward-char 1)
+ "")
+ ((eq (char-after) ?\")
+ (forward-char 1)
+ (let ((parts nil)
+ (start (point))
+ done)
+ (while (not done)
+ (if (search-forward "\"" nil t)
+ (if (eq (char-after) ?\")
+ (progn
+ (push (buffer-substring-no-properties start (1- (point))) parts)
+ (push "\"" parts)
+ (forward-char 1)
+ (setq start (point)))
+ (push (buffer-substring-no-properties start (1- (point))) parts)
+ (setq done t))
+ (push (buffer-substring-no-properties start (point-max)) parts)
+ (goto-char (point-max))
+ (setq done t)))
+ (when (eq (char-after) ?,)
+ (forward-char 1))
+ (apply #'concat (nreverse parts))))
+ (t
+ (let ((start (point)))
+ (while (and (not (eobp))
+ (not (memq (char-after) '(?, ?\n ?\r))))
+ (forward-char 1))
+ (prog1 (buffer-substring-no-properties start (point))
+ (when (eq (char-after) ?,)
+ (forward-char 1)))))))
+
+(defun gptel--crowdsourced-prompts ()
+ "Acquire and read crowdsourced LLM system prompts.
+
+These are stored in the variable `gptel--crowdsourced-prompts',
+which see."
+ (when (hash-table-p gptel--crowdsourced-prompts)
+ (when (hash-table-empty-p gptel--crowdsourced-prompts)
+ (unless gptel-crowdsourced-prompts-file
+ (run-at-time 0 nil #'gptel-system-prompt)
+ (user-error "No crowdsourced prompts available"))
+ (unless (and (file-exists-p gptel-crowdsourced-prompts-file)
+ (time-less-p
+ (time-subtract (current-time) (days-to-time 14))
+ (file-attribute-modification-time
+ (file-attributes gptel-crowdsourced-prompts-file))))
+ (when (y-or-n-p
+ (concat
+ "Fetch crowdsourced system prompts from "
+ (propertize gptel--crowdsourced-prompts-url 'face 'link)
+ "?"))
+ ;; Fetch file
+ (message "Fetching prompts...")
+ (let ((dir (file-name-directory gptel-crowdsourced-prompts-file)))
+ (unless (file-exists-p dir) (mkdir dir 'create-parents))
+ (if (url-copy-file gptel--crowdsourced-prompts-url
+ gptel-crowdsourced-prompts-file
+ 'ok-if-already-exists)
+ (message "Fetching prompts... done.")
+ (message "Could not retrieve new prompts.")))))
+ (if (not (file-readable-p gptel-crowdsourced-prompts-file))
+ (progn (message "No crowdsourced prompts available")
+ (call-interactively #'gptel-system-prompt))
+ (with-temp-buffer
+ (insert-file-contents gptel-crowdsourced-prompts-file)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (not (eobp))
+ (when-let* ((act (gptel--read-csv-column))
+ (prompt (gptel--read-csv-column)))
+ (puthash act prompt gptel--crowdsourced-prompts))
+ (forward-line 1)))))
+ gptel--crowdsourced-prompts))
+
+;; FIXME(targeted-context): This does not handle :bounds and :lines.
+(defun gptel--describe-infix-context ()
+ "Return a count of the number of context chunks."
+ (if (null gptel-context) "Context"
+ (pcase-let*
+ ((buffer-count (length gptel-context))
+ (`(,file-count ,ov-count)
+ (if (> buffer-count 0)
+ (cl-loop for entry in gptel-context
+ for (buf-file . spec) = (ensure-list entry)
+ if (bufferp buf-file)
+ sum (max (length (plist-get spec :overlays)) 1)
+ into ov-count
+ else count (stringp buf-file) into file-count
+ finally return (list file-count ov-count))
+ (list 0 0))))
+ (concat "Context ("
+ (propertize
+ (concat
+ (and (> ov-count 0)
+ (format "%d region%s in %d buffer%s"
+ ov-count (if (> ov-count 1) "s" "")
+ (- buffer-count file-count)
+ (if (> ( - buffer-count file-count) 1) "s" "")))
+ (and (> file-count 0)
+ (format "%s%d file%s"
+ (if (> ov-count 0) ", " "") file-count
+ (if (> file-count 1) "s" ""))))
+ 'face 'warning)
+ ")"))))
+
+(defun gptel--describe-suffix-send ()
+ "Describe the action of `gptel--suffix-send'."
+ (cl-flet ((ptv (s) (propertize s 'face 'warning))
+ (pth (s) (propertize s 'face 'transient-heading)))
+ (let* ((args (or (and transient-current-command
+ (transient-args transient-current-command))
+ ;; Not yet exported, simulate. HACK: We are accessing
+ ;; Transient's internal variables here for live updates.
+ (let* ((transient-current-command (oref transient--prefix command))
+ (transient-current-suffixes transient--suffixes))
+ (transient-args transient-current-command))))
+ (lbeg (line-number-at-pos (if (use-region-p) (region-beginning)
+ (point-min))))
+ (lend (line-number-at-pos (if (use-region-p) (region-end)
+ (point))))
+ (ltext (ptv (if (> lend lbeg)
+ (format " (lines %d-%d)" lbeg lend)
+ (format " (line %d)" lbeg))))
+ (dest) (context))
+ (setq dest (cond
+ ((member "e" args) (ptv "echo area"))
+ ((member "k" args) (ptv "kill-ring"))
+ ((cl-some (lambda (s)
+ (and (stringp s) (memq (aref s 0) '(?g ?b))
+ (not (equal (substring s 1) (buffer-name)))
+ (concat (pth "buffer ") (ptv (substring s 1)))))
+ args))))
+ (setq context
+ (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)
+ (concat (pth "Read prompt from ") (ptv "minibuffer")
+ context
+ (if dest (concat (pth ", response to ") dest)
+ (concat (pth ", insert response at point")))))
+ ((member "y" args)
+ (concat (pth "Send prompt from ")
+ (concat (ptv "kill-ring (")
+ (if-let* ((val (current-kill 0))
+ (val (substring-no-properties val))
+ (len (length val)))
+ (ptv (concat
+ "\"" (string-replace
+ "\n" "⮐"
+ (truncate-string-to-width
+ val 20 nil nil t))
+ "\"" (when (> len 20)
+ (concat
+ ", "
+ (file-size-human-readable len 'si " ")
+ " chars"))))
+ (propertize "empty" 'face 'error))
+ (ptv ")"))
+ context
+ (if dest (concat (pth ", response to ") dest)
+ (concat (pth ", insert response at point")))))
+ ((member "i" args)
+ (let* ((reg (use-region-p))
+ (src (ptv (if reg "selection" (buffer-name)))))
+ (if dest (concat (pth "Send ") src ltext context (pth ", with response to ")
+ (ptv dest) (pth "; kill") ltext
+ (and (not reg) (concat (pth " in ") src)))
+ (concat (pth "Replace ") src ltext (pth " with response")
+ (and context
+ (concat (pth " ( with") (substring context 11) " )"))))))
+ ((use-region-p)
+ (concat (pth "Send ") (ptv "selection") ltext
+ context (if dest (concat (pth ", with response to ") dest)
+ (concat (pth ", insert response at region end")))))
+ (t (concat (pth "Send ") (ptv (buffer-name)) ltext
+ context (if dest (concat (pth ", with response to ") dest)
+ (concat (pth ", insert response at point")))))))))
+
+(defun gptel--format-preset-string ()
+ "Format the preset indicator display for `gptel-menu'."
+ (if (and gptel--known-presets gptel--preset)
+ (apply
+ #'format " (%s%s)"
+ (let ((mismatch (gptel--preset-mismatch-p gptel--preset)))
+ (list (propertize "@" 'face (if mismatch 'transient-key
+ '( :inherit transient-key
+ :inherit secondary-selection
+ :box -1 :weight bold)))
+ (propertize (format "%s" gptel--preset) 'face
+ (if mismatch
+ '(:inherit warning :strike-through t)
+ '(:inherit secondary-selection :box -1))))))
+ (format " (%s%s)"
+ (propertize "@" 'face 'transient-key)
+ (propertize "preset" 'face 'transient-inactive-value))))
+
+\f
+;; * Transient classes and methods for gptel
+
+;; ** Class for generic gptel elisp variables
+
+(defclass gptel-lisp-variable (transient-lisp-variable)
+ ((display-nil :initarg :display-nil) ;String to display if value if nil
+ (display-map :initarg :display-map :initform nil)) ;Display string from alist display-map
+ "Lisp variables that show :display-nil instead of nil.")
+
+(cl-defmethod transient-format-value ((obj gptel-lisp-variable))
+ (let ((display-value
+ (with-slots (value display-nil display-map) obj
+ (cond ((null value) display-nil)
+ (display-map (or (cdr (assoc value display-map)) value))
+ (t value)))))
+ (propertize
+ (if (stringp display-value) display-value (prin1-to-string display-value))
+ 'face 'transient-value)))
+
+(cl-defmethod transient-infix-set ((obj gptel-lisp-variable) value)
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (oset obj value value)
+ gptel--set-buffer-locally))
+
+;; ** Class for managing gptel tools
+
+(defclass gptel--switch (transient-switch)
+ ((category :initarg :category))
+ "Class used for arguments that share a category.")
+
+(cl-defmethod transient-infix-set ((obj gptel--switch) value)
+ "Set VALUE of a `gptel--switch' OBJ.
+
+It is a list of the category and argument, e.g.
+ (\"filesystem\" \"read_file\")."
+ (let ((state (transient-scope))
+ (category (oref obj category)))
+ (if value
+ (progn
+ (cl-pushnew (list category value)
+ (plist-get state :tools) :test #'equal)
+ (oset obj value (list category value)))
+ (plist-put state :tools
+ (delete (list category (oref obj argument))
+ (plist-get state :tools)))
+ (oset obj value nil))
+ (oset transient--prefix scope state)))
+
+;; ** Class for managing gptel tool categories
+
+(defclass gptel--switch-category (transient-switch)
+ ((category :initarg :category))
+ "Class used for arguments that switch a group of other arguments.
+
+Their own value is ignored")
+
+(cl-defmethod transient-format-value ((obj gptel--switch-category))
+ (let* ((category (oref obj category))
+ (active-count
+ (cl-count-if (lambda (tl) (equal (car tl) category))
+ (plist-get (transient-scope) :tools)))
+ (total-count (length (cdr (assoc category gptel--known-tools)))))
+ (if (> active-count 0)
+ (propertize (format "(%d/%d)" active-count total-count) 'face 'transient-value)
+ (propertize (format "(0/%d)" total-count) 'face 'transient-inactive-value))))
+
+;; Pressing a tool category key should have different behaviors in different
+;; contexts:
+;; - If the tools for the category are not shown, show them, do nothing else
+;; - If the tools are showing and any of them are selected, deselect all
+;; - If the tools are showing and none of them are selected, select all
+
+;; To do this we independently track whether the category tools are visible
+;; ("active"), and whether any category tools have been "selected":
+(cl-defmethod transient-infix-read ((obj gptel--switch-category))
+ "Determine OBJ value according to category toggle settings."
+ (let* ((category (oref obj category))
+ (active (equal category (plist-get (transient-scope) :category)))
+ (selected (cl-some (lambda (tool-spec) (equal category (car tool-spec)))
+ (plist-get (transient-scope) :tools))))
+ (if (not active)
+ (oref obj value)
+ (if selected nil (oref obj argument)))))
+
+(cl-defmethod transient-infix-set ((obj gptel--switch-category) value)
+ "When setting VALUE, set all options in the category of OBJ."
+ (dolist (suffix-obj transient--suffixes)
+ ;; Find all suffixes that have this category
+ (when-let* (((cl-typep suffix-obj 'gptel--switch))
+ ((equal (oref suffix-obj category)
+ (oref obj category)))
+ (arg (if (slot-boundp suffix-obj 'argument)
+ (oref suffix-obj argument)
+ (oref obj argument-format))))
+ (if value ; Turn on/off all members in category
+ (transient-infix-set suffix-obj arg)
+ (transient-infix-set suffix-obj nil))))
+ ;; Update the active menu category and key in the prefix scope
+ (plist-put (transient-scope) :category (oref obj category))
+ (plist-put (transient-scope) :key (oref obj key))
+ ;; Finally set the "value" of the category itself
+ (oset obj value value))
+
+;; ** Class for gptel options that are three-way switches
+
+(defclass gptel--switches (gptel-lisp-variable)
+ ((display-if-true :initarg :display-if-true :initform "True")
+ (display-if-false :initarg :display-if-false :initform "False"))
+ "Boolean Lisp variable class for gptel-transient.")
+
+(cl-defmethod transient-infix-read ((obj gptel--switches))
+ "Cycle through the mutually exclusive switches for OBJ."
+ (not (oref obj value)))
+
+(cl-defmethod transient-format-value ((obj gptel--switches))
+ (with-slots (value display-if-true display-if-false) obj
+ (format
+ (propertize "(%s)" 'face 'transient-delimiter)
+ (concat
+ (propertize display-if-false
+ 'face (if value 'transient-inactive-value 'transient-value))
+ (propertize "|" 'face 'transient-delimiter)
+ (propertize display-if-true
+ 'face (if value 'transient-value 'transient-inactive-value))))))
+
+;; ** Class for gptel's scope management, singleton
+
+(defclass gptel--scope (gptel--switches)
+ ((display-if-true :initarg :display-if-true :initform "buffer")
+ (display-if-false :initarg :display-if-false :initform "global"))
+ "Singleton Lisp variable class for `gptel--set-buffer-locally'.
+
+This is used only for setting this variable via `gptel-menu'.")
+
+(cl-defmethod transient-infix-read ((obj gptel--scope))
+ "Cycle through the mutually exclusive switches for OBJ."
+ (with-slots (value) obj
+ (pcase value
+ ('t (message "Parameters will be set for the next request only"))
+ ('nil (message "Parameters will be set buffer-locally"))
+ (1 (message "Parameters will be set globally")))
+ (pcase value ('t 1) ('nil t) (1 nil))))
+
+(cl-defmethod transient-format-value ((obj gptel--scope))
+ (with-slots (value display-if-true display-if-false) obj
+ (format
+ (propertize "(%s)" 'face 'transient-delimiter)
+ (concat
+ (propertize display-if-false
+ 'face (if (null value) 'transient-value 'transient-inactive-value))
+ (propertize "|" 'face 'transient-delimiter)
+ (propertize display-if-true
+ 'face (if (eq value t) 'transient-value 'transient-inactive-value))
+ (propertize "|" 'face 'transient-delimiter)
+ (propertize "oneshot" 'face
+ (if (eql value 1) 'transient-value 'transient-inactive-value))))))
+
+(cl-defmethod transient-infix-set ((obj gptel--scope) value)
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (oset obj value value)))
+
+;; ** Class for managing gptel's backend and model, singleton
+
+(defclass gptel-provider-variable (transient-lisp-variable)
+ ((backend :initarg :backend)
+ (backend-value :initarg :backend-value)
+ (always-read :initform t)
+ (set-value :initarg :set-value :initform #'set))
+ "Class used for gptel-backends.")
+
+(cl-defmethod transient-format-value ((obj gptel-provider-variable))
+ (propertize (concat
+ (gptel-backend-name
+ (buffer-local-value (oref obj backend) transient--original-buffer)) ":"
+ (gptel--model-name (oref obj value)))
+ 'face 'transient-value))
+
+(cl-defmethod transient-infix-set ((obj gptel-provider-variable) value)
+ (pcase-let ((`(,backend-value ,model-value) value))
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (oset obj value model-value)
+ gptel--set-buffer-locally)
+ (funcall (oref obj set-value)
+ (oref obj backend)
+ (oset obj backend-value backend-value)
+ gptel--set-buffer-locally))
+ (transient-setup))
+
+;; ** Class for infix options with in-buffer overlay display
+
+(defclass gptel-option-overlaid (transient-option)
+ ((display-nil :initarg :display-nil)
+ (overlay :initarg :overlay))
+ "Transient options for overlays displayed in the working buffer.")
+
+(cl-defmethod transient-format-value ((obj gptel-option-overlaid))
+ "Set up the in-buffer overlay for additional directive, a string.
+
+Also format the value of OBJ in the transient menu."
+ (let ((value (oref obj value))
+ (ov (oref obj overlay))
+ (argument (oref obj argument)))
+ ;; Making an overlay
+ (if (or (not value) (string-empty-p value))
+ (when ov (delete-overlay ov))
+ (with-current-buffer transient--original-buffer
+ (oset obj overlay (gptel--instructions-make-overlay value ov)))
+ (letrec ((ov-clear-hook
+ (lambda () (when-let* ((ov (oref obj overlay))
+ ((overlayp ov)))
+ (remove-hook 'transient-exit-hook
+ ov-clear-hook)
+ (delete-overlay ov)))))
+ (add-hook 'transient-exit-hook ov-clear-hook)))
+ ;; Updating transient menu display
+ (if value
+ (propertize (concat argument (truncate-string-to-width value 35 nil nil t))
+ 'face 'transient-value)
+ (propertize
+ (concat "(" (symbol-name (oref obj display-nil)) ")")
+ 'face 'transient-inactive-value))))
+
+\f
+;; * Transient Prefixes
+
+;;;###autoload (autoload 'gptel-menu "gptel-transient" nil t)
+(transient-define-prefix gptel-menu ()
+ "Change parameters of prompt to send to the LLM."
+ :incompatible '(("m" "y" "i") ("e" "g" "b" "k"))
+ ;; :value (list (concat "b" (buffer-name)))
+ [:description gptel-system-prompt--format
+ [""
+ :if (lambda () (not (gptel--model-capable-p 'nosystem)))
+ "Instructions"
+ ("s" "Set system message" gptel-system-prompt :transient t)
+ (gptel--infix-add-directive)]
+ [:pad-keys t ""
+ (:info #'gptel--describe-infix-context
+ :face transient-heading :format "%d")
+ (gptel--infix-context-add-current-kill)
+ (gptel--infix-context-add-region)
+ (gptel--infix-context-add-buffer)
+ (gptel--infix-context-add-file)
+ (gptel--infix-context-remove-all)
+ (gptel--suffix-context-buffer)]
+ [:pad-keys t
+ :if (lambda () (and gptel-use-tools
+ (or gptel--known-tools (featurep 'gptel-integrations))))
+ "" (:info
+ (lambda ()
+ (concat
+ "Tools" (and gptel-tools
+ (concat " (" (propertize (format "%d selected"
+ (length gptel-tools))
+ 'face 'warning)
+ ")"))))
+ :format "%d" :face transient-heading)
+ ("t" "Select tools" gptel-tools :transient t)
+ ("T" "Continue tool calls"
+ (lambda () (interactive) (gptel--handle-tool-use gptel--fsm-last))
+ :if (lambda () (and gptel--fsm-last
+ (eq (gptel-fsm-state gptel--fsm-last) 'TOOL))))]]
+ [[(gptel-preset
+ :transient t
+ :key "@" :format "%d"
+ :description
+ (lambda ()
+ (concat (propertize "Request Parameters" 'face 'transient-heading)
+ (gptel--format-preset-string))))
+ (gptel--infix-variable-scope)
+ (gptel--infix-provider)
+ (gptel--infix-max-tokens)
+ (gptel--infix-num-messages-to-send
+ :if (lambda () (and gptel-expert-commands
+ (or gptel-mode gptel-track-response))))
+ (gptel--infix-temperature :if (lambda () gptel-expert-commands))
+ (gptel--infix-use-context)
+ (gptel--infix-include-reasoning)
+ (gptel--infix-use-tools)
+ (gptel--infix-track-response
+ :if (lambda () (and gptel-expert-commands (not gptel-mode))))
+ (gptel--infix-track-media :if (lambda () gptel-mode))]
+ [" <Prompt from"
+ ("m" "Minibuffer instead" "m")
+ ("y" "Kill-ring instead" "y")
+ ""
+ ("i" "Respond in place" "i")]
+ [" >Response to"
+ ("e" "Echo area" "e")
+ ("b" "Other buffer" "b"
+ :class transient-option
+ :prompt "Output to buffer: "
+ :reader (lambda (prompt _ _history)
+ (read-buffer prompt (buffer-name (other-buffer)) nil)))
+ ("g" "gptel session" "g"
+ :class transient-option
+ :prompt "Existing or new gptel session: "
+ :reader
+ (lambda (prompt _ _history)
+ (read-buffer
+ prompt (generate-new-buffer-name
+ (concat "*" (gptel-backend-name gptel-backend) "*"))
+ nil (lambda (buf-name)
+ (if (consp buf-name) (setq buf-name (car buf-name)))
+ (let ((buf (get-buffer buf-name)))
+ (and (buffer-local-value 'gptel-mode buf)
+ (not (eq (current-buffer) buf))))))))
+ ("k" "Kill-ring" "k")]]
+ [[:description (lambda () (concat (and gptel--rewrite-overlays "Continue ")
+ "Rewrite"))
+ :if (lambda () (or (use-region-p)
+ (and gptel--rewrite-overlays
+ (gptel--rewrite-sanitize-overlays))))
+ ("r"
+ (lambda () (if (get-char-property (point) 'gptel-rewrite)
+ "Iterate" "Rewrite"))
+ gptel-rewrite)]
+ ["Tweak Response" :if gptel--in-response-p :pad-keys t
+ ("SPC" "Mark" gptel--mark-response)
+ ("M-RET" "Regenerate" gptel--regenerate :if gptel--in-response-p)
+ ("P" "Previous variant" gptel--previous-variant
+ :if gptel--at-response-history-p
+ :transient t)
+ ("N" "Next variant" gptel--previous-variant
+ :if gptel--at-response-history-p
+ :transient t)
+ ("E" "Ediff previous" gptel--ediff
+ :if gptel--at-response-history-p)]
+ ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands))
+ ("I" "Inspect query (Lisp)"
+ (lambda ()
+ "Inspect the query that will be sent as a lisp object."
+ (interactive)
+ (gptel--sanitize-model)
+ (gptel--inspect-query
+ (gptel--suffix-send
+ (cons "I" (transient-args transient-current-command))))))
+ ("J" "Inspect query (JSON)"
+ (lambda ()
+ "Inspect the query that will be sent as a JSON object."
+ (interactive)
+ (gptel--sanitize-model)
+ (gptel--inspect-query
+ (gptel--suffix-send
+ (cons "I" (transient-args transient-current-command)))
+ 'json)))]
+ ["Logging"
+ :if (lambda () (or gptel-log-level gptel-expert-commands))
+ ("-l" "Log level" "-l"
+ :class gptel-lisp-variable
+ :variable gptel-log-level
+ :set-value gptel--set-with-scope
+ :display-nil "Off"
+ :prompt "Log level: "
+ :reader
+ (lambda (prompt _ _)
+ "Manage gptel's logging."
+ (let ((state (completing-read
+ prompt '("off" "info" "debug") nil t)))
+ (message "Log level set to %s" state)
+ (if (string= state "off") nil (intern state)))))
+ ("L" "Inspect Log"
+ (lambda () (interactive)
+ (pop-to-buffer (get-buffer-create gptel--log-buffer-name)))
+ :format " %k %d")]]
+ [(gptel--suffix-send)]
+ (interactive)
+ (gptel--sanitize-model)
+ (when gptel-context ;MAYBE: Move this to a dedicated sanitize function?
+ (setq gptel-context
+ (cl-delete-if
+ (lambda (entry)
+ (let ((first (or (car-safe entry) entry)))
+ (and (bufferp first) (not (buffer-live-p first)))))
+ gptel-context)))
+ (transient-setup 'gptel-menu))
+
+;; ** Prefix for setting the system prompt.
+
+(defun gptel--setup-directive-menu (sym msg &optional external)
+ "Return a list of infix definitions for setting gptel directives.
+
+SYM is the symbol whose value is set to the selected directive..
+MSG is the meaning of symbol, used when messaging.
+If EXTERNAL is non-nil, include external sources of directives."
+ (cl-loop for (type . prompt) in gptel-directives
+ ;; Avoid clashes with the custom directive key
+ with unused-keys = (delete ?s (nconc (number-sequence ?a ?z)
+ (number-sequence ?0 ?9)))
+ with width = (window-width)
+ for name = (symbol-name type)
+ for key = (seq-find (lambda (k) (member k unused-keys)) name (seq-first unused-keys))
+ do (setq unused-keys (delete key unused-keys))
+ ;; The explicit declaration ":transient transient--do-return" here
+ ;; appears to be required for Transient v0.5 and up. Without it, these
+ ;; 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 "(" (gptel--describe-directive prompt (- width 30)) ")")
+ 'face 'shadow))
+ `(lambda () (interactive)
+ (message "%s: %s" ,msg ,(gptel--describe-directive prompt 100 "⮐ "))
+ (gptel--set-with-scope ',sym ',prompt gptel--set-buffer-locally))
+ :transient 'transient--do-return)
+ into prompt-suffixes
+ finally return
+ (nconc
+ prompt-suffixes
+ (list (list "DEL" "None"
+ `(lambda () (interactive)
+ (message "%s unset" ,msg)
+ (gptel--set-with-scope ',sym nil gptel--set-buffer-locally))
+ :transient 'transient--do-return))
+ (and external
+ (list (list "SPC" "Pick crowdsourced prompt"
+ 'gptel--read-crowdsourced-prompt
+ ;; NOTE: Quitting the completing read when picking a
+ ;; crowdsourced prompt will cause the transient to exit
+ ;; instead of returning to the system prompt menu.
+ :transient 'transient--do-exit))))))
+
+;;;###autoload (autoload 'gptel-system-prompt "gptel-transient" nil t)
+(transient-define-prefix gptel-system-prompt ()
+ "Set the LLM system message for LLM interactions.
+
+The \"system message\" establishes directives for the chat
+session and modifies the behavior of the LLM. Some examples of
+system prompts are:
+
+You are a helpful assistant. Answer as concisely as possible.
+Reply only with shell commands and no prose.
+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-system-prompt--format
+ [(gptel--suffix-system-message)]
+ [(gptel--infix-variable-scope)]]
+ [:class transient-column
+ :setup-children
+ (lambda (_) (transient-parse-suffixes
+ 'gptel-system-prompt
+ (gptel--setup-directive-menu
+ 'gptel--system-message "Directive" t)))
+ :pad-keys t])
+
+;; ** Prefix for saving and applying presets
+;;;###autoload
+(defun gptel-preset (preset &optional setter)
+ "Load gptel PRESET with SETTER.
+
+Interactively, query for PRESET, allow the preset scope to be set
+dynamically, and offer to save the current gptel settings as a new or
+existing preset, as well."
+ (interactive
+ (let ((hint (concat (propertize "C-s" 'face 'transient-value)
+ (propertize " Save as preset"
+ 'face 'transient-inactive-value)
+ ", " (propertize "=" 'face 'transient-value)
+ (propertize " Scope " 'face 'transient-inactive-argument)))
+ (scope-obj (gptel--scope :variable 'gptel--set-buffer-locally))
+ (completion-extra-properties
+ (list :annotation-function
+ (lambda (cand)
+ (and-let* ((str (plist-get
+ (cdr (assq (intern cand) gptel--known-presets))
+ :description)))
+ (concat (propertize " " 'display '(space :align-to 25))
+ (truncate-string-to-width str (- (frame-width) 40)
+ nil nil t)))))))
+ (cl-flet* ((key-hint-ov ()
+ (or (cdr-safe (get-char-property-and-overlay (point-min) 'gptel))
+ (let ((ov (make-overlay (point-min) (minibuffer-prompt-end))))
+ (overlay-put ov 'gptel 'prefix)
+ (overlay-put ov 'before-string
+ (concat hint (transient-format-value scope-obj)
+ "\n"))
+ ov)))
+ (save-preset ()
+ (interactive)
+ (when (minibufferp)
+ (run-at-time 0 nil (lambda (menu) (call-interactively #'gptel--save-preset)
+ (when menu (transient-setup 'gptel-menu)))
+ transient--prefix)
+ (minibuffer-quit-recursive-edit)))
+ (update-scope ()
+ (interactive)
+ (transient-infix-set
+ scope-obj
+ (pcase gptel--set-buffer-locally (1 nil) ('nil t) ('t 1)))
+ (overlay-put (key-hint-ov) 'before-string
+ (concat hint
+ (transient-format-value scope-obj)
+ "\n"))))
+ (minibuffer-with-setup-hook
+ (lambda () (use-local-map (make-composed-keymap
+ (define-keymap "C-s" #'save-preset "=" #'update-scope)
+ (current-local-map)))
+ (key-hint-ov))
+ (list (intern (completing-read (format "Load preset: ")
+ gptel--known-presets nil t)))))))
+ (gptel--apply-preset preset
+ (or setter (lambda (sym val) (gptel--set-with-scope
+ sym val gptel--set-buffer-locally))))
+ (when transient--prefix
+ (transient-setup 'gptel-menu)))
+
+;; ** Prefix for selecting tools
+
+;; gptel-tools offers a two-level menu for selecting tools, its design is a
+;; little convoluted so here's an explanation:
+;;
+;; Normally a transient prefix exports its value via transient-args, to be
+;; consumed by suffixes, where these args are determined by the state of the
+;; menu at the time of export. The gptel-tools menu is dynamic and needs to
+;; store tool selections that may not be visible in the meny any more, so we
+;; cannot use the transient-args.
+;;
+;; We can not (should not?) control the value of the prefix directly, so we
+;; instead use the scope (a secondary value) of the prefix to maintain the
+;; history of selections. When running a suffix, we gather tool selections from
+;; the scope. The scope is also used as a message channel for connecting the
+;; category menu and the tool list menu for that category.
+
+;;;###autoload (autoload 'gptel-tools "gptel-transient" nil t)
+(transient-define-prefix gptel-tools ()
+ "Select tools to include with gptel requests.
+
+Tools are organized into categories. Selecting the category
+toggles all the tools with that category.
+
+To add tools to this list, use `gptel-make-tool', which see.
+
+Using the scope option, you can set tools to use with gptel
+requests globally, in this buffer or for the next request
+only (\"oneshot\")."
+ :refresh-suffixes t
+ [:description "Provide the LLM with tools to run tasks for you"
+ [""
+ (gptel--infix-variable-scope)
+ (gptel--infix-use-tools)
+ (gptel--infix-confirm-tool-calls)
+ (gptel--infix-include-tool-results)]
+ [""
+ ("RET" "Confirm selection"
+ (lambda (tools)
+ ;; We don't care about the transient args of this prefix at all, since
+ ;; the state is managed entirely through its transient-scope:
+ (interactive (list (plist-get (transient-scope 'gptel-tools) :tools)))
+ (gptel--set-with-scope
+ 'gptel-tools
+ (mapcar (lambda (category-and-name)
+ (map-nested-elt gptel--known-tools category-and-name))
+ (cl-delete-if-not #'consp tools))
+ gptel--set-buffer-locally))
+ :transient transient--do-return)
+ ("q" "Cancel" transient-quit-one)]]
+ [[:class transient-column ;Display known categories
+ :setup-children
+ (lambda (_)
+ (transient-parse-suffixes
+ 'gptel-tools
+ (cl-loop ;loop through gptel--known tools and collect categories
+ for (category . tools-alist) in gptel--known-tools
+ with unused-keys = (nconc (delete ?q (number-sequence ?a ?z))
+ (number-sequence ?0 ?9)
+ (delete ?M (number-sequence ?A ?Z))) ;M used by MCP integration
+ for category-key = (seq-find (lambda (k) (member k unused-keys))
+ (string-remove-prefix "mcp-" category)
+ (seq-first unused-keys))
+ do (setq unused-keys (delete category-key unused-keys))
+ collect (list (key-description (list category-key))
+ (concat (propertize category 'face 'transient-heading)
+ (make-string (max (- 14 (length category)) 0) ? ))
+ (char-to-string category-key)
+ :format " %k %d %v"
+ :class 'gptel--switch-category
+ :category category)
+ into categories
+ finally do (plist-put (transient-scope) :keys unused-keys)
+ finally return categories)))]
+ [:class transient-column ;Display known tools for selected category
+ :setup-children
+ (lambda (_)
+ (transient-parse-suffixes
+ 'gptel-tools
+ (when-let* ((category (plist-get (transient-scope) :category))
+ (tool-keys (plist-get (transient-scope) :keys)))
+ (cl-loop ;for each category, collect tools as infixes
+ with tools-alist = (cdr (assoc category gptel--known-tools))
+ for (name . tool) in tools-alist
+ for tool-key = (seq-find (lambda (k) (member k tool-keys)) name (seq-first tool-keys))
+ do (setq tool-keys (delete tool-key tool-keys))
+ collect ;Each list is a transient infix of type gptel--switch
+ (list (key-description (list tool-key))
+ (concat (make-string (max (- 20 (length name)) 0) ? )
+ (propertize
+ (concat "(" (gptel--describe-directive
+ (gptel-tool-description tool) (- (window-width) 60))
+ ")")
+ 'face 'shadow))
+ (gptel-tool-name tool)
+ :format " %k %v %d"
+ :init-value #'gptel--tools-init-value
+ :class 'gptel--switch
+ :category category)
+ into infixes-for-category
+ finally return
+ (cons (list :info
+ (lambda () (concat
+ (propertize (plist-get (transient-scope) :key)
+ 'face 'transient-key)
+ (propertize " toggle all" 'face 'transient-heading)))
+ :format " %d")
+ infixes-for-category)))))]]
+ (interactive)
+ (transient-setup
+ 'gptel-tools nil nil
+ :scope (list :tools (mapcar (lambda (tool) (list (or (gptel-tool-category tool) "misc")
+ (gptel-tool-name tool)))
+ gptel-tools))))
+
+\f
+;; * Transient Infixes
+
+;; ** Infixes for context aggregation
+
+(transient-define-infix gptel--infix-use-context ()
+ "Describe target destination for context injection.
+
+gptel will include with the LLM request any additional context
+added with `gptel-add'. This context can be ignored, included
+with the system message or included with the user prompt.
+
+Where in the request this context is included depends on the
+value of `gptel-use-context', set from here."
+ :description "Include context"
+ :class 'gptel-lisp-variable
+ :variable 'gptel-use-context
+ :format " %k %d %v"
+ :set-value #'gptel--set-with-scope
+ :display-nil "No"
+ :display-map '((nil . "No")
+ (system . "with system message")
+ (user . "with user prompt"))
+ :key "-i"
+ :reader (lambda (prompt &rest _)
+ (let* ((choices '(("No" . nil)
+ ("with system message" . system)
+ ("with user prompt" . user)))
+ (destination (completing-read prompt choices nil t)))
+ (cdr (assoc destination choices)))))
+
+;; ** Infixes for model parameters
+
+(transient-define-infix gptel--infix-variable-scope ()
+ "Set gptel's model parameters and system message in this buffer or globally."
+ :argument "scope"
+ :variable 'gptel--set-buffer-locally
+ :class 'gptel--scope
+ :format " %k %d %v"
+ :key "="
+ :description (propertize "Scope" 'face 'transient-inactive-argument))
+
+(transient-define-infix gptel--infix-num-messages-to-send ()
+ "Number of recent messages to send with each exchange.
+
+By default, the full conversation history is sent with every new
+prompt. This retains the full context of the conversation, but
+can be expensive in token size. Set how many recent messages to
+include."
+ :description "previous responses"
+ :class 'gptel-lisp-variable
+ :variable 'gptel--num-messages-to-send
+ :set-value #'gptel--set-with-scope
+ :display-nil 'all
+ :format " %k %v %d"
+ :key "-n"
+ :prompt "Number of past messages to include for context (leave empty for all): "
+ :reader 'gptel--transient-read-number)
+
+(transient-define-infix gptel--infix-max-tokens ()
+ "Max tokens per response.
+
+This is roughly the number of words in the response. 100-300 is a
+reasonable range for short answers, 400 or more for longer
+responses."
+ :description "Response length (tokens)"
+ :class 'gptel-lisp-variable
+ :variable 'gptel-max-tokens
+ :set-value #'gptel--set-with-scope
+ :display-nil 'auto
+ :key "-c"
+ :prompt "Response length in tokens (leave empty: default, 80-200: short, 200-500: long): "
+ :reader 'gptel--transient-read-number)
+
+;; TODO(links): Run `gptel-refresh-buffer-hook' after a model change
+(transient-define-infix gptel--infix-provider ()
+ "AI Provider for Chat."
+ :description "Model"
+ :class 'gptel-provider-variable
+ :prompt "Model: "
+ :variable 'gptel-model
+ :set-value #'gptel--set-with-scope
+ :backend 'gptel-backend
+ :key "-m"
+ :reader (lambda (prompt &rest _)
+ (cl-loop
+ for (name . backend) in gptel--known-backends
+ nconc (cl-loop for model in (gptel-backend-models backend)
+ collect (list (concat name ":" (gptel--model-name model))
+ backend model))
+ into models-alist
+ with completion-extra-properties =
+ `(:annotation-function
+ ,(lambda (comp)
+ (let* ((model (nth 2 (assoc comp models-alist)))
+ (desc (get model :description))
+ (caps (get model :capabilities))
+ (context (get model :context-window))
+ (input-cost (get model :input-cost))
+ (output-cost (get model :output-cost))
+ (cutoff (get model :cutoff-date)))
+ (when (or desc caps context input-cost output-cost cutoff)
+ (concat
+ (propertize " " 'display `(space :align-to 40))
+ (when desc (truncate-string-to-width desc 70 nil ? t t))
+ " " (propertize " " 'display `(space :align-to 112))
+ (when caps (truncate-string-to-width (prin1-to-string caps) 21 nil ? t t))
+ " " (propertize " " 'display `(space :align-to 134))
+ (when context (format "%5dk" context))
+ " " (propertize " " 'display `(space :align-to 142))
+ (when input-cost (format "$%5.2f in" input-cost))
+ (if (and input-cost output-cost) "," " ")
+ " " (propertize " " 'display `(space :align-to 153))
+ (when output-cost (format "$%6.2f out" output-cost))
+ " " (propertize " " 'display `(space :align-to 166))
+ cutoff)))))
+ finally return
+ (cdr (assoc (completing-read prompt models-alist nil t nil nil
+ (concat (gptel-backend-name gptel-backend) ":"
+ (gptel--model-name gptel-model)))
+ models-alist)))))
+
+(transient-define-infix gptel--infix-temperature ()
+ "Temperature of request."
+ :description "Temperature (0 - 2.0)"
+ :display-nil "default"
+ :class 'gptel-lisp-variable
+ :variable 'gptel-temperature
+ :set-value #'gptel--set-with-scope
+ :key "-T"
+ :prompt "Temperature controls the response randomness (0.0-2.0, leave empty for API default): "
+ :reader 'gptel--transient-read-number)
+
+(transient-define-infix gptel--infix-track-response ()
+ "Distinguish between user messages and LLM responses.
+
+When creating a prompt to send to the LLM, gptel distinguishes
+between text entered by the user and past LLM responses. This is
+required for multi-turn conversations, and is always the case in
+dedicated chat buffers (in `gptel-mode').
+
+In regular buffers, you can toggle this behavior here or by
+customizing `gptel-track-response'. When response tracking is
+turned off, all text will be assigned the \"user\" role when
+querying the LLM."
+ :description "Track LLM responses"
+ :class 'gptel--switches
+ :variable 'gptel-track-response
+ :set-value #'gptel--set-with-scope
+ :display-if-true "Yes"
+ :display-if-false "No"
+ :key "-R")
+
+(transient-define-suffix gptel--infix-track-media ()
+ "Send media from links in the prompt.
+
+gptel can send images or other media from links in the buffer to the
+LLM. What link types are sent depends on the mime-types the model
+supports. See `gptel-track-media' for more information."
+ :description "Send media from links"
+ :transient t
+ :class 'gptel--switches
+ :variable 'gptel-track-media
+ :set-value #'gptel--set-with-scope
+ :display-if-true "Yes"
+ :display-if-false "No"
+ :key "-I"
+ (interactive)
+ (let ((obj (transient-suffix-object)))
+ (transient-infix-set obj (transient-infix-read obj))
+ (transient--show))
+ (if gptel-track-media
+ (run-hooks 'gptel-refresh-buffer-hook)
+ (gptel--annotate-link-clear)))
+
+;; ** Infixes for adding and removing context
+
+(declare-function gptel-context--at-point "gptel-context")
+(declare-function gptel-add "gptel-context")
+(declare-function gptel-context-add-current-kill "gptel-context")
+
+(transient-define-suffix gptel--infix-context-add-current-kill (&optional arg)
+ "Add current kill to gptel's context."
+ :transient 'transient--do-stay
+ :key "C-y"
+ :if (lambda () gptel-expert-commands)
+ :description
+ "Yank to context"
+ (interactive "P")
+ (require 'gptel-context)
+ (gptel-context-add-current-kill arg)
+ (transient-setup))
+
+(transient-define-suffix gptel--infix-context-add-region ()
+ "Add current region to gptel's context."
+ :transient 'transient--do-stay
+ :key "-r"
+ :if (lambda () (or (use-region-p)
+ (and (fboundp 'gptel-context--at-point)
+ (gptel-context--at-point))))
+ :description
+ (lambda ()
+ (if (and (fboundp 'gptel-context--at-point)
+ (gptel-context--at-point))
+ "Remove context at point"
+ "Add region to context"))
+ (interactive)
+ (gptel-add)
+ (transient-setup))
+
+(transient-define-suffix gptel--infix-context-add-buffer ()
+ "Add a buffer to gptel's context."
+ :transient 'transient--do-stay
+ :key "-b"
+ :description "Add a buffer to context"
+ (interactive)
+ (gptel-add '(4))
+ (transient-setup))
+
+(declare-function gptel-add-file "gptel-context")
+(declare-function gptel-context-remove-all "gptel-context")
+
+(transient-define-suffix gptel--infix-context-add-file ()
+ "Add a file to gptel's context."
+ :transient 'transient--do-stay
+ :key "-f"
+ :description "Add a file to context"
+ (interactive)
+ (call-interactively #'gptel-add-file)
+ (transient-setup))
+
+(transient-define-suffix gptel--infix-context-remove-all ()
+ "Clear gptel's context."
+ :if (lambda () gptel-context)
+ :transient 'transient--do-stay
+ :key "-d"
+ :description "Remove all"
+ (interactive)
+ (gptel-context-remove-all t)
+ (transient-setup))
+
+;; ** Infix for additional directive
+
+(transient-define-infix gptel--infix-add-directive ()
+ "Additional directive intended for the next query only.
+
+This is useful to define a quick task on top of a more extensive
+or detailed system message.
+
+For example, with code/text selected:
+
+- Rewrite this function to do X while avoiding Y.
+- Change the tone of the following paragraph to be more direct.
+
+Or in an extended conversation:
+
+- Phrase you next response in ten words or less.
+- Pretend for now that you're an anthropologist."
+ :class 'gptel-option-overlaid
+ ;; :variable 'gptel--instructions
+ :display-nil 'none
+ :overlay nil
+ :argument ":"
+ :prompt (concat "Add instructions for next request only ("
+ gptel--read-with-prefix-help ") ")
+ ;; TODO: Add the ability to edit this in a separate buffer, with
+ ;; `gptel--edit-directive'. This requires setting up gptel-menu with the
+ ;; result as the :scope.
+ :reader (lambda (prompt initial history)
+ (let* ((directive
+ (car-safe (gptel--parse-directive gptel--system-message 'raw)))
+ (cycle-prefix (lambda () (interactive)
+ (gptel--read-with-prefix directive)))
+ (minibuffer-local-map
+ (make-composed-keymap
+ (define-keymap "TAB" cycle-prefix "<tab>" cycle-prefix)
+ minibuffer-local-map))
+ (extra (minibuffer-with-setup-hook cycle-prefix
+ (read-string prompt (or initial " ") history))))
+ (unless (string-empty-p extra) extra)))
+ :format " %k %d %v"
+ :key "d"
+ :argument ":"
+ :description "Add instruction"
+ :transient t)
+
+;; ** Infix for reasoning block control
+
+(transient-define-infix gptel--infix-include-reasoning ()
+ "How to handle reasoning/thinking response blocks.
+
+Some LLMs include in their response a \"thinking\" section. This
+text improves the quality of the LLM's final output, but may not
+be interesting to you by itself.
+
+You can control how gptel should handle the thinking blocks via
+this option, or by setting the variable `gptel-include-reasoning'
+via elisp, which see.
+
+Available behaviors are
+- to include thinking blocks with the response,
+- to omit them entirely,
+- to include them but ignore them in consequent conversation turns, and
+- to append them to a buffer of your choosing."
+ :description "Include reasoning"
+ :class 'gptel-lisp-variable
+ :variable 'gptel-include-reasoning
+ :format " %k %d %v"
+ :set-value #'gptel--set-with-scope
+ :display-nil "No"
+ :display-map '((nil . "No")
+ (ignore . "and ignore")
+ (t . "with response"))
+ :key "-v"
+ :prompt "Include reasoning: "
+ :reader (lambda (prompt &rest _)
+ (let* ((choices '(("no" . nil)
+ ("ignore" . ignore)
+ ("yes" . t)
+ ("other buffer" . buffer)))
+ (destination
+ (completing-read prompt choices nil t)))
+ (if (equal destination "other buffer")
+ (read-buffer "Append reasoning to buffer: ")
+ (cdr (assoc destination choices))))))
+
+;; ** Infixes for tool use
+
+(transient-define-infix gptel--infix-use-tools ()
+ "Whether LLM tool use with gptel is enabled.
+
+This is a three-way toggle. Assuming one or more tools to be
+sent with requests have been selected, tool use can be
+
+- disabled,
+- enabled, where the LLM may choose to respond with tool calls
+- forced, where the LLM must respond with one or more tool calls.
+
+You can set this here or by customizing `gptel-use-tools', which
+see."
+ :description "Use tools"
+ :class 'gptel-lisp-variable
+ :variable 'gptel-use-tools
+ :set-value (lambda (sym value scope)
+ (gptel--set-with-scope sym value scope)
+ (transient-setup))
+ :display-nil "off"
+ :display-map '((nil . "off")
+ (t . "on")
+ (force . "force"))
+ :prompt "Use tools? "
+ :reader (lambda (prompt &rest _)
+ (let* ((choices '(("disable" . nil)
+ ("enable" . t)
+ ("force" . force)))
+ (pref (completing-read prompt choices nil t)))
+ (cdr (assoc pref choices))))
+ :key "-t")
+
+(transient-define-infix gptel--infix-confirm-tool-calls ()
+ "Whether tool calls should wait for the user to run them.
+
+This is a three-way toggle between these behaviors:
+
+- All tool calls run without confirmation.
+- All tool calls wait for confirmation.
+- Decided per-tool, according to the value of the tool spec's
+ :confirm slot.
+
+This sets the variable `gptel-confirm-tool-calls', which see."
+ :key "-c"
+ :description "Confirm tool calls"
+ :class 'gptel-lisp-variable
+ :variable 'gptel-confirm-tool-calls
+ :set-value #'gptel--set-with-scope
+ :display-nil "never"
+ :display-map '((nil . "never")
+ (t . "always")
+ (auto . "auto"))
+ :prompt "Tool calls require confirmation? "
+ :reader (lambda (prompt &rest _)
+ (let* ((choices '(("no" . nil)
+ ("always" . t)
+ ("tool decides" . auto)))
+ (pref (completing-read prompt choices nil t)))
+ (cdr (assoc pref choices)))))
+
+(transient-define-infix gptel--infix-include-tool-results ()
+ "Whether tool call results should be included in the response.
+
+This is a three-way toggle between these behaviors:
+
+- All tool results are included.
+- No tool results are included.
+- Decided per-tool, according to the value of the tool spec's
+ :include slot.
+
+This sets the variable `gptel-include-tool-results', which see."
+ :key "-i"
+ :description "Include results "
+ :class 'gptel-lisp-variable
+ :variable 'gptel-include-tool-results
+ :set-value #'gptel--set-with-scope
+ :display-nil "never"
+ :display-map '((nil . "never")
+ (t . "always")
+ (auto . "auto"))
+ :prompt "Include tool results in LLM response? "
+ :reader (lambda (prompt &rest _)
+ (let* ((choices '(("never" . nil)
+ ("always" . t)
+ ("tool decides" . auto)))
+ (pref (completing-read prompt choices nil t)))
+ (cdr (assoc pref choices)))))
+
+\f
+;; * Transient Suffixes
+
+;; ** Suffix to send prompt
+
+(transient-define-suffix gptel--suffix-send (args)
+ "Call `gptel-send' with ARGS."
+ :key "RET"
+ :description #'gptel--describe-suffix-send
+ (interactive (list (transient-args
+ (or transient-current-command 'gptel-menu))))
+ (let ((stream gptel-stream)
+ (in-place (and (member "i" args) t))
+ (redirect-output)
+ (backend gptel-backend)
+ (model gptel-model)
+ (backend-name (gptel-backend-name gptel-backend))
+ (buffer) (position)
+ (callback) (gptel-buffer-name)
+ (system-extra (gptel--get-directive args))
+ (dry-run (and (member "I" args) t))
+ ;; Input redirection: grab prompt from elsewhere?
+ (prompt
+ (cond
+ ((member "m" args) (gptel--read-minibuffer-prompt))
+ ((member "y" args)
+ (unless (car-safe kill-ring)
+ (user-error "`kill-ring' is empty! Nothing to send"))
+ (if current-prefix-arg
+ (read-from-kill-ring "Prompt from kill-ring: ")
+ (current-kill 0))))))
+
+ ;; Output redirection: Send response elsewhere?
+ (cond
+ ((member "e" args) ;Send to echo-area
+ (setq redirect-output t)
+ (setq stream nil)
+ (setq callback
+ (lambda (resp info &optional _raw)
+ (pcase resp
+ ((pred stringp) (message "%s response: %s" backend-name resp))
+ (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer))
+ (_ (when (and (null resp) (plist-get info :error))
+ (message "%s response error: %s"
+ backend-name (plist-get info :status))))))))
+ ((member "k" args) ;Send to kill-ring
+ (setq redirect-output t)
+ (setq stream nil)
+ (setq callback
+ (let ((accum))
+ (lambda (resp info &optional _raw)
+ (pcase resp
+ ((pred stringp) (push resp accum)
+ (unless (plist-get info :tool-use)
+ (kill-new (apply #'concat (nreverse accum)))
+ (message "%s response: \"%s\" copied to kill-ring." backend-name
+ (truncate-string-to-width resp 30 nil nil t))))
+ (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer))
+ (_ (when (and (null resp) (plist-get info :error))
+ (if accum (kill-new (apply #'concat (nreverse accum))))
+ (message
+ (concat "%s response error: %s."
+ (and accum " Partial response copied to kill-ring."))
+ backend-name (plist-get info :status)))))))))
+ ((setq gptel-buffer-name ;Send to gptel buffer
+ (cl-some (lambda (s) (and (stringp s) (string-prefix-p "g" s)
+ (substring s 1)))
+ args))
+ (setq redirect-output t)
+ (let* ((reduced-prompt ;For inserting into the gptel buffer as
+ ;context, not the prompt used for the
+ ;request itself
+ (or prompt
+ (if (use-region-p)
+ (buffer-substring-no-properties (region-beginning)
+ (region-end))
+ (buffer-substring-no-properties
+ (save-excursion
+ (text-property-search-backward
+ 'gptel 'response
+ (when (get-char-property (max (point-min) (1- (point)))
+ 'gptel)
+ t))
+ (point))
+ (gptel--at-word-end (point))))))
+ (gptel-buffer (get-buffer gptel-buffer-name))
+ (gptel-buffer-mode
+ (if (buffer-live-p gptel-buffer)
+ (buffer-local-value 'major-mode gptel-buffer)
+ gptel-default-mode)))
+ ;; Add code fences or Org src markers around the reduced-prompt
+ (cond ((and (stringp prompt) (eq major-mode gptel-buffer-mode)))
+ ((provided-mode-derived-p gptel-buffer-mode 'org-mode)
+ (setq reduced-prompt
+ (if (consp reduced-prompt);either (region . prompt) or prompt
+ (concat (and (car reduced-prompt)
+ (concat "#+begin_src " (gptel--strip-mode-suffix major-mode)
+ "\n" (org-escape-code-in-string (car reduced-prompt))
+ "\n#+end_src\n\n"))
+ (cdr reduced-prompt))
+ (concat "#+begin_src " (gptel--strip-mode-suffix major-mode)
+ "\n" (org-escape-code-in-string
+ (or (cdr-safe reduced-prompt) reduced-prompt))
+ "\n#+end_src"))))
+ (t (setq reduced-prompt
+ (if (consp reduced-prompt);either (region . prompt) or prompt
+ (concat (and (car reduced-prompt)
+ (concat "``` " (gptel--strip-mode-suffix major-mode) "\n"
+ (car reduced-prompt) "\n```\n\n"))
+ (cdr reduced-prompt))
+ (concat "``` " (gptel--strip-mode-suffix major-mode) "\n"
+ (or (cdr-safe reduced-prompt) reduced-prompt) "\n```" )))))
+ (cond
+ ((buffer-live-p gptel-buffer)
+ ;; Insert into existing gptel session
+ (setq buffer gptel-buffer)
+ (with-current-buffer buffer
+ (goto-char (point-max))
+ (unless (or buffer-read-only
+ (get-char-property (point) 'read-only))
+ (unless (bolp) (insert "\n"))
+ (insert reduced-prompt))
+ (setq position (point-marker))
+ (when (and gptel-mode (not dry-run))
+ (gptel--update-status " Waiting..." 'warning))))
+ ;; Insert into new gptel session
+ (t (setq buffer
+ (gptel gptel-buffer-name
+ (condition-case nil
+ (gptel--get-api-key)
+ ((error user-error)
+ (setq gptel-api-key
+ (read-passwd
+ (format "%s API key: "
+ (gptel-backend-name
+ gptel-backend))))))
+ reduced-prompt))
+ ;; Set backend and model in new session from current buffer
+ (with-current-buffer buffer
+ (setq gptel-backend backend)
+ (setq gptel-model model)
+ (unless dry-run
+ (gptel--update-status " Waiting..." 'warning))
+ (setq position (point-marker)))))))
+ ((setq gptel-buffer-name ;Send to specified buffer
+ (cl-some (lambda (s) (and (stringp s) (string-prefix-p "b" s)
+ (substring s 1)))
+ args))
+ (setq redirect-output t)
+ (setq buffer (get-buffer-create gptel-buffer-name))
+ (with-current-buffer buffer (setq position (point-marker)))))
+
+ ;; MAYBE: This is no a good way to handle two-part (region + instruction) prompts
+ ;; If the prompt is a cons (region-text . instructions), collapse it
+ (when (consp prompt) (setq prompt (concat (car prompt) "\n\n" (cdr prompt))))
+
+ (prog1 (gptel-request prompt
+ :position position
+ :in-place in-place
+ :stream stream
+ :system
+ (if system-extra
+ (gptel--merge-additional-directive system-extra)
+ gptel--system-message)
+ :callback callback
+ :transforms gptel-prompt-transform-functions
+ :fsm (gptel-make-fsm :handlers gptel-send--handlers)
+ :dry-run dry-run)
+
+ (unless dry-run
+ (gptel--update-status " Waiting..." 'warning))
+
+ ;; NOTE: Possible future race condition here if Emacs ever drops the GIL.
+ ;; The HTTP request callback might modify the buffer before the in-place
+ ;; text is killed below.
+ (when in-place
+ (if (or buffer-read-only (get-char-property (point) 'read-only))
+ (cond
+ ((derived-mode-p 'vterm-mode)
+ (require 'gptel-integrations)
+ (gptel--vterm-delete))
+ (t (message "Not replacing prompt: region is read-only")))
+ (let ((beg (if (use-region-p)
+ (region-beginning)
+ (max (previous-single-property-change
+ (point) 'gptel nil (point-min))
+ (previous-single-property-change
+ (point) 'read-only nil (point-min)))))
+ (end (if (use-region-p) (region-end) (point))))
+ (unless redirect-output
+ ;; store the killed text in gptel-history
+ (gptel--attach-response-history
+ (list (buffer-substring-no-properties beg end))))
+ (kill-region beg end))))
+
+ (when (and redirect-output gptel-buffer-name)
+ (message (concat "Prompt sent to buffer: "
+ (propertize gptel-buffer-name 'face 'help-key-binding)))
+ (display-buffer
+ buffer '((display-buffer-reuse-window
+ 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))
+ (cons (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)
+
+;; ** Suffix to regenerate response
+
+(defun gptel--regenerate ()
+ "Regenerate gptel response at point."
+ (interactive)
+ (when (gptel--in-response-p)
+ (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds))
+ (history (get-char-property (point) 'gptel-history))
+ (prev-responses (cons (buffer-substring-no-properties beg end)
+ history)))
+ (when gptel-mode ;Remove prefix/suffix
+ (save-excursion
+ (goto-char beg)
+ (when (looking-back (concat "\n+" (regexp-quote (gptel-response-prefix-string)))
+ (point-min) 'greedy)
+ (setq beg (match-beginning 0)))
+ (goto-char end)
+ (when (looking-at
+ (concat "\n+" (regexp-quote (gptel-prompt-prefix-string))))
+ (setq end (match-end 0)))))
+ (delete-region beg end)
+ (gptel--attach-response-history prev-responses)
+ (call-interactively #'gptel--suffix-send))))
+
+;; ** Set system message
+(defun gptel--read-crowdsourced-prompt ()
+ "Pick a crowdsourced system prompt for gptel.
+
+This uses the prompts in the variable
+`gptel--crowdsourced-prompts', which see."
+ (interactive)
+ (if (not (hash-table-empty-p (gptel--crowdsourced-prompts)))
+ (let ((choice
+ (completing-read
+ "Pick and edit prompt: "
+ (lambda (str pred action)
+ (if (eq action 'metadata)
+ `(metadata
+ ( affixation-function .
+ (lambda (cands)
+ (mapcar
+ (lambda (c)
+ ( list c ""
+ (concat
+ (propertize " " 'display '(space :align-to 22))
+ " " (propertize
+ (gptel--describe-directive
+ (gethash c gptel--crowdsourced-prompts)
+ 54 " ")
+ 'face 'completions-annotations))))
+ cands))))
+ (complete-with-action action gptel--crowdsourced-prompts str pred)))
+ nil t)))
+ (when-let* ((prompt (gethash choice gptel--crowdsourced-prompts)))
+ (gptel--set-with-scope
+ 'gptel--system-message prompt gptel--set-buffer-locally)
+ (gptel--edit-directive 'gptel--system-message
+ :callback (lambda (_) (call-interactively #'gptel-menu)))))
+ (message "No prompts available.")))
+
+(transient-define-suffix gptel--suffix-system-message (&optional cancel)
+ "Edit LLM system message.
+
+CANCEL is used to avoid touching dynamic system messages,
+generated from functions."
+ :transient 'transient--do-exit
+ :description "Set or edit system message"
+ :format " %k %d"
+ :key "s"
+ (interactive
+ (list (and (functionp gptel--system-message)
+ (not (y-or-n-p
+ "Active directive is dynamically generated: Edit its current value instead?")))))
+ (if cancel (progn (message "Edit canceled")
+ (call-interactively #'gptel-menu))
+ (gptel--edit-directive 'gptel--system-message
+ :setup #'activate-mark
+ :callback (lambda (_) (call-interactively #'gptel-menu)))))
+
+;; MAYBE: Eventually can be simplified with string-edit, after we drop support
+;; for Emacs 28.2.
+(cl-defun gptel--edit-directive (&optional sym &key prompt initial callback setup buffer)
+ "Edit a gptel directive in a dedicated buffer.
+
+Store the result in SYM, a symbol. PROMPT and INITIAL are the heading
+and initial text. If SETUP is a function, run it after setting up the
+buffer. If CALLBACK is specified, it is run after exiting the edit. It
+is called with one argument: the buffer text or with nil depending on
+whether the action is confirmed/cancelled."
+ (declare (indent 1))
+ (let ((orig-buf (or buffer (current-buffer)))
+ (msg-start (make-marker))
+ (directive (symbol-value sym)))
+ (when (functionp directive)
+ (setq directive (funcall directive)))
+ ;; TODO: Handle editing list-of-strings directives
+ (with-current-buffer (get-buffer-create "*gptel-prompt*")
+ (let ((inhibit-read-only t) (inhibit-message t))
+ (erase-buffer)
+ (text-mode)
+ (visual-line-mode 1)
+ (setq header-line-format
+ (concat "Edit your instructions 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
+ (or prompt
+ (concat
+ "# 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) (point)
+ (list 'read-only t 'face 'font-lock-comment-face 'front-sticky t 'rear-nonsticky t))
+ (set-marker msg-start (point))
+ (save-excursion
+ ;; If it's a list, insert only the system message part
+ ;; If all is nil, insert "" at least
+ (insert (or initial (car-safe (gptel--parse-directive directive 'raw)) ""))
+ (push-mark nil 'nomsg))
+ (and (functionp setup) (funcall setup)))
+ (display-buffer (current-buffer)
+ `((display-buffer-below-selected
+ display-buffer-use-some-window)
+ (some-window . lru)
+ (body-function . ,#'select-window)
+ (window-height . ,#'fit-window-to-buffer)))
+ (let ((quit-to-menu
+ (lambda () "Cancel system message update and return."
+ (quit-window)
+ (unless (minibufferp)
+ (display-buffer orig-buf
+ `((display-buffer-reuse-window
+ display-buffer-use-some-window)
+ (body-function . ,#'select-window)))))))
+ (use-local-map
+ (make-composed-keymap
+ (define-keymap
+ "C-c C-c"
+ (lambda () "Confirm system message and return."
+ (interactive)
+ (let ((system-message
+ (buffer-substring-no-properties msg-start (point-max))))
+ (when sym
+ (with-current-buffer orig-buf
+ (gptel--set-with-scope
+ sym (if (cdr-safe directive) ;Handle list of strings
+ (prog1 directive (setcar directive system-message))
+ system-message)
+ gptel--set-buffer-locally)))
+ (funcall quit-to-menu)
+ (when (functionp callback) (funcall callback system-message))))
+ "C-c C-k" (lambda () (interactive)
+ (funcall quit-to-menu)
+ (when (functionp callback) (funcall callback nil))))
+ text-mode-map))))))
+
+;; ** Suffix for displaying and removing context
+(declare-function gptel-context--buffer-setup "gptel-context")
+(declare-function gptel-context--collect "gptel-context")
+
+(transient-define-suffix gptel--suffix-context-buffer ()
+ "Display all contexts from all buffers & files."
+ :transient 'transient--do-exit
+ :key " C"
+ :if (lambda () gptel-context)
+ :description "Inspect context"
+ (interactive)
+ (gptel-context--buffer-setup nil nil gptel-context))
+
+(provide 'gptel-transient)
+;;; gptel-transient.el ends here
+
+;; Local Variables:
+;; outline-regexp: "^;; \\*+"
+;; eval: (outline-minor-mode 1)
+;; End:
--- /dev/null
+;;; gptel.el --- Interact with ChatGPT or other LLMs -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Karthik Chikmagalur
+
+;; Author: Karthik Chikmagalur <karthik.chikmagalurNOSPAMgmail.com>
+;; Package-Version: 20260425.846
+;; Package-Revision: 101904a1a856
+;; Package-Requires: ((emacs "27.1") (transient "0.7.4") (compat "30.1.0.0"))
+;; Keywords: convenience, tools
+;; URL: https://github.com/karthink/gptel
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;; This file is NOT part of GNU Emacs.
+
+;;; Commentary:
+
+;; gptel is a simple Large Language Model chat client, with support for multiple
+;; models and backends.
+;;
+;; It works in the spirit of Emacs, available at any time and in any buffer.
+;;
+;; gptel supports:
+;;
+;; - The services ChatGPT, Azure, Gemini, Anthropic AI, Together.ai, Perplexity,
+;; AI/ML API, Anyscale, OpenRouter, Groq, PrivateGPT, DeepSeek, Cerebras, Github Models,
+;; GitHub Copilot chat, AWS Bedrock, Novita AI, xAI, Sambanova, Mistral Le
+;; Chat and Kagi (FastGPT & Summarizer).
+;; - Local models via Ollama, Llama.cpp, Llamafiles or GPT4All
+;;
+;; Additionally, any LLM service (local or remote) that provides an
+;; OpenAI-compatible API is supported.
+;;
+;; Features:
+;;
+;; - Interact with LLMs from anywhere in Emacs (any buffer, shell, minibuffer,
+;; wherever).
+;; - LLM responses are in Markdown or Org markup.
+;; - Supports conversations and multiple independent sessions.
+;; - Supports tool-use to equip LLMs with agentic capabilities.
+;; - Supports Model Context Protocol (MCP) integration using the mcp.el package.
+;; - Supports multi-modal models (send images, documents).
+;; - Supports "reasoning" content in LLM responses.
+;; - Save chats as regular Markdown/Org/Text files and resume them later.
+;; - You can go back and edit your previous prompts or LLM responses when
+;; continuing a conversation. These will be fed back to the model.
+;; - Redirect prompts and responses easily
+;; - Rewrite, refactor or fill in regions in buffers.
+;; - Write your own commands for custom tasks with a simple API.
+;;
+;; Requirements for ChatGPT, Azure, Gemini or Kagi:
+;;
+;; - You need an appropriate API key. Set the variable `gptel-api-key' to the
+;; key or to a function of no arguments that returns the key. (It tries to
+;; use `auth-source' by default)
+;;
+;; ChatGPT is configured out of the box. For the other sources:
+;;
+;; - For Azure: define a gptel-backend with `gptel-make-azure'.
+;; - For Gemini: define a gptel-backend with `gptel-make-gemini'.
+;; - For Anthropic (Claude): define a gptel-backend with `gptel-make-anthropic'.
+;; - For AI/ML API, Together.ai, Anyscale, Groq, OpenRouter, DeepSeek, Cerebras
+;; or Github Models: define a gptel-backend with `gptel-make-openai'.
+;; - For PrivateGPT: define a backend with `gptel-make-privategpt'.
+;; - For Perplexity: define a backend with `gptel-make-perplexity'.
+;; - For Deepseek: define a backend with `gptel-make-deepseek'.
+;; - For Kagi: define a gptel-backend with `gptel-make-kagi'.
+;;
+;; For local models using Ollama, Llama.cpp or GPT4All:
+;;
+;; - The model has to be running on an accessible address (or localhost)
+;; - Define a gptel-backend with `gptel-make-ollama' or `gptel-make-gpt4all'.
+;; - Llama.cpp or Llamafiles: Define a gptel-backend with `gptel-make-openai'.
+;;
+;; Consult the package README for examples and more help with configuring
+;; backends.
+;;
+;; Usage:
+;;
+;; gptel can be used in any buffer or in a dedicated chat buffer. The
+;; interaction model is simple: Type in a query and the response will be
+;; inserted below. You can continue the conversation by typing below the
+;; response.
+;;
+;; To use this in any buffer:
+;;
+;; - Call `gptel-send' to send the buffer's text up to the cursor. Select a
+;; region to send only the region.
+;;
+;; - You can select previous prompts and responses to continue the conversation.
+;;
+;; - Call `gptel-send' with a prefix argument to access a menu where you can set
+;; your backend, model and other parameters, or to redirect the
+;; prompt/response.
+;;
+;; To use this in a dedicated buffer:
+;;
+;; - M-x gptel: Start a chat session.
+;;
+;; - In the chat session: Press `C-c RET' (`gptel-send') to send your prompt.
+;; Use a prefix argument (`C-u C-c RET') to access a menu. In this menu you
+;; can set chat parameters like the system directives, active backend or
+;; model, or choose to redirect the input or output elsewhere (such as to the
+;; kill ring or the echo area).
+;;
+;; - You can save this buffer to a file. When opening this file, turn on
+;; `gptel-mode' before editing it to restore the conversation state and
+;; continue chatting.
+;;
+;; - To include media files with your request, you can add them to the context
+;; (described next), or include them as links in Org or Markdown mode chat
+;; buffers. Sending media is disabled by default, you can turn it on globally
+;; via `gptel-track-media', or locally in a chat buffer via the header line.
+;;
+;; Include more context with requests:
+;;
+;; If you want to provide the LLM with more context, you can add arbitrary
+;; regions, buffers, files or directories to the query with `gptel-add'. To add
+;; text or media files, call `gptel-add' in Dired or use the dedicated
+;; `gptel-add-file'.
+;;
+;; You can also add context from gptel's menu instead (`gptel-send' with a
+;; prefix arg), as well as examine or modify context.
+;;
+;; When context is available, gptel will include it with each LLM query.
+;;
+;; LLM Tool use:
+;;
+;; gptel supports "tool calling" behavior, where LLMs can specify arguments with
+;; which to call provided "tools" (elisp functions). The results of running the
+;; tools are fed back to the LLM, giving it capabilities and knowledge beyond
+;; what is available out of the box. For example, tools can perform web
+;; searches or API lookups, modify files and directories, and so on.
+;;
+;; Tools can be specified via `gptel-make-tool', or obtained from other
+;; repositories, or from Model Context Protocol (MCP) servers using the mcp.el
+;; package. See the README for details.
+;;
+;; Tools can be included with LLM queries using gptel's menu, or from
+;; `gptel-tools'.
+;;
+;; Rewrite interface
+;;
+;; In any buffer: with a region selected, you can rewrite prose, refactor code
+;; or fill in the region. This is accessible via `gptel-rewrite', and also from
+;; the `gptel-send' menu.
+;;
+;; Presets
+;;
+;; Define a bundle of configuration (model, backend, system message, tools etc)
+;; as a "preset" that can be applied together, making it easy to switch between
+;; tasks in gptel. Presets can be saved and applied from gptel's transient
+;; menu. You can also include a cookie of the form "@preset-name" in the prompt
+;; to send a request with a preset applied. This feature works everywhere, but
+;; preset cookies are also fontified in chat buffers.
+;;
+;; gptel in Org mode:
+;;
+;; gptel offers a few extra conveniences in Org mode:
+;;
+;; - You can limit the conversation context to an Org heading with
+;; `gptel-org-set-topic'.
+;;
+;; - You can have branching conversations in Org mode, where each hierarchical
+;; outline path through the document is a separate conversation branch.
+;; See the variable `gptel-org-branching-context'.
+;;
+;; - You can declare the gptel model, backend, temperature, system message and
+;; other parameters as Org properties with the command
+;; `gptel-org-set-properties'. gptel queries under the corresponding heading
+;; will always use these settings, allowing you to create mostly reproducible
+;; LLM chat notebooks.
+;;
+;; Finally, gptel offers a general purpose API for writing LLM ineractions that
+;; suit your workflow. See `gptel-request', and `gptel-fsm' for more advanced
+;; usage.
+
+;;; Code:
+(defconst gptel-version "0.9.9.4")
+
+(declare-function markdown-mode "markdown-mode")
+(declare-function gptel-menu "gptel-transient")
+(declare-function gptel-system-prompt "gptel-transient")
+(declare-function gptel-tools "gptel-transient")
+(declare-function gptel--vterm-pre-insert "gptel-integrations")
+(declare-function pulse-momentary-highlight-region "pulse")
+
+(declare-function ediff-make-cloned-buffer "ediff-util")
+(declare-function ediff-regions-internal "ediff")
+(declare-function hl-line-highlight "hl-line")
+
+(declare-function org-escape-code-in-string "org-src")
+(declare-function gptel-org-set-topic "gptel-org")
+(declare-function gptel-org--save-state "gptel-org")
+(declare-function gptel-org--restore-state "gptel-org")
+(declare-function gptel-org--annotate-links "gptel-org")
+(define-obsolete-function-alias
+ 'gptel-set-topic 'gptel-org-set-topic "0.7.5")
+
+(declare-function markdown-link-at-pos "markdown-mode")
+
+(eval-when-compile
+ (require 'subr-x))
+(require 'cl-lib)
+(require 'compat nil t)
+(require 'url)
+(require 'map)
+(require 'text-property-search)
+(require 'cl-generic)
+(eval-and-compile (require 'gptel-request))
+
+\f
+;;; User options
+(defcustom gptel-pre-response-hook nil
+ "Hook run before inserting the LLM response into the current buffer.
+
+This hook is called in the buffer where the LLM response will be
+inserted.
+
+Note: this hook only runs if the request succeeds."
+ :type 'hook
+ :group 'gptel)
+
+(define-obsolete-variable-alias
+ 'gptel-post-response-hook 'gptel-post-response-functions
+ "0.6.0"
+ "Post-response functions are now called with two arguments: the
+start and end buffer positions of the response.")
+
+(defcustom gptel-post-response-functions nil
+ "Abnormal hook run after inserting the LLM response into the current buffer.
+
+This hook is called in the buffer to which the LLM response is
+sent, and after the full response has been inserted. Each
+function is called with two arguments: the response beginning and
+end positions.
+
+Note: this hook runs even if the request fails. In this case the
+response beginning and end positions are both the cursor position
+at the time of the request."
+ :type 'hook
+ :group 'gptel)
+
+(add-hook 'gptel-post-response-functions 'pulse-momentary-highlight-region 70)
+
+(defcustom gptel-post-stream-hook nil
+ "Hook run after each insertion of the LLM's streaming response.
+
+This hook is called in the buffer from which the prompt was sent
+to the LLM, and after a text insertion."
+ :type 'hook
+ :group 'gptel)
+
+(defcustom gptel-pre-tool-call-functions nil
+ "Abnormal hook called before each tool call.
+
+Each hook function is called a plist with the following keys:
+
+:name - the name of the tool being called, a string
+:args - a plist of the tool call arguments, as specified in the tool
+ definition. For a hypothetical edit_file tool that takes three
+ arguments, a FILENAME, an ORIGINAL and REPLACEMENT strings, this
+ plist is structured as
+
+ (:filename \"/path/to/file.md\"
+ :original \"...\"
+ :replacement \"...\")
+
+:buffer - The name of the buffer from which the request was sent.
+:backend - The name of the gptel backend used for the request.
+:model - The name of the gptel model used for the request.
+
+The function can work by side effects and return nil, or return a plist
+with one or more of the following keys.
+
+:stop - If non-nil, stop the request entirely.
+:stop-reason - If :stop is non-nil, the reason for stopping. Intended
+ for the user, not the LLM.
+
+:block - If non-nil, continue the request but block this tool call and
+ mark it as having erred. Can be a string to send as the
+ result instead, typically an explanation for why the tool was
+ not run. Intended for the LLM, not the user.
+
+:confirm - Whether the tool call should seek confirmation from the user.
+ t and nil are both meaningful, signifying that the tool call
+ should and should not seek user confirmation, respectively.
+ When present, this key overrides all other confirmation
+ options (such as `gptel-confirm-tool-calls' and the tool's
+ CONFIRM slot).
+:args - The updated argument plist for the tool call.
+:result - The result of this tool call, used instead of the tool call
+ output. Not marked as an error."
+ :type 'hook
+ :group 'gptel)
+
+(defcustom gptel-post-tool-call-functions nil
+ "Abnormal hook called after each tool call.
+
+Each hook function is called a plist with the following keys:
+
+:name - the name of the tool being called, a string
+:args - a plist of the tool call arguments, as specified in the tool
+ definition. For a hypothetical edit_file tool that takes three
+ arguments, a FILENAME, an ORIGINAL and REPLACEMENT strings, this
+ plist is structured as
+
+ (:filename \"/path/to/file.md\"
+ :original \"...\"
+ :replacement \"...\")
+
+:result - The tool call result, serialized to a string.
+:buffer - The name of the buffer from which the request was sent.
+:backend - The name of the gptel backend used for the request.
+:model - The name of the gptel model used for the request.
+
+The function can work by side effects and return nil, or return a plist
+with one or more of the following keys.
+
+:stop - If non-nil, stop the request entirely.
+:stop-reason - If :stop is non-nil, the reason for stopping. Intended
+ for the user, not the LLM.
+
+:block - If non-nil, continue the request but block this tool call and
+ mark it as having erred. Can be a string to send as the
+ result instead, typically an explanation for why the tool was
+ not run. Intended for the LLM, not the user.
+
+:result - The updated result of this tool call, used instead of the
+ tool call output. Not marked as an error."
+ :type 'hook
+ :group 'gptel)
+
+(defcustom gptel-save-state-hook nil
+ "Hook run before gptel saves model parameters to a file.
+
+You can use this hook to store additional conversation state or
+model parameters to the chat buffer, or to modify the buffer in
+some other way."
+ :type 'hook
+ :group 'gptel)
+
+(defcustom gptel-default-mode (if (fboundp 'markdown-mode)
+ 'markdown-mode
+ 'text-mode)
+ "The default major mode for dedicated chat buffers.
+
+If `markdown-mode' is available, it is used. Otherwise gptel
+defaults to `text-mode'."
+ :type 'function
+ :group 'gptel)
+
+(defcustom gptel-use-header-line t
+ "Whether `gptel-mode' should use header-line for status information.
+
+When set to nil, use the mode line for (minimal) status
+information and the echo area for messages."
+ :type 'boolean
+ :group 'gptel)
+
+;; Set minimally to avoid display-buffer action alist conflicts (#533)
+(defcustom gptel-display-buffer-action `(nil (body-function . ,#'select-window))
+ "The action used to display gptel chat buffers.
+
+The gptel buffer is displayed in a window using
+
+ (display-buffer BUFFER gptel-display-buffer-action)
+
+The value of this option has the form (FUNCTION . ALIST),
+where FUNCTION is a function or a list of functions. Each such
+function should accept two arguments: a buffer to display and an
+alist of the same form as ALIST. See info node `(elisp)Choosing
+Window' for details."
+ :type display-buffer--action-custom-type
+ :group 'gptel)
+
+(defcustom gptel-crowdsourced-prompts-file
+ (let ((cache-dir (or (eval-when-compile
+ (require 'xdg)
+ (xdg-cache-home))
+ user-emacs-directory)))
+ (expand-file-name "gptel-crowdsourced-prompts.csv" cache-dir))
+ "File used to store crowdsourced system prompts.
+
+These are prompts cached from an online source (see
+`gptel--crowdsourced-prompts-url'), and can be set from the
+transient menu interface provided by `gptel-menu'."
+ :type 'file
+ :group 'gptel)
+
+(defvar gptel-refresh-buffer-hook '(jit-lock-refontify)
+ "Hook run in gptel buffers after changing gptel's configuration.
+
+This hook runs in gptel chat buffers after making a change to gptel's
+configuration that might require a UI update.")
+
+(defvar-local gptel--bounds nil)
+(put 'gptel--bounds 'safe-local-variable #'listp)
+
+(defvar gptel--preset nil
+ "Name of last applied gptel preset.
+
+For internal use only.")
+(put 'gptel--preset 'safe-local-variable #'symbolp)
+
+(defvar-local gptel--tool-names nil
+ "Store to persist tool names to file across Emacs sessions.
+
+Note: Changing this variable does not affect gptel\\='s behavior
+in any way.")
+(put 'gptel--tool-names 'safe-local-variable #'listp)
+
+(defvar-local gptel--backend-name nil
+ "Store to persist backend name across Emacs sessions.
+
+Note: Changing this variable does not affect gptel\\='s behavior
+in any way.")
+(put 'gptel--backend-name 'safe-local-variable #'stringp)
+
+(defvar-local gptel--old-header-line nil)
+
+(defvar gptel--markdown-block-map
+ (define-keymap
+ "<tab>" 'gptel-markdown-cycle-block
+ "TAB" 'gptel-markdown-cycle-block)
+ "Keymap for folding and unfolding Markdown code blocks.")
+
+\f
+;;; Utility functions
+(defun gptel--modify-value (original new-spec)
+ "Combine ORIGINAL with NEW-SPEC and return the new result.
+
+This function is non-destructive, ORIGINAL is not modified.
+
+NEW-SPEC is either a declarative action spec (plist) of the form
+ (:key val ...), or a simple value. Recognized spec keys are :append,
+:prepend, :eval, :function and :merge. If NEW-SPEC does not have this
+form it is returned as is.
+
+- :append and :prepend will append/prepend val (a list or string) to ORIGINAL.
+ Actions on strings are idempotent, they will only be appended/prepended once.
+- :eval will evaluate val and return the result, and
+- :function will call val with ORIGINAL as its argument, and return the result.
+- :merge will treat ORIGINAL and NEW-SPEC as plists and return a merged plist,
+ with NEW-SPEC taking precedence."
+ (if (not (and (consp new-spec) (keywordp (car new-spec))))
+ new-spec
+ (let ((current original) (tail new-spec))
+ (while tail
+ (let ((key (pop tail)) (form (pop tail)))
+ (setq current
+ (pcase key
+ (:append (if (stringp form)
+ (if (string-suffix-p form current t)
+ current (concat current form))
+ (append current form)))
+ (:prepend (if (stringp form)
+ (if (string-prefix-p form current t)
+ current (concat form current))
+ (append form current)))
+ (:eval (eval form t))
+ (:function (funcall form current))
+ (:merge (gptel--merge-plists (copy-sequence current) form))
+ (_ new-spec)))))
+ current)))
+
+(defun gptel-auto-scroll ()
+ "Scroll window if LLM response continues below viewport.
+
+Note: This will move the cursor."
+ (when-let* ((win (get-buffer-window (current-buffer) 'visible))
+ ((not (pos-visible-in-window-p (point) win)))
+ (scroll-error-top-bottom t))
+ (condition-case nil
+ (with-selected-window win
+ (scroll-up-command))
+ (error nil))))
+
+(defun gptel-beginning-of-response (&optional beg _end arg)
+ "Move point to BEG, or to the beginning of the LLM response ARG times."
+ (interactive (list nil nil
+ (prefix-numeric-value current-prefix-arg)))
+ (gptel-end-of-response beg nil (- (or arg 1))))
+
+(defun gptel-end-of-response (&optional beg end arg)
+ "Move point to end of LLM response.
+
+With BEG, start search from BEG when ARG is negative.
+With END, start search from END when ARG is positive.
+Otherwise move ARG times, defaulting to 1."
+ (interactive (list nil nil
+ (prefix-numeric-value current-prefix-arg)))
+ (unless arg (setq arg 1))
+ (let* ((search (if (> arg 0)
+ #'text-property-search-forward
+ #'text-property-search-backward))
+ (goto-prefix-end
+ (lambda () (when-let* ((prefix (gptel-prompt-prefix-string))
+ ((not (string-empty-p prefix)))
+ ((looking-at (concat "\n\\{1,2\\}"
+ (regexp-quote prefix) "?"))))
+ (goto-char (match-end 0)))))
+ (goto-prefix-beg
+ (lambda () (when-let* ((prefix (gptel-response-prefix-string))
+ ((not (string-empty-p prefix)))
+ ((looking-back (concat (regexp-quote prefix) "?")
+ (point-min))))
+ (goto-char (match-beginning 0))))))
+ (cond
+ ((and end (> arg 0)) (goto-char end) (cl-decf arg) (funcall goto-prefix-end))
+ ((and beg (< arg 0)) (goto-char beg) (cl-incf arg) (funcall goto-prefix-beg)))
+ (dotimes (_ (abs arg))
+ (funcall search 'gptel 'response t)
+ (if (> arg 0)
+ (funcall goto-prefix-end)
+ (funcall goto-prefix-beg)))))
+
+(defun gptel-markdown-cycle-block ()
+ "Cycle code blocks in Markdown."
+ (interactive)
+ (save-excursion
+ (forward-line 0)
+ (let (start end (parity 0))
+ (cond ;Find start and end of block, with possible nested blocks
+ ((looking-at-p "^``` *\n") ;end of block, find corresponding start
+ (setq parity -1 end (line-end-position))
+ (while (and (not (= parity 0)) (not (bobp)) (forward-line -1))
+ (cond ((looking-at-p "^``` *\n") (cl-decf parity))
+ ((looking-at-p "^``` ?[a-z]") (cl-incf parity))))
+ (when (= parity 0) (setq start (point))))
+
+ ((looking-at-p "^``` ?[a-z]") ;beginning of block, find corresponding end
+ (setq parity 1 start (point))
+ (while (and (not (= parity 0)) (not (eobp)) (forward-line 1))
+ (cond ((looking-at-p "^``` *\n") (cl-decf parity))
+ ((looking-at-p "^``` ?[a-z]") (cl-incf parity))))
+ (when (= parity 0) (setq end (line-end-position)))))
+ (when (and start end)
+ (goto-char start)
+ (end-of-line)
+ (pcase-let* ((`(,value . ,hide-ov)
+ (get-char-property-and-overlay (point) 'invisible)))
+ (if (and hide-ov (eq value t))
+ (delete-overlay hide-ov)
+ (unless hide-ov (setq hide-ov (make-overlay (point) end)))
+ (overlay-put hide-ov 'evaporate t)
+ (overlay-put hide-ov 'invisible t)
+ (overlay-put hide-ov 'before-string
+ (propertize "..." 'face 'shadow))))))))
+
+(defsubst gptel--annotate-link (ov link-status)
+ "Annotate link overlay OV according to LINK-STATUS.
+
+LINK-STATUS is a list of link properties relevant to gptel queries, of
+the form (valid . REST). See `gptel-markdown--validate-link' for
+details. Indicate the (in)validity of the link for inclusion with gptel
+queries via OV."
+ (cl-destructuring-bind
+ (valid _ path resource-type user-check readablep mime-valid _mime)
+ link-status
+ (if valid
+ (progn
+ (overlay-put
+ ov 'before-string
+ (concat (propertize "SEND" 'face '(:inherit success :height 0.8))
+ (if (display-graphic-p)
+ (propertize " " 'display '(space :width 0.5)) " ")))
+ (overlay-put ov 'help-echo
+ (format "Sending %s %s with gptel requests" resource-type path)))
+ (overlay-put ov 'before-string
+ (concat (propertize "!" 'face '(:inherit error))
+ (propertize " " 'display '(space :width 0.3))))
+ (overlay-put
+ ov 'help-echo
+ (concat
+ "Sending only link text with gptel requests, "
+ "this link will not be followed to its source.\n\nReason: "
+ (cond
+ ((not resource-type) "Not a supported link type\
+ (Only \"file\" and \"attachment\" are supported)")
+ ((not user-check)
+ (concat
+ "\nNot a standalone link -- separate link from text around it. \n (OR)
+Link failed to validate, see `gptel-markdown-validate-link' or `gptel-org-validate-link'."))
+ ((not readablep) (format "File %s is not readable" path))
+ ((not mime-valid)
+ (pcase resource-type
+ ('file (format "%s does not support binary file %s" gptel-model path))
+ ('url (format "%s does not support fetching non-image URLs" gptel-model))))))))))
+
+(defun gptel--annotate-link-clear (&optional beg end)
+ "Delete all gptel org link annotations between BEG and END."
+ (mapc #'delete-overlay
+ (cl-delete-if-not
+ (lambda (o) (overlay-get o 'gptel-track-media))
+ (overlays-in (or beg (point-min)) (or end (point-max))))))
+
+;;;; Response text recognition
+
+(defun gptel--get-buffer-bounds ()
+ "Return the gptel response boundaries in the buffer as an alist."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (let ((bounds) (prev-pt (point)))
+ (while (and (/= prev-pt (point-min))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min))))
+ (when-let* ((prop (get-char-property (point) 'gptel)))
+ (let* ((prop-name (if (symbolp prop) prop (car prop)))
+ (val (when (consp prop) (cdr prop)))
+ (bound (if val
+ (list (point) prev-pt val)
+ (list (point) prev-pt))))
+ (push bound (alist-get prop-name bounds))))
+ (setq prev-pt (point)))
+ bounds))))
+
+(define-obsolete-function-alias
+ 'gptel--get-bounds 'gptel--get-response-bounds "0.9.8")
+
+(defun gptel--get-response-bounds ()
+ "Return the gptel response boundaries around point."
+ (let (prop)
+ (save-excursion
+ (when (text-property-search-forward
+ 'gptel 'response t)
+ (when (setq prop (text-property-search-backward
+ 'gptel 'response t))
+ (cons (prop-match-beginning prop)
+ (prop-match-end prop)))))))
+
+(defun gptel--in-response-p (&optional pt)
+ "Check if position PT is inside a gptel response."
+ (eq (get-char-property (or pt (point)) 'gptel) 'response))
+
+(defun gptel--at-response-history-p (&optional pt)
+ "Check if gptel response at position PT has variants."
+ (get-char-property (or pt (point)) 'gptel-history))
+
+\f
+;;; Saving and restoring state
+
+(defun gptel--restore-props (bounds-alist)
+ "Restore text properties from BOUNDS-ALIST.
+BOUNDS-ALIST is (PROP . BOUNDS). BOUNDS is a list of BOUND. Each BOUND
+is either (BEG END VAL) or (BEG END).
+
+For (BEG END VAL) forms, even if VAL is nil, the gptel property will be
+set to (PROP . VAL). For (BEG END) forms, except when PROP is response,
+the gptel property is set to just PROP.
+
+The legacy structure, a list of (BEG . END) is also supported and will be
+applied before being re-persisted in the new structure."
+ ;; Run silently to avoid `gptel--inherit-stickiness' and other hooks that
+ ;; might modify the gptel text property.
+ (with-silent-modifications
+ (if (symbolp (caar bounds-alist))
+ (mapc
+ (lambda (bounds)
+ (let* ((prop (pop bounds)))
+ (mapc
+ (lambda (bound)
+ (let ((prop-has-val (> (length bound) 2)))
+ (add-text-properties
+ (pop bound) (pop bound)
+ (if (eq prop 'response)
+ '(gptel response front-sticky (gptel))
+ (list 'gptel
+ (if prop-has-val
+ (cons prop (pop bound))
+ prop))))))
+ bounds)))
+ bounds-alist)
+ (mapc (lambda (bound)
+ (add-text-properties
+ (car bound) (cdr bound) '(gptel response front-sticky (gptel))))
+ bounds-alist))))
+
+(defun gptel--restore-state ()
+ "Restore gptel state when turning on `gptel-mode'."
+ (when (buffer-file-name)
+ (if (derived-mode-p 'org-mode)
+ (progn
+ (require 'gptel-org)
+ (gptel-org--restore-state))
+ (when gptel--bounds
+ (gptel--restore-props gptel--bounds)
+ (message "gptel chat restored."))
+ (when gptel--preset
+ (if (gptel-get-preset gptel--preset)
+ (gptel--apply-preset
+ gptel--preset (lambda (sym val) (set (make-local-variable sym) val)))
+ (display-warning
+ '(gptel presets)
+ (format "Could not activate gptel preset `%s' in buffer \"%s\""
+ gptel--preset (buffer-name)))))
+ (when gptel--backend-name
+ (if-let* ((backend (alist-get
+ gptel--backend-name gptel--known-backends
+ nil nil #'equal)))
+ (setq-local gptel-backend backend)
+ (message
+ (substitute-command-keys
+ (concat
+ "Could not activate gptel backend \"%s\"! "
+ "Switch backends with \\[universal-argument] \\[gptel-send]"
+ " before using gptel."))
+ gptel--backend-name)))
+ (when gptel--tool-names
+ (if-let* ((tools (cl-loop
+ for tname in gptel--tool-names
+ for tool = (with-demoted-errors "gptel: %S"
+ (gptel-get-tool tname))
+ if tool collect tool else do
+ (display-warning
+ '(gptel org tools)
+ (format "Tool %s not found, ignoring" tname)))))
+ (setq-local gptel-tools tools))))))
+
+(defun gptel--save-state ()
+ "Write the gptel state to the buffer.
+
+This saves chat metadata when writing the buffer to disk. To
+restore a chat session, turn on `gptel-mode' after opening the
+file.
+
+If a gptel preset has been applied in this buffer, a reference to it is
+saved.
+
+Additional metadata is stored only if no preset was applied or if it
+differs from the preset specification. This is limited to the active
+gptel model and backend names, the system message, active tools, the
+response temperature, max tokens and number of conversation turns to
+send in queries. (See `gptel--num-messages-to-send' for the last one.)"
+ (run-hooks 'gptel-save-state-hook)
+ (if (derived-mode-p 'org-mode)
+ (progn
+ (require 'gptel-org)
+ (gptel-org--save-state))
+ (let ((print-escape-newlines t)
+ (preset-spec (and gptel--preset
+ (gptel-get-preset gptel--preset))))
+ (save-excursion
+ (save-restriction
+
+ (if preset-spec
+ (add-file-local-variable 'gptel--preset gptel--preset)
+ (delete-file-local-variable 'gptel--preset))
+
+ ;; Model and backend
+ (if (gptel--preset-mismatch-value preset-spec :model gptel-model)
+ (add-file-local-variable 'gptel-model gptel-model))
+ (if (gptel--preset-mismatch-value preset-spec :backend gptel-backend)
+ (add-file-local-variable 'gptel--backend-name
+ (gptel-backend-name gptel-backend)))
+ ;; System message
+ (let ((parsed (car-safe (gptel--parse-directive gptel--system-message))))
+ (if (gptel--preset-mismatch-value preset-spec :system parsed)
+ (add-file-local-variable 'gptel--system-message parsed)
+ (delete-file-local-variable 'gptel--system-message)))
+ ;; Tools
+ (let ((tool-names (mapcar #'gptel-tool-name gptel-tools)))
+ (if (gptel--preset-mismatch-value preset-spec :tools tool-names)
+ (add-file-local-variable 'gptel--tool-names tool-names)
+ (delete-file-local-variable 'gptel--tool-names)))
+ ;; Temperature, max tokens and cutoff
+ (if (and (gptel--preset-mismatch-value preset-spec :temperature gptel-temperature)
+ (not (equal (default-value 'gptel-temperature) gptel-temperature)))
+ (add-file-local-variable 'gptel-temperature gptel-temperature)
+ (delete-file-local-variable 'gptel-temperature))
+ (if (and (gptel--preset-mismatch-value preset-spec :max-tokens gptel-max-tokens)
+ gptel-max-tokens)
+ (add-file-local-variable 'gptel-max-tokens gptel-max-tokens)
+ (delete-file-local-variable 'gptel-max-tokens))
+ (if (and (gptel--preset-mismatch-value
+ preset-spec :num-messages-to-send gptel--num-messages-to-send)
+ (natnump gptel--num-messages-to-send))
+ (add-file-local-variable 'gptel--num-messages-to-send
+ gptel--num-messages-to-send)
+ (delete-file-local-variable 'gptel--num-messages-to-send))
+ (add-file-local-variable 'gptel--bounds (gptel--get-buffer-bounds)))))))
+
+\f
+;;; Minor modes and UI
+
+;; NOTE: It's not clear that this is the best strategy:
+(cl-pushnew '(gptel . t) (default-value 'text-property-default-nonsticky)
+ :test #'equal)
+
+(defun gptel--inherit-stickiness (beg end _pre)
+ "Mark any change to an LLM response region as a response.
+
+Intended to be added to `after-change-functions' in gptel chat buffers,
+which see for BEG, END and PRE."
+ (and (/= beg end) (< end (point-max))
+ (and-let* ((val (get-text-property end 'gptel)))
+ (add-text-properties
+ beg end `(gptel ,val front-sticky (gptel))))))
+
+(defun gptel-markdown--annotate-links (beg end)
+ "Annotate Markdown links whose sources will be sent with `gptel-send'.
+
+Search between BEG and END."
+ (when gptel-track-media
+ (save-excursion
+ (goto-char beg) (forward-line -1)
+ (let ((link-ovs (cl-loop for o in (overlays-in (point) end)
+ if (overlay-get o 'gptel-track-media)
+ collect o into os finally return os)))
+ (while (re-search-forward gptel-markdown--link-regex end t)
+ (unless (gptel--in-response-p (1- (point)))
+ (let* ((link (markdown-link-at-pos (point)))
+ (from (car link)) (to (cadr link))
+ (link-status (gptel-markdown--validate-link link))
+ (ov (cl-loop for o in (overlays-in from to)
+ if (overlay-get o 'gptel-track-media)
+ return o)))
+ (if ov ; Ensure overlay over each link
+ (progn (move-overlay ov from to)
+ (setq link-ovs (delq ov link-ovs)))
+ (setq ov (make-overlay from to nil t))
+ (overlay-put ov 'gptel-track-media t)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'priority -80))
+ ;; Check if link will be sent, and annotate accordingly
+ (gptel--annotate-link ov link-status))))
+ (and link-ovs (mapc #'delete-overlay link-ovs))))
+ `(jit-lock-bounds ,beg . ,end)))
+
+(defvar gptel--header-line-info
+ '(:eval
+ (let* ((model (gptel--model-name gptel-model))
+ (system
+ (propertize
+ (buttonize
+ (format "[Prompt: %s]"
+ (or (car-safe (rassoc gptel--system-message gptel-directives))
+ (gptel--describe-directive gptel--system-message 15)))
+ (lambda (&rest _) (gptel-system-prompt)))
+ 'mouse-face 'highlight
+ 'help-echo "System message for session"))
+ (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 (not gptel-track-media))
+ (if gptel-track-media
+ (progn
+ (run-hooks 'gptel-refresh-buffer-hook)
+ (message "Sending media from included links."))
+ (without-restriction (gptel--annotate-link-clear))
+ (message "Ignoring links. Only link text will be sent."))
+ (run-at-time 0 nil #'force-mode-line-update)))
+ (track-media
+ (and (gptel--model-capable-p 'media)
+ (if gptel-track-media
+ (propertize
+ (buttonize "[Sending media]" toggle-track-media)
+ 'mouse-face 'highlight
+ 'help-echo
+ "Sending media from links/urls when supported.\nClick to toggle")
+ (propertize
+ (buttonize "[Ignoring media]" toggle-track-media)
+ 'mouse-face 'highlight
+ 'help-echo
+ "Ignoring media from links/urls.\nClick to toggle"))))
+ (toggle-tools (lambda (&rest _) (interactive)
+ (run-at-time 0 nil
+ (lambda () (call-interactively #'gptel-tools)))))
+ (tools (when (and gptel-use-tools gptel-tools)
+ (propertize
+ (buttonize (pcase (length gptel-tools)
+ (0 "[No tools]") (1 "[1 tool]")
+ (len (format "[%d tools]" len)))
+ toggle-tools)
+ 'mouse-face 'highlight
+ 'help-echo "Select tools"))))
+ (let ((rhs (concat
+ tools (and track-media " ") track-media
+ (and context " ") context " " system " "
+ (propertize
+ (buttonize (concat "[" model "]")
+ (lambda (&rest _) (gptel-menu)))
+ 'mouse-face 'highlight
+ 'help-echo "Model in use"))))
+ (concat
+ (propertize
+ " " 'display
+ (if (fboundp 'string-pixel-width)
+ `(space :align-to (- right (,(string-pixel-width rhs))))
+ `(space :align-to (- right ,(+ 5 (string-width rhs))))))
+ rhs))))
+ "Information segment for the header-line in `gptel-mode'.")
+
+(defun gptel-use-header-line ()
+ "Set up the header-line for a gptel buffer.
+
+It is composed of three segments: the backend name, the
+status (Ready/Waiting etc) and the info segment, showing the current
+context, tools, system prompt, model and more."
+ (setq
+ header-line-format
+ (list '(:eval (concat (propertize " " 'display '(space :align-to 0))
+ (format "%s" (gptel-backend-name gptel-backend))))
+ (propertize " Ready" 'face 'success)
+ gptel--header-line-info)))
+
+;;;###autoload
+(define-minor-mode gptel-mode
+ "Minor mode for interacting with LLMs."
+ :lighter " GPT"
+ :keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c RET") #'gptel-send)
+ map)
+ (if gptel-mode
+ (progn
+ (unless (derived-mode-p 'org-mode 'markdown-mode 'text-mode)
+ (gptel-mode -1)
+ (user-error (format "`gptel-mode' is not supported in `%s'." major-mode)))
+ (add-hook 'before-save-hook #'gptel--save-state nil t)
+ (add-hook 'after-change-functions 'gptel--inherit-stickiness nil t)
+ (gptel--prettify-preset)
+ (cond
+ ((derived-mode-p 'org-mode)
+ (require 'gptel-org)
+ (jit-lock-register 'gptel-org--annotate-links)
+ ;; Work around bug in `org-fontify-extend-region'.
+ (add-hook 'gptel-post-response-functions #'font-lock-flush nil t))
+ ((derived-mode-p 'markdown-mode)
+ (font-lock-add-keywords ;keymap is a font-lock-managed property in markdown-mode
+ nil '(("^```[ \t]*\\([[:alpha:]][^\n]*\\)?$" ;match code fences
+ 0 (list 'face nil 'keymap gptel--markdown-block-map))))
+ (jit-lock-register 'gptel-markdown--annotate-links)))
+ (gptel--restore-state)
+ (if gptel-use-header-line
+ (progn (setq gptel--old-header-line header-line-format)
+ (gptel-use-header-line))
+ (gptel--update-status " Ready" 'success)))
+ (remove-hook 'before-save-hook #'gptel--save-state t)
+ (remove-hook 'after-change-functions 'gptel--inherit-stickiness t)
+ (cond
+ ((derived-mode-p 'org-mode)
+ (jit-lock-unregister #'gptel-org--annotate-links)
+ (without-restriction (gptel--annotate-link-clear)))
+ ((derived-mode-p 'markdown-mode)
+ (jit-lock-unregister #'gptel-markdown--annotate-links)
+ (without-restriction (gptel--annotate-link-clear))))
+ (gptel--prettify-preset)
+ (if gptel-use-header-line
+ (setq header-line-format gptel--old-header-line
+ gptel--old-header-line nil)
+ (setq mode-line-process nil))))
+
+;; ;TODO(request-lib): Declaration no longer needed
+(defvar gptel--fsm-last) ;Defined further below
+(defun gptel--update-status (msg &optional face)
+ "Update status MSG with FACE."
+ (when gptel-mode
+ (let* ((inspect (lambda (&rest _) (gptel--inspect-fsm)))
+ (button (propertize (buttonize msg inspect)
+ 'mouse-face 'highlight)))
+ (when face (setq button (propertize button 'face face)))
+ (if gptel-use-header-line
+ (and (consp header-line-format) (setf (nth 1 header-line-format) button))
+ (if (equal msg " Ready")
+ (setq mode-line-process
+ `(:eval (concat " " (buttonize (gptel--model-name gptel-model)
+ ,inspect))))
+ (setq mode-line-process button)
+ (message msg))))
+ (force-mode-line-update)))
+
+\f
+;;;; gptel-highlight-mode
+
+(defcustom gptel-highlight-methods '(margin)
+ "Types of LLM response highlighting used by `gptel-highlight-mode'.
+
+This must be a list of symbols denoting types of highlighting for LLM responses:
+- face: highlight LLM responses using face `gptel-response-highlight'.
+- fringe: highlight using a (left) fringe marker.
+- margin: highlight in the (left) display margin.
+
+margin and fringe markings are mutually exclusive, and use the
+`gptel-response-fringe-highlight' face."
+ :type '(set (const :tag "Fringe marker" fringe)
+ (const :tag "Face highlighting" face)
+ (const :tag "Margin indicator" margin))
+ :group 'gptel)
+
+(defface gptel-response-highlight
+ '((((background light) (min-colors 88)) :background "linen" :extend t)
+ (((background dark) (min-colors 88)) :background "gray14" :extend t)
+ (t :inherit mode-line))
+ "Face used to highlight LLM responses when using `gptel-highlight-mode'.
+
+To enable this face for responses, `gptel-highlight-methods' must be set."
+ :group 'gptel)
+
+(defface gptel-response-fringe-highlight
+ ;; NOTE: Remove conditional after we drop Emacs 28.1 (#1254)
+ (if (< emacs-major-version 29)
+ '((t :inherit outline-1 :height 1.0))
+ '((t :inherit outline-1 :height reset)))
+ "LLM response fringe/margin face when using `gptel-highlight-mode'.
+
+To enable response highlights in the fringe, `gptel-highlight-methods'
+must be set."
+ :group 'gptel)
+
+(define-fringe-bitmap 'gptel-highlight-fringe
+ (make-vector 28 #b01100000)
+ nil nil 'center)
+
+;; Common options for margin indicator:
+;; BOX DRAWINGS LIGHT VERTICAL 0x002502
+;; LEFT ONE QUARTER BLOCK 0x00258E
+;; LEFT THREE EIGHTHS BLOCK 0x00258D
+;; BOX DRAWINGS HEAVY VERTICAL 0x002503
+;; VERTICAL ONE EIGHTH BLOCK-2 0x01FB70
+
+(defun gptel-highlight--margin-prefix (type)
+ "Create margin prefix string for TYPE.
+
+Supported TYPEs are response, ignore and tool calls."
+ (propertize ">" 'display
+ `( (margin left-margin)
+ ,(propertize "▎" 'face
+ (pcase type
+ ('response 'gptel-response-fringe-highlight)
+ ('ignore 'shadow)
+ (`(tool . ,_) 'shadow))))))
+
+(defun gptel-highlight--fringe-prefix (type)
+ "Create fringe prefix string for TYPE.
+
+Supported TYPEs are response, ignore and tool calls."
+ (propertize ">" 'display
+ `( left-fringe gptel-highlight-fringe
+ ,(pcase type
+ ('response 'gptel-response-fringe-highlight)
+ ('ignore 'shadow)
+ (`(tool . ,_) 'shadow)))))
+
+(defun gptel-highlight--decorate (ov &optional val)
+ "Decorate gptel indicator overlay OV whose type is VAL."
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'gptel-highlight t)
+ (when (memq 'face gptel-highlight-methods)
+ (overlay-put ov 'font-lock-face
+ (pcase val
+ ('response 'gptel-response-highlight)
+ ('ignore 'shadow)
+ (`(tool . ,_) 'shadow))))
+ (when-let* ((prefix
+ (cond ((memq 'margin gptel-highlight-methods)
+ (gptel-highlight--margin-prefix (or val 'response)))
+ ((memq 'fringe gptel-highlight-methods)
+ (gptel-highlight--fringe-prefix (or val 'response))))))
+ (overlay-put ov 'line-prefix prefix)
+ (overlay-put ov 'wrap-prefix prefix)))
+
+(defun gptel-highlight--update (beg end)
+ "JIT-lock function: mark gptel response/reasoning regions.
+
+BEG and END delimit the region to refresh."
+ (save-excursion ;Scan across region for the gptel text property
+ (let ((prev-pt (goto-char end)))
+ (while (and (goto-char (previous-single-property-change
+ (point) 'gptel nil beg))
+ (/= (point) prev-pt))
+ (pcase (get-char-property (point) 'gptel)
+ ((and (or 'response 'ignore `(tool . ,_)) val)
+ (if-let* ((ov (or (cdr-safe (get-char-property-and-overlay
+ (point) 'gptel-highlight))
+ (cdr-safe (get-char-property-and-overlay
+ prev-pt 'gptel-highlight))))
+ (from (overlay-start ov)) (to (overlay-end ov)))
+ (unless (<= from (point) prev-pt to)
+ (move-overlay ov (min from (point)) (max to prev-pt)))
+ (gptel-highlight--decorate ;Or make new overlay covering just region
+ (make-overlay (point) prev-pt nil t) val)))
+ ('nil ;If there's an overlay, we need to split it.
+ (when-let* ((ov (cdr-safe (get-char-property-and-overlay
+ (point) 'gptel-highlight)))
+ (from (overlay-start ov)) (to (overlay-end ov)))
+ (move-overlay ov from (point)) ;Move overlay to left side
+ (gptel-highlight--decorate ;Make a new one on the right
+ (make-overlay prev-pt to nil t)
+ (get-char-property prev-pt 'gptel)))))
+ (setq prev-pt (point)))))
+ `(jit-lock-bounds ,beg . ,end))
+
+(define-minor-mode gptel-highlight-mode
+ "Visually highlight LLM respones regions.
+
+Highlighting is via fringe or margin markers, and optionally a response
+face. See `gptel-highlight-methods' for highlighting methods, and
+`gptel-response-highlight' and `gptel-response-fringe-highlight' for the
+faces.
+
+This minor mode can be used anywhere in Emacs, and not just gptel chat
+buffers."
+ :lighter nil
+ :global nil
+ (cond
+ (gptel-highlight-mode
+ (when (memq 'margin gptel-highlight-methods)
+ (setq left-margin-width (1+ left-margin-width))
+ (if-let* ((win (get-buffer-window (current-buffer))))
+ (set-window-buffer win (current-buffer))))
+ (jit-lock-register #'gptel-highlight--update)
+ (gptel-highlight--update (point-min) (point-max)))
+ (t (when (memq 'margin gptel-highlight-methods)
+ (setq left-margin-width (max (1- left-margin-width) 0))
+ (if-let* ((win (get-buffer-window (current-buffer))))
+ (set-window-buffer win (current-buffer))))
+ (jit-lock-unregister #'gptel-highlight--update)
+ (without-restriction
+ (remove-overlays nil nil 'gptel-highlight t)))))
+
+\f
+;;; State machine additions for `gptel-send'.
+
+(defvar gptel-send--transitions
+ `((INIT . ((t . WAIT)))
+ (WAIT . ((t . TYPE)))
+ (TYPE . ((,#'gptel--error-p . ERRS)
+ (,#'gptel--tool-use-p . TPRE)
+ (t . DONE)))
+ (TPRE . ((,#'gptel--error-p . ERRS)
+ (t . TOOL)))
+ (TOOL . ((t . TRET)))
+ (TRET . ((,#'gptel--error-p . ERRS)
+ (,#'gptel--tool-result-p . WAIT)
+ (t . DONE))))
+ "Alist specifying state transitions for `gptel-send'.
+
+See `gptel-request--transitions' for details.")
+
+(defvar gptel-send--handlers
+ `((WAIT ,#'gptel--handle-wait ,#'gptel--update-wait)
+ (TYPE ,#'gptel--handle-pre-insert)
+ (ERRS ,#'gptel--handle-error ,#'gptel--fsm-last)
+ (TPRE ,#'gptel--handle-pre-tool ,#'gptel--fsm-transition)
+ (TOOL ,#'gptel--update-tool-call ,#'gptel--handle-tool-use
+ ,#'gptel--update-tool-ask)
+ (TRET ,#'gptel--handle-post-tool ,#'gptel--handle-tool-result)
+ (DONE ,#'gptel--handle-post-insert ,#'gptel--fsm-last)
+ (ABRT ,#'gptel--handle-abort))
+ "Alist specifying handlers for `gptel-send' state transitions.
+
+See `gptel-request--handlers' for details.")
+
+(defvar-local gptel--fsm-last nil
+ "State machine for latest request in the buffer.")
+
+(defun gptel--fsm-last (fsm)
+ "Capture the latest request state FSM for introspection."
+ (let ((info (gptel-fsm-info fsm)))
+ (unless gptel-log-level
+ (let ((data (plist-get info :data)))
+ (dolist (key '(:messages :contents :query))
+ (setf (plist-get data key) nil))))
+ (setf (gptel-fsm-info fsm)
+ (plist-put info :end-time (current-time-string)))
+ (with-current-buffer (plist-get info :buffer)
+ (setq gptel--fsm-last fsm))))
+
+(defun gptel--inspect-fsm (&optional fsm)
+ "Inspect gptel request state FSM.
+
+FSM defaults to the state of the last request in the current
+buffer."
+ (unless fsm
+ (setq fsm (or gptel--fsm-last
+ (cadr (cl-find-if
+ (lambda (proc-list)
+ (eq (thread-first (cadr proc-list)
+ (gptel-fsm-info)
+ (plist-get :buffer))
+ (current-buffer)))
+ gptel--request-alist)))))
+ (unless (cl-typep fsm 'gptel-fsm)
+ (user-error "No gptel request log in this buffer yet!"))
+ (require 'tabulated-list)
+ (with-current-buffer (get-buffer-create "*gptel-diagnostic*")
+ (setq tabulated-list-format [("Request attribute" 30 t) ("Value" 30)])
+ (let* ((pb (lambda (s) (propertize s 'face 'font-lock-builtin-face)))
+ (ps (lambda (s) (propertize s 'face 'font-lock-string-face)))
+ (fmt (lambda (s) (cond ((memq (car-safe s) '(closure lambda))
+ (format "#<lambda %#x>" (sxhash s)))
+ ((byte-code-function-p s)
+ (format "#<compiled %#x>" (sxhash s)))
+ ((stringp s) (string-replace "\n" "⮐ " s))
+ (t (prin1-to-string s)))))
+ (inhibit-read-only t)
+ (info (gptel-fsm-info fsm))
+ (entries-info
+ (cl-loop
+ for idx upfrom 3
+ for (key val) on info by #'cddr
+ unless (memq key '(:data :history :tools
+ :partial_text :partial_json))
+ collect
+ (list idx `[,(funcall pb (symbol-name key))
+ ,(funcall ps (funcall fmt val))])))
+ (entries-data
+ (cl-loop
+ for idx upfrom 50
+ for (key val) on (plist-get info :data) by #'cddr
+ unless (memq key '(:messages :stream :contents :query))
+ collect
+ (list idx `[,(funcall pb (symbol-name key))
+ ,(funcall ps (funcall fmt val))]))))
+ (setq tabulated-list-entries
+ (nconc (list `(2 [,(funcall pb ":state")
+ ,(funcall ps
+ (mapconcat
+ fmt (reverse (cons (gptel-fsm-state fsm)
+ (plist-get info :history)))
+ " → "))]))
+ entries-info
+ entries-data))
+ (tabulated-list-print)
+ (tabulated-list-mode)
+ (tabulated-list-init-header)
+ (hl-line-mode 1)
+ (display-buffer
+ (current-buffer)
+ '((display-buffer-in-side-window)
+ (side . bottom)
+ (window-height . fit-window-to-buffer)
+ (slot . 10)
+ (body-function . select-window))))))
+
+;;;; State machine handlers
+;; The next few functions are default state handlers for gptel-send, see
+;; `gptel-send--handlers'.
+
+(defun gptel--handle-pre-insert (fsm)
+ "Tasks before inserting the LLM response for state FSM.
+
+Handle read-only buffers and run pre-response hooks (but only if
+the request succeeded)."
+ (let* ((info (gptel-fsm-info fsm))
+ (start-marker (plist-get info :position)))
+ (when (memq (plist-get info :callback)
+ '(gptel--insert-response gptel-curl--stream-insert-response))
+ (with-current-buffer (marker-buffer start-marker)
+ (when (or buffer-read-only (get-char-property start-marker 'read-only))
+ (cond
+ ((derived-mode-p 'vterm-mode)
+ (require 'gptel-integrations)
+ (gptel--vterm-pre-insert info))
+ (t
+ (message "Buffer is read only, displaying reply in buffer \"*LLM response*\"")
+ (display-buffer
+ (with-current-buffer (get-buffer-create "*LLM response*")
+ (visual-line-mode 1)
+ (goto-char (point-max))
+ (move-marker start-marker (point) (current-buffer))
+ (current-buffer))
+ '((display-buffer-reuse-window
+ display-buffer-pop-up-window)
+ (reusable-frames . visible))))))))
+ (with-current-buffer (marker-buffer start-marker)
+ (when (plist-get info :stream)
+ (gptel--update-status " Typing..." 'success))
+ (save-excursion
+ (goto-char start-marker)
+ (when (and (member (plist-get info :http-status) '("200" "100"))
+ gptel-pre-response-hook)
+ (run-hooks 'gptel-pre-response-hook))))))
+
+(defun gptel--handle-post-insert (fsm)
+ "Tasks after successfully inserting the LLM response with state FSM.
+
+Indicate gptel status, pulse the inserted text and run post-response hooks.
+
+No state transition here since that's handled by the process sentinels."
+ (let* ((info (gptel-fsm-info fsm))
+ (start-marker (plist-get info :position))
+ (tracking-marker (or (plist-get info :tracking-marker)
+ start-marker))
+ ;; start-marker may have been moved if :buffer was read-only
+ (gptel-buffer (marker-buffer start-marker)))
+ (with-current-buffer gptel-buffer
+ (if (not tracking-marker) ;Empty response
+ (when gptel-mode (gptel--update-status " Empty response" 'success))
+ (set-marker-insertion-type tracking-marker nil) ;Lock tracking-marker
+ (when gptel-mode
+ (unless (plist-get info :in-place)
+ (save-excursion (goto-char tracking-marker)
+ (insert gptel-response-separator
+ (gptel-prompt-prefix-string))))
+ (gptel--update-status " Ready" 'success))))
+ ;; Run hook in visible window to set window-point, BUG #269
+ (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible)))
+ (with-selected-window gptel-window
+ (mapc (lambda (f) (funcall f info)) (plist-get info :post))
+ (run-hook-with-args
+ 'gptel-post-response-functions
+ (marker-position start-marker) (marker-position tracking-marker)))
+ (with-current-buffer gptel-buffer
+ (mapc (lambda (f) (funcall f info)) (plist-get info :post))
+ (run-hook-with-args
+ 'gptel-post-response-functions
+ (marker-position start-marker) (marker-position tracking-marker))))))
+
+(defun gptel--handle-error (fsm)
+ "Check for errors in request state FSM.
+
+Perform UI updates and run post-response hooks."
+ (when-let* ((info (gptel-fsm-info fsm))
+ (error-data (plist-get info :error)))
+ (let* ((status (plist-get info :status))
+ (gptel-buffer (plist-get info :buffer))
+ (start-marker (plist-get info :position))
+ (tracking-marker (or (plist-get info :tracking-marker)
+ start-marker))
+ (backend-name
+ (gptel-backend-name
+ (buffer-local-value 'gptel-backend gptel-buffer))))
+ (if (stringp error-data)
+ (message "%s error: (%s) %s" backend-name status (string-trim error-data))
+ (when-let* ((error-type (plist-get error-data :type)))
+ (setq status (concat "(" status ") "
+ (string-trim (gptel--to-string error-type)))))
+ (when-let* ((error-msg (plist-get error-data :message)))
+ (message "%s error: (%s) %s" backend-name status
+ (string-trim (gptel--to-string error-msg)))))
+ (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible)))
+ (with-selected-window gptel-window
+ (mapc (lambda (f) (funcall f info)) (plist-get info :post))
+ (run-hook-with-args
+ 'gptel-post-response-functions
+ (marker-position start-marker) (marker-position tracking-marker)))
+ (with-current-buffer gptel-buffer
+ (mapc (lambda (f) (funcall f info)) (plist-get info :post))
+ (run-hook-with-args
+ 'gptel-post-response-functions
+ (marker-position start-marker) (marker-position tracking-marker))))
+ (with-current-buffer gptel-buffer
+ (when gptel-mode
+ (gptel--update-status
+ (format " Error: %s" status) 'error))))))
+
+(defun gptel--handle-abort (fsm)
+ "Perform UI update on `gptel-abort' for FSM."
+ (when-let* ((info (gptel-fsm-info fsm))
+ (gptel-buffer (plist-get info :buffer))
+ (start-marker (plist-get info :position))
+ (tracking-marker (or (plist-get info :tracking-marker)
+ start-marker)))
+ (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible)))
+ (with-selected-window gptel-window
+ (mapc (lambda (f) (funcall f info)) (plist-get info :post))
+ (run-hook-with-args
+ 'gptel-post-response-functions
+ (marker-position start-marker) (marker-position tracking-marker)))
+ (with-current-buffer gptel-buffer
+ (mapc (lambda (f) (funcall f info)) (plist-get info :post))
+ (run-hook-with-args
+ 'gptel-post-response-functions
+ (marker-position start-marker) (marker-position tracking-marker))))
+ (with-current-buffer gptel-buffer
+ (when gptel-mode (gptel--update-status " Abort" 'error)))))
+
+(defun gptel--handle-pre-tool (fsm)
+ "Run `gptel-pre-tool-call-functions' for FSM."
+ (let* ((info (gptel-fsm-info fsm))
+ (buffer (plist-get info :buffer)))
+ (when (buffer-local-value 'gptel-pre-tool-call-functions buffer)
+ ;; This function might run many times, so only act on the remaining tool calls.
+ (let ((tool-use (cl-remove-if (lambda (tc) (plist-get tc :result))
+ (plist-get info :tool-use)))
+ (hook-func-args (list :buffer (buffer-name buffer)
+ :backend (plist-get info :backend)
+ :model (plist-get info :model))))
+ (with-current-buffer buffer
+ (run-hook-wrapped ; Run pre tool call functions
+ 'gptel-pre-tool-call-functions
+ (lambda (hook-func)
+ (prog1 nil
+ (dolist (tool-call tool-use)
+ (let* ((name (plist-get tool-call :name))
+ (args (plist-get tool-call :args))
+ (hook-func-result
+ (with-demoted-errors "gptel-pre-tool-call hook error: %S"
+ (funcall hook-func (nconc (list :name name :args args)
+ hook-func-args)))))
+ (if (plist-get hook-func-result :stop) ; Stop the request immediately
+ (let ((reason (or (plist-get hook-func-result :stop-reason)
+ (concat "Request stopped by pre-tool-call hook "
+ (and (symbolp hook-func)
+ (symbol-name hook-func))
+ " (tool \"" name "\")"))))
+ (plist-put info :stop-reason reason)
+ (plist-put info :status "Stopped by hook")
+ (plist-put info :error reason))
+ ;; if hook-func returns :confirm, add the check
+ (when (plist-get hook-func-result :confirm)
+ (plist-put tool-call :confirm t))
+ ;; if hook-func returns :args or :name, replace in the call
+ (when (or (plist-get hook-func-result :args)
+ (plist-get hook-func-result :name))
+ ;; Merge with args in the messages array sent to the LLM
+ (gptel--inject-tool-call
+ (plist-get info :backend) (plist-get info :data)
+ tool-call hook-func-result)
+ ;; Merge with the tool-call in tool-use that actually runs
+ (gptel--merge-plists tool-call hook-func-result))
+ ;; TODO(tool-hooks): :block behavior not final!
+ (let ((blockp (plist-get hook-func-result :block))
+ (result (plist-get hook-func-result :result)))
+ (when blockp
+ (plist-put tool-call :error t)
+ (setq result
+ (concat "<tool_call_error>\n"
+ (if (stringp blockp) blockp
+ (format "Tool %s blocked by user" name))
+ "\n</tool_call_error>")))
+ (when result
+ (gptel--process-tool-call
+ fsm (cl-find-if (lambda (ts) (equal (gptel-tool-name ts) name))
+ (plist-get info :tools))
+ tool-call result))))))))))))))
+
+(defun gptel--handle-post-tool (fsm)
+ "Run `gptel-post-tool-call-functions for FSM."
+ (let* ((info (gptel-fsm-info fsm))
+ (buffer (plist-get info :buffer)))
+ (when (buffer-local-value 'gptel-post-tool-call-functions buffer)
+ (let ((hook-func-args (list :buffer (buffer-name buffer)
+ :backend (plist-get info :backend)
+ :model (plist-get info :model))))
+ (with-current-buffer buffer
+ (run-hook-wrapped ; Run pre tool call functions
+ 'gptel-post-tool-call-functions
+ (lambda (hook-func)
+ (prog1 nil
+ (dolist (tool-call (plist-get info :tool-use))
+ (let* ((name (plist-get tool-call :name))
+ (args (plist-get tool-call :args))
+ (hook-func-result
+ (with-demoted-errors "gptel-post-tool-call hook error: %S"
+ (funcall hook-func
+ (nconc (list :name name :args args
+ :result (plist-get tool-call :result))
+ hook-func-args)))))
+ (if (plist-get hook-func-result :stop)
+ (let ((reason (or (plist-get hook-func-result :stop-reason)
+ (concat "Request stopped by post-tool-call hook "
+ (and (symbolp hook-func)
+ (symbol-name hook-func))
+ " (tool \"" name "\")"))))
+ (plist-put info :stop-reason reason)
+ (plist-put info :status "Stopped by hook")
+ (plist-put info :error reason))
+ ;; TODO(tool-hooks): :block behavior not final!
+ (let ((blockp (plist-get hook-func-result :block))
+ (result (plist-get hook-func-result :result)))
+ (when blockp
+ (plist-put tool-call :error t)
+ (setq result
+ (concat "<tool_call_error>\n"
+ (if (stringp blockp) blockp
+ (format "Tool %s blocked by user" name))
+ "\n</tool_call_error>")))
+ (when result
+ (cl-loop ; Update results sent to callback
+ for call in (plist-get info :tool-result)
+ for (spec stored-args _) = call
+ when (and (equal (gptel-tool-name spec) name)
+ (null (cl-set-difference
+ stored-args args :test #'equal)))
+ do (setf (caddr call) result) and return nil
+ finally
+ (display-warning
+ '(gptel tools)
+ (format "Tool %s: Could not replace tool results" name)))
+ ;; Update results sent to LLM
+ (plist-put tool-call :result result))))))))))))))
+
+(defun gptel--update-wait (fsm)
+ "Update gptel's status in FSM after sending a request."
+ (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer)
+ (when gptel-mode
+ (gptel--update-status " Waiting..." 'warning))))
+
+(defun gptel--update-tool-call (fsm)
+ "Update gptel's status in FSM when calling a tool."
+ (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer)
+ (setq gptel--fsm-last fsm)
+ (when gptel-mode
+ (if-let* ((info (gptel-fsm-info fsm))
+ (names (cl-loop for call in (plist-get info :tool-use)
+ collect (plist-get call :name))))
+ (gptel--update-status
+ (concat
+ (propertize
+ (if (length> names 1) " Calling tools (" " Calling tool (")
+ 'face 'mode-line-emphasis)
+ (mapconcat (lambda (name) (propertize name 'face 'font-lock-keyword-face))
+ names (propertize ", " 'face 'mode-line-emphasis))
+ (propertize ")" 'face 'mode-line-emphasis)))
+ ;; FIXME: Is this branch reachable?
+ (gptel--update-status " Calling tool..." 'mode-line-emphasis)))))
+
+(defun gptel--update-tool-ask (fsm)
+ "Update gptel's status in FSM when there are pending tool-calls."
+ (when (plist-get (gptel-fsm-info fsm) :tool-pending)
+ (plist-put (gptel-fsm-info fsm) :tool-pending nil)
+ (when gptel-mode
+ (gptel--update-status " Run tools?" 'mode-line-emphasis))))
+
+\f
+;;; Send queries, handle responses
+;;;###autoload
+(defun gptel-send (&optional arg)
+ "Submit this prompt to the current LLM backend.
+
+By default, the contents of the buffer up to the cursor position
+are sent. If the region is active, its contents are sent
+instead.
+
+The response from the LLM is inserted below the cursor position
+at the time of sending. To change this behavior or model
+parameters, use prefix arg ARG activate a transient menu with
+more options instead.
+
+This command is asynchronous, you can continue to use Emacs while
+waiting for the response."
+ (interactive "P")
+ (if (and arg (require 'gptel-transient nil t))
+ (call-interactively #'gptel-menu)
+ (gptel--sanitize-model)
+ (let ((fsm (gptel-make-fsm :table gptel-send--transitions
+ :handlers gptel-send--handlers)))
+ (gptel-request nil
+ :stream gptel-stream
+ :transforms gptel-prompt-transform-functions
+ :fsm fsm)
+ (message "Querying %s..."
+ (thread-first (gptel-fsm-info fsm)
+ (plist-get :backend)
+ (or gptel-backend)
+ (gptel-backend-name))))
+ (gptel--update-status " Waiting..." 'warning)))
+
+(declare-function json-pretty-print-buffer "json")
+(defun gptel--inspect-query (&optional request-fsm format)
+ "Show the full LLM query that will be sent in a buffer.
+
+This functions as a dry run of `gptel-send'. The request data
+may be edited and the query continued from this buffer.
+
+REQUEST-FSM is the state of the request, as returned by
+`gptel-request'. If FORMAT is the symbol json, show the encoded
+JSON query instead of the Lisp structure gptel uses."
+ (unless request-fsm (setq request-fsm gptel--fsm-last))
+ (if (bufferp (plist-get (gptel-fsm-info request-fsm) :data))
+ (letrec ((dry-run-poll
+ (run-with-timer
+ 0 1 (lambda (fsm form)
+ (unless (bufferp (plist-get (gptel-fsm-info fsm) :data))
+ (cancel-timer dry-run-poll)
+ (gptel--inspect-query fsm form)))
+ request-fsm format))))
+ (with-current-buffer (plist-get (gptel-fsm-info request-fsm) :buffer)
+ (gptel--update-status " Ready" 'success))
+ (with-current-buffer (get-buffer-create "*gptel-query*")
+ (let* ((standard-output (current-buffer))
+ (inhibit-read-only t)
+ (request-data
+ (plist-get (gptel-fsm-info request-fsm) :data)))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if (eq format 'json)
+ (progn (fundamental-mode)
+ (insert (gptel--json-encode request-data))
+ (json-pretty-print-buffer))
+ (lisp-data-mode)
+ (prin1 request-data)
+ (pp-buffer))
+ (setq-local gptel--fsm-last request-fsm)
+ (goto-char (point-min))
+ (view-mode 1)
+ (setq buffer-undo-list nil)
+ (use-local-map
+ (make-composed-keymap
+ (define-keymap
+ "C-c C-c" #'gptel--continue-query
+ "C-c C-w" (lambda () "Copy Curl command for query."
+ (interactive) (gptel--continue-query 'copy))
+ "C-c C-k" #'quit-window)
+ (current-local-map)))
+ (unless header-line-format
+ (setq header-line-format
+ (substitute-command-keys
+ (concat
+ "Edit request: \\[read-only-mode],"
+ " Send request: \\[gptel--continue-query],"
+ (format " Copy Curl: %s"
+ (propertize "C-c C-w" 'face 'help-key-binding))
+ " Quit: \\[quit-window]"))))
+ (display-buffer (current-buffer) gptel-display-buffer-action)))))
+
+(defun gptel--continue-query (&optional copy)
+ "Continue sending the gptel query displayed in this buffer.
+
+The request is continued with the same parameters as originally
+specified.
+
+With prefix arg COPY, copy the Curl command for the request to the
+kill ring instead."
+ (interactive "P" lisp-data-mode fundamental-mode)
+ (unless (equal (buffer-name) "*gptel-query*")
+ (user-error "This command is meant for use in a gptel dry-run buffer"))
+ (save-excursion
+ (goto-char (point-min))
+ (condition-case-unless-debug nil
+ (when-let* ((data (if (eq major-mode 'lisp-data-mode)
+ (read (current-buffer))
+ (gptel--json-read))))
+ (cl-assert (cl-typep gptel--fsm-last 'gptel-fsm))
+ (plist-put (gptel-fsm-info gptel--fsm-last) :data data)
+ (if copy ;Copy Curl command instead of sending request
+ (let ((args (gptel-curl--get-args (gptel-fsm-info gptel--fsm-last)
+ (md5 (format "%s" (random))) t)))
+ (kill-new
+ (mapconcat #'shell-quote-argument
+ (cons (gptel--curl-path) args) " \\\n"))
+ (message "Curl command for request copied to kill-ring"))
+ (gptel--fsm-transition gptel--fsm-last) ;INIT -> WAIT
+ (quit-window)))
+ (error
+ (user-error "Can not resume request: could not read data from buffer!")))))
+
+(defun gptel--insert-response (response info &optional raw)
+ "Insert the LLM RESPONSE into the gptel buffer.
+
+INFO is a plist containing information relevant to this buffer.
+See `gptel--url-get-response' for details.
+
+Optional RAW disables text properties and transformation."
+ (let* ((gptel-buffer (plist-get info :buffer))
+ (start-marker (plist-get info :position))
+ (tracking-marker (plist-get info :tracking-marker)))
+ (pcase response
+ ((pred stringp) ;Response text
+ (with-current-buffer gptel-buffer
+ (when tracking-marker ;separate from previous response
+ (setq response (concat gptel-response-separator response)))
+ (save-excursion
+ (with-current-buffer (marker-buffer start-marker)
+ (goto-char (or tracking-marker start-marker))
+ ;; (run-hooks 'gptel-pre-response-hook)
+ (unless (or (bobp) (plist-get info :in-place)
+ tracking-marker)
+ (insert gptel-response-separator)
+ (when gptel-mode
+ (insert (gptel-response-prefix-string)))
+ (move-marker start-marker (point)))
+ (unless raw
+ (when-let* ((transformer (plist-get info :transformer)))
+ (setq response (funcall transformer response)))
+ (add-text-properties
+ 0 (length response) '(gptel response front-sticky (gptel)) response))
+ (insert response)
+ (plist-put info :tracking-marker (setq tracking-marker (point-marker)))
+ ;; for uniformity with streaming responses
+ (set-marker-insertion-type tracking-marker t)))))
+ (`(reasoning . ,text)
+ (when-let* ((include (plist-get info :include-reasoning)))
+ (if (stringp include)
+ (with-current-buffer (get-buffer-create
+ (plist-get info :include-reasoning))
+ (save-excursion (goto-char (point-max)) (insert text)))
+ (with-current-buffer (marker-buffer start-marker)
+ (let ((separator ;Separate from response prefix if required
+ (and (not tracking-marker) gptel-mode
+ (not (string-suffix-p "\n" (gptel-response-prefix-string)))
+ "\n"))
+ (blocks (if (derived-mode-p 'org-mode)
+ `("#+begin_reasoning\n" . ,(concat "\n#+end_reasoning"
+ gptel-response-separator))
+ ;; TODO(reasoning) remove properties and strip instead
+ (cons (propertize "``` reasoning\n" 'gptel 'ignore
+ 'keymap gptel--markdown-block-map)
+ (concat (propertize "\n```" 'gptel 'ignore
+ 'keymap gptel--markdown-block-map)
+ gptel-response-separator)))))
+ (if (eq include 'ignore)
+ (progn
+ (add-text-properties
+ 0 (length text) '(gptel ignore front-sticky (gptel)) text)
+ (gptel--insert-response
+ (concat (car blocks) text (cdr blocks)) info t))
+ (gptel--insert-response (concat separator (car blocks)) info t)
+ (gptel--insert-response text info)
+ (gptel--insert-response (cdr blocks) info t))
+ (save-excursion
+ (goto-char (plist-get info :tracking-marker))
+ (if (derived-mode-p 'org-mode) ;fold block
+ (progn (search-backward "#+end_reasoning" start-marker t)
+ (when (looking-at "^#\\+end_reasoning")
+ (org-cycle)))
+ (when (re-search-backward "^```" start-marker t)
+ (gptel-markdown-cycle-block)))))))))
+ (`(tool-call . ,tool-calls)
+ (gptel--display-tool-calls tool-calls info))
+ (`(tool-result . ,tool-results)
+ (gptel--display-tool-results tool-results info)))))
+
+(defun gptel-curl--stream-insert-response (response info &optional raw)
+ "Insert streaming RESPONSE from an LLM into the gptel buffer.
+
+INFO is a mutable plist containing information relevant to this buffer.
+See `gptel--url-get-response' for details.
+
+Optional RAW disables text properties and transformation."
+ (pcase response
+ ((pred stringp)
+ (let ((start-marker (plist-get info :position))
+ (tracking-marker (plist-get info :tracking-marker))
+ (transformer (plist-get info :transformer)))
+ (with-current-buffer (marker-buffer start-marker)
+ (save-excursion
+ (unless tracking-marker
+ (goto-char start-marker)
+ (unless (or (bobp) (plist-get info :in-place))
+ (insert gptel-response-separator)
+ (when gptel-mode
+ ;; Put prefix before AI response.
+ (insert (gptel-response-prefix-string)))
+ (move-marker start-marker (point)))
+ (setq tracking-marker (set-marker (make-marker) (point)))
+ (set-marker-insertion-type tracking-marker t)
+ (plist-put info :tracking-marker tracking-marker))
+ (goto-char tracking-marker)
+ (unless raw
+ (when transformer
+ (setq response (funcall transformer response)))
+ (add-text-properties
+ 0 (length response) '(gptel response front-sticky (gptel))
+ response))
+ ;; (run-hooks 'gptel-pre-stream-hook)
+ (insert response)
+ (run-hooks 'gptel-post-stream-hook)))))
+ (`(reasoning . ,text)
+ (gptel--display-reasoning-stream text info))
+ (`(tool-call . ,tool-calls)
+ (gptel--display-tool-calls tool-calls info))
+ (`(tool-result . ,tool-results)
+ (gptel--display-tool-results tool-results info)
+ ;; Adjust for tool calls inside reasoning blocks
+ (when (eq (plist-get info :reasoning-block) 'in)
+ (when-let* ((rm (plist-get info :reasoning-marker))
+ (tm (plist-get info :tracking-marker)))
+ (move-marker rm tm (marker-buffer tm)))))))
+
+;;;###autoload
+(defun gptel (name &optional _ initial interactivep)
+ "Switch to or start a chat session with NAME.
+
+Ask for API-KEY if `gptel-api-key' is unset.
+
+If region is active, use it as the INITIAL prompt. Returns the
+buffer created or switched to.
+
+INTERACTIVEP is t when gptel is called interactively."
+ (interactive
+ (progn
+ (gptel--sanitize-model :backend (default-value 'gptel-backend)
+ :shoosh t)
+ (let* ((backend (default-value 'gptel-backend))
+ (backend-name
+ (format "*%s*" (gptel-backend-name backend))))
+ (list (read-buffer
+ "Create or choose gptel buffer: "
+ backend-name nil ; DEFAULT and REQUIRE-MATCH
+ (lambda (b) ; PREDICATE
+ ;; NOTE: buffer check is required (#450)
+ (and-let* ((buf (get-buffer (or (car-safe b) b))))
+ (buffer-local-value 'gptel-mode buf))))
+ (condition-case nil
+ (gptel--get-api-key
+ (gptel-backend-key backend))
+ ((error user-error)
+ (setq gptel-api-key
+ (read-passwd
+ (format "%s API key: " backend-name)))))
+ (and (use-region-p)
+ (buffer-substring (region-beginning)
+ (region-end)))
+ t))))
+ (with-current-buffer (get-buffer-create name)
+ (cond ;Set major mode
+ ((eq major-mode gptel-default-mode))
+ ((eq gptel-default-mode 'text-mode)
+ (text-mode)
+ (visual-line-mode 1))
+ (t (funcall gptel-default-mode)))
+ (gptel--sanitize-model :backend (default-value 'gptel-backend)
+ :model (default-value 'gptel-model)
+ :shoosh nil)
+ (unless gptel-mode (gptel-mode 1))
+ (goto-char (point-max))
+ (skip-chars-backward "\t\r\n")
+ (if (bobp) (insert (or initial (gptel-prompt-prefix-string))))
+ (when interactivep
+ (display-buffer (current-buffer) gptel-display-buffer-action)
+ (message "Send your query with %s!"
+ (substitute-command-keys "\\[gptel-send]")))
+ (current-buffer)))
+
+\f
+;;; Reasoning content UI
+(defun gptel--display-reasoning-stream (text info)
+ "Show reasoning TEXT in an appropriate location.
+
+INFO is the request INFO, see `gptel--url-get-response'. This is
+for streaming responses only."
+ (when-let* ((include (plist-get info :include-reasoning)))
+ (if (stringp include)
+ (unless (eq text t)
+ (with-current-buffer (get-buffer-create include)
+ (save-excursion (goto-char (point-max))
+ (insert text))))
+ (let* ((reasoning-marker (plist-get info :reasoning-marker))
+ (tracking-marker (plist-get info :tracking-marker))
+ (start-marker (plist-get info :position)))
+ (with-current-buffer (marker-buffer start-marker)
+ (if (eq text t) ;end of stream
+ (progn
+ (gptel-curl--stream-insert-response
+ (concat (if (derived-mode-p 'org-mode)
+ "\n#+end_reasoning"
+ ;; TODO(reasoning) remove properties and strip instead
+ (propertize "\n```" 'gptel 'ignore
+ 'keymap gptel--markdown-block-map))
+ gptel-response-separator)
+ info t)
+ (ignore-errors ;fold block
+ (save-excursion
+ (goto-char tracking-marker)
+ (if (derived-mode-p 'org-mode)
+ (progn (search-backward "#+end_reasoning" start-marker t)
+ (when (looking-at "^#\\+end_reasoning")
+ (org-cycle)))
+ (when (re-search-backward "^```" start-marker t)
+ (gptel-markdown-cycle-block))))))
+ (unless (and reasoning-marker tracking-marker
+ (= reasoning-marker tracking-marker))
+ (let ((separator ;Separate from response prefix if required
+ (and (not tracking-marker) gptel-mode
+ (not (string-suffix-p
+ "\n" (gptel-response-prefix-string)))
+ "\n")))
+ (gptel-curl--stream-insert-response
+ (concat separator
+ (if (derived-mode-p 'org-mode)
+ "#+begin_reasoning\n"
+ ;; TODO(reasoning) remove properties and strip instead
+ (propertize "``` reasoning\n" 'gptel 'ignore
+ 'keymap gptel--markdown-block-map)))
+ info t)))
+ (if (eq include 'ignore)
+ (progn
+ (add-text-properties
+ 0 (length text) '(gptel ignore front-sticky (gptel)) text)
+ (gptel-curl--stream-insert-response text info t))
+ (gptel-curl--stream-insert-response text info)))
+ (setq tracking-marker (plist-get info :tracking-marker))
+ (if reasoning-marker
+ (move-marker reasoning-marker tracking-marker)
+ (plist-put info :reasoning-marker
+ (copy-marker tracking-marker nil))))))))
+
+(defvar gptel--tool-preview-alist nil
+ "Alist mapping tool names to preview functions for tools.
+
+Each key is a tool name (string) and value is a list of one or two
+functions, for preview-setup and (optional) preview-teardown.
+
+The preview-setup function is called with two arguments: a plist of the
+corresponding tool call arguments and the request INFO plist. It must
+set up the preview for the tool call and return a handle to the preview,
+which can be any object, but typically an overlay or a buffer.
+
+The preview-setup can integrate with gptel's default previewer by
+inserting at point (and moving point), or use a different preview method
+entirely.
+
+The preview-teardown function, if provided, is called with this handle
+when the tool call is accepted or rejected, and it must clear the
+preview.
+
+Note: This tool call preview API is currently experimental.")
+
+\f
+;;; Tool use UI
+(defvar-keymap gptel-tool-call-actions-map
+ :doc "Keymap for actions on tool calls."
+ "<mouse-1>" #'gptel--dispatch-tool-calls
+ "C-c C-c" #'gptel--accept-tool-calls
+ "C-c C-k" #'gptel--reject-tool-calls
+ "C-c C-i" #'gptel--inspect-tool-calls)
+
+(defun gptel--display-tool-calls (tool-calls info &optional use-minibuffer)
+ "Handle tool call confirmation.
+
+TOOL-CALLS should be a list of tool call specifications or results,
+structured as:
+
+ ((tool args callback) ...)
+
+for tool call specifications to be confirmed. INFO contains the
+state of the request. To prompt for tool call confirmation, use
+either an overlay in the request buffer or the minibuffer (if
+USE-MINIBUFFER is non-nil)."
+ (let* ((start-marker (plist-get info :position))
+ (tracking-marker (plist-get info :tracking-marker)))
+ ;; pending tool calls look like ((tool callback args) ...)
+ (with-current-buffer (marker-buffer start-marker)
+ (if (or use-minibuffer ;prompt for confirmation from the minibuffer
+ buffer-read-only ;TEMP(tool-preview) Handle read-only buffers better
+ (get-char-property
+ (max (point-min) (1- (or tracking-marker start-marker)))
+ 'read-only))
+ (let* ((minibuffer-allow-text-properties t)
+ (backend-name (gptel-backend-name (plist-get info :backend)))
+ (tool-call-names
+ (mapconcat (lambda (c) (propertize (gptel-tool-name (car c))
+ 'face 'font-lock-keyword-face))
+ tool-calls ", "))
+ (len (length tool-calls))
+ (prompt (format "%s wants to run %s tool %s (%s). "
+ backend-name len (if (> len 1) "calls" "call")
+ tool-call-names))
+ (choices '((?y "Run tools") (?n "Cancel (resumable)")
+ (?i "Inspect or edit")))
+ (choice (read-multiple-choice prompt choices)))
+ (pcase (car choice)
+ (?y (gptel--accept-tool-calls tool-calls))
+ (?n (gptel--reject-tool-calls))
+ (?i (gptel--inspect-tool-calls
+ ;; TODO Verify that the query buffer is the correct source to send
+ tool-calls (plist-get info :buffer)))))
+ ;; Prompt for confirmation from the response buffer
+ (let* ((backend-name (gptel-backend-name (plist-get info :backend)))
+ (actions-string
+ (concat (propertize "Run tools: " 'face 'font-lock-string-face)
+ (propertize "C-c C-c" 'face 'help-key-binding)
+ (propertize ", Cancel request: " 'face 'font-lock-string-face)
+ (propertize "C-c C-k" 'face 'help-key-binding)
+ (propertize ", Inspect or Edit: " 'face 'font-lock-string-face)
+ (propertize "C-c C-i" 'face 'help-key-binding)))
+ (confirm-strings)
+ ;; FIXME(tool) use a wrapper instead of a manual text-property search,
+ ;; this is fragile
+ (ov-start (save-excursion
+ (goto-char start-marker)
+ (text-property-search-backward 'gptel 'response)
+ (point)))
+ (preview-handlers)
+ (ov (or (cdr-safe (get-char-property-and-overlay
+ start-marker 'gptel-tool))
+ (make-overlay ov-start (or tracking-marker start-marker)
+ nil nil nil)))
+ (arg-values)
+ (prompt-ov))
+ ;; If the cursor is at the overlay-end, it ends up outside, so move it back
+ (unless tracking-marker
+ (when (= (point) start-marker) (ignore-errors (backward-char))))
+ (save-excursion
+ (goto-char (overlay-end ov))
+ (pcase-dolist (`(,tool-spec ,arg-plist _) tool-calls)
+ ;; Call tool-specific confirmation prompt
+ (setq arg-values (gptel--map-tool-args tool-spec arg-plist))
+ (if-let* ((funcs (cdr (assoc (gptel-tool-name tool-spec)
+ gptel--tool-preview-alist)))
+ ((functionp (car-safe funcs))))
+ ;;preview-teardown func preview-handle overlay/buffer
+ (push (list (cadr funcs) (funcall (car funcs) arg-values info))
+ preview-handlers)
+ (push (gptel--format-tool-call (gptel-tool-name tool-spec) arg-values)
+ confirm-strings)))
+ (and confirm-strings (apply #'insert (nreverse confirm-strings)))
+ (add-text-properties (overlay-end ov) (1- (point))
+ '(read-only t font-lock-fontified t))
+ (setq prompt-ov (make-overlay (overlay-end ov) (point) nil t))
+ (overlay-put
+ prompt-ov 'before-string
+ (concat
+ "\n"
+ (propertize " " 'display `(space :align-to (- right ,(length actions-string) 2))
+ 'face '(:inherit font-lock-string-face :underline t :extend t))
+ actions-string
+ (format (propertize "\n%s wants to run:\n\n"
+ 'face 'font-lock-string-face)
+ backend-name)))
+ (overlay-put
+ prompt-ov 'after-string
+ (concat (propertize "\n" 'face
+ '(:inherit font-lock-string-face :underline t :extend t))))
+ (overlay-put prompt-ov 'evaporate t)
+ (overlay-put ov 'prompt (cons prompt-ov (overlay-get ov 'prompt)))
+ (move-overlay ov ov-start (point)))
+ ;; Add confirmation prompt to the overlay
+ (when preview-handlers
+ (overlay-put ov 'previews
+ (nconc (overlay-get ov 'previews) preview-handlers)))
+ (overlay-put ov 'mouse-face 'highlight)
+ (overlay-put ov 'gptel-tool
+ (nconc (overlay-get ov 'gptel-tool) tool-calls))
+ (overlay-put ov 'help-echo
+ (concat "Tool call(s) requested: " actions-string))
+ (overlay-put ov 'keymap gptel-tool-call-actions-map)
+ prompt-ov)))))
+
+(defun gptel--display-tool-results (tool-results info)
+ "Insert TOOL-RESULTS into buffer.
+
+TOOL-RESULTS is
+
+ ((tool args result) ...)
+
+for tool call results. INFO contains the state of the request."
+ (let* ((start-marker (plist-get info :position))
+ (tool-marker (plist-get info :tool-marker))
+ (tracking-marker (plist-get info :tracking-marker)))
+ ;; Insert tool results
+ (with-current-buffer (marker-buffer start-marker)
+ (when gptel-include-tool-results
+ (cl-loop
+ for (tool args result) in tool-results
+ with include-names =
+ (mapcar #'gptel-tool-name
+ (cl-remove-if-not #'gptel-tool-include (plist-get info :tools)))
+ if (or (eq gptel-include-tool-results t)
+ (member (gptel-tool-name tool) include-names))
+ do (funcall
+ (plist-get info :callback)
+ (let* ((name (gptel-tool-name tool))
+ (separator ;Separate from response prefix if required
+ (cond ((not tracking-marker)
+ (and gptel-mode
+ (not (string-suffix-p
+ "\n" (gptel-response-prefix-string)))
+ "\n")) ;start of response
+ ((not tool-marker) gptel-response-separator)
+ ((and (not (= tracking-marker tool-marker))
+ (not (eq (char-before tracking-marker) ?\n)))
+ gptel-response-separator)))
+ (tool-use
+ ;; TODO(tool) also check args since there may be more than
+ ;; one call/result for the same tool
+ (cl-find-if
+ (lambda (tu) (equal (plist-get tu :name) name))
+ (plist-get info :tool-use)))
+ (id (plist-get tool-use :id))
+ (display-call (format "(%s %s)" name
+ (string-trim (prin1-to-string args) "(" ")")))
+ (call (prin1-to-string `(:name ,name :args ,args)))
+ (truncated-call
+ (string-replace "\n" " "
+ (truncate-string-to-width
+ display-call
+ (floor (* (window-width) 0.6)) 0 nil " ...)"))))
+ (if (derived-mode-p 'org-mode)
+ (concat
+ separator
+ "#+begin_tool "
+ truncated-call
+ (propertize
+ (org-escape-code-in-string (concat "\n" call "\n\n" result))
+ 'gptel `(tool . ,id))
+ "\n#+end_tool\n")
+ ;; TODO(tool) else branch is handling all front-ends as markdown.
+ ;; At least escape markdown.
+ (concat
+ separator
+ ;; TODO(tool) remove properties and strip instead of ignoring
+ (propertize (format "``` tool %s" truncated-call)
+ 'gptel 'ignore 'keymap gptel--markdown-block-map)
+ (propertize
+ ;; TODO(tool) escape markdown in result
+ (concat "\n" call "\n\n" result)
+ 'gptel `(tool . ,id))
+ ;; TODO(tool) remove properties and strip instead of ignoring
+ (propertize "\n```\n" 'gptel 'ignore
+ 'keymap gptel--markdown-block-map))))
+ info
+ 'raw)
+ ;; tool-result insertion has updated the tracking marker
+ (unless tracking-marker
+ (setq tracking-marker (plist-get info :tracking-marker)))
+ (if tool-marker
+ (move-marker tool-marker tracking-marker)
+ (setq tool-marker (copy-marker tracking-marker nil))
+ (plist-put info :tool-marker tool-marker))
+ (ignore-errors ;fold drawer
+ (save-excursion
+ (goto-char tracking-marker)
+ (forward-line -1)
+ (if (derived-mode-p 'org-mode)
+ (when (looking-at-p "^#\\+end_tool") (org-cycle))
+ (when (looking-at-p "^```") (gptel-markdown-cycle-block))))))))))
+
+(defun gptel--format-tool-call (name arg-values)
+ "Format a tool call for display in the buffer.
+
+NAME and ARG-VALUES are the name and arguments for the call."
+ (format "(%s %s)\n"
+ (propertize name 'font-lock-face 'font-lock-keyword-face)
+ (propertize
+ (mapconcat (lambda (arg)
+ (cond ((stringp arg)
+ (prin1-to-string
+ (replace-regexp-in-string
+ "\n" "⮐" (truncate-string-to-width
+ arg (floor (window-width) 2)
+ nil nil t))))
+ (t (prin1-to-string arg))))
+ arg-values " ")
+ 'font-lock-face 'font-lock-constant-face)))
+
+(defun gptel--accept-tool-calls (&optional tool-calls ov)
+ "Run pending tool-calls.
+
+TOOL-CALLS is the edited tool call list, OV is the tool call dispatch
+overlay in the query buffer."
+ (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay
+ (point) 'gptel-tool)))
+ (list resp o)))
+ (when (overlayp ov) ;Update UI indicator
+ (with-current-buffer (overlay-buffer ov)
+ (when gptel-mode
+ (let ((names (cl-loop for call in tool-calls
+ collect (gptel-tool-name (car call)))))
+ (gptel--update-status
+ (concat
+ (propertize
+ (if (length> names 1) " Calling tools (" " Calling tool (")
+ 'face 'mode-line-emphasis)
+ (mapconcat (lambda (name) (propertize name 'face 'font-lock-keyword-face))
+ names (propertize ", " 'face 'mode-line-emphasis))
+ (propertize ")" 'face 'mode-line-emphasis)))))))
+ ;; Clear the overlays first, because we need the buffer to be cleaned up
+ ;; before inserting synchronous tool results.
+ (when (and (overlayp ov) (overlay-buffer ov))
+ (with-current-buffer (overlay-buffer ov)
+ (when-let* ((preview-handles (overlay-get ov 'previews)))
+ (dolist (func-to-handle preview-handles)
+ (when (car func-to-handle) (apply func-to-handle))))
+ (dolist (prompt-ov (overlay-get ov 'prompt))
+ (when-let* (((overlay-buffer prompt-ov))
+ (inhibit-read-only t))
+ (delete-region (overlay-start prompt-ov)
+ (overlay-end prompt-ov)))))
+ (delete-overlay ov))
+ (message "Continuing query...")
+ (cl-loop for (tool-spec arg-plist process-tool-result) in tool-calls
+ for arg-values = (gptel--map-tool-args tool-spec arg-plist)
+ do
+ (if (gptel-tool-async tool-spec)
+ (apply (gptel-tool-function tool-spec)
+ process-tool-result arg-values)
+ (let ((result
+ (condition-case errdata
+ (apply (gptel-tool-function tool-spec) arg-values)
+ (error (mapconcat #'gptel--to-string errdata " ")))))
+ (funcall process-tool-result result)))))
+
+(defun gptel--reject-tool-calls (&optional _tool-calls ov)
+ "Cancel pending tool-calls.
+
+OV is the tool call dispatch overlay."
+ (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay
+ (point) 'gptel-tool)))
+ (list resp o)))
+ (gptel--update-status " Tools cancelled" 'error)
+ (message (substitute-command-keys
+ "Tool calls canceled. \\[gptel-menu] to continue them!"))
+ (when (and (overlayp ov) (overlay-buffer ov))
+ (with-current-buffer (overlay-buffer ov)
+ (when-let* ((preview-handles (overlay-get ov 'previews)))
+ (dolist (func-to-handle preview-handles)
+ (when (car func-to-handle) (apply func-to-handle))))
+ (dolist (prompt-ov (overlay-get ov 'prompt))
+ (when-let* (((overlay-buffer prompt-ov))
+ (inhibit-read-only t))
+ (delete-region (overlay-start prompt-ov)
+ (overlay-end prompt-ov)))))
+ (delete-overlay ov)))
+
+(defun gptel--dispatch-tool-calls (choice)
+ "Dispatch on tool-calls with CHOICE."
+ (interactive
+ (list
+ (let ((choices '((?y "yes") (?n "do nothing")
+ (?k "cancel request") (?i "inspect call(s)"))))
+ (read-multiple-choice "Run tool calls? " choices))))
+ (pcase (car choice)
+ (?y (call-interactively #'gptel--accept-tool-calls))
+ (?k (call-interactively #'gptel--reject-tool-calls))
+ (?i (call-interactively #'gptel--inspect-tool-calls))))
+
+;;;; Tool call inspection UI
+(defvar-keymap gptel-tool-call-inspection-map
+ :doc "Actions in the gptel tool inspection buffer."
+ "C-c C-c" #'gptel--inspect-accept-tool-calls
+ "C-c C-k" #'gptel--inspect-reject-tool-calls
+ "C-c C-i" #'gptel--inspect-quit-tool-calls)
+
+(defun gptel--inspect-accept-tool-calls (&optional _)
+ "Run possibly edited tool-calls read from the tool call inspection buffer."
+ (interactive)
+ (let ((call) (index)
+ (read-error
+ (lambda () (user-error
+ "Cannot read modified arguments, please check modifications")))
+ (apply-error
+ (lambda () (message "Cannot apply argument modifications. \
+This is a bug, please report it!"))))
+ (unless (gptel-fsm-p gptel--fsm-last) (funcall apply-error))
+ (cond
+ ((buffer-modified-p)
+ (let* ((info (gptel-fsm-info gptel--fsm-last))
+ (backend (plist-get info :backend))
+ (tool-use (plist-get info :tool-use))
+ (tool-spec-args-cb) (name)
+ (tool-calls))
+ (dolist (o (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-overlay))
+ (overlays-in (point-min) (point-max))))
+ (goto-char (overlay-start o))
+ (condition-case nil
+ (save-restriction
+ (narrow-to-region (point) (overlay-end o))
+ (skip-chars-forward "\n\r\ ")
+ (unless (eobp)
+ (setq call (read (current-buffer))
+ name (plist-get call :name))))
+ (error (funcall read-error)))
+ (unless (integerp (setq index (overlay-get o 'gptel-overlay)))
+ (funcall read-error))
+ ;; Merge with or remove from messages array...
+ (gptel--inject-tool-call
+ backend (plist-get info :data) (nth index tool-use) call)
+ (if (not call)
+ ;; Remove from tool-use
+ (plist-put info :tool-use
+ (append (cl-subseq tool-use 0 index)
+ (cl-subseq tool-use (1+ index))))
+ ;; ...before modifying the tool use block
+ (gptel--merge-plists (nth index tool-use) call)
+ (setq tool-spec-args-cb (overlay-get o 'gptel-tool))
+ ;; and modifying the arguments sent to the callback
+ (setf (nth 0 tool-spec-args-cb)
+ (or (cl-find name (plist-get info :tools)
+ :key #'gptel-tool-name :test #'string=)
+ (gptel-get-tool name)))
+ (setf (nth 1 tool-spec-args-cb) (plist-get call :args))
+ (push tool-spec-args-cb tool-calls)))
+ (gptel--accept-tool-calls ;include overlay to clean up if there is one
+ tool-calls (cadr (plist-get info :tool-display)))))
+ (t (let* ((tool-display (plist-get (gptel-fsm-info gptel--fsm-last)
+ :tool-display)))
+ (apply #'gptel--accept-tool-calls tool-display)))))
+ (quit-window t))
+
+(defun gptel--inspect-reject-tool-calls (&optional _)
+ "Cancel tool-calls and return to query buffer."
+ (interactive)
+ (quit-window t)
+ (apply #'gptel--reject-tool-calls
+ (thread-first (gptel-fsm-info gptel--fsm-last)
+ (plist-get :tool-display))))
+
+(defun gptel--inspect-quit-tool-calls (&optional _)
+ "Quit inspection window and return to query buffer."
+ (interactive)
+ (quit-window t))
+
+(defalias 'gptel--inspect-tool-post-command
+ (let ((highlight-ov))
+ (lambda ()
+ (unless (memq highlight-ov (overlays-at (point)))
+ (let ((context-ov
+ (cl-loop for ov in (overlays-at (point))
+ thereis (and (overlay-get ov 'gptel-overlay) ov)))
+ (line (propertize "\n" 'font-lock-face
+ '(:inherit separator-line :extend t))))
+ (when highlight-ov
+ (overlay-put highlight-ov 'face nil)
+ (overlay-put highlight-ov 'before-string nil)
+ (overlay-put highlight-ov 'after-string nil))
+ (when context-ov
+ (overlay-put context-ov 'face 'gptel-response-highlight)
+ (overlay-put context-ov 'before-string line)
+ (overlay-put context-ov 'after-string (concat "\n" line)))
+ (setq highlight-ov context-ov)))))
+ "Highlight tool call under cursor in gptel tool call inspection buffers.")
+
+(defun gptel--inspect-tool-calls (&optional tool-calls loc)
+ "Set up and switch to a buffer to inspect pending tool-calls.
+
+TOOL-CALLS is the alist of tool calls. LOC is the source of the query;
+either the query buffer or the tool call dispatch overlay in the query
+buffer. If it is an overlay, it will be cleaned up when dispatching on
+TOOL-CALLS."
+ (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay
+ (point) 'gptel-tool)))
+ (list resp o)))
+ (with-current-buffer (get-buffer-create "*gptel-tool-calls*")
+ (let ((inhibit-read-only t) tool-use
+ (tool-overlay (and (overlayp loc) loc)))
+ (remove-overlays)
+ (erase-buffer)
+ (unless (derived-mode-p 'lisp-data-mode)
+ (lisp-data-mode)
+ (add-hook 'post-command-hook #'gptel--inspect-tool-post-command nil t))
+ ;; NOTE: This needs to be called after setting the major mode, as
+ ;; buffer-local variables are wiped out.
+ (setq gptel--fsm-last
+ (buffer-local-value 'gptel--fsm-last
+ (if tool-overlay (overlay-buffer loc) loc))
+ tool-use (plist-get (gptel-fsm-info gptel--fsm-last) :tool-use))
+ ;; For access from the dispatch functions, add tool-calls and the location
+ ;; (if it's an overlay) to INFO. Overlays will be cleaned up.
+ (plist-put (gptel-fsm-info gptel--fsm-last)
+ :tool-display (list tool-calls tool-overlay))
+ (insert ";; Inspect or edit tool calls.
+;; Adding or deleting tool calls is not supported.\n\n")
+ (cl-loop for tool-spec-args-cb in tool-calls
+ for (tool-spec arg-plist _process-tool-result) = tool-spec-args-cb
+ with o
+ for name = (gptel-tool-name tool-spec)
+ for pt = (point)
+ for index =
+ (cl-position-if
+ (lambda (call) (and (not (plist-get call :result))
+ (string= (plist-get call :name) name)
+ (null (cl-set-difference
+ (plist-get call :args) arg-plist
+ :test #'equal))))
+ tool-use)
+ do (prin1 (list :name name :args arg-plist)
+ (current-buffer) '((length . nil) (level . nil)))
+ (insert "\n\n") ;Avoid extending the overlay
+ (setq o (make-overlay pt (- (point) 2) nil nil t))
+ (overlay-put o 'gptel-tool tool-spec-args-cb)
+ (overlay-put o 'gptel-overlay index))
+ (goto-char (point-min)) (forward-line 3))
+ (use-local-map
+ (make-composed-keymap
+ gptel-tool-call-inspection-map (current-local-map)))
+ (unless header-line-format
+ (setq header-line-format
+ (substitute-command-keys
+ (concat
+ (propertize "Tool calls" 'face 'font-lock-string-face) ": "
+ (buttonize "Confirm" #'gptel--inspect-accept-tool-calls)
+ " \\[gptel--inspect-accept-tool-calls], "
+ (buttonize "Cancel" #'gptel--inspect-reject-tool-calls)
+ " \\[gptel--inspect-reject-tool-calls], "
+ (buttonize "Return" #'gptel--inspect-quit-tool-calls)
+ " \\[gptel--inspect-quit-tool-calls], "
+ (buttonize "Edit" (lambda (_) (read-only-mode 'toggle)))
+ " \\[read-only-mode]"))))
+ (set-buffer-modified-p nil)
+ (read-only-mode)
+ (gptel--inspect-tool-post-command)
+ (display-buffer (current-buffer) gptel-display-buffer-action)))
+
+\f
+;;; Presets
+;;;; Presets implementation
+(defvar gptel--known-presets
+ '((gptel-default
+ :description "Use gptel's default configuration."
+ :context nil :use-context system
+ :tools nil :use-tools t
+ :temperature nil :max-tokens nil
+ :num-messages-to-send nil
+ :request-params nil
+ :org-convert-response t
+ :track-media nil
+ :track-response t
+ :system nil
+ :stream t
+ :cache nil))
+ "Alist of presets for gptel.
+
+Each entry maps a preset name (a symbol) to a plist of
+specifications (see `gptel-make-preset').")
+
+(defun gptel-make-preset (name &rest keys)
+ "Define a gptel preset with NAME.
+
+A preset is a combination of gptel options intended to be applied and
+used together. Presets can make it less tedious to change gptel
+settings on the fly.
+
+Typically this will include a model, backend, system message and perhaps
+some tools, but any set of gptel options can be set this way.
+
+NAME must be a symbol. KEYS is a plist corresponding to the options
+being set. All KEYS are optional.
+
+Recognized keys:
+
+DESCRIPTION is a description of the preset, used when selecting a
+preset.
+
+PARENTS is a preset name (or list of preset names) to apply before this
+one.
+
+PRE and POST are functions to run before and after the preset is
+applied. They take no arguments.
+
+BACKEND is the `gptel-backend' to set, or its name (like \"ChatGPT\").
+
+MODEL is the `gptel-model', a symbol.
+
+SYSTEM is the directive. It can be
+- the system message (a string),
+- a list of strings (a conversation template)
+- or a function (dynamic system message).
+- It can also be a symbol naming a directive in `gptel-directives'.
+
+TOOLS is a list of gptel tools or tool names, like
+\\='(\"read_url\" \"read_buffer\" ...)
+
+Recognized keys are not limited to the above. Any other key (like
+`:foo') corresponds to the value of either `gptel-foo' (preferred) or
+`gptel--foo'.
+- So TOOLS corresponds to option `gptel-tools',
+- CONFIRM-TOOL-CALLS to `gptel-confirm-tool-calls',
+- TEMPERATURE to `gptel-temperature' and so on.
+See gptel's customization options for all available settings.
+
+Specifying the value of a key will set the corresponding gptel option to
+it. For example,
+
+ (gptel-make-preset \\='websearch
+ :tools \\='(\"search_web\" \"read_url\")
+ :system \"Use the provided tools to search the web
+ for up-to-date information\")
+
+will replace the currently active option `gptel-tools' and the system
+message.
+
+Alternatively,
+
+- You can require that the value be appended or prepended to the
+ existing value instead of replacing it. This can be done by
+ specifying the value as a plist instead with the keys `:prepend' or
+ `:append'.
+
+ (gptel-make-preset \\='websearch
+ :tools \\='(:append (\"search_web\" \"read_url\"))
+ :system \\='(:prepend \"Use the provided tools to search the web
+ for up-to-date information.\"))
+
+- You can dynamically compute the value for a key at the time the preset
+ is applied with `:eval' or `:function'. This is mostly useful when
+ using presets in the prompt, as @preset-name.
+
+ An `:eval' form is evaluated when the preset is applied:
+
+ (gptel-make-preset \\='visible-buffers
+ :description \"Include the full text of all buffers visible in the
+ frame.\"
+ :context \\='(:eval (mapcar #\\='window-buffer (window-list))))
+ ▲ ▲
+ │ ╰╴evaluated when preset is applied
+ ╰╴sets `gptel-context'
+
+ `:function' should take the current value of the key as an input and
+ return the new value. Here we combine it with `:append' in the plist.
+
+ (gptel-make-preset \\='github-read-only
+ :description \"Provide read-only GitHub tools\"
+ :pre (lambda () (gptel-mcp-connect \\='(\"github\") \\='sync))
+ :tools
+ \\='( :append (\"mcp-github\") ;Adds all github MCP tools
+ :function (lambda (tools)
+ (cl-delete-if ;Remove \"write\" access to GitHub
+ (lambda (tool)
+ (string-match-p \"create_\" (gptel-tool-name tool)))
+ tools))))
+
+ NOTE: `:eval' and `:function' are evaluated in a temporary buffer, and
+ not the buffer from which the request is sent."
+ (declare (indent 1))
+ (if-let* ((p (assoc name gptel--known-presets)))
+ (setcdr p keys)
+ (setq gptel--known-presets ;Add at end of presets for menu ordering
+ (nconc gptel--known-presets (list (cons name keys))))))
+
+(defun gptel-get-preset (name)
+ "Get the gptel preset spec with NAME."
+ (alist-get name gptel--known-presets nil nil #'equal))
+
+(defun gptel--save-preset (name &optional description)
+ "Save gptel's current settings as a preset with NAME.
+
+NAME must be a symbol. DESCRIPTION is added if provided. In addition
+to registering the preset, elisp code to do the same is copied to the
+`kill-ring'."
+ (interactive
+ (list (intern (completing-read "Save gptel settings to (existing or new) preset: "
+ gptel--known-presets))
+ (read-string "Description (optional): ")))
+ (let ((preset-code
+ `(gptel-make-preset ',name
+ :description ,(when (and description
+ (not (string-blank-p description)))
+ description)
+ :backend ,(gptel-backend-name gptel-backend)
+ :model ',gptel-model
+ :system ,(if-let* ((directive (car-safe (rassoc gptel--system-message
+ gptel-directives))))
+ `',directive
+ gptel--system-message)
+ :tools ',(mapcar #'gptel-tool-name gptel-tools)
+ :stream ,gptel-stream
+ :temperature ,gptel-temperature
+ :max-tokens ,gptel-max-tokens
+ :use-context ',gptel-use-context
+ :track-media ,gptel-track-media
+ :include-reasoning ,(let ((reasoning gptel-include-reasoning))
+ (if (eq reasoning 'ignore)
+ ''ignore reasoning)))))
+ (kill-new (pp-to-string preset-code))
+ (eval preset-code)
+ (message "Preset %s saved. (Lisp expression for preset saved to kill-ring)"
+ (propertize (symbol-name name) 'face 'highlight))))
+
+(defvar gptel--rewrite-directive)
+(defun gptel--apply-preset (preset &optional setter)
+ "Apply gptel PRESET with SETTER.
+
+PRESET is the name of a preset, or a spec (plist) of the form
+ (:KEY1 VAL1 :KEY2 VAL2 ...).
+
+SETTER is the function used to set the gptel options. It must accept
+two arguments, the symbol being set and the value to set it to. It
+defaults to `set', and can be set to a different function to (for
+example) apply the preset buffer-locally."
+ (unless setter (setq setter #'set))
+ (cl-flet ((preset-spec (preset)
+ (if (memq (type-of preset) '(symbol string))
+ (or (gptel-get-preset preset)
+ (user-error "gptel preset \"%s\": Cannot find preset"
+ preset))
+ preset)))
+ ;; Record preset name for persistence and UI display
+ (when (memq (type-of preset) '(string symbol))
+ (funcall setter 'gptel--preset preset))
+ ;; Ensure that preset is a plist spec
+ (setq preset (preset-spec preset))
+ (when-let* ((func (plist-get preset :pre))) (funcall func))
+ (when-let* ((parents (plist-get preset :parents)))
+ (mapc (lambda (parent) (gptel--apply-preset (preset-spec parent) setter))
+ (ensure-list parents))))
+ (map-do
+ (lambda (key val)
+ (pcase key
+ ((or :parents :description :pre :post) nil)
+ ((or :system :system-message :rewrite-directive)
+ (let ((sym (if (eq key :rewrite-directive)
+ 'gptel--rewrite-directive 'gptel--system-message)))
+ (when (consp val)
+ ;; Possibly complain about trying to compose a system message string
+ ;; with a non-string
+ ;; TODO(modify-list): Catch other incompatible combinations
+ (and (or (plist-member val :append) (plist-member val :prepend))
+ (not (stringp (symbol-value sym)))
+ (user-error "Composing non-string system messages is not implemented"))
+ (setq val (gptel--modify-value (symbol-value sym) val)))
+ (if (and (symbolp val) (not (functionp val)))
+ (if-let* ((directive (alist-get val gptel-directives)))
+ (funcall setter sym directive)
+ (user-error "gptel preset: Cannot find directive %s" val))
+ (funcall setter sym val))))
+ (:backend
+ (when (consp val) (setq val (gptel--modify-value 'gptel-backend val)))
+ (setq val (cl-etypecase val
+ (gptel-backend val)
+ (string (gptel-get-backend val))))
+ (unless val
+ (user-error "gptel preset: Cannot find backend %s" val))
+ (funcall setter 'gptel-backend val))
+ (:tools ;TEMP Confirm this `:append' convention
+ (setq val (gptel--modify-value gptel-tools val))
+ (let* ((tools
+ (flatten-list
+ (cl-loop for tool-name in (ensure-list val)
+ for tool = (cl-etypecase tool-name
+ (gptel-tool tool-name)
+ (string (ignore-errors
+ (gptel-get-tool tool-name))))
+ do (unless tool
+ (user-error "gptel preset: Cannot find tool %S"
+ tool-name))
+ collect tool))))
+ (funcall setter 'gptel-tools (cl-delete-duplicates tools :test #'eq))))
+ ((and (let sym (or (intern-soft
+ (concat "gptel-" (substring (symbol-name key) 1)))
+ (intern-soft
+ (concat "gptel--" (substring (symbol-name key) 1)))))
+ (guard (and sym (boundp sym))))
+ (funcall setter sym (if (consp val)
+ (gptel--modify-value (symbol-value sym) val)
+ val)))
+ (_ (display-warning
+ '(gptel presets)
+ (format "gptel preset: setting for %s not found, ignoring." key)))))
+ preset)
+ (when-let* ((func (plist-get preset :post))) (funcall func)))
+
+(defun gptel--preset-syms (preset)
+ "Return a list of gptel variables (symbols) set by PRESET.
+
+PRESET is the name of a preset, or a spec (plist) of the form
+ (:KEY1 VAL1 :KEY2 VAL2 ...)."
+ (when (memq (type-of preset) '(string symbol))
+ (let ((spec (or (gptel-get-preset preset)
+ (user-error "gptel preset \"%s\": Cannot find preset"
+ preset))))
+ (setq preset spec)))
+ (let* ((index preset)
+ syms key val)
+ (while index
+ (setq key (pop index) val (pop index))
+ (pcase key
+ ((or :description :pre :post))
+ (:parents
+ (setq syms
+ (nconc syms (mapcan #'gptel--preset-syms (ensure-list val)))))
+ (:system (push 'gptel--system-message syms))
+ (_ (if-let* ((var (or (intern-soft
+ (concat "gptel-" (substring (symbol-name key) 1)))
+ (intern-soft
+ (concat "gptel--" (substring (symbol-name key) 1))))))
+ (push var syms)
+ (display-warning
+ '(gptel presets)
+ (format "gptel preset \"%s\": setting for %s not found, ignoring."
+ (car preset) key))))))
+ (cl-delete-duplicates syms)))
+
+;; This is identical to `cl-progv', only we let-bind symbols SYM from the preset
+;; to their current values instead of evaluating the values explicitly. (#1005)
+(defmacro gptel-with-preset (name &rest body)
+ "Run BODY with gptel preset NAME applied.
+
+This macro can be used to create `gptel-request' command with settings
+from a gptel preset applied.
+
+NAME is the name of a preset, or a spec (plist) of the form
+ (:KEY1 VAL1 :KEY2 VAL2 ...). It must be quoted."
+ (declare (indent 1))
+ (let ((syms (make-symbol "syms"))
+ (binds (make-symbol "binds"))
+ (bodyfun (make-symbol "body")))
+ ;; Let-bind symbols that we want to modify with the presets. Also include
+ ;; `gptel--preset' in this list as we don't want to change its value outside
+ ;; of this macro's scope.
+ `(let* ((,syms (cons 'gptel--preset (gptel--preset-syms ,name)))
+ (,bodyfun (lambda () (gptel--apply-preset ,name) ,@body))
+ (,binds nil))
+ (while ,syms (push (list (car ,syms) (pop ,syms)) ,binds))
+ (eval (list 'let (nreverse ,binds) (list 'funcall (list 'quote ,bodyfun)))))))
+
+(defun gptel--preset-mismatch-value (preset-spec key val)
+ "Determine if the value of KEY in PRESET-SPEC matches VAL.
+
+This is an imperfect check for whether the value corresponding to KEY (a
+keyword) in PRESET-SPEC (a plist) matches VAL. This is required
+primarily to identify which gptel variable values have changed since
+PRESET-SPEC was applied, which is relevant when writing gptel metadata
+to a chat file.
+
+See also `gptel--preset-mismatch-p'."
+ ;; In all cases, assume a mismatch if the preset's value for KEY is a
+ ;; modify-list spec, such as (:append ...)
+ ;; Mismatches may not even be well-defined/determinable in these cases.
+ (or (not preset-spec)
+ (pcase key
+ ;; special cases
+ ((or :system :system-message)
+ (let ((system (plist-get preset-spec :system)))
+ (or (and (stringp system) (not (equal system val)))
+ (functionp system)
+ (and (consp system) (keywordp (car system)))
+ (and (consp system)
+ (not (equal (car-safe (gptel--parse-directive system))
+ val))))))
+ (:backend
+ (let ((backend (plist-get preset-spec :backend)))
+ (or (and (consp backend) (keywordp (car-safe backend)))
+ (not (equal (or (and (gptel-backend-p val) (gptel-backend-name val))
+ val)
+ (or (and (gptel-backend-p backend) (gptel-backend-name backend))
+ backend))))))
+ ;; FIXME: We're assuming that val is a list of tool names, not tools
+ (:tools
+ (and-let* ((preset-tools (plist-get preset-spec :tools)))
+ (or (keywordp (car-safe preset-tools))
+ (cl-loop
+ for tool in preset-tools
+ for tool-name =
+ (or (and (stringp tool) tool)
+ (ignore-errors (gptel-tool-name tool)))
+ if (not (member tool-name uniq-tool-names))
+ collect tool-name into uniq-tool-names
+ finally return
+ (not (equal (sort uniq-tool-names #'string-lessp)
+ (sort (copy-sequence (ensure-list val)) #'string-lessp)))))))
+ ;; Generic case
+ (_ (let ((field-val (plist-get preset-spec key)))
+ (or (and (consp field-val) (keywordp (car field-val)))
+ (not (equal field-val val))))))))
+
+;;;; Presets in-buffer UI
+(defun gptel--transform-apply-preset (_fsm)
+ "Apply a gptel preset to the buffer depending on the prompt.
+
+If the last user prompt includes @foo, the preset foo is applied.
+Before applying the preset, \"@foo\" is removed from the prompt and
+point is placed at its position."
+ (when gptel--known-presets
+ (text-property-search-backward 'gptel nil t)
+ (while (re-search-forward "@\\([^[:space:]]+\\)\\_>" nil t)
+ ;; The following convoluted check is because re-search is much faster if
+ ;; the search pattern begins with a non-whitespace char.
+ (when (or (= (match-beginning 0) (point-min))
+ (memq (char-syntax (char-before (match-beginning 0))) '(32 62)))
+ (when-let* ((name (match-string 1))
+ (preset (or (gptel-get-preset (intern-soft name))
+ (gptel-get-preset name))))
+ (delete-region (match-beginning 0) (match-end 0))
+ ;; Point must be after @foo when the preset is applied to allow for
+ ;; more advanced transformations.
+ (gptel--apply-preset preset
+ (lambda (sym val)
+ (set (make-local-variable sym) val))))))))
+
+;; ;; Alternative approach with string search
+;; (search-forward "@" nil t)
+;; (if (and (memq (char-syntax (char-before (1- (point)))) '(32 62))
+;; (looking-at "\\([^[:blank:]]+?\\)[[:punct:]]?\\s-+"))
+;; do-stuff)
+
+(defun gptel--fontify-preset-keyword (end)
+ "Font-lock function for preset indicators in chat buffers.
+
+Return preset fontification info for text up to END."
+ (and (re-search-forward "@\\([^[:space:]]+\\)\\_>" end t)
+ (or (= (match-beginning 0) (point-min))
+ (memq (char-syntax (char-before (match-beginning 0))) '(32 62)))
+ (not (plist-get (text-properties-at (match-beginning 1)) 'gptel))))
+
+(defun gptel-preset-capf ()
+ "Completion at point for gptel presets in `gptel-mode'.
+
+Add this to `completion-at-point-functions'."
+ (and gptel--known-presets
+ (save-excursion
+ (let ((num (- (skip-syntax-backward "w_"))))
+ (when (eql (char-before) ?@)
+ (list (point) (+ (point) num)
+ gptel--known-presets
+ :exclusive 'no
+ :annotation-function
+ #'(lambda (c) (thread-first
+ (intern-soft c)
+ (assq gptel--known-presets) (cdr)
+ (plist-get :description)))))))))
+
+(defun gptel--prettify-preset ()
+ "Get visual and completion help with presets in gptel buffers.
+
+Intended to be added to `gptel-mode-hook'."
+ (let ((keyword '((gptel--fontify-preset-keyword
+ ;; subexp 0 here is not required, we retain it to make it
+ ;; easy to swtich to more complex patterns in the future
+ 0 (when-let* ((comps (all-completions (match-string 1)
+ gptel--known-presets))
+ ((member (match-string 1) comps)))
+ '(:box -1 :inherit secondary-selection))
+ prepend))))
+ (cond
+ (gptel-mode
+ (font-lock-add-keywords nil keyword t)
+ (add-hook 'completion-at-point-functions #'gptel-preset-capf nil t))
+ (t (font-lock-remove-keywords nil keyword)
+ (remove-hook 'completion-at-point-functions #'gptel-preset-capf t)))))
+
+\f
+;;; Response tweaking commands
+
+(defun gptel--attach-response-history (history &optional buf)
+ "Attach HISTORY to the next gptel response in buffer BUF.
+
+HISTORY is a list of strings typically containing text replaced
+by gptel. BUF is the current buffer if not specified.
+
+This is used to maintain variants of prompts or responses to diff
+against if required."
+ (with-current-buffer (or buf (current-buffer))
+ (letrec ((gptel--attach-after
+ (lambda (b e)
+ (when (and b e)
+ (add-text-properties
+ b e `(gptel-history
+ ,(append (ensure-list history)
+ (get-char-property (1- e) 'gptel-history))
+ front-sticky (gptel gptel-history))))
+ (remove-hook 'gptel-post-response-functions
+ gptel--attach-after 'local))))
+ (add-hook 'gptel-post-response-functions gptel--attach-after
+ nil 'local))))
+
+(defun gptel--ediff (&optional arg bounds-func)
+ "Ediff response at point against previous gptel responses.
+
+If prefix ARG is non-nil, select the previous response to ediff
+against interactively.
+
+If specified, use BOUNDS-FUNC to compute the bounds of the
+response at point. This can be used to include additional
+context for the ediff session."
+ (interactive "P")
+ (when (gptel--at-response-history-p)
+ (pcase-let* ((`(,beg . ,end) (funcall (or bounds-func #'gptel--get-response-bounds)))
+ (prev-response
+ (if arg
+ (completing-read "Choose response variant to diff against: "
+ (get-char-property (point) 'gptel-history)
+ nil t)
+ (car-safe (get-char-property (point) 'gptel-history))))
+ (buffer-mode major-mode)
+ (bufname (buffer-name))
+ (`(,new-buf ,new-beg ,new-end)
+ (with-current-buffer
+ (get-buffer-create (concat bufname "-PREVIOUS-*"))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (delay-mode-hooks (funcall buffer-mode))
+ (visual-line-mode)
+ (insert prev-response)
+ (goto-char (point-min))
+ (list (current-buffer) (point-min) (point-max))))))
+ (unless prev-response (user-error "gptel response is additive: no changes to ediff"))
+ (require 'ediff)
+ (letrec ((cwc (current-window-configuration))
+ (gptel--ediff-restore
+ (lambda ()
+ (when (window-configuration-p cwc)
+ (set-window-configuration cwc))
+ (kill-buffer (get-buffer (concat bufname "-PREVIOUS-*")))
+ (kill-buffer (get-buffer (concat bufname "-CURRENT-*")))
+ (remove-hook 'ediff-quit-hook gptel--ediff-restore))))
+ (add-hook 'ediff-quit-hook gptel--ediff-restore)
+ (apply
+ #'ediff-regions-internal
+ (get-buffer (ediff-make-cloned-buffer (current-buffer) "-CURRENT-*"))
+ beg end new-buf new-beg new-end
+ nil
+ (list 'ediff-regions-wordwise 'word-wise nil)
+ ;; (if (transient-arg-value "-w" args)
+ ;; (list 'ediff-regions-wordwise 'word-wise nil)
+ ;; (list 'ediff-regions-linewise nil nil))
+ )))))
+
+(defun gptel--mark-response ()
+ "Mark gptel response at point, if any."
+ (interactive)
+ (unless (gptel--in-response-p) (user-error "No gptel response at point"))
+ (pcase-let ((`(,beg . ,end) (gptel--get-response-bounds)))
+ (goto-char beg) (push-mark) (goto-char end) (activate-mark)))
+
+(defun gptel--previous-variant (&optional arg)
+ "Switch to ARG previous gptel-response at this point, if it exists."
+ (interactive "p")
+ (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds))
+ (history (get-char-property (point) 'gptel-history))
+ (alt-response (car-safe history))
+ (offset))
+ (unless (and history alt-response)
+ (user-error "No variant responses available"))
+ (if (> arg 0)
+ (setq history (append (cdr history)
+ (list (buffer-substring-no-properties beg end))))
+ (setq
+ alt-response (car (last history))
+ history (cons (buffer-substring-no-properties beg end)
+ (nbutlast history))))
+ (add-text-properties
+ 0 (length alt-response)
+ `(gptel response gptel-history ,history)
+ alt-response)
+ (setq offset (min (- (point) beg) (1- (length alt-response))))
+ (delete-region beg end)
+ (insert alt-response)
+ (goto-char (+ beg offset))
+ (pulse-momentary-highlight-region beg (+ beg (length alt-response)))))
+
+(defun gptel--next-variant (&optional arg)
+ "Switch to ARG next gptel-response at this point, if it exists."
+ (interactive "p")
+ (gptel--previous-variant (- arg)))
+
+(provide 'gptel)
+;;; gptel.el ends here
+
+;; Local Variables:
+;; bug-reference-url-format: "https://github.com/karthink/gptel/issues/%s"
+;; End:
projects / emacsconfig.git / commitdiff