;;; gptel-request.el --- LLM request library for gptel -*- lexical-binding: t; -*- ;; Copyright (C) 2023-2026 Karthik Chikmagalur ;; Author: Karthik Chikmagalur;; ;; 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 . ;;; Commentary: ;; LLM querying library used by gptel. This file provides the basic data ;; structures (models, backends) and prompt construction functions used by ;; gptel, along with the `gptel-request' API. ;; ;; This is everything required to use `gptel-request' to write custom commands, ;; UIs or packages that use gptel to implement custom workflows. To use gptel's ;; LLM querying API, you can ;; ;; (require 'gptel-request) ;; ;; and make calls to `gptel-request'. ;; ;; Note that this file does not provide any of the UI components used by gptel ;; (chat buffers, tool use prompts, transient menus), nor does it provide the ;; default response callbacks used by `gptel-request'. You will need to provide ;; your own callback to `gptel-request' to act on the LLM response, or require ;; the larger `gptel' feature. ;;; Code: (eval-when-compile (require 'subr-x)) (require 'compat nil t) (require 'cl-lib) (require 'url) (require 'text-property-search) (require 'cl-generic) (require 'map) (require 'mailcap) ;FIXME Avoid this somehow (declare-function json-read "json" ()) (defvar json-object-type) (declare-function gptel--stream-convert-markdown->org "gptel-org") (declare-function gptel--convert-markdown->org "gptel-org") (declare-function gptel-org--create-prompt-buffer "gptel-org") (declare-function gptel-context--wrap "gptel-context") (declare-function gptel--transform-apply-preset "gptel") (declare-function gptel--insert-response "gptel") (declare-function gptel-curl--stream-insert-response "gptel") (declare-function gptel-make-openai "gptel-openai") ;;; 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 in bytes 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 default of #x8000 on Windows comes from Microsoft's documentation." :type 'natnum) (make-obsolete-variable 'gptel-curl-file-size-threshold "gptel now sends request contents via stdin, no longer subject to command-line argument limits. `gptel-curl-file-size-threshold' and the related temporary-file mechanism are no longer needed." "0.9.9.6") (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 state machine (see `gptel-fsm') for the current request. Asynchronous hook functions must accept two arguments: a callback to call after the transformation is complete, and the state machine 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 prompt/directive to the directive itself. By default, gptel uses the directive with the key \\+`default'. To set the system prompt for a chat session from this list interactively, call `gptel-send' with a prefix argument, or call `gptel-menu'. A \"directive\" is typically the system prompt (also called system message 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. A directive in `gptel-directives' can be a string (included as-is), a list of strings (system prompt + conversation template) or a function returning a string or list of strings. See `gptel-system-prompt' for details." :safe #'always :type '(alist :key-type symbol :value-type string)) (define-obsolete-variable-alias 'gptel--system-message 'gptel-system-prompt "0.9.9.6") (put 'gptel--system-message 'safe-local-variable #'(lambda (v) (or (string-or-null-p v) (and (listp v) (cl-every #'string-or-null-p v))))) (defcustom gptel-system-prompt (or (alist-get 'default gptel-directives) "You are a large language model living in Emacs and a helpful assistant. Respond concisely.") "System prompt used by gptel. A system prompt is used to provide the LLM with general instructions, set expectations, or establish an overall tone. It is also commonly referred to as the \"system message\" or \"directive\". This is typically a string, but can be specified more generally as well. It can be - A string, included with gptel requests as-is. - nil, to not include any system prompt. - A list of strings, whose first (possibly nil) element is interpreted as the system prompt, 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 of no arguments that returns a string or a list of strings, interpreted as the above. When sending a request, this will 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. If you alternate between a few different system prompts, you can save them all in `gptel-directives' and pick between them in `gptel-menu'. This way system prompts can be set globally, per-buffer or for the next request only. The system prompt is typically one part of the configuration required for custom LLM tasks. You can include system prompts along with other settings in gptel presets (see `gptel-make-preset') with the :system key. By default this system prompt is used when using gptel programmatically with `gptel-request'. It can be overridden by supplying an explicit `:system' argument to this function." :group 'gptel :type '(choice (string :tag "Prompt string") (const :tag "No system prompt" nil) (repeat :tag "Conversation template" string) (function :tag "Dynamic prompt (function)")) :safe #'(lambda (v) (or (string-or-null-p v) (and (listp v) (cl-every #'string-or-null-p v))))) (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 nil "\"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. It can also be nil for the LLM API's default value. To set the temperature for a chat session interactively call `gptel-send' with a prefix argument." :safe (lambda (v) (or (null v) (numberp v))) :type '(choice (number :tag "Temperature value") (const :tag "Use default" nil))) (defcustom gptel-cache nil "Whether the LLM should cache request content. Some LLM backends can cache content sent to it by gptel, so that only the newly included part of the text needs to be processed on subsequent conversation turns. This results in faster and significantly cheaper processing. NOTE: Manual or client-configurable caching is currently supported only by the Anthropic API and thus the `gptel-anthropic' backend. This variable has no effect on the behavior of other backends. This variable controls which parts of the query will be cached, and can be the symbols t or nil to cache everything or nothing respectively. It can also be a list of symbols: - message: Cache conversation messages - system: Cache the system message - tool: Cache tool definitions Examples: Setting it to (message system) will cache the system message and the conversation text. Setting it to (message system tool) will cache everything and is the same as t." :type '(choice (const :tag "Cache everything" t) (const :tag "Do not cache" nil) (repeat symbol)) :group 'gptel) (defvar gptel--known-backends nil "Alist of LLM backends known to gptel. This is an alist mapping user-provided names to backend structs, see `gptel-backend'. You can have more than one backend pointing to the same resource with differing settings.") (defvar gptel--openai nil) (make-obsolete-variable 'gptel--openai "No longer used" "v0.9.9.5") (defcustom gptel-backend nil "LLM backend to use. This is the default \"backend\" used by gptel, an object specifying connection, authentication and model information required to send LLM requests. There are two ways to set `gptel-backend': 1. with `setopt' or the Customize interface, 2. and via constructors (such as `gptel-make-openai') in Elisp code. When using `setopt' or the customize interface, a backend may be specified in a list such as (BACKEND-TYPE NAME . PLIST) where: BACKEND-TYPE is one of `gptel-openai' (all OpenAI-compatible services), `gptel-anthropic', `gptel-gemini', `gptel-ollama', `gptel-kagi', `gptel--gh' (GitHub Copilot), `gptel-bedrock' (AWS Bedrock), `gptel-perplexity', `gptel-deepseek' or `gptel-privategpt'. NAME is a string, any backend name of your choosing. PLIST is an optional plist specifying connection and authentication information, with keys :protocol - \"http\" or \"https\" :host - Host, such as \"api.openai.com\" or \"localhost:1616\" :endpoint - connection endpoint, such as \"/v1/chat/completions\" :header - HTTP header to inclue with the request, a string or function :key - API key, if required for authentication String, symbol or function, see `gptel-api-key' :models - List of supported models (symbols, see `gptel--openai-models' for an example) :stream - Whether to stream responses, boolean :request-params - Additional parameters to send with backend queries, as a plist. This plist is converted to JSON when sending. This is meant for request parameters that gptel does not provide user options for. :curl-args - list of strings representing additional Curl arguments (if `gptel-use-curl' is set) When using the OpenAI, Anthropic, Gemini, Kagi, Github Copilot, Perplexity or Deepseek backends, all plist keys are optional. For other services, specifying some fields may be required. Examples: (setopt gptel-backend \\='(gptel-openai \"OpenAI\" :key gptel-api-key-from-auth-source :stream t)) (setopt gptel-backend \\='(gptel-anthropic \"Claude\" :key \"sk-...\")) (setopt gptel-backend \\='(gptel-ollama \"Ollama\" :host \"localhost:11434\" :models (qwen3:4b llama3.1:8b) :stream t)) This list of keys is non-exhaustive. Some backends (such as `gptel-bedrock') recognize or require additional keys. To see what other keys are available, check the corresponding constructor (such as `gptel-make-bedrock'). When not using `setopt', backends for LLM providers (local or remote) may be constructed and registered using one of the available backend constructor functions: - `gptel-make-openai' - `gptel-make-anthropic' - `gptel-make-gemini' - `gptel-make-ollama' - `gptel-make-azure' - `gptel-make-gpt4all' - `gptel-make-kagi' - `gptel-make-privategpt' - `gptel-make-perplexity' - `gptel-make-deepseek' - `gptel-make-xai' - `gptel-make-gh-copilot' - `gptel-make-bedrock' In addition, `gptel-backend' can be assigned to them. Examples: (setq gptel-backend (gptel-make-openai \"llamacpp\" :host \"localhost:8080\" :protocol \"http\" :models \\='(gpt-oss-120b glm-4.7-flash))) (setq gptel-backend (gptel-make-gemini \"Gemini\" :key gptel-api-key :stream t)) (setq gptel-backend (gptel-make-anthropic \"Claude-think\" :key gptel-api-key :request-params \\='(:thinking (:type \"enabled\" :budget_tokens 1024) :max_tokens 2048))) See their documentation for more information and the package README for examples. Once registered, backends may be retrieved using `gptel-get-backend' or switched to interactively from gptel's menu (see `gptel-menu')." :safe #'always :type (let ((types '( choice :tag "Type" (const :tag "OpenAI compatible" gptel-openai) (const gptel-anthropic) (const gptel-gemini) (const gptel-ollama) (const gptel-kagi) (const :tag "GitHub Copilot" gptel-gh) (const gptel-bedrock) (const gptel-perplexity) (const gptel-deepseek) (const gptel-privategpt)))) `(choice (restricted-sexp :match-alternatives (gptel-backend-p 'nil) :tag "No backend") (cons :tag "(BACKEND-TYPE NAME . PLIST)" ;accommodate (gptel-openai "chatgpt" . plist) ,types (cons string (plist :value-type (choice string symbol function (repeat symbol))))) (cons :tag "(BACKEND-TYPE . PLIST)" ;accommodate (gptel-openai :name "chatgpt" . plist) ,types (plist :value-type (choice string symbol function (repeat symbol)))))) :get (lambda (sym) (when-let* ((backend (default-toplevel-value sym)) (type (type-of backend)) (plist (list :protocol (gptel-backend-protocol backend) :host (gptel-backend-host backend) :endpoint (gptel-backend-endpoint backend) :header (gptel-backend-header backend) :key (gptel-backend-key backend) :models (gptel-backend-models backend) :stream (gptel-backend-stream backend) :curl-args (gptel-backend-curl-args backend) :request-params (gptel-backend-request-params backend)))) (apply #'list type (gptel-backend-name backend) (cl-loop for (k v) on plist by #'cddr if (and (readablep v) (not (null v))) collect k and collect v)))) :set (lambda (sym val) (cond ((null val) (set-default-toplevel-value sym val)) ((listp val) (let* ((name (if (stringp (cadr val)) ;explicit and implicit :name specification (cadr val) (plist-get (cdr val) :name))) (args (if name (cddr val) (cdr val))) type) (cl-remf args :name) (if (memq (car val) '(gptel-gh gptel--gh)) (setq type 'gptel-gh-copilot) (setq type (car val))) (set-default-toplevel-value sym (apply (intern (concat "gptel-make-" (substring (symbol-name type) 6))) name args)))) ((gptel-backend-p val) (set-default-toplevel-value sym val))))) (defcustom gptel-model nil (concat "Model for gptel queries. The name of the model, as a symbol. This is the name as expected by the LLM provider's API. To set the model for a chat session interactively call `gptel-send' with a prefix argument.") :safe #'always :type `(choice (symbol :tag "Specify model name") ,@(cl-loop for (_name . backend) in gptel--known-backends append (mapcar (lambda (model) (list 'const :tag (symbol-name model) model)) (gptel-backend-models backend))))) (defvar gptel-expert-commands nil "Whether experimental gptel options should be enabled. This opens up advanced options in `gptel-menu'.") (defvar gptel--num-messages-to-send nil) (put 'gptel--num-messages-to-send 'safe-local-variable #'integer-or-null-p) (defcustom gptel-log-level nil "Logging level for gptel. This is one of nil or the symbols info and debug: nil: Don't log responses info: Log request and response bodies debug: Log request/response bodies, headers and all other connection settings. When non-nil, information is logged to `gptel--log-buffer-name', which see." :type '(choice (const :tag "No logging" nil) (const :tag "Limited" info) (const :tag "Full" debug))) (defcustom gptel-track-response t "Distinguish between user messages and LLM responses. When creating a prompt to send to the LLM, gptel distinguishes between text entered by the user and past LLM responses. This distinction is necessary for back-and-forth conversation with an LLM. In regular Emacs buffers you can turn this behavior off by setting `gptel-track-response' to nil. All text, including past LLM responses, is then treated as user input when sending queries. This variable has no effect in dedicated chat buffers (buffers with `gptel-mode' enabled), where user prompts and responses are always handled separately." :type 'boolean) (defcustom gptel-track-media nil "Whether links to supported media types should be followed. When this is non-nil, gptel will send text, images or other media from links in Org and Markdown buffers to the LLM. Sending images or other binary media from links requires the active `gptel-model' to support it. See `gptel-make-openai', `gptel-make-anthropic', `gptel-make-ollama' or `gptel-make-gemini' for details on how to specify media support for models. To include media (including binary formats like images) more generally, you can also use `gptel-add' or `gptel-add-file' instead." :type 'boolean) (defcustom gptel-use-context 'system "Where in the request to inject gptel's additional context. gptel always includes the active region or the buffer up to the cursor in the request to the LLM. Additionally, you can add other buffers or their regions to the context with `gptel-add-context', or from gptel's menu. This data will be sent with every request. This option controls whether and where this additional context is included in the request. Currently supported options are: nil - Do not use the context. system - Include the context with the system message. user - Include the context with the user prompt." :group 'gptel :type '(choice (const :tag "Don't include context" nil) (const :tag "With system message" system) (const :tag "With user prompt" user))) (defcustom gptel-include-reasoning 'ignore "How to handle LLM reasoning or \"thinking\" text blocks. Some LLMs include in their response a \"thinking\" section. This text improves the quality of the LLM's final output, but may not be interesting to you by itself. Supported options are the symbols ignore - Include in the response but ignore on subsequent conversation turns (default) t - Include in the response nil - Do not include It can also be a string naming a buffer, in which case the reasoning text will be inserted at the end of that buffer." :group 'gptel :type '(choice (const :tag "Include with response" t) (const :tag "Don't include" nil) (const :tag "Include but ignore" ignore) (string :tag "Include in buffer"))) (define-obsolete-variable-alias 'gptel-context--alist 'gptel-context "0.9.9.3") (defcustom gptel-context nil "List of gptel's context sources. The items in this list (file names or buffers) are included with gptel queries as additional context. Each entry can be a file path (string) or a buffer (object, not buffer name): \\='(\"~/path/to/file1\" \"./file2\" # ...) The above covers the most common cases. You can also specify context sources in a more targeted way, with entries of the form ( . 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: ( :bounds ((start1 . end1) (start2 . end2) ...) :lines ((from1 . to1) (from2 . end2) ...) :overlays (ov1 ov2 ...)) For files, spec can include buffer spans and line number ranges, as well as the MIME type of the file: (\"/path/to/file\" :bounds ((start1 . end1) (start2 . end2) ...) :lines ((from1 . to1) (from2 . end2) ...) :mime \"image/png\") gptel tries to guess file MIME types, but is not always successful, so it is recommended to provide it with non-text files. Usage of context commands (such as `gptel-add' and `gptel-add-file') will modify this variable. You can also set this variable buffer-locally, or let-bind it around calls to gptel queries, or via gptel presets with the :context key." :type '(repeat string)) (defcustom gptel-markdown-validate-link #'always "Validate links to be sent as context with gptel queries. When `gptel-track-media' is enabled, this option determines if a supported link will be followed and its source included with gptel queries from Markdown buffers. Currently only links to files are supported (along with web URLs if the model supports them). It should be a function that accepts a Markdown link and return non-nil if the link should be followed. See `markdown-link-at-pos' for the structure of a Markdown link object. By default, all links are considered valid. Set this to `gptel--link-standalone-p' to only follow links placed on a line by themselves, separated from surrounding text." :type '(choice (const :tag "All links" always) (const :tag "Standalone links" gptel--link-standalone-p) (function :tag "Function")) :group 'gptel) (defvar gptel--request-alist nil "Alist of active gptel requests. Each entry has the form (PROCESS . (FSM ABORT-CLOSURE)) If the ABORT-CLOSURE is called, it must abort the PROCESS.") (defvar gptel--request-params nil "Extra parameters sent with each gptel request. These parameters are combined with model-specific and backend-specific :request-params before sending a request, which see. Warning: values incompatible with the active backend can break gptel. Do not use this variable unless you know what you're doing!") (defconst gptel--ersatz-json-tool "response_json" "Name of ersatz tool used to force JSON output. Some APIs, like Anthropic, use a tool to produce structured JSON output.") (defcustom gptel-curl-extra-args nil "Extra arguments to pass to Curl when sending queries. This should be a list of strings, each one a Curl command line argument. Note that these should not conflict with the options in `gptel-curl--common-args', which gptel requires for correct functioning. If you want to specify extra arguments only when using a specific gptel backend, use the `:curl-args' slot of the backend instead. See `gptel-backend'." :group 'gptel :type '(repeat string)) (defconst gptel-curl--common-args (cond ((memq system-type '(windows-nt ms-dos)) '("--disable" "--location" "--silent" "-XPOST" "-y7200" "-Y1" "-N" "-D-")) ((eq system-type 'darwin) '("--disable" "--location" "--silent" "--compressed" "-XPOST" "-y7200" "-Y1" "-N" "-D-")) (t '("--disable" "--location" "--silent" "--compressed" "-XPOST" "-y7200" "-Y1" "-N" "-D-"))) "Arguments always passed to Curl for gptel queries.") (defvar gptel--link-type-cache nil "Cache of checks for binary files. Each alist entry maps an absolute file path to a cons cell of the form (t . binaryp), where binaryp is non-nil if the file is binary-encoded.") ;; The following is derived from: ;; ;; (concat "\\(?:" markdown-regex-link-inline "\\|" markdown-regex-angle-uri "\\)") ;; ;; Since we want this known at compile time, when markdown-mode is not ;; guaranteed to be available, we have to hardcode it. (defconst gptel-markdown--link-regex "\\(?:\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)\\|\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^] \n <>,;()]+\\)\\(>\\)\\)" "Link regex for `gptel-mode' in Markdown mode.") (defvar gptel--mode-description-alist '((js2-mode . "Javascript") (sh-mode . "Shell") (enh-ruby-mode . "Ruby") (yaml-mode . "Yaml") (yaml-ts-mode . "Yaml") (rustic-mode . "Rust") (tuareg-mode . "OCaml")) "Mapping from unconventionally named major modes to languages. This is used when generating system prompts for rewriting and when including context from these major modes.") ;;; Utility functions ;;;; JSON parsing helpers ;; JSON conversion semantics used by gptel ;; empty object "{}" => empty list '() == nil ;; null => :null ;; false => :json-false ;; TODO(tool) Except when reading JSON from a string, where null => nil (defmacro gptel--json-read () "Parse JSON at point in buffer." (if (fboundp 'json-parse-buffer) `(json-parse-buffer :object-type 'plist :null-object :null :false-object :json-false) (require 'json) (defvar json-object-type) (defvar json-null) (declare-function json-read "json" ()) `(let ((json-object-type 'plist) (json-null :null)) (json-read)))) (defmacro gptel--json-read-string (str) "Pasre JSON string STR." (if (fboundp 'json-parse-string) `(json-parse-string ,str :object-type 'plist :null-object nil :false-object :json-false) (require 'json) (defvar json-object-type) (declare-function json-read-from-string "json" (string)) `(let ((json-object-type 'plist)) (json-read-from-string ,str)))) (defmacro gptel--json-encode (object) "Serialize OBJECT as JSON." (if (fboundp 'json-serialize) `(json-serialize ,object :null-object :null :false-object :json-false) (require 'json) (defvar json-false) (defvar json-null) (declare-function json-encode "json" (object)) `(let ((json-false :json-false) (json-null :null)) (json-encode ,object)))) (defmacro gptel--maybe-funcall (func-or-sym &rest args) "If FUNC-OR-SYM is a function, call it with ARGS. Otherwise, evaluate it as a variable." `(if (functionp ,func-or-sym) ;; TODO(v1.0) Remove this condition-case. This arity check is for ;; benefit of users who have personal customizations touching gptel's ;; internal API re: backend header and url functions. (condition-case nil (apply ,func-or-sym (list ,@args)) (wrong-number-of-arguments (message "Displaying warning") (display-warning 'gptel (format "%s calling convention has changed: \ Called with %d arguments but accept %d. \ Please update them, and see NEWS (0.9.9.5) for details." (if (symbolp ,func-or-sym) (format "Function %s" ,func-or-sym) "gptel-backend-header/gptel-backend-url function") (length ',args) (car (func-arity ,func-or-sym)))) (funcall ,func-or-sym))) ,func-or-sym)) (defun gptel--process-models (models) "Convert items in MODELS to symbols with appropriate properties." (let ((models-processed)) (dolist (model models) (cl-etypecase model (string (push (intern model) models-processed)) (symbol (push model models-processed)) (cons (cl-destructuring-bind (name . props) model (setf (symbol-plist name) ;; MAYBE: Merging existing symbol plists is safer, but makes it ;; difficult to reset a symbol plist, since removing keys from ;; it (as opposed to setting them to nil) is more work. ;; ;; (map-merge 'plist (symbol-plist name) props) props) (push name models-processed))))) (nreverse models-processed))) ;;;; Backend interface (defun gptel-get-backend (name) "Return gptel backend with NAME. Throw an error if there is no match." (or (alist-get name gptel--known-backends nil nil #'equal) (user-error "Backend %s is not known to be defined" name))) (gv-define-setter gptel-get-backend (val name) `(setf (alist-get ,name gptel--known-backends nil t #'equal) ,val)) (cl-defstruct (gptel-backend (:constructor gptel--make-backend) (:copier gptel--copy-backend)) name host header protocol stream endpoint key models url request-params curl-args (coding-system nil :documentation "Can be set to `binary' if the backend expects non UTF-8 output.")) ;;;; Misc utilities (defun gptel-api-key-from-auth-source (&optional host user) "Lookup api key in the auth source. By default, the LLM host for the active backend is used as HOST, and \"apikey\" as USER." (if-let* ((secret (plist-get (car (auth-source-search :host (or host (gptel-backend-host gptel-backend)) :user (or user "apikey") :require '(:secret))) :secret))) (if (functionp secret) (encode-coding-string (funcall secret) 'utf-8) secret) (user-error "No `gptel-api-key' found in the auth source"))) ;; FIXME Should we utf-8 encode the api-key here? (defun gptel--get-api-key (&optional key) "Get api key from KEY, or from `gptel-api-key'." (when-let* ((key-sym (or key (gptel-backend-key gptel-backend)))) (cl-typecase key-sym (function (string-trim-right (funcall key-sym) "[\n\r]+")) (string (string-trim-right key-sym "[\n\r]+")) (symbol (if-let* ((val (symbol-value key-sym))) (gptel--get-api-key val) (error "`gptel-api-key' is not valid"))) (t (error "`gptel-api-key' is not valid"))))) (defsubst gptel--to-number (val) "Ensure VAL is a number." (cond ((numberp val) val) ((stringp val) (string-to-number val)) ((error "%S cannot be converted to a number" val)))) (defsubst gptel--to-string (s) "Convert S to a string, if possible." (cl-typecase s (symbol (symbol-name s)) (string s) (otherwise (prin1-to-string s)))) (defun gptel--sanitize-raw-bytes (s) "Return string S if it is UTF-8 encodable, else a sanitized copy. Tool results may contain raw bytes that are not valid UTF-8 (e.g. from reading a binary file), which `json-serialize' rejects. Decode UTF-8 sequences that arrived undecoded, and replace any remaining raw bytes with the Unicode replacement character." (if (not (memq 'eight-bit (find-charset-string s))) s ;; Flatten S to bytes and decode it, recovering valid UTF-8 sequences. (let ((s (decode-coding-string (encode-coding-string s 'utf-8 'nocopy) 'utf-8 'nocopy))) ;; Raw bytes are left as codepoints in the #x3FFF80..#x3FFFFF range. (if (unencodable-char-position 0 nil 'utf-8 nil s) (replace-regexp-in-string "[\x3FFF80-\x3FFFFF]" "\ufffd" s t t) 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)) ;; MAYBE: Can be generalized to gptel--combine-plists, taking a "combiner" ;; function and default-value as arguments. (defun gptel--sum-plists (&rest plists) "Sum the values of keys across PLISTS. All values must be numeric or nil. Returns a new plist." (let ((rtn (copy-sequence (pop plists))) k v ls) (while plists (setq ls (pop plists)) (while ls (setq k (pop ls) v (pop ls)) (setq rtn (plist-put rtn k (+ (or (plist-get rtn k) 0) (or v 0)))))) rtn)) ;; NOTE: Remove after we drop Emacs 27.1 (#724) (defmacro gptel--temp-buffer (buf) "Generate a temp buffer BUF. Compatibility macro for Emacs 27.1." (if (< emacs-major-version 28) `(generate-new-buffer ,buf) `(generate-new-buffer ,buf t))) (defconst gptel--binary-sniff-bytes 8000 "Number of leading bytes examined to detect binary files. Matches Git's NUL-detection window.") (defvar gptel--binary-sniff-buffer nil "Reusable unibyte buffer used by `gptel--file-binary-p'.") (defun gptel--file-binary-p (path) "Check if file at PATH is readable and binary. Return nil if PATH is missing, unreadable or a directory." (or (let ((case-fold-search t)) (string-match-p ;Fast heuristic for images (JPEGs etc) "\\.\\(jpe?g\\|png\\|gif\\|webp\\)\\'" path)) (condition-case nil (progn (unless (buffer-live-p gptel--binary-sniff-buffer) (setq gptel--binary-sniff-buffer (gptel--temp-buffer " *gptel-sniff*")) (with-current-buffer gptel--binary-sniff-buffer (set-buffer-multibyte nil))) (with-current-buffer gptel--binary-sniff-buffer (insert-file-contents-literally ;raw bytes, byte 0 included path nil 0 gptel--binary-sniff-bytes 'replace) ;replace buffer contents (goto-char (point-min)) (skip-chars-forward "^\0") ;C-level scan for first NUL (and (not (eobp)) ;NUL found, but... ;; ...not UTF-16 text: exempt a UTF-16 BOM in the ;; first two bytes (not (and (>= (buffer-size) 2) (let ((b0 (char-after (point-min))) (b1 (char-after (+ (point-min) 1)))) (or (and (= b0 #xFF) (= b1 #xFE)) (and (= b0 #xFE) (= b1 #xFF))))))))) (file-missing (message "File \"%s\" is not readable." path) nil) (file-error nil)))) ;directory, permissions => not binary (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) ;; TODO: Handle and return HTTP errors (cl-defun gptel--url-retrieve (url &key method data headers (content-type "application/json")) "Retrieve URL synchronously with METHOD, DATA and HEADERS. CONTENT-TYPE (optional) is the MIME type of the request body, defaults to \"application/json\"." (declare (indent 1)) (let ((url-request-method (if (eq method 'post) "POST" "GET")) (url-request-data (when (eq method 'post) (encode-coding-string (pcase content-type ("application/json" (gptel--json-encode data)) (_ data)) 'utf-8))) (url-mime-accept-string "application/json") (url-request-extra-headers `(("content-type" . ,content-type) ,@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))) ;; 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-prompt 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) "Run CALLBACK, adding gptel's context to the request data of 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 (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)))))))) ;;;; Error handling (defun gptel--parse-response-plist-error (response) "Extract errors from RESPONSE when it is a plist. Return nil if no error occurred." (or (plist-get response :error) ; generic (plist-get response :detail) ; openai-oauth (plist-get response :message) ; bedrock (plist-get response :Message))) ; bedrock (defun gptel--parse-response-error (response) "Extract errors from RESPONSE. Return nil if no error occurred." (cond ((plistp response) (gptel--parse-response-plist-error response)) ((arrayp response) (cl-some #'gptel--parse-response-plist-error response)))) ;;; 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))))))) ;;; 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) ;;; 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, tool calls and results are always included in the LLM response. If set to nil, tool calls are never shown in the buffer. If set to the symbol `call', only the tool call parameters are included in the buffer; results are omitted. If set to the symbol auto (the default), this is left up to the tool: a tool call 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 "Call only, no results" call) (const :tag "Never" nil))) (defcustom gptel-tools nil "A list of tools to include with gptel requests. Each tool should be a `gptel-tool' struct, which see. To specify a tool, use `gptel-make-tool', which see." :group 'gptel :type '(repeat gptel-tool)) (cl-defstruct (gptel-tool (:constructor nil) (:constructor gptel--make-tool-internal (&key function name description args async category confirm include &allow-other-keys)) (:copier gptel--copy-tool)) "Struct to specify tools for LLMs to run. A tool is a function specification sent to the LLM along with a (plain language) task. If the LLM decides to use the tool to accomplish the task, gptel will run the tool and (optionally) feed the LLM the results. You can add tools via `gptel-make-tool', which see." (function nil :type function :documentation "Function that runs the tool") (name nil :type string :documentation "Tool name, snake_case recommended") (description nil :type string :documentation "What the tool does, intended for the LLM") (args nil :type list :documentation "List of plists specifying function arguments") (async nil :type boolean :documentation "Whether the function runs asynchronously") (category nil :type string :documentation "Use to group tools by purpose") (confirm nil :type boolean :documentation "Seek confirmation before running tool?") (include t :type (choice (const :tag "Include call and result" t) (const :tag "Include call only, no result" call) (const :tag "Exclude" nil)) :documentation "Include tool call 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. - as a gptel-tool object, which is returned as-is." (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)))) (gptel-tool path)) (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. Possible values: - t (default): Include both the call parameters and the result. - symbol `call': Include only the call parameters, not the result. - nil: Exclude the tool call from the buffer entirely. Here is an example definition: (gptel-make-tool :function (lambda (location unit) (url-retrieve-synchronously \"api.weather.com/...\" location unit)) :name \"get_weather\" :description \"Get the current weather in a given location\" :args (list \\='(:name \"location\" :type string :description \"The city and state, e.g. San Francisco, CA\") \\='(:name \"unit\" :type string :enum [\"celsius\" \"farenheit\"] :description \"The unit of temperature, either \\='celsius\\=' or \\='fahrenheit\\='\" :optional t))) If the tool is asynchronous, the function is modified to take a callback as its first argument, which it runs with the result: (lambda (callback location unit) (url-retrieve \"api.weather.com/...\" (lambda (_) (let ((result (parse-this-buffer))) (funcall callback result)))))" (let* ((tool (apply #'gptel--make-tool slots)) (category (or (gptel-tool-category tool) "misc"))) (setf (alist-get (gptel-tool-name tool) (alist-get category gptel--known-tools nil nil #'equal) nil nil #'equal) tool))) (cl-defgeneric gptel--parse-tools (_backend tools) "Parse TOOLS and return a list of prompts. TOOLS is a list of `gptel-tool' structs, which see. _BACKEND is the LLM backend in use. This is the default implementation, used by OpenAI-compatible APIs and Ollama." (vconcat (mapcar (lambda (tool) (list :type "function" :function (append (list :name (gptel-tool-name tool) :description (gptel-tool-description tool)) (if (gptel-tool-args tool) (list :parameters (list :type "object" ;; gptel's tool args spec is close to the JSON schema, except ;; that we use (:name "argname" ...) ;; instead of (:argname (...)), and ;; (:optional t) for each arg instead of (:required [...]) ;; for all args at once. Handle this difference by ;; modifying a copy of the gptel tool arg spec. :properties (cl-loop for arg in (gptel-tool-args tool) for argspec = (copy-sequence arg) for name = (plist-get arg :name) ;handled differently for newname = (or (and (keywordp name) name) (make-symbol (concat ":" name))) do ;ARGSPEC is ARG without unrecognized keys (cl-remf argspec :name) (cl-remf argspec :optional) if (equal (plist-get arg :type) "object") do (unless (plist-member argspec :required) (plist-put argspec :required [])) (plist-put argspec :additionalProperties :json-false) append (list newname argspec)) :required (vconcat (delq nil (mapcar (lambda (arg) (and (not (plist-get arg :optional)) (plist-get arg :name))) (gptel-tool-args tool)))) :additionalProperties :json-false)) (list :parameters (list :type "object" :properties nil)))))) (ensure-list tools)))) (cl-defgeneric gptel--parse-tool-results (backend results) "Return a BACKEND appropriate prompt containing tool call RESULTS. This will be injected into the messages list in the prompt to send to the LLM.") ;; FIXME(fsm) unify this with `gptel--inject-media', which is a mess (cl-defgeneric gptel--inject-prompt (_backend data new-prompt &optional position) "Inject NEW-PROMPT into existing prompts in query DATA. NEW-PROMPT can be a single message or a list of messages. If POSITION is - nil, append NEW-PROMPT at the end of DATA - a non-negative integer, insert it at that position in DATA. - a negative integer, insert it there counting from the end. - Not implemented: a list of accessors, inject it at that position. This generic implementation handles the Anthropic, OpenAI-compatible and Ollama message formats." (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many? (setq new-prompt (list new-prompt))) (let ((prompts (plist-get data :messages))) (pcase position ('nil (plist-put data :messages (vconcat prompts new-prompt))) ((pred integerp) (when (< position 0) (setq position (+ (length prompts) position))) (plist-put data :messages (vconcat (substring prompts 0 position) new-prompt (substring prompts position))))))) (cl-defgeneric gptel--inject-tool-call (backend _data _tool-call new-call) "Replace TOOL-CALL in query DATA with NEW-CALL. DATA is the request payload containing the array of user and assistant messages, typically available as (plist-get INFO :data). TOOL-CALL is the call plist as recorded by gptel's response parser(s). NEW-CALL is the replacement plist containing the new tool name and arguments, in the form (:name \"newName\" :args (:arg1 \"newArg\" :arg2 ...)) :name and :args are both optional. If NEW-CALL is nil, the tool call is removed from DATA and thus the turn history. BACKEND is the `gptel-backend'." (display-warning '(gptel tool-call) (format "Editing tool call arguments is not implemented for %s.\ Ignoring new arguments %s" (type-of backend) (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))) ;;; State machine for driving requests (defvar gptel-request--transitions `((INIT . ((t . WAIT))) (WAIT . ((t . TYPE))) (TYPE . ((,#'gptel--error-p . ERRS) (,#'gptel--tool-use-p . TOOL) (t . DONE))) (TOOL . ((t . TRET))) (TRET . ((,#'gptel--error-p . ERRS) (,#'gptel--tool-result-p . WAIT) (t . DONE)))) "Alist specifying gptel's default state transition table for requests. Each entry is a list whose car is a request state (any symbol) and whose cdr is an alist listing possible next states. Each key is either a predicate function or t. When `gptel--fsm-next' is called, the predicates are called in the order they appear here to find the next state. Each predicate is called with the state machine's INFO, see `gptel-fsm'. A predicate of t is considered a success and acts as a default.") (defvar gptel-request--handlers `((WAIT ,#'gptel--handle-wait) (TOOL ,#'gptel--handle-tool-use) (TRET ,#'gptel--handle-tool-result) (DONE ,#'gptel--handle-post) (ERRS ,#'gptel--handle-post) (ABRT ,#'gptel--handle-post)) "Alist specifying handlers for gptel's default state transitions. Each entry is a list whose car is a request state (a symbol) and whose cdr is a list of handler functions called when transitioning to that state. The handlers are called in the sequence that they appear in the list, and each function receives the state machine as its only argument. Information about the request state can be retrieved via the machine's INFO slot, see `gptel-fsm'. Handlers are responsible for doing state-related tasks (like logging errors or inserting responses) and transitioning to the next state by calling `gptel--fsm-transition'. Handlers can be asynchronous, in which case the transition call should typically be placed in its callback.") (cl-defstruct (gptel-fsm (:constructor gptel-make-fsm) (:copier gptel-copy-fsm)) "State machine for gptel requests. STATE: The current state of the machine, can be any symbol. TABLE: Alist mapping states to possible next states along with predicates to determine the next state. See `gptel-request--transitions' for an example. HANDLERS: Alist mapping states to state handler functions. Handlers are called when entering each state. See `gptel-request--handlers' for an example INFO: The state machine's current context. This is a plist holding all the information required for the ongoing request, and can be used to tweak and resume a paused request. This should be called \"context\", but context means too many things already in gptel's code! Each gptel request is passed an instance of this state machine and driven by it." (state 'INIT) (table gptel-request--transitions) (handlers gptel-request--handlers) info) (defun gptel--fsm-transition (machine &optional new-state) "Move MACHINE to its next state. MACHINE is an instance of `gptel-fsm'. The next state is NEW-STATE if given. Otherwise it is determined automatically from MACHINE's transition table." (unless new-state (setq new-state (gptel--fsm-next machine))) (push (gptel-fsm-state machine) (plist-get (gptel-fsm-info machine) :history)) (setf (gptel-fsm-state machine) new-state) (when-let* ((handlers (alist-get new-state (gptel-fsm-handlers machine)))) (mapc (lambda (h) (funcall h machine)) handlers))) (defun gptel--fsm-next (machine) "Determine MACHINE's next state according to its transition table. MACHINE is an instance of `gptel-fsm'" (let* ((current (gptel-fsm-state machine)) (transitions (alist-get current (gptel-fsm-table machine)))) (cl-loop with info = (gptel-fsm-info machine) for (pred . next) in transitions when (or (eq pred t) (funcall pred info)) return next))) ;;;; State machine handlers ;; The next few functions are default state handlers for gptel's state machine, ;; see `gptel-request--handlers'. (defun gptel--handle-wait (fsm) "Fire the request contained in state machine FSM's info." ;; Reset some flags in info. This is necessary when reusing fsm's context for ;; a second network request: gptel tests for the presence of these flags to ;; handle state transitions. (NOTE: Don't add :uuid to this.) (let ((req-info (gptel-fsm-info fsm))) (dolist (key '(:tool-result :tool-use :error :http-status :reasoning :tokens)) (when (plist-get req-info key) (plist-put req-info key nil))) (funcall (if gptel-use-curl #'gptel-curl-get-response #'gptel--url-get-response) fsm) (with-current-buffer (plist-get req-info :buffer) (run-hooks 'gptel-post-request-hook)))) (defun gptel--process-tool-call (fsm tool-spec tool-call result) "Add tool RESULT to a TOOL-CALL and transition FSM if required. TOOL-CALL is a plist with the tool :name, :args and other metadata. TOOL-SPEC is the `gptel-tool' object, and FSM is the request state. If all pending tool calls in the current request have finished, it injects the results into the prompt data and transitions the FSM." (let* ((info (gptel-fsm-info fsm)) (tool-result-alist (plist-get info :tool-result)) ;; MAYBE(tool-hooks): Use plist-member for valid nil :result? (remaining (cl-loop for call in (plist-get info :tool-use) count (not (plist-get call :result))))) (let ((result (gptel--sanitize-raw-bytes (gptel--to-string result)))) ;; FIXME(tool-hooks): If a hook has changed the tool that was called ;; tool-spec needs to be updated. (push (list tool-spec (plist-get tool-call :args) result) tool-result-alist) (plist-put info :tool-result tool-result-alist) ;for the callback ;; NOTE: tool-call is a member of (plist-get info :tool-use), so :tool-use ;; is modified by side effect. ;; FIXME: Make the implicit addition to :tool-use explicit (plist-put tool-call :result result)) ;for the LLM ;; All tools have run (when (<= (cl-decf remaining) 0) (gptel--fsm-transition fsm)))) (defun gptel--handle-tool-use (fsm) "Run tool calls captured in FSM, and advance the state machine with the results." (when-let* ((info (gptel-fsm-info fsm)) (backend (plist-get info :backend)) ;; This function might run many times, so only act on the remaining tool calls. (tool-use (cl-remove-if (lambda (tc) (plist-get tc :result)) (plist-get info :tool-use)))) (with-current-buffer (plist-get info :buffer) (let ((pending-calls)) (mapc ; Construct function calls (lambda (tool-call) (letrec ((args (plist-get tool-call :args)) (name (plist-get tool-call :name)) (tool-spec (cl-find-if (lambda (ts) (equal (gptel-tool-name ts) name)) (plist-get info :tools))) (process-tool-result (apply-partially #'gptel--process-tool-call fsm tool-spec tool-call))) (if (null tool-spec) (if (equal name gptel--ersatz-json-tool) ;Could be a JSON response (progn ;Handle structured JSON output supplied as tool call (funcall (plist-get info :callback) (gptel--json-encode (plist-get tool-call :args)) info) (plist-put info :tool-use ;Remove this tool call from the list (cl-remove-if (lambda (tc) (equal (plist-get tc :name) gptel--ersatz-json-tool)) (plist-get info :tool-use))) (when (plist-get info :stream) (funcall (plist-get info :callback) t info))) (message "Unknown tool called by model: %s" name) (funcall process-tool-result (format "Error: Tool '%s' is not available. Available tools: %s" name (mapconcat #'gptel-tool-name (plist-get info :tools) ", ")))) (let ((confirm)) ;Check if tool requires confirmation (cond ;:confirm in tool-call (from hooks) takes precedence ((and-let* ((call-confirm (plist-member tool-call :confirm))) (prog1 t (setq confirm (cadr call-confirm))))) ((and gptel-confirm-tool-calls ;global and tool-specific setting (or (eq gptel-confirm-tool-calls t) ;always confirm, or (and-let* ((confirm (gptel-tool-confirm tool-spec))) (or (not (functionp confirm)) (apply confirm (gptel--map-tool-args tool-spec args)))))) (setq confirm t))) (if confirm ;To send to callback for confirmation (push (list tool-spec args process-tool-result) pending-calls) (let ((arg-values (gptel--map-tool-args tool-spec args))) (if (gptel-tool-async tool-spec) ;If not, run the tool (apply (gptel-tool-function tool-spec) process-tool-result arg-values) (let ((result (condition-case errdata (apply (gptel-tool-function tool-spec) arg-values) (error (mapconcat #'gptel--to-string errdata " "))))) (funcall process-tool-result result))))))))) tool-use) (when pending-calls (plist-put info :tool-pending t) (funcall (plist-get info :callback) (cons 'tool-call pending-calls) info)))))) (defun gptel--map-tool-args (tool-spec args) "Create a tool call argument list from TOOL-SPEC and ARGS. TOOL-SPEC is a `gptel-tool' and ARGS is a plist of arguments for a tool call. The argument list is suitable for supplying to the tool function." (mapcar (lambda (arg) (let ((key (intern (concat ":" (plist-get arg :name))))) (plist-get args key))) (gptel-tool-args tool-spec))) (defun gptel--handle-tool-result (fsm) "Handle the results of tool execution in FSM. Inject tool results into into the prompt data (for the LLM), run the callback (for the user), and transition the request state." (let ((info (gptel-fsm-info fsm))) (gptel--inject-prompt (plist-get info :backend) (plist-get info :data) (gptel--parse-tool-results (plist-get info :backend) (plist-get info :tool-use))) (funcall (plist-get info :callback) (cons 'tool-result (plist-get info :tool-result)) info)) (gptel--fsm-transition fsm)) (defun gptel--handle-post (fsm) "Run cleanup for `gptel-request' with FSM." (when-let* ((info (gptel-fsm-info fsm)) (post (plist-get info :post))) (mapc (lambda (f) (funcall f info)) post))) ;;;; State machine predicates ;; Predicates used to find the next state to transition to, see ;; `gptel-request--transitions'. (defun gptel--error-p (info) "Return non-nil if INFO contains an error." (plist-get info :error)) (defun gptel--tool-use-p (info) "Return non-nil if INFO contains pending tool calls." (plist-get info :tool-use)) (defun gptel--tool-result-p (info) "Return non-nil if INFO contains tool results." (plist-get info :tool-result)) ;;; 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-prompt) schema transforms (fsm (gptel-make-fsm))) "Request a response from the `gptel-backend' for PROMPT. The request is asynchronous, this function returns immediately. If PROMPT is - a string, it is used to create a full prompt suitable for sending to the LLM. - A list of strings, it is interpreted as a conversation, i.e. a series of alternating user prompts and LLM responses. (\"user msg 1\" \"llm msg 1\" \"user msg 2\" \"llm msg 2\" ...) - nil but region is active, the region contents are used. - nil, the current buffer's contents up to (point) are used. Previous responses from the LLM are identified as responses. Keyword arguments: CALLBACK, if supplied, is a function of two arguments, called with the RESPONSE (usually a string) and INFO (a plist): (funcall CALLBACK RESPONSE INFO) RESPONSE is - A string if the request was successful - nil if there was no response or an error. These are the only two cases you typically need to consider, unless you need to clean up after aborted requests, use LLM tools, handle \"reasoning\" content specially or stream responses (see STREAM). In these cases, RESPONSE can be - The symbol `abort' if the request is aborted, see `gptel-abort'. - A cons cell of the form (tool-call . ((TOOL ARGS CB) ...)) where TOOL is a gptel-tool struct, ARGS is a plist of arguments, and CB is a function for handling the results. You can call CB with the result of calling the tool to continue the request. - A cons cell of the form (tool-result . ((TOOL ARGS RESULT) ...)) where TOOL is a gptel-tool struct, ARGS is a plist of arguments, and RESULT was returned from calling the tool function. - A cons cell of the form (reasoning . text) where text is the contents of the reasoning block. (Also see STREAM if you are using streaming.) See `gptel--insert-response' for an example callback handling all cases. The INFO plist has (at least) the following keys: :data - The request data included with the query :position - marker where the response will (nominally) be inserted. Of course, the insertion is left to the CALLBACK. :buffer - The buffer current when the request was sent, unless BUFFER is specified. :status - Short string describing the result of the request, including possible HTTP errors. Example of a callback that messages the user with the response and info: (lambda (response info) (if (stringp response) (let ((posn (marker-position (plist-get info :position))) (buf (buffer-name (plist-get info :buffer)))) (message \"Response for request from %S at %d: %s\" buf posn response)) (message \"gptel-request failed with message: %s\" (plist-get info :status)))) Or, for just the response: (lambda (response _) ;; Do something with response (message (rot13-string response))) If CALLBACK is omitted, the response is inserted at the point the request was sent. STREAM is a boolean that determines if the response should be streamed, as in `gptel-stream'. If the model or the backend does not support streaming, this will be ignored. When streaming responses - CALLBACK will be called repeatedly with each RESPONSE text chunk (a string) as it is received. - When the HTTP request ends successfully, CALLBACK will be called with a RESPONSE argument of t to indicate success. - Similarly, CALLBACK will be called with (reasoning . text-chunk) for each reasoning chunk, and (reasoning . t) to indicate the end of the reasoning block. BUFFER and POSITION are the buffer and position (integer or marker) at which the response is inserted. If a CALLBACK is specified, no response is inserted and these arguments are ignored, but they are still available in the INFO plist passed to CALLBACK for you to use. BUFFER defaults to the current buffer, and POSITION to the value of (point) or (region-end), depending on whether the region is active. CONTEXT is any additional data needed for the callback to run. It is included in the INFO argument to the callback. Note: This is intended for storing Emacs state to be used by CALLBACK, and unrelated to the context supplied to the LLM. SYSTEM is the system message or extended chat directive sent to the LLM. This can be a string, a list of strings or a function that returns either; see `gptel-directives' for more information. If SYSTEM is omitted, the value of `gptel-system-prompt' in 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-system-prompt system) ;Required for copying into the prompt buffer (gptel--schema schema) (prompt-buffer (cond ;prompt from buffer or explicitly supplied ((null prompt) ;Send text up to end of word (for evil-mode users) (with-current-buffer buffer (gptel--create-prompt-buffer (gptel--at-word-end (point))))) ((stringp prompt) (gptel--with-buffer-copy buffer nil nil (insert prompt) (setq major-mode 'fundamental-mode) ;Avoid mode-specific behavior (current-buffer))) ((consp prompt) ;; (gptel--parse-list gptel-backend prompt) (gptel--with-buffer-copy buffer nil nil ;; TEMP Decide on the annotated prompt-list format (gptel--parse-list-and-insert prompt) (setq major-mode 'fundamental-mode) ;Avoid mode-specific behavior (current-buffer))))) (info (list :data prompt-buffer :buffer buffer :position start-marker))) (when transforms (plist-put info :transforms transforms)) ;; Evaluate function valued system prompts in the request buffer, but then ;; set it in the prompt construction buffer (when-let* ((system (buffer-local-value 'gptel-system-prompt prompt-buffer)) ((functionp system))) (let ((system-list (with-current-buffer buffer (gptel--parse-directive system 'raw)))) (with-current-buffer prompt-buffer ;and then set the result in the prompt buffer (setq gptel-system-prompt ;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-prompt 'raw)) ;; DIRECTIVE contains both the system message and the template prompts (gptel-system-prompt (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)))) ;;; 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 `gptel-request' for the former. Support for the latter format is experimental." (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 (prin1-to-string `( :name ,(plist-get call :name) :args ,(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 "ext: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 (eq resource-type 'url) ;Assume URLs are reachable (file-remote-p default-directory) (file-remote-p path) (file-readable-p path))) (mime-valid (if (or (eq resource-type 'url) (with-memoization (alist-get (expand-file-name path) gptel--link-type-cache nil nil #'string=) (gptel--file-binary-p path))) (progn (setq mime (mailcap-file-name-to-mime-type path)) (gptel--model-mime-capable-p mime)) t))) (list t link-type path resource-type user-check readablep mime-valid mime) (list nil link-type path resource-type user-check readablep mime-valid mime)))) (cl-defmethod gptel--parse-media-links ((_mode (eql 'markdown-mode)) beg end) "Parse text and actionable links between BEG and END. Return a list of the form ((:text \"some text\") (:media \"/path/to/media.png\" :mime \"image/png\") (:text \"More text\")) for inclusion into the user prompt for the gptel request." (let ((parts) (from-pt)) (save-excursion (setq from-pt (goto-char beg)) (while (re-search-forward gptel-markdown--link-regex end t) (let* ((link-at-pt (markdown-link-at-pos (point))) (link-status (gptel-markdown--validate-link link-at-pt))) (cl-destructuring-bind (valid type path resource-type user-check readablep mime-valid mime) link-status (cond ((and valid (member type '("http" "https" "ftp"))) ;; Collect text up to this image, and collect this image url (let ((text (buffer-substring-no-properties from-pt (car link-at-pt)))) (unless (string-blank-p text) (push (list :text text) parts)) (push (list :url path :mime mime) parts) (setq from-pt (cadr link-at-pt)))) (valid ; Collect text up to this link, and collect this link data (let ((text (buffer-substring-no-properties from-pt (car link-at-pt)))) (unless (string-blank-p text) (push (list :text text) parts)) (push (if mime (list :media path :mime mime) (list :textfile path)) parts) (setq from-pt (cadr link-at-pt)))) ((not resource-type) (message "Link source not followed for unsupported link type \"%s\"." type)) ((not user-check) (message (if (eq gptel-markdown-validate-link 'gptel--link-standalone-p) "Ignoring non-standalone link \"%s\"." "Link %s failed to validate, see `gptel-markdown-validate-link'.") path)) ((not readablep) (message "Ignoring inaccessible file \"%s\"." path)) ((and (not mime-valid) (eq resource-type 'file)) (message "Ignoring unsupported binary file \"%s\"." path))))))) (unless (= from-pt end) (push (list :text (buffer-substring-no-properties from-pt end)) parts)) (nreverse parts))) (cl-defgeneric gptel--inject-media (backend _prompts) "Wrap the last prompt in PROMPTS with gptel's context. PROMPTS is a structure as returned by `gptel--parse-buffer'. Typically this is a list of plists. BACKEND is the gptel backend in use." (display-warning '(gptel context) (format "Context support not implemented for backend %s, ignoring context" (gptel-backend-name backend)))) (cl-defgeneric gptel--request-data (backend prompts) "Generate a plist of all data for an LLM query. BACKEND is the LLM backend in use. PROMPTS is the plist of previous user queries and LLM responses.") (cl-defun gptel--sanitize-model (&key (backend gptel-backend) (model gptel-model) (shoosh t)) "Check if MODEL is available in BACKEND, adjust accordingly. If SHOOSH is true, don't issue a warning." (unless backend (setq gptel-backend (or (cdar gptel--known-backends) ;First available backend (gptel-make-openai "ChatGPT" :key 'gptel-api-key :stream t)) backend gptel-backend) (unless shoosh (display-warning 'gptel (format "No gptel-backend defined: defaulting to %s" (gptel-backend-name gptel-backend))))) (let ((available (gptel-backend-models backend))) (when (stringp model) (unless shoosh (display-warning 'gptel (format "`gptel-model' expects a symbol, found string \"%s\" Resetting `gptel-model' to %s" model model))) (setq gptel-model (gptel--intern model) model gptel-model)) (unless (member model available) (let ((fallback (car available))) (unless shoosh (display-warning 'gptel (format (concat "Preferred `gptel-model' \"%s\" not" "supported in \"%s\", using \"%s\" instead") model (gptel-backend-name backend) fallback))) (setq gptel-model fallback))))) ;;; url-retrieve response handling (defun gptel--url-get-response (fsm) "Fetch response to prompt in state FSM from the LLM. FSM is the state machine driving this request. Its INFO slot contains the data required for setting up the request. INFO is a plist with the following keys, among others: - :data (the data being sent) - :buffer (the gptel buffer) - :position (marker at which to insert the response). - :callback (optional, the request callback) Call CALLBACK with the response and INFO afterwards. If omitted the response is inserted into the current buffer after point." (let* ((inhibit-message t) (message-log-max nil) (url-request-method "POST") (info (gptel-fsm-info fsm)) ;; We have to let-bind the following two since their dynamic ;; values are used for key lookup and url resolution (gptel-backend (plist-get info :backend)) (gptel-model (plist-get info :model)) (url-request-extra-headers (append '(("Content-Type" . "application/json")) (when-let* ((header (gptel-backend-header gptel-backend))) (gptel--maybe-funcall header info)))) (callback (or (plist-get info :callback) ;if not the first run #'gptel--insert-response)) ;default callback ;; NOTE: We don't need the decode-coding-string dance here since we ;; don't pass it to the OS environment and Curl. (url-request-data (gptel--json-encode (plist-get info :data)))) (when (with-current-buffer (plist-get info :buffer) (and (derived-mode-p 'org-mode) gptel-org-convert-response)) (plist-put info :transformer #'gptel--convert-markdown->org)) (plist-put info :callback callback) (when gptel-log-level ;logging (when (eq gptel-log-level 'debug) (gptel--log (gptel--json-encode (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair))) url-request-extra-headers)) "request headers")) (gptel--log url-request-data "request body")) (let ((proc-buf (url-retrieve (let ((backend-url (gptel-backend-url gptel-backend))) (gptel--maybe-funcall backend-url info)) (lambda (_) (set-buffer-multibyte t) (set-buffer-file-coding-system 'utf-8-unix) (pcase-let ((`(,response ,http-status ,http-msg ,error) (gptel--url-parse-response (plist-get info :backend) info)) (buf (current-buffer))) (plist-put info :http-status http-status) (plist-put info :status http-msg) (gptel--fsm-transition fsm) ;WAIT -> TYPE (when error (plist-put info :error error)) (when response ;Look for a reasoning block (if (string-match-p "^\\s-*" response) (when-let* ((idx (string-search "" 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 (gptel--parse-response-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."))) ;;; Curl request response handling (defun gptel-curl--get-config-args (info) "Return extra Curl arguments for INFO." (let ((gptel-backend (plist-get info :backend)) (gptel-model (plist-get info :model)) (gptel-stream (plist-get info :stream))) (append gptel-curl--common-args gptel-curl-extra-args (and-let* ((curl-args (gptel-backend-curl-args gptel-backend))) (gptel--maybe-funcall curl-args))))) (defun gptel-curl--get-args (info uuid) "Produce list of arguments for calling Curl. INFO contains the request data, UUID is a unique identifier." (let* (;; We have to let-bind the following three since their dynamic ;; values are used for key lookup and url resolution (gptel-backend (plist-get info :backend)) (gptel-model (plist-get info :model)) (gptel-stream (plist-get info :stream)) (url (let ((backend-url (gptel-backend-url gptel-backend))) (gptel--maybe-funcall backend-url info))) (data (plist-get info :data)) (data-json (decode-coding-string (gptel--json-encode data) 'utf-8 t))) (when gptel-log-level (gptel--log data-json "request body")) (append (gptel-curl--get-config-args info) (cl-loop for (key . val) in (append '(("Content-Type" . "application/json")) (when-let* ((header (gptel-backend-header gptel-backend))) (gptel--maybe-funcall header info))) collect (format "-H%s: %s" key val)) (list (format "-w(%s . %%{size_header})" uuid)) (list (format "-d%s" data-json)) (when (not (string-empty-p gptel-proxy)) (list "--proxy" gptel-proxy "--proxy-negotiate" "--proxy-user" ":")) (list url)))) (defun gptel-curl--get-config (info uuid) "Produce config text for calling Curl. INFO contains the request data, UUID is a unique identifier." (let* (;; We have to let-bind the following three since their dynamic ;; values are used for key lookup and url resolution (gptel-backend (plist-get info :backend)) (gptel-model (plist-get info :model)) (gptel-stream (plist-get info :stream)) (url (let ((backend-url (gptel-backend-url gptel-backend))) (gptel--maybe-funcall backend-url info))) (data (plist-get info :data)) (data-json (encode-coding-string (gptel--json-encode data) 'utf-8-unix t)) (headers (append '(("Content-Type" . "application/json")) (when-let* ((header (gptel-backend-header gptel-backend))) (gptel--maybe-funcall header info)))) (items (nconc (cl-loop for (key . val) in headers collect (cons "header" (format "%s: %s" key val))) (when (not (string-empty-p gptel-proxy)) (list (cons "proxy" gptel-proxy) "proxy-negotiate" (cons "proxy-user" ":"))) (list (cons "url" url) (cons "write-out" (format "(%s . %%{size_header})" uuid)) (cons "data-binary" '@-)))) (config (cl-loop for item in items concat (cl-etypecase item (string (format "%s" item)) (cons (format "%s = %S" (car item) (cdr item)))) concat "\n"))) (when gptel-log-level (when (eq gptel-log-level 'debug) (gptel--log config "request config")) (gptel--log data-json "request body")) (concat config "\n" data-json))) ;;;###autoload (defun gptel-curl-get-response (fsm) "Fetch response to prompt in state FSM from the LLM using Curl. FSM is the state machine driving this request. FSM is the state machine driving this request. Its INFO slot contains the data required for setting up the request. INFO is a plist with the following keys, among others: - :data (the data being sent) - :buffer (the gptel buffer) - :position (marker at which to insert the response). - :callback (optional, the request callback) Call CALLBACK with the response and INFO afterwards. If omitted the response is inserted into the current buffer after point." (let* ((uuid (md5 (format "%s%s%s%s" (random) (emacs-pid) (user-full-name) (recent-keys)))) (info (gptel-fsm-info fsm)) (backend (plist-get info :backend)) (stream (plist-get info :stream)) (command (nconc (list (gptel--curl-path)) (gptel-curl--get-config-args info) (list "--config" "-"))) (process (make-process :name "gptel-curl" :buffer (gptel--temp-buffer " *gptel-curl*") :command command :connection-type 'pipe))) (when (eq gptel-log-level 'debug) (gptel--log (format "%s" command) "request command")) (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) (process-send-string process (gptel-curl--get-config info uuid)) (process-send-eof process) (if (plist-get info :uuid) ;not the first run, set only the uuid (plist-put info :uuid uuid) (setf (gptel-fsm-info fsm) ;fist run, set all process parameters (nconc (list :uuid uuid :transformer (when (with-current-buffer (plist-get info :buffer) (and (derived-mode-p 'org-mode) gptel-org-convert-response)) (gptel--stream-convert-markdown->org (plist-get info :position)))) (unless (plist-get info :callback) (list :callback (if stream #'gptel-curl--stream-insert-response #'gptel--insert-response))) info))) (if stream (progn (set-process-sentinel process #'gptel-curl--stream-cleanup) (set-process-filter process #'gptel-curl--stream-filter)) (set-process-sentinel process #'gptel-curl--sentinel)) (setf (alist-get process gptel--request-alist) (cons fsm #'(lambda () ;; Clean up Curl process (set-process-sentinel process #'ignore) (delete-process process) (kill-buffer (process-buffer process)))))))) ;; ;; Ahead-Of-Time dispatch code for the parsers ;; :parser ; FIXME `cl--generic-*' are internal functions ;; (cl--generic-method-function ;; (if stream ;; (cl-loop ;; for type in ;; (cl--class-allparents (get (type-of backend) 'cl--class)) ;; with methods = (cl--generic-method-table ;; (cl--generic 'gptel-curl--parse-stream)) ;; when (cl--generic-member-method `(,type t) nil methods) ;; return (car it)) ;; (cl-loop ;; for type in ;; (cl--class-allparents (get (type-of backend) 'cl--class)) ;; with methods = (cl--generic-method-table ;; (cl--generic 'gptel--parse-response)) ;; when (cl--generic-member-method `(,type t t) nil methods) ;; return (car it)))) (defun gptel-curl--log-response (proc-buf proc-info) "Parse response buffer PROC-BUF and log response. PROC-INFO is the plist containing process metadata." (with-current-buffer proc-buf (save-excursion (goto-char (point-min)) (when (re-search-forward " ?\n ?\n" nil t) (when (eq gptel-log-level 'debug) (gptel--log (gptel--json-encode (buffer-substring-no-properties (point-min) (1- (point)))) "response headers")) (let ((p (point))) (when (search-forward (plist-get proc-info :uuid) nil t) (goto-char (1- (match-beginning 0))) (gptel--log (buffer-substring-no-properties p (point)) "response body"))))))) ;; TODO: Separate user-messaging from this function (defun gptel-curl--stream-cleanup (process _status) "Process sentinel for gptel curl requests. PROCESS and _STATUS are process parameters." (let ((proc-buf (process-buffer process)) (exit-status (process-exit-status process))) (let* ((fsm (car (alist-get process gptel--request-alist))) (info (gptel-fsm-info fsm)) (http-status (plist-get info :http-status))) (when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging (cond ;; Curl exited with a non-zero status: connection-level failure ((not (zerop exit-status)) (plist-put info :error (format "Curl failed with exit code %d. See Curl manpage for details." exit-status)) (plist-put info :status "Curl failure") ;; MAYBE: This transition should happen in the process filter, but it's ;; not clear how to reliably detect Curl failure there. (gptel--fsm-transition fsm) ;Curl failed, WAIT -> TYPE (with-demoted-errors "gptel callback error: %S" (funcall (plist-get info :callback) nil info))) ;; Finish handling a successful streaming response ((member http-status '("200" "100")) (with-demoted-errors "gptel callback error: %S" (funcall (plist-get info :callback) t info))) ;; Capture error message from HTTP error response (t (with-current-buffer proc-buf (goto-char (point-max)) (if (not (search-backward (plist-get info :uuid) nil t)) (plist-put info :error "Could not parse Curl response") (backward-char) (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))) (response (progn (goto-char header-size) (condition-case nil (gptel--json-read) (error 'json-read-error)))) (error-data (gptel--parse-response-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) "Process OUTPUT from a Curl PROCESS for gptel. Run the response callback with any completed chunks in OUTPUT." (let* ((fsm (car (alist-get process gptel--request-alist))) (proc-info (gptel-fsm-info fsm)) (callback (or (plist-get proc-info :callback) #'gptel-curl--stream-insert-response))) (with-current-buffer (process-buffer process) ;; Insert output (save-excursion (goto-char (process-mark process)) (insert output) (set-marker (process-mark process) (point))) ;; Find HTTP status (unless (plist-get proc-info :http-status) (save-excursion (goto-char (point-min)) (when-let* (((not (= (line-end-position) (point-max)))) (http-msg (buffer-substring (line-beginning-position) (line-end-position))) (http-status (save-match-data (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) (match-string 1 http-msg))))) (plist-put proc-info :http-status http-status) (plist-put proc-info :status (string-trim http-msg)) (gptel--fsm-transition fsm)))) ;Response started, WAIT -> TYPE (when-let* ((http-msg (plist-get proc-info :status)) (http-status (plist-get proc-info :http-status))) ;; Find data chunk(s) and run callback ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 (when (member http-status '("200" "100")) (let ((response (gptel-curl--parse-stream (plist-get proc-info :backend) proc-info)) (reasoning-block (plist-get proc-info :reasoning-block))) ;; Depending on the API, there are two modes that reasoning or ;; chain-of-thought content appears: as part of the main response ;; but surrounded by ... 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 "" response))) (progn (when (> idx 0) ;Collect leading whitespace before (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 "" response))) (progn (funcall callback (cons 'reasoning (substring response nil (+ idx 8))) proc-info) (setq reasoning-block t) ;Signal end of reasoning stream (plist-put proc-info :reasoning-block t) (setq response (substring response (+ idx 8)))) (setq response (cons 'reasoning response))))) (when (eq reasoning-block t) ;End of reasoning block (funcall callback '(reasoning . t) proc-info) (plist-put proc-info :reasoning-block 'done)))) (unless (equal response "") ;Response callback (funcall callback response proc-info)))))))) (cl-defgeneric gptel-curl--parse-stream (backend proc-info) "Stream parser for gptel-curl. Implementations of this function run as part of the process filter for the active query, and return partial responses from the LLM. BACKEND is the LLM backend in use. PROC-INFO is a plist with process information and other context. See `gptel-curl--get-response' for its contents.") (defun gptel-curl--sentinel (process _status) "Process sentinel for gptel curl requests. PROCESS and _STATUS are process parameters." (let ((proc-buf (process-buffer process))) (when-let* (((eq (process-status process) 'exit)) (fsm (car (alist-get process gptel--request-alist))) (proc-info (gptel-fsm-info fsm)) (proc-callback (plist-get proc-info :callback))) (when gptel-log-level (gptel-curl--log-response proc-buf proc-info)) ;logging (let ((exit-status (process-exit-status process))) (if (zerop exit-status) (pcase-let ((`(,response ,http-status ,http-msg ,error) (with-current-buffer proc-buf (gptel-curl--parse-response proc-info)))) (plist-put proc-info :http-status http-status) (plist-put proc-info :status http-msg) (gptel--fsm-transition fsm) ;WAIT -> TYPE (when error (plist-put proc-info :error error)) ;; Look for a reasoning block (if (and (stringp response) (string-match-p "^\\s-*" response)) (when-let* ((idx (string-search "" response))) (with-demoted-errors "gptel callback error: %S" (funcall proc-callback (cons 'reasoning (substring response nil (+ idx 8))) proc-info)) (setq response (string-trim-left (substring response (+ idx 8))))) (when-let* ((reasoning (plist-get proc-info :reasoning)) ((stringp reasoning))) (funcall proc-callback (cons 'reasoning reasoning) proc-info))) ;; Call callback with response text (when (or response (not (member http-status '("200" "100")))) (with-demoted-errors "gptel callback error: %S" (funcall proc-callback response proc-info)))) ;; Curl exited with a non-zero status: connection-level failure (plist-put proc-info :error (format "Curl failed with exit code %d. See Curl manpage for details." exit-status)) (plist-put proc-info :status "Curl failure") (gptel--fsm-transition fsm) ;WAIT -> TYPE (with-demoted-errors "gptel callback error: %S" (funcall proc-callback nil proc-info)))) (gptel--fsm-transition fsm)) ;TYPE -> next (setf (alist-get process gptel--request-alist nil 'remove) nil) (kill-buffer proc-buf))) (defun gptel-curl--parse-response (proc-info) "Parse the buffer BUF with curl's response. PROC-INFO is a plist with contextual information." (let ((uuid (plist-get proc-info :uuid))) (goto-char (point-max)) (if (not (search-backward uuid nil t)) (list nil nil nil "Could not parse curl response.") (backward-char) (pcase-let* ((`(,_ . ,header-size) (read (current-buffer)))) (goto-char (point-min)) (if-let* ((http-msg (string-trim (buffer-substring (line-beginning-position) (line-end-position)))) (http-status (save-match-data (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) (match-string 1 http-msg)))) (response (progn (goto-char header-size) (condition-case nil (gptel--json-read) (error 'json-read-error))))) (cond ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 ((member http-status '("200" "100")) (list (and-let* ((resp (gptel--parse-response (plist-get proc-info :backend) response proc-info)) ((not (string-blank-p resp)))) (string-trim resp)) http-status http-msg)) ((and-let* ((error-data (gptel--parse-response-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