(lsp-define-stdio-client lsp-sql "sql"
(lsp-make-traverser #'(lambda (dir) (directory-files dir nil "sss.sql"))) '("~/.vscode/extensions/ms-mssql.mssql-1.4.0/sqltoolsservice/1.4.0/Ubuntu16/MicrosoftSqlToolsServiceLayer"))
#+end_src
+* gptel
+[2026-01-29 Thu 10:14]
+
+#+begin_src emacs-lisp
+ (if (file-exists-p "/usr/local/bin/ollama")
+ (progn (require 'gptel)
+ (gptel-make-ollama "Ollama" ;Any name of your choosing
+ :host "localhost:11434" ;Where it's running
+ :stream t ;Stream responses
+ :models '(gpt-oss:20b))
+ (setq
+ gptel-model 'gpt-oss:20b
+ gptel-backend (gptel-make-ollama "Ollama"
+ :host "localhost:11434"
+ :stream t
+ :models '(gpt-oss:20b))
+ gptel-expert-commands t)
+ (define-key global-map (kbd "C-c <return>") 'gptel-send)))
+#+end_src
+
* sql
[2016-11-27 Sun 17:56]
--- /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 \" key)))))) (HOST \"api.x.ai\") (PROTOCOL \"https\") (ENDPOINT&nbsi 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:
projects / emacsconfig.git / commitdiff