From: Andreas Gerler Date: Sun, 26 Apr 2026 17:53:40 +0000 (+0200) Subject: update gptel X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=e20eb7a1f5de05712f841ad04eb2670fa2f765b1;p=emacsconfig.git update gptel --- diff --git a/elpa/gptel-20260123.739/gptel-anthropic.el b/elpa/gptel-20260123.739/gptel-anthropic.el deleted file mode 100644 index 6ef77ba4..00000000 --- a/elpa/gptel-20260123.739/gptel-anthropic.el +++ /dev/null @@ -1,722 +0,0 @@ -;;; gptel-anthropic.el --- Anthropic AI suppport for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur - -;; 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: - -;; This file adds support for Anthropic's Messages API to gptel - -;;; Code: -(require 'cl-generic) -(require 'cl-lib) -(require 'map) -(require 'gptel) - -(defvar json-object-type) - -(declare-function prop-match-value "text-property-search") -(declare-function text-property-search-backward "text-property-search") -(declare-function json-read "json" ()) -(declare-function gptel-context--wrap "gptel-context") -(declare-function gptel-context--collect-media "gptel-context") - -;;; Anthropic (Messages API) -(cl-defstruct (gptel-anthropic (:constructor gptel--make-anthropic) - (:copier nil) - (:include gptel-backend))) - -;; NOTE the crucial difference between -;; - (push val (plist-get info :key)) and -;; (plist-put (plist-get info :key) (cons val ...)) -;; -;; - (setf (plist-get info :key) val) and -;; (plist-put info :key val) -;; -;; in the following function. The first variant conses at the head of info, the -;; second one at the tail. This means only the second option is viable for -;; mutating a plist function argument that's passed by reference. -;; Do NOT change the plist-put to push or setf! - -;; NOTE: The stream parser looks complicated only because it handles streaming -;; tool calls, streaming "thinking" blocks and their interactions. Stream -;; parsing is simple: if you are studying this code, look instead at a commit -;; from before tool-use support was added to gptel. -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-anthropic) info) - "Parse an Anthropic data stream. - -Return the text response accumulated since the last call to this -function. Additionally, mutate state INFO to add tool-use -information if the stream contains it. Not my best work, I know." - (let* ((content-strs) - (pt (point))) - (condition-case nil - (while (re-search-forward "^event: " nil t) - (setq pt (match-beginning 0)) - (if (equal (line-end-position) (point-max)) - (error "Data block incomplete")) - (cond - ((looking-at "content_block_delta") ;collect incremental - (forward-line 1) (forward-char 5) ;text, tool or thinking block - (when-let* ((delta (plist-get (gptel--json-read) :delta))) - (if-let* ((content (plist-get delta :text)) - ((not (eq content :null)))) - (push content content-strs) ;collect text - (if-let* ((partial-json (plist-get delta :partial_json))) - (plist-put ;collect partial tool input - info :partial_json - (cons partial-json (plist-get info :partial_json))) - (if-let* ((thinking (plist-get delta :thinking))) - (plist-put info :reasoning - (concat (plist-get info :reasoning) thinking)) - (if-let* ((signature (plist-get delta :signature))) - (plist-put info :signature - (concat (plist-get info :signature) signature)))))))) - - ((looking-at "content_block_start") ;Is the following block text or tool-use? - (forward-line 1) (forward-char 5) - (when-let* ((cblock (plist-get (gptel--json-read) :content_block))) - (pcase (plist-get cblock :type) - ("text" (push (plist-get cblock :text) content-strs)) - ("tool_use" (plist-put info :tool-use - (cons (list :id (plist-get cblock :id) - :name (plist-get cblock :name)) - (plist-get info :tool-use)))) - ("thinking" (plist-put info :reasoning (plist-get cblock :thinking)) - (plist-put info :reasoning-block 'in))))) - - ((looking-at "content_block_stop") - (cond - ((plist-get info :partial_json) ;End of tool block - (condition-case-unless-debug nil ;Combine partial tool inputs - (let* ((args-json (apply #'concat (nreverse (plist-get info :partial_json)))) - (args-decoded ;Handle blank argument strings - (if (string-empty-p args-json) - nil (gptel--json-read-string args-json)))) - ;; Add the input to the tool-call spec - (plist-put (car (plist-get info :tool-use)) :input args-decoded)) - ;; If there was an error in reading that tool, we ignore it: - ;; TODO(tool) handle this error better - (error (pop (plist-get info :tool-use)))) ;TODO: nreverse :tool-use list - (plist-put info :partial_json nil)) - - ((eq (plist-get info :reasoning-block) 'in) ;End of reasoning block - (plist-put info :reasoning-block t)))) ;Signal end of reasoning stream to filter - - ((looking-at "message_delta") - ;; collect stop_reason, usage_tokens and prepare tools - (forward-line 1) (forward-char 5) - (when-let* ((tool-use (plist-get info :tool-use)) - (response (gptel--json-read))) - (let* ((data (plist-get info :data)) - (prompts (plist-get data :messages))) - (plist-put ; Append a COPY of response text + tool-use to the prompts list - data :messages - (vconcat - prompts - `((:role "assistant" - :content ,(vconcat ;Insert any LLM text and thinking text - (and-let* ((reasoning (plist-get info :partial_reasoning))) - `((:type "thinking" :thinking ,reasoning - :signature ,(plist-get info :signature)))) - (and-let* ((strs (plist-get info :partial_text))) - `((:type "text" :text ,(apply #'concat (nreverse strs))))) - (mapcar (lambda (tool-call) ;followed by the tool calls - (append (list :type "tool_use") - (copy-sequence tool-call))) - tool-use)))))) - (plist-put info :partial_text nil) ; Clear any captured text - ;; Then shape the tool-use block by adding args so we can call the functions - (mapc (lambda (tool-call) - (plist-put tool-call :args (plist-get tool-call :input)) - (plist-put tool-call :input nil) - (plist-put tool-call :id (plist-get tool-call :id))) - tool-use)) - (plist-put info :output-tokens - (map-nested-elt response '(:usage :output_tokens))) - (plist-put info :stop-reason - (map-nested-elt response '(:delta :stop_reason))))))) - (error (goto-char pt))) - (let ((response-text (apply #'concat (nreverse content-strs)))) - (unless (string-empty-p response-text) - (plist-put info :partial_text - (cons response-text (plist-get info :partial_text)))) - (when (plist-get info :tools) - (when-let* ((reasoning (plist-get info :reasoning))) - (plist-put info :partial_reasoning - (concat (plist-get info :partial_reasoning) reasoning)))) - response-text))) - -(cl-defmethod gptel--parse-response ((_backend gptel-anthropic) response info) - "Parse an Anthropic (non-streaming) RESPONSE and return response text. - -Mutate state INFO with response metadata." - (plist-put info :stop-reason (plist-get response :stop_reason)) - (plist-put info :output-tokens - (map-nested-elt response '(:usage :output_tokens))) - (cl-loop - with content = (plist-get response :content) - for cblock across content - for type = (plist-get cblock :type) - if (equal type "text") - ;; TODO(tool) can :text be :null? - collect (plist-get cblock :text) into content-strs - else if (equal type "tool_use") - collect cblock into tool-use - else if (equal type "thinking") - do - (plist-put - info :reasoning - (concat (plist-get info :reasoning) - (plist-get cblock :thinking))) - finally do - (when tool-use - ;; First, add the tool call to the prompts list - (let* ((data (plist-get info :data)) - (prompts (plist-get data :messages))) - (plist-put - data :messages - (vconcat prompts `((:role "assistant" :content ,content))))) - ;; Then capture the tool call data for running the tool - (cl-loop - for call-raw in tool-use - for call = (copy-sequence call-raw) do - (plist-put call :args (plist-get call :input)) - (plist-put call :input nil) - (plist-put call :id (plist-get call :id)) - collect call into calls - finally do (plist-put info :tool-use calls))) - finally return - (and content-strs (apply #'concat content-strs)))) - -(cl-defmethod gptel--request-data ((backend gptel-anthropic) prompts) - "JSON encode PROMPTS for sending to ChatGPT." - (let ((prompts-plist - `( :model ,(gptel--model-name gptel-model) - :stream ,(or gptel-stream :json-false) - :max_tokens ,(or gptel-max-tokens 4096) - :messages [,@prompts])) - (cachep (and (or (eq gptel-cache t) (memq 'system gptel-cache)) - (gptel--model-capable-p 'cache)))) - (when gptel--system-message - ;; gptel--system-message is a string or a list of strings - (plist-put - prompts-plist :system - (cond - ((consp gptel--system-message) ;multi-part system message - (vconcat (mapcar (lambda (part) - (nconc (list :type "text" :text part) - (and cachep - (list :cache_control - '(:type "ephemeral"))))) - gptel--system-message))) - (cachep `[(:type "text" :text ,gptel--system-message - :cache_control (:type "ephemeral"))]) - (t gptel--system-message)))) - (when gptel-temperature - (plist-put prompts-plist :temperature gptel-temperature)) - (when gptel-use-tools - (when (eq gptel-use-tools 'force) - (plist-put prompts-plist :tool_choice '(:type "any"))) - (when gptel-tools - (let ((tools-array (gptel--parse-tools backend gptel-tools))) - (plist-put prompts-plist :tools tools-array) - (when (and (or (eq gptel-cache t) (memq 'tool gptel-cache)) - (gptel--model-capable-p 'cache)) - (nconc (aref tools-array (1- (length tools-array))) - '(:cache_control (:type "ephemeral"))))))) - (when gptel--schema - (plist-put prompts-plist :tools - (vconcat - (list (gptel--parse-schema backend gptel--schema)) - (plist-get prompts-plist :tools))) - (plist-put prompts-plist :tool_choice - `(:type "tool" :name ,gptel--ersatz-json-tool))) - ;; Merge request params with model and backend params. - (gptel--merge-plists - prompts-plist - gptel--request-params - (gptel-backend-request-params gptel-backend) - (gptel--model-request-params gptel-model)))) - -(cl-defmethod gptel--parse-schema ((_backend gptel-anthropic) schema) - ;; Unlike the other backends, Anthropic generates JSON using a tool call. We - ;; write the tool here, meant to be added to :tools. - (list - :name "response_json" - :description "Record JSON output according to user prompt" - :input_schema (gptel--preprocess-schema - (gptel--dispatch-schema-type schema)))) - -(cl-defmethod gptel--parse-tools ((_backend gptel-anthropic) tools) - "Parse TOOLS to the Anthropic API tool definition spec. - -TOOLS is a list of `gptel-tool' structs, which see." - (vconcat - (mapcar - (lambda (tool) - (list :name (gptel-tool-name tool) - :description (gptel-tool-description tool) - :input_schema ;NOTE: Anthropic wants "{}" if the function takes no args, not null - (list :type "object" - ;; See the generic implementation for an explanation of this - ;; transformation. - :properties - (cl-loop - for arg in (gptel-tool-args tool) - for argspec = (copy-sequence arg) - for name = (plist-get arg :name) ;handled differently - for newname = (or (and (keywordp name) name) - (make-symbol (concat ":" name))) - do ;ARGSPEC is ARG without unrecognized keys - (cl-remf argspec :name) - (cl-remf argspec :optional) - if (equal (plist-get arg :type) "object") - do (unless (plist-member argspec :required) - (plist-put argspec :required [])) - append (list newname argspec)) - :required - (vconcat - (delq nil (mapcar - (lambda (arg) (and (not (plist-get arg :optional)) - (plist-get arg :name))) - (gptel-tool-args tool))))))) - (ensure-list tools)))) - -(cl-defmethod gptel--parse-tool-results ((_backend gptel-anthropic) tool-use) - "Return a prompt containing tool call results in TOOL-USE. - -TOOL-USE is a list of plists containing tool names, arguments and call results." - ;; (declare (side-effect-free t)) - (list - :role "user" - :content - (vconcat - (mapcar - (lambda (tool-call) - (let* ((result (plist-get tool-call :result)) - (formatted - (list :type "tool_result" - :tool_use_id (plist-get tool-call :id) - :content (if (stringp result) result - (prin1-to-string result))))) - (prog1 formatted - (when (plist-get tool-call :error) - (plist-put formatted :is_error t))))) - tool-use)))) - -;; NOTE: No `gptel--inject-prompt' method required for gptel-anthropic, since -;; this is handled by its defgeneric implementation - -;; TODO: Remove these functions (#792) -(defun gptel--anthropic-format-tool-id (tool-id) - (unless tool-id - (setq tool-id (substring - (md5 (format "%s%s" (random) (float-time))) - nil 24))) - (if (or (string-prefix-p "call_" tool-id) - (string-prefix-p "toolu_" tool-id)) - tool-id - (format "toolu_%s" tool-id))) - -(defun gptel--anthropic-unformat-tool-id (tool-id) - (or (and (string-match "toolu_\\(.+\\)" tool-id) - (match-string 1 tool-id)) - tool-id)) - -(cl-defmethod gptel--parse-list ((backend gptel-anthropic) prompt-list) - (let ((full-prompt - (if (consp (car prompt-list)) - (let ((prompts)) - (dolist (entry prompt-list) ; Advanced format, list of lists - (pcase entry - (`(prompt . ,msg) - (push (list :role "user" - :content `[(:type "text" :text ,(or (car-safe msg) msg))]) - prompts)) - (`(response . ,msg) - (push (list :role "assistant" - :content `[(:type "text" :text ,(or (car-safe msg) msg))]) - prompts)) - (`(tool . ,call) - (unless (plist-get call :id) - (plist-put call :id (gptel--anthropic-format-tool-id nil))) - (push (list :role "assistant" - :content `[( :type "tool_use" :id ,(plist-get call :id) - :name ,(plist-get call :name) - :input ,(plist-get call :args))]) - prompts) - (push (gptel--parse-tool-results backend (list (cdr entry))) prompts)))) - (nreverse prompts)) - (cl-loop for text in prompt-list ; Simple format, list of strings - for role = t then (not role) - if text - collect (list :role (if role "user" "assistant") - :content `[(:type "text" :text ,text)]))))) - ;; cache messages if required: add cache_control to the last message - (when (and (or (eq gptel-cache t) (memq 'message gptel-cache)) - (gptel--model-capable-p 'cache)) - (nconc (aref (plist-get (car (last full-prompt)) :content) 0) - '(:cache_control (:type "ephemeral")))) - full-prompt)) - -(cl-defmethod gptel--parse-buffer ((backend gptel-anthropic) &optional max-entries) - (let ((prompts) (prev-pt (point))) - (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min))) - (not (= (point) prev-pt))) - ;; HACK Until we can find a more robust solution for editing - ;; responses, ignore prompts containing only whitespace, as the - ;; Anthropic API can't handle it. See #452, #409, #406, #351 and #321 - ;; We check for blank prompts by skipping whitespace and comparing - ;; point against the previous. - (unless (save-excursion (skip-syntax-forward " ") (>= (point) prev-pt)) - (pcase (get-char-property (point) 'gptel) - ('response - (when-let* ((content - (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt)))) - (when (not (string-blank-p content)) - (push (list :role "assistant" :content content) prompts)))) - (`(tool . ,id) - (save-excursion - (condition-case nil - (let* ((tool-call (read (current-buffer))) - ;; (id (gptel--anthropic-format-tool-id id)) - (name (plist-get tool-call :name)) - (arguments (plist-get tool-call :args))) - (unless id (setq id (gptel--anthropic-format-tool-id nil))) - (plist-put tool-call :id id) - (plist-put tool-call :result - (string-trim (buffer-substring-no-properties - (point) prev-pt))) - (push (gptel--parse-tool-results backend (list tool-call)) - prompts) - (push (list :role "assistant" - :content `[( :type "tool_use" :id ,id :name ,name - :input ,arguments)]) - prompts)) - ((end-of-file invalid-read-syntax) - (message (format "Could not parse tool-call %s on line %s" - id (line-number-at-pos (point)))))))) - ('ignore) - ('nil ; user role: possibly with media - (if gptel-track-media - (when-let* ((content (gptel--anthropic-parse-multipart - (gptel--parse-media-links major-mode (point) prev-pt)))) - (when (> (length content) 0) - (push (list :role "user" :content content) prompts))) - (when-let* ((content (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt)))) - (push (list :role "user" :content content) prompts)))))) - (setq prev-pt (point)) - (and max-entries (cl-decf max-entries))) - (when-let* ((content (string-trim (buffer-substring-no-properties - (point-min) (point-max))))) - ;; XXX fails if content is empty. The correct error behavior is left to - ;; a future discussion. - (push (list :role "user" :content content) prompts))) - ;; Cache messages if required: add cache_control to the last message - (if (and (or (eq gptel-cache t) (memq 'message gptel-cache)) - (gptel--model-capable-p 'cache)) - (let ((last-message (plist-get (car (last prompts)) :content))) - (if (stringp last-message) - (plist-put - (car (last prompts)) :content - `[(:type "text" :text ,last-message - :cache_control (:type "ephemeral"))]) - (nconc (aref (plist-get (car (last prompts)) :content) 0) - '(:cache_control (:type "ephemeral")))))) - prompts)) - -(defun gptel--anthropic-parse-multipart (parts) - "Convert a multipart prompt PARTS to the Anthropic API format. - -The input is an alist of the form - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")). - -The output is a vector of entries in a backend-appropriate -format." - (cl-loop - for part in parts - for n upfrom 1 - with last = (length parts) - with type - for text = (plist-get part :text) - for mime = (plist-get part :mime) - for media = (plist-get part :media) - if text do - (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and - if text - collect `(:type "text" :text ,text) into parts-array end - else if media - do - (setq type (cond ;Currently supported: Images and PDFs - ((equal (substring mime 0 5) "image") "image") - ;; NOTE: Only Claude 3.5 Sonnet supports PDF documents: - ((equal mime "application/pdf") "document") - (t (error (concat "(gptel-anthropic) Request aborted: " - "trying to send unsupported MIME type %s") - mime)))) - and collect - `(:type ,type - :source (:type "base64" - :media_type ,(plist-get part :mime) - :data ,(gptel--base64-encode media))) - into parts-array - else if (plist-get part :textfile) collect - `(:type "text" - :text ,(with-temp-buffer - (gptel--insert-file-string (plist-get part :textfile)) - (buffer-string))) - into parts-array - finally return (vconcat parts-array))) - -(cl-defmethod gptel--inject-media ((_backend gptel-anthropic) prompts) - "Wrap the first user prompt in PROMPTS with included media files. - -Media files, if present, are placed in `gptel-context'." - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf (lambda (current) - (vconcat - (gptel--anthropic-parse-multipart media-list) - (cl-typecase current - (string `((:type "text" :text ,current))) - (vector current) - (t current)))) - (plist-get (car prompts) :content)))) - -;; (if-let* ((context-string (gptel-context--string gptel-context))) -;; (cl-callf (lambda (previous) -;; (cl-typecase previous -;; (string (concat context-string previous)) -;; (vector (vconcat `((:type "text" :text ,previous)) -;; previous)) -;; (t context-string))) -;; (plist-get (car (last prompts)) :content))) - -(defconst gptel--anthropic-models - '((claude-sonnet-4-5-20250929 - :description "High-performance model with exceptional reasoning and efficiency" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 3 - :output-cost 15 - :cutoff-date "2025-07") - (claude-haiku-4-5-20251001 - :description "Near-frontier intelligence at blazing speeds with extended thinking" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 1 - :output-cost 5 - :cutoff-date "2025-02") - (claude-sonnet-4-20250514 - :description "High-performance model with exceptional reasoning and efficiency" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 3 - :output-cost 15 - :cutoff-date "2025-03") - (claude-opus-4-5-20251101 - :description "Most capable model for complex reasoning and advanced coding" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 5 - :output-cost 25 - :cutoff-date "2025-03") - (claude-opus-4-1-20250805 - :description "Most capable model for complex reasoning and advanced coding" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 15 - :output-cost 75 - :cutoff-date "2025-03") - (claude-opus-4-20250514 - :description "Anthropic's previous flagship model" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 15 - :output-cost 75 - :cutoff-date "2025-03") - (claude-3-7-sonnet-20250219 - :description "Hybrid model capable of standard thinking and extended thinking modes" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 3 - :output-cost 15 - :cutoff-date "2025-02") - (claude-3-5-sonnet-20241022 - :description "Highest level of intelligence and capability" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 200 - :input-cost 3 - :output-cost 15 - :cutoff-date "2024-04") - (claude-3-5-sonnet-20240620 - :description "Highest level of intelligence and capability (earlier version)" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 200 - :input-cost 3 - :output-cost 15 - :cutoff-date "2024-04") - (claude-3-5-haiku-20241022 - :description "Intelligence at blazing speeds" - :capabilities (tool-use cache) - :context-window 200 - :input-cost 1.00 - :output-cost 5.00 - :cutoff-date "2024-07") - (claude-3-opus-20240229 - :description "Top-level performance, intelligence, fluency, and understanding" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 200 - :input-cost 15 - :output-cost 75 - :cutoff-date "2023-08") - (claude-3-haiku-20240307 - :description "Fast and most compact model for near-instant responsiveness" - :capabilities (tool-use cache) - :context-window 200 - :input-cost 0.25 - :output-cost 1.25 - :cutoff-date "2023-08")) - "List of available Anthropic models and associated properties. -Keys: - -- `:description': a brief description of the model. - -- `:capabilities': a list of capabilities supported by the model. - -- `:mime-types': a list of supported MIME types for media files. - -- `:context-window': the context window size, in thousands of tokens. - -- `:input-cost': the input cost, in US dollars per million tokens. - -- `:output-cost': the output cost, in US dollars per million tokens. - -- `:cutoff-date': the knowledge cutoff date. - -- `:request-params': a plist of additional request parameters to - include when using this model. - -Information about the Anthropic models was obtained from the following -comparison table: - -URL `https://docs.anthropic.com/en/docs/about-claude/models#model-comparison-table'") - -;;;###autoload -(cl-defun gptel-make-anthropic - (name &key curl-args stream key request-params - (header - (lambda () (when-let* ((key (gptel--get-api-key))) - `(("x-api-key" . ,key) - ("anthropic-version" . "2023-06-01") - ("anthropic-beta" . "extended-cache-ttl-2025-04-11"))))) - (models gptel--anthropic-models) - (host "api.anthropic.com") - (protocol "https") - (endpoint "/v1/messages")) - "Register an Anthropic API-compatible backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, \"api.anthropic.com\" by default. - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--anthropic-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(claude-3-haiku-20240307 ;Simple specs - claude-3-opus-20240229 - (claude-3-5-sonnet-20240620 ;Full spec - :description \"Balance of intelligence and speed\" - :capabilities (media tool json) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1/messages\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY is a variable whose value is the API key, or function that -returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for." - (declare (indent 1)) - (let ((backend (gptel--make-anthropic - :curl-args curl-args - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :url (if protocol - (concat protocol "://" host endpoint) - (concat host endpoint))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -(provide 'gptel-anthropic) -;;; gptel-anthropic.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not docstrings) -;; End: - diff --git a/elpa/gptel-20260123.739/gptel-autoloads.el b/elpa/gptel-20260123.739/gptel-autoloads.el deleted file mode 100644 index d01e3cb8..00000000 --- a/elpa/gptel-20260123.739/gptel-autoloads.el +++ /dev/null @@ -1,700 +0,0 @@ -;;; gptel-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from gptel.el - -(autoload 'gptel-mode "gptel" "\ -Minor mode for interacting with LLMs. - -This is a minor mode. If called interactively, toggle the `GPTel mode' -mode. If the prefix argument is positive, enable the mode, and if it is -zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate the variable `gptel-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(autoload 'gptel-send "gptel" "\ -Submit this prompt to the current LLM backend. - -By default, the contents of the buffer up to the cursor position -are sent. If the region is active, its contents are sent -instead. - -The response from the LLM is inserted below the cursor position -at the time of sending. To change this behavior or model -parameters, use prefix arg ARG activate a transient menu with -more options instead. - -This command is asynchronous, you can continue to use Emacs while -waiting for the response. - -(fn &optional ARG)" t) -(autoload 'gptel "gptel" "\ -Switch to or start a chat session with NAME. - -Ask for API-KEY if `gptel-api-key' is unset. - -If region is active, use it as the INITIAL prompt. Returns the -buffer created or switched to. - -INTERACTIVEP is t when gptel is called interactively. - -(fn NAME &optional _ INITIAL INTERACTIVEP)" t) -(register-definition-prefixes "gptel" '("gptel-")) - - -;;; Generated autoloads from gptel-anthropic.el - -(autoload 'gptel-make-anthropic "gptel-anthropic" "\ -Register an Anthropic API-compatible backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, \"api.anthropic.com\" by default. - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--anthropic-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(claude-3-haiku-20240307 ;Simple specs - claude-3-opus-20240229 - (claude-3-5-sonnet-20240620 ;Full spec - :description \"Balance of intelligence and speed\" - :capabilities (media tool json) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1/messages\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY is a variable whose value is the API key, or function that -returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"x-api-key\" \\=\\, key) (\"anthropic-version\" . \"2023-06-01\") (\"anthropic-beta\" . \"extended-cache-ttl-2025-04-11\"))))) (MODELS gptel--anthropic-models) (HOST \"api.anthropic.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/messages\"))") -(function-put 'gptel-make-anthropic 'lisp-indent-function 1) -(register-definition-prefixes "gptel-anthropic" '("gptel--anthropic-")) - - -;;; Generated autoloads from gptel-bedrock.el - -(autoload 'gptel-make-bedrock "gptel-bedrock" "\ -Register an AWS Bedrock backend for gptel with NAME. - -Keyword arguments: - -REGION - AWS region name (e.g. \"us-east-1\") -MODELS - The list of models supported by this backend -MODEL-REGION - one of apac, eu, us or nil -AWS-PROFILE - the aws profile to use for aws configure export-credentials -AWS-BEARER-TOKEN - the aws bearer-token for authenticating with AWS -CURL-ARGS - additional curl args -STREAM - Whether to use streaming responses or not. -REQUEST-PARAMS - a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. - -(fn NAME &key REGION (MODELS gptel--bedrock-models) (MODEL-REGION nil) STREAM CURL-ARGS REQUEST-PARAMS AWS-PROFILE AWS-BEARER-TOKEN (PROTOCOL \"https\"))") -(function-put 'gptel-make-bedrock 'lisp-indent-function 1) -(register-definition-prefixes "gptel-bedrock" '("gptel-")) - - -;;; Generated autoloads from gptel-context.el - - (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t) - (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t) -(autoload 'gptel-context--wrap "gptel-context" "\ -Add request context to DATA-BUF and run CALLBACK. - -DATA-BUF is the buffer where the request prompt is constructed. - -(fn CALLBACK DATA-BUF)") -(autoload 'gptel-context--collect "gptel-context" "\ -Get the list of all active context sources from CONTEXT-ALIST. - -CONTEXT-ALIST defaults to the current value of `gptel-context'. - -Ignore overlays, buffers and files that are not live or readable. - -(fn &optional CONTEXT-ALIST)") -(register-definition-prefixes "gptel-context" '("gptel-context-")) - - -;;; Generated autoloads from gptel-gemini.el - -(autoload 'gptel-make-gemini "gptel-gemini" "\ -Register a Gemini backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, defaults to -\"generativelanguage.googleapis.com\". - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--gemini-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(gemini-2.0-flash-lite ;Simple specs - gemini-1.5-flash - (gemini-1.5-pro-latest ;Full spec - :description - \"Complex reasoning tasks, problem solving and data extraction\" - :capabilities (tool json) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\"))) - - -STREAM is a boolean to enable streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, \"https\" by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1beta/models\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -(fn NAME &key CURL-ARGS HEADER KEY REQUEST-PARAMS (STREAM nil) (HOST \"generativelanguage.googleapis.com\") (PROTOCOL \"https\") (MODELS gptel--gemini-models) (ENDPOINT \"/v1beta/models\"))") -(function-put 'gptel-make-gemini 'lisp-indent-function 1) -(register-definition-prefixes "gptel-gemini" '("gptel--gemini-")) - - -;;; Generated autoloads from gptel-gh.el - -(autoload 'gptel-make-gh-copilot "gptel-gh" "\ -Register a Github Copilot chat backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, typically \"api.githubcopilot.com\". - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--openai-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(gpt-3.5-turbo ;Simple specs - gpt-4-turbo - (gpt-4o-mini ;Full spec - :description - \"Affordable and intelligent small model for lightweight tasks\" - :capabilities (media tool json url) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) - -Defaults to a list of models supported by GitHub Copilot. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/chat/completions\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that returns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -Defaults to headers required by GitHub Copilot. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -(fn NAME &key CURL-ARGS REQUEST-PARAMS (HEADER (lambda nil (gptel--gh-auth) \\=`((\"openai-intent\" . \"conversation-panel\") (\"authorization\" \\=\\, (concat \"Bearer \" (plist-get (gptel--gh-token gptel-backend) :token))) (\"x-request-id\" \\=\\, (gptel--gh-uuid)) (\"vscode-sessionid\" \\=\\, (or (gptel--gh-sessionid gptel-backend) \"\")) (\"vscode-machineid\" \\=\\, (or (gptel--gh-machineid gptel-backend) \"\")) ,@(when (and gptel-track-media (gptel--model-capable-p \\='media)) \\=`((\"copilot-vision-request\" . \"true\"))) (\"copilot-integration-id\" . \"vscode-chat\")))) (HOST \"api.githubcopilot.com\") (PROTOCOL \"https\") (ENDPOINT \"/chat/completions\") (STREAM t) (MODELS gptel--gh-models))") -(function-put 'gptel-make-gh-copilot 'lisp-indent-function 1) -(register-definition-prefixes "gptel-gh" '("gptel-")) - - -;;; Generated autoloads from gptel-integrations.el - -(register-definition-prefixes "gptel-integrations" '("gptel-mcp-")) - - -;;; Generated autoloads from gptel-kagi.el - -(autoload 'gptel-make-kagi "gptel-kagi" "\ -Register a Kagi FastGPT backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is the Kagi host (with port), defaults to \"kagi.com\". - -MODELS is a list of available Kagi models: only fastgpt is supported. - -STREAM is a boolean to toggle streaming responses, defaults to -false. Kagi does not support a streaming API yet. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/api/v0/fastgpt\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -Example: -------- - - (gptel-make-kagi \"Kagi\" :key my-kagi-key) - -(fn NAME &key CURL-ARGS STREAM KEY (HOST \"kagi.com\") (HEADER (lambda nil \\=`((\"Authorization\" \\=\\, (concat \"Bot \" (gptel--get-api-key)))))) (MODELS \\='((fastgpt :capabilities (nosystem)) (summarize:cecil :capabilities (nosystem)) (summarize:agnes :capabilities (nosystem)) (summarize:daphne :capabilities (nosystem)) (summarize:muriel :capabilities (nosystem)))) (PROTOCOL \"https\") (ENDPOINT \"/api/v0/\"))") -(function-put 'gptel-make-kagi 'lisp-indent-function 1) - - -;;; Generated autoloads from gptel-ollama.el - -(autoload 'gptel-make-ollama "gptel-ollama" "\ -Register an Ollama backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is where Ollama runs (with port), defaults to localhost:11434 - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -Currently recognized plist keys are :description, :capabilities -and :mime-types. An example of a model specification including -both kinds of specs: - -:models -\\='(mistral:latest ;Simple specs - openhermes:latest - (llava:13b ;Full spec - :description - \"Llava 1.6: Large Lanuage and Vision Assistant\" - :capabilities (media) - :mime-types (\"image/jpeg\" \"image/png\"))) - - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, http by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/api/generate\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. This is typically not required -for local models like Ollama. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -Example: -------- - - (gptel-make-ollama - \"Ollama\" - :host \"localhost:11434\" - :models \\='(mistral:latest) - :stream t) - -(fn NAME &key CURL-ARGS HEADER KEY MODELS STREAM REQUEST-PARAMS (HOST \"localhost:11434\") (PROTOCOL \"http\") (ENDPOINT \"/api/chat\"))") -(function-put 'gptel-make-ollama 'lisp-indent-function 1) -(register-definition-prefixes "gptel-ollama" '("gptel--ollama-")) - - -;;; Generated autoloads from gptel-openai.el - -(autoload 'gptel-make-openai "gptel-openai" "\ -Register an OpenAI API-compatible backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, typically \"api.openai.com\". - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--openai-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(gpt-3.5-turbo ;Simple specs - gpt-4-turbo - (gpt-4o-mini ;Full spec - :description - \"Affordable and intelligent small model for lightweight tasks\" - :capabilities (media tool json url) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1/chat/completions\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that returns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -(fn NAME &key CURL-ARGS MODELS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.openai.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\"))") -(function-put 'gptel-make-openai 'lisp-indent-function 1) -(autoload 'gptel-make-azure "gptel-openai" "\ -Register an Azure backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is the API host. - -MODELS is a list of available model names, as symbols. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT is the API endpoint for completions. - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -Example: -------- - - (gptel-make-azure - \"Azure-1\" - :protocol \"https\" - :host \"RESOURCE_NAME.openai.azure.com\" - :endpoint - \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\" - :stream t - :models \\='(gpt-3.5-turbo gpt-4)) - -(fn NAME &key CURL-ARGS HOST (PROTOCOL \"https\") (HEADER (lambda nil \\=`((\"api-key\" \\=\\, (gptel--get-api-key))))) (KEY \\='gptel-api-key) MODELS STREAM ENDPOINT REQUEST-PARAMS)") -(function-put 'gptel-make-azure 'lisp-indent-function 1) -(defalias 'gptel-make-gpt4all 'gptel-make-openai "\ -Register a GPT4All backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is where GPT4All runs (with port), typically localhost:4891 - -MODELS is a list of available model names, as symbols. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/api/v1/completions\" - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: -((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. This is typically not required for -local models like GPT4All. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -Example: -------- - -(gptel-make-gpt4all - \"GPT4All\" - :protocol \"http\" - :host \"localhost:4891\" - :models \\='(mistral-7b-openorca.Q4_0.gguf))") -(register-definition-prefixes "gptel-openai" '("gptel-")) - - -;;; Generated autoloads from gptel-openai-extras.el - -(autoload 'gptel-make-privategpt "gptel-openai-extras" "\ -Register an Privategpt API-compatible backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, \"api.privategpt.com\" by default. - -MODELS is a list of available model names. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1/messages\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: -((\"Content-Type\" . \"application/json\")) - -KEY is a variable whose value is the API key, or function that -returns the key. - -CONTEXT and SOURCES: if true (the default), use available context -and provide sources used by the model to generate the response. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"localhost:8001\") (PROTOCOL \"http\") (MODELS \\='(private-gpt)) (ENDPOINT \"/v1/chat/completions\") (CONTEXT t) (SOURCES t))") -(function-put 'gptel-make-privategpt 'lisp-indent-function 1) -(autoload 'gptel-make-perplexity "gptel-openai-extras" "\ -Register a Perplexity backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, \"api.perplexity.ai\" by default. - -MODELS is a list of available model names. - -STREAM is a boolean to toggle streaming responses. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions. - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that returns an -alist. - -KEY is a variable whose value is the API key, or function that -returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters. - -(fn NAME &key CURL-ARGS STREAM KEY (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.perplexity.ai\") (PROTOCOL \"https\") (MODELS \\='(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research)) (ENDPOINT \"/chat/completions\") REQUEST-PARAMS)") -(function-put 'gptel-make-perplexity 'lisp-indent-function 1) -(autoload 'gptel-make-deepseek "gptel-openai-extras" "\ -Register a DeepSeek backend for gptel with NAME. - -For the meanings of the keyword arguments, see `gptel-make-openai'. - -(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.deepseek.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((deepseek-reasoner :capabilities (tool reasoning) :context-window 128 :input-cost 0.56 :output-cost 1.68) (deepseek-chat :capabilities (tool) :context-window 128 :input-cost 0.56 :output-cost 1.68))))") -(function-put 'gptel-make-deepseek 'lisp-indent-function 1) -(autoload 'gptel-make-xai "gptel-openai-extras" "\ -Register an xAI backend for gptel with NAME. - -Keyword arguments: - -KEY is a variable whose value is the API key, or function that -returns the key. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -The other keyword arguments are all optional. For their meanings -see `gptel-make-openai'. - -(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda nil (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.x.ai\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((grok-4 :description \"Grok Flagship model\" :capabilities (tool-use json reasoning) :context-window 256 :input-cost 3 :output-cost 15) (grok-code-fast-1 :description \"Fast reasoning model for agentic coding\" :capabilities (tool-use json reasoning) :context-window 256 :input-cost 0.2 :output-cost 1.5) (grok-3 :description \"Grok 3\" :capabilities (tool-use json reasoning) :context-window 131 :input-cost 3 :output-cost 15) (grok-3-fast :description \"Faster Grok 3\" :capabilities (tool-use json reasoning) :context-window 131 :input-cost 5 :output-cost 25) (grok-3-mini :description \"Mini Grok 3\" :capabilities (tool-use json reasoning) :context-window 131 :input-cost 0.3 :output-cost 0.5) (grok-3-mini-fast :description \"Faster mini Grok 3\" :capabilities (tool-use json reasoning) :context-window 131072 :input-cost 0.6 :output-cost 4) (grok-2-vision-1212 :description \"Grok 2 Vision\" :capabilities (tool-use json media) :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\") :context-window 32768 :input-cost 2 :output-cost 10))))") -(function-put 'gptel-make-xai 'lisp-indent-function 1) -(register-definition-prefixes "gptel-openai-extras" '("gptel--p")) - - -;;; Generated autoloads from gptel-org.el - -(autoload 'gptel--convert-markdown->org "gptel-org" "\ -Convert string STR from markdown to org markup. - -This is a very basic converter that handles only a few markup -elements. - -(fn STR)") -(autoload 'gptel--stream-convert-markdown->org "gptel-org" "\ -Return a Markdown to Org converter. - -This function parses a stream of Markdown text to Org -continuously when it is called with successive chunks of the -text stream. - -START-MARKER is used to identify the corresponding process when -cleaning up after. - -(fn START-MARKER)") -(register-definition-prefixes "gptel-org" '("gptel-")) - - -;;; Generated autoloads from gptel-request.el - -(autoload 'gptel-curl-get-response "gptel-request" "\ -Fetch response to prompt in state FSM from the LLM using Curl. - -FSM is the state machine driving this request. - -FSM is the state machine driving this request. Its INFO slot -contains the data required for setting up the request. INFO is a -plist with the following keys, among others: -- :data (the data being sent) -- :buffer (the gptel buffer) -- :position (marker at which to insert the response). -- :callback (optional, the request callback) - -Call CALLBACK with the response and INFO afterwards. If omitted -the response is inserted into the current buffer after point. - -(fn FSM)") -(register-definition-prefixes "gptel-request" '("gptel-")) - - -;;; Generated autoloads from gptel-rewrite.el - - (autoload 'gptel-rewrite "gptel-rewrite" nil t) -(register-definition-prefixes "gptel-rewrite" '("gptel-")) - - -;;; Generated autoloads from gptel-transient.el - - (autoload 'gptel-menu "gptel-transient" nil t) - (autoload 'gptel-system-prompt "gptel-transient" nil t) - (autoload 'gptel-tools "gptel-transient" nil t) -(register-definition-prefixes "gptel-transient" '("gptel-")) - -;;; End of scraped data - -(provide 'gptel-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; gptel-autoloads.el ends here diff --git a/elpa/gptel-20260123.739/gptel-bedrock.el b/elpa/gptel-20260123.739/gptel-bedrock.el deleted file mode 100644 index 0ccbd5cf..00000000 --- a/elpa/gptel-20260123.739/gptel-bedrock.el +++ /dev/null @@ -1,660 +0,0 @@ -;;; gptel-bedrock.el --- AWS Bedrock support for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2025 Karthik Chikmagalur - -;; Keywords: comm, convenience - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This file adds support for AWS Bedrock to gptel. Documentation for the request data and the -;; response payloads can be found at these two links: -;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html -;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ConverseStream.html - -;;; Code: -(require 'cl-lib) -(require 'map) -(require 'gptel) -(require 'mail-parse) - -(declare-function gptel-context--collect-media "gptel-context") -(declare-function gptel-context--wrap "gptel-context") - -(cl-defstruct (gptel-bedrock (:constructor gptel--make-bedrock) - (:copier nil) - (:include gptel-backend)) - model-region) - -(defconst gptel-bedrock--prompt-type - ;; For documentation purposes only -- this describes the type of prompt objects that get passed - ;; around. https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Message.html - '(plist - :role (member "user" "assistant") - :content (array (or (plist :text string) - (plist :image (:format (member "png" "jpeg" "gif" "webp") - :source (plist :bytes string))) ; bytes is b64 encoded - (plist :document (:format (member "pdf" "csv" "doc" "docx" "xls" "xlsx" "html" "txt" "md") - :name string - :source (plist :bytes string))) ; bytes is b64 encoded - (plist :toolUse (plist :input any :name string :toolUseId string)) - (plist :toolResult (plist - :toolUseId string - :status (member "success" "error") - ;; AWS allows more result types in - ;; ToolResultContentBlock, but we only send text results - :content (array (plist :text string)))))))) - -(cl-defmethod gptel--request-data ((backend gptel-bedrock) prompts) - "Prepare request data for AWS Bedrock BACKEND from PROMPTS." - ;; First, build the core Bedrock request data structure. - (let ((base-request-data - (nconc - `(:messages [,@prompts] :inferenceConfig (:maxTokens ,(or gptel-max-tokens 500))) - (when gptel--system-message `(:system [(:text ,gptel--system-message)])) - (when gptel-temperature `(:temperature ,gptel-temperature)) - (when (and gptel-use-tools gptel-tools) - `(:toolConfig (:toolChoice ,(if (eq gptel-use-tools 'force) '(:any '()) '(:auto '())) - :tools ,(gptel--parse-tools backend gptel-tools))))))) - - ;; Finally, merge all potential :request-params sources. - (gptel--merge-plists - base-request-data ; The core data we just built - gptel--request-params ; Global/buffer-local gptel--request-params - (gptel-backend-request-params backend) ; From `gptel-make-bedrock` call - (gptel--model-request-params gptel-model)))) ; From the model's properties - -(cl-defmethod gptel--parse-tools ((_backend gptel-bedrock) tools) - "Parse TOOLS and return a list of ToolSpecification objects. - -TOOLS is a list of `gptel-tool' structs, which see." - ;; https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ToolSpecification.html - (let ((default-outputs (cl-call-next-method))) ;; use openai tool-parse - (cl-map 'vector - (lambda (tool spec) - (list :toolSpec - (list - :name (gptel-tool-name tool) - :description (gptel-tool-description tool) - :inputSchema (list :json (plist-get (plist-get spec :function) :parameters))))) - (ensure-list tools) default-outputs))) - -(cl-defmethod gptel--parse-response ((_backend gptel-bedrock) response info) - "Parse a Bedrock (non-streaming) RESPONSE and return response text. - -Mutate state INFO with response metadata." - (plist-put info :stop-reason (plist-get response :stopReason)) - (plist-put info :input-tokens - (map-nested-elt response '(:usage :inputTokens))) - (plist-put info :output-tokens - (map-nested-elt response '(:usage :outputTokens))) - - (let* ((message (map-nested-elt response '(:output :message))) - (content-strs (thread-last (plist-get message :content) - (mapcar (lambda (cblock) (plist-get cblock :text))) - (delq nil)))) - (gptel-bedrock--record-tool-use message info) - (and content-strs (apply #'concat content-strs)))) - -(defun gptel-bedrock--record-tool-use (message info) - "If MESSAGE has tool use requests, save those to INFO." - (let* ((content (plist-get message :content)) - (tool-use-blocks (cl-remove-if-not - (lambda (cblock) (plist-get cblock :toolUse)) - content))) - (when tool-use-blocks - (cl-callf vconcat (plist-get (plist-get info :data) :messages) (list message)) - - (plist-put info :tool-use - (mapcar (lambda (block) - (let ((tool-use (plist-get block :toolUse))) - (list - :name (plist-get tool-use :name) - :args (plist-get tool-use :input) - :id (plist-get tool-use :toolUseId)))) - tool-use-blocks))))) - -(cl-defmethod gptel--parse-list ((_backend gptel-bedrock) prompt-strings) - "Create a list of prompt objects from PROMPT-STRINGS. - -Assumes this is a conversation with alternating roles." - (cl-loop for text in prompt-strings - for role = t then (not role) - if text collect - (list :role (if role "user" "assistant") - :content `[(:text ,text)]))) - -(cl-defmethod gptel--inject-media ((_backend gptel-bedrock) prompts) - "Wrap the first user prompt in PROMPTS with included media files. - -Media files, if present, are placed in `gptel-context'." - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf2 vconcat (gptel-bedrock--parse-multipart media-list) - (plist-get (car prompts) :content)))) - -(defvar-local gptel-bedrock--stream-cursor nil - "Marker to indicate last point parsed.") - -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-bedrock) info) - "Parse an AWS Bedrock streaming response from the ConverseStream API. -INFO is a plist containing the request context." - (cl-block fn - (save-excursion - ;; Each streaming request uses a fresh buffer, so the cursor starts out null. We keep it unset - ;; until we have received all the headers - (when (null gptel-bedrock--stream-cursor) - (goto-char (point-min)) - (unless (search-forward "\r\n\r\n" nil t) (cl-return-from fn)) - (save-restriction - (narrow-to-region (point-min) (point)) ; Required by mail-fetch-field - (let ((content-type (mail-header-parse-content-type - (mail-fetch-field "Content-Type")))) - (cl-assert content-type nil "No Content-Type header found") - (cl-assert (string-equal (car content-type) "application/vnd.amazon.eventstream") - t "Unexpected Content-Type %S, expected %S"))) - (setq gptel-bedrock--stream-cursor (point-marker)) - - ;; :accumulated-events contains the events from an in-progress message, from the - ;; messageStart onwards. With each messageStop it gets cleared - (plist-put info :accumulated-events nil)) - - ;; Start of main routine - (let ((acc-cell (cdr (plist-member info :accumulated-events))) strings prompts) - (goto-char gptel-bedrock--stream-cursor) - (while-let ((event (gptel-bedrock--parse-stream-message))) - (let ((event-type (assoc-default ":event-type" (plist-get event :headers)))) - (when (member event-type '("messageStart" "contentBlockStart" "contentBlockDelta" - "contentBlockStop")) - (push event (car acc-cell))) - (pcase event-type - ("metadata" - (plist-put info :input-tokens (map-nested-elt event '(:payload :usage :inputTokens))) - (plist-put info :output-tokens (map-nested-elt event '(:payload :usage :outputTokens)))) - ("contentBlockDelta" - (when-let ((delta-text (map-nested-elt event '(:payload :delta :text)))) - (push delta-text strings))) - ("messageStop" - (push (gptel-bedrock--assemble-content-blocks (nreverse (car acc-cell))) prompts) - (setf (car acc-cell) nil) - (plist-put info :stop-reason (map-nested-elt event '(:payload :stopReason))) - (plist-put info :message-complete t))))) - (move-marker gptel-bedrock--stream-cursor (point)) - - (dolist (message prompts) (gptel-bedrock--record-tool-use message info)) - (apply #'concat (nreverse strings)))))) - -(defun gptel-bedrock--parse-stream-message () - "Parse AWS Bedrock event-stream message starting at current position. -Point should be at the beginning of an event in the `vnd.amazon.event-stream' -format. Returns plist with :headers and :payload keys if successful, nil if -incomplete." - ;; https://github.com/awslabs/aws-c-event-stream has documentation of this format - ;; The format consists of three main sections: Prelude, Data, and Message CRC. - ;; 1. Prelude (12 bytes) - ;; a. Total Byte Length (4 bytes): Specifies the total length of the message. - ;; b. Headers Byte Length (4 bytes): Indicates the length of the headers section. - ;; c. Prelude CRC (4 bytes): A CRC value for validating the integrity of the prelude. - ;; 2. Data (variable length) - ;; a. Headers: An array of packed headers. Each header has a specific format documented in - ;; gptel-bedrock--parse-headers - ;; b. Payload: The main message content, also of variable length. Length can be computed from - ;; the prelude fields by subtracting the prelude length, headers length, and message CRC - ;; length from the total. - ;; 3. Message CRC (4 bytes): A 4-byte CRC to validate the integrity of the entire message. - - ;; (point-max) is the position after the last character, hence the use of >= and not > below - (when (>= (- (point-max) (point)) 12) - (let* ((prelude-start (point)) - (prelude-length 12) - (prelude-end (+ prelude-start prelude-length)) - (prelude (buffer-substring-no-properties prelude-start prelude-end)) - (total-length (gptel-bedrock--bytes-to-int32 (substring prelude 0 4))) - (headers-length (gptel-bedrock--bytes-to-int32 (substring prelude 4 8))) - (headers-start prelude-end) - (headers-end (+ headers-start headers-length)) - headers payload) - ;; We don't validate either CRC because isn't that what the networking stack is for? - - (when (>= (point-max) (+ prelude-start total-length)) - (goto-char headers-start) - (setq headers (gptel-bedrock--parse-headers (buffer-substring (point) headers-end))) - (cl-assert (equal (assoc-default ":message-type" headers) "event") - t "Unknown message type %S; expected %S") - (cl-assert (equal (assoc-default ":content-type" headers) "application/json") - t "Unexpected content-type %S is not %S") - - (goto-char headers-end) - (setq payload (gptel--json-read)) - (let* ((message-crc 4) - (payload-length (- total-length headers-length prelude-length message-crc))) - (cl-assert (= (- (point) headers-end) payload-length) - t "Unexpected payload length %d; expected %d.")) - - (goto-char (+ prelude-start total-length)) - `(:headers ,headers :payload ,payload))))) - -(defun gptel-bedrock--parse-headers (headers-data) - "Parse HEADERS-DATA into alist of (NAME . VALUE). -Keys are string-valued, lower-cased names." - ;; Header wire format: - ;; 1. Header Name Byte Length (1 byte): Specifies the length of the header name. - ;; 2. Header Name (String) (Variable length): Contains the name of the header. - ;; 3. Header Value Type (1 byte): Identifies the type of the header value. - ;; 4. Value String Byte Length (2 bytes): Indicates the length of the value string. - ;; 5. Value (Variable length): Holds the actual value bytes - (let ((pos 0) (max (length headers-data)) headers) - (cl-flet ((pos++ () (prog1 pos (cl-incf pos))) - (++pos (n) (cl-incf pos n)) - (utf8 (unibyte-string) (decode-coding-string unibyte-string 'utf-8 t))) - (while (< pos max) - (let* ((name-len (aref headers-data (pos++))) - (name (substring headers-data pos (++pos name-len))) - (type (aref headers-data (pos++))) - (value-len (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2)))) - (value - (pcase type - ;; Header types from https://awslabs.github.io/aws-crt-python/api/eventstream.html - (0 t) - (1 :json-false) - (2 (let ((res (aref headers-data (pos++)))) ; int8 - (if (> res 127) (- res 256) res))) - (3 (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2)))) ; int16 - (4 (gptel-bedrock--bytes-to-int32 (substring headers-data pos (++pos 4)))) ; int32 - (5 (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8)))) ; int64 - (6 (substring headers-data pos (++pos value-len))) ; raw bytes - (7 (utf8 (substring headers-data pos (++pos value-len)))) ; utf8 string - (8 (decode-time ; 64 bit int with seconds since the Unix epoch - (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8))) t)) - (9 (gptel-bedrock--bytes-to-uuid ; 16 byte UUID - (substring headers-data pos (++pos 16)))) - (_ (error "Unknown header type: %d" type))))) - (push (cons (downcase (utf8 name)) value) headers))) - (cl-assert (= pos max) t "Headers did not parse cleanly. pos=%d header-len=%d") - headers))) - -(defun gptel-bedrock--bytes-to-int16 (bytes) - "Convert 2-byte string BYTES to big-endian signed integer." - (let ((b0 (logand (aref bytes 0) 255)) - (b1 (logand (aref bytes 1) 255))) - (let ((result (+ (ash b0 8) b1))) - (if (>= b0 #x80) (- result (ash 1 16)) result)))) - -(defun gptel-bedrock--bytes-to-int32 (bytes) - "Convert 4-byte string BYTES to big-endian signed integer." - (let ((b0 (logand (aref bytes 0) 255)) - (b1 (logand (aref bytes 1) 255)) - (b2 (logand (aref bytes 2) 255)) - (b3 (logand (aref bytes 3) 255))) - (let ((result (+ (ash b0 24) (ash b1 16) (ash b2 8) b3))) - (if (>= b0 #x80) (- result (ash 1 32)) result)))) - -(defun gptel-bedrock--bytes-to-int64 (bytes) - "Convert 8-byte string BYTES to big-endian signed integer." - (let ((b0 (logand (aref bytes 0) 255)) - (b1 (logand (aref bytes 1) 255)) - (b2 (logand (aref bytes 2) 255)) - (b3 (logand (aref bytes 3) 255)) - (b4 (logand (aref bytes 4) 255)) - (b5 (logand (aref bytes 5) 255)) - (b6 (logand (aref bytes 6) 255)) - (b7 (logand (aref bytes 7) 255))) - (let ((result-u63 (+ (ash (logand b0 #x7f) 56) (ash b1 48) - (ash b2 40) (ash b3 32) (ash b4 24) (ash b5 16) (ash b6 8) b7))) - (if (>= b0 #x80) - (- result-u63 (ash 1 63)) - result-u63)))) - -(defun gptel-bedrock--bytes-to-uuid (bytes) - "Convert a 16-byte unibyte BYTES to a 36 character UUID string." - (unless (and (stringp bytes) (= (length bytes) 16)) - (error "Input must be a 16-byte unibyte string")) - (let ((hex (mapconcat (lambda (i) (format "%02x" (aref bytes i))) (number-sequence 0 15) ""))) - (format "%s-%s-%s-%s-%s" - (substring hex 0 8) - (substring hex 8 12) - (substring hex 12 16) - (substring hex 16 20) - (substring hex 20 32)))) - -(defun gptel-bedrock--assemble-content-blocks (events) - "Build a completed prompt object contained from EVENTS. -EVENTS should be a list of messageStart, contentBlockStart, -contentBlockDelta, and contentBlockStop stream messages as -returned by `gptel-bedrock--parse-stream-message', in the order -received." - (let ((blocks (make-hash-table :test #'eql)) - role contents) - (dolist (event events) - (let* ((headers (plist-get event :headers)) - (payload (plist-get event :payload)) - (event-type (assoc-default ":event-type" headers))) - (pcase event-type - ("messageStart" (setq role (plist-get payload :role))) - ("contentBlockStart" - (puthash (plist-get payload :contentBlockIndex) (list event) blocks)) - ("contentBlockDelta" - (push event (gethash (plist-get payload :contentBlockIndex) blocks))) - ("contentBlockStop" - (let* ((block-index (plist-get payload :contentBlockIndex)) - (block-events (nreverse (gethash block-index blocks))) - (start (car block-events)) - (deltas (cdr block-events))) - (when-let ((tool-use (map-nested-elt start '(:payload :start :toolUse)))) - (let ((id (plist-get tool-use :toolUseId)) - (name (plist-get tool-use :name)) - (input (gptel--json-read-string - (mapconcat - (lambda (delta) (map-nested-elt delta '(:payload :delta :toolUse :input))) - deltas)))) - (push - (list :toolUse (list :input input :name name :toolUseId id)) - contents))) - (when-let ((texts (delq nil (mapcar (lambda (d) (map-nested-elt d '(:payload :delta :text))) deltas)))) - (push (list :text (apply #'concat texts)) contents)) - ;; Currently we discard any reasoning content but this would be the spot to handle it - )) - (_ (error "Unexpected event-type %S" event-type))))) - (list :role role :content (vconcat (nreverse contents))))) - -(cl-defmethod gptel--parse-buffer ((_backend gptel-bedrock) &optional max-entries) - "Parse current buffer and return a list of prompt objects for Bedrock. - -MAX-ENTRIES is the maximum number of prompts to include." - (unless max-entries (setq max-entries most-positive-fixnum)) - (let ((prompts nil) (prev-pt (point)) - (include-media (and gptel-track-media (gptel--model-capable-p 'media)))) - (cl-flet ((capture-prompt (role beg end) - (let* ((content (if include-media - (gptel-bedrock--parse-multipart - (gptel--parse-media-links major-mode beg end)) - `[(:text ,(gptel--trim-prefixes - (buffer-substring-no-properties beg end)))])) - (prompt (list :role role :content content))) - (push prompt prompts)))) - - (if (or gptel-mode gptel-track-response) - (while (and (> max-entries 0) - (/= prev-pt (point-min)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min)))) - (capture-prompt (pcase (get-char-property (point) 'gptel) - ('response "assistant") - ('nil "user")) - (point) prev-pt) - (setq prev-pt (point)) - (cl-decf max-entries)) - (capture-prompt "user" (point-min) (point-max))) - prompts))) - -(defconst gptel-bedrock--image-formats - '(("image/jpg" . "jpeg") - ("image/jpeg" . "jpeg") - ("image/png" . "png") - ("image/gif" . "gif") - ("image/webp" . "webp")) - "Map of mime type to image formats as used in AWS's ImageBlock.") - -(defconst gptel-bedrock--doc-formats - '(("application/pdf" . "pdf") - ("text/csv" . "csv") - ("application/msword" . "doc") - ("application/vnd.openxmlformats-officedocument.wordprocessingml.document" . "docx") - ("application/vnd.ms-excel" . "xls") - ("application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" . "xlsx") - ("text/html" . "html") - ("text/plain" . "txt") - ("text/markdown" . "md")) - "Map of mime type to document formats as used in AWS's DocumentBlock.") - -(defun gptel-bedrock--parse-multipart (parts) - "Convert a multipart prompt PARTS to the AWS Bedrock API format. - -The input is a list of text and media plists of the form: - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")). - -The output is a vector of entries in Bedrock API format." - (thread-last parts - (cl-maplist - (lambda (tail) - (let* ((part (car tail)) - (text (plist-get part :text)) - (mime (plist-get part :mime)) - (media (plist-get part :media)) - (textfile (plist-get part :textfile)) - format) - (cond - (text (when (or (eq part (car parts)) (null (cdr tail))) - (setq text (gptel--trim-prefixes text))) - (unless (string-empty-p text) - `(:text ,text))) - (media - (cond - ((setq format (assoc mime gptel-bedrock--image-formats)) - `(:image (:format ,(cdr format) :source (:bytes ,(gptel--base64-encode media))))) - ((setq format (assoc mime gptel-bedrock--doc-formats)) - `(:document (:format ,(cdr format) - :name ,(file-name-nondirectory media) - :source (:bytes ,(gptel--base64-encode media))))) - (t (error "Unsupported MIME type %s for AWS Bedrock" mime)))) - (textfile `(:text ,(with-temp-buffer - (gptel--insert-file-string textfile) - (buffer-string)))))))) - (delq nil) - (vconcat))) - -;; gptel--inject-prompt not needed since the default implementation works here - -(cl-defmethod gptel--parse-tool-results ((_backend gptel-bedrock) tool-use-requests) - "Return a backend-appropriate prompt containing tool call results. - -TOOL-USE-REQUESTS is a list of request plists that have been -completed. Returns a single prompt object to inject into the -conversation." - (list - :role "user" - :content - (vconcat - (mapcar - (lambda (tool-call) - `(:toolResult (:toolUseId ,(plist-get tool-call :id) - :status "success" - :content [(:text ,(plist-get tool-call :result))]))) - tool-use-requests)))) - -(defvar gptel-bedrock--aws-profile-cache nil - "Cache for AWS profile credentials in the form of (PROFILE . CREDS).") - -(defun gptel-bedrock--fetch-aws-profile-credentials (profile &optional clear-cache) - "Fetch & cache AWS credentials for PROFILE using aws-cli. - -If PROFILE is the keyword ':static', then it fetches IAM credentials -from the aws-cli without any profile argument. - -Non-nil CLEAR-CACHE will refresh credentials." - (let* ((creds-json - (let ((cell (or (assoc profile gptel-bedrock--aws-profile-cache #'string=) - (car (push (cons profile nil) gptel-bedrock--aws-profile-cache))))) - (or (and (not clear-cache) (cdr cell)) - (setf (cdr cell) - (with-temp-buffer - (unless (zerop (apply #'call-process "aws" nil t nil "configure" "export-credentials" - (unless (eql profile :static) (list (format "--profile=%s" profile))))) - (user-error "Failed to get AWS credentials from profile")) - (json-parse-string (buffer-string))))))) - (expiration (if-let (exp (gethash "Expiration" creds-json)) - (date-to-time exp)))) - (cond - ((time-less-p (current-time) expiration) - (let ((access-key (gethash "AccessKeyId" creds-json)) - (secret-key (gethash "SecretAccessKey" creds-json)) - (session-token (gethash "SessionToken" creds-json))) - (cl-values access-key secret-key session-token))) - ((not clear-cache) - (gptel-bedrock--fetch-aws-profile-credentials profile t)) - (t (user-error "AWS credentials expired for profile: %s" profile))))) - -(defun gptel-bedrock--get-credentials (profile) - "Return the AWS credentials to use for the request. - -If credentials are not available based on the AWS_ACCESS_KEY_ID -AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN environment variables, -aws configure export-credentials is used to obtain credentials. -PROFILE specifies the AWS profile to use for retrieving -credentials. If PROFILE is unset, AWS_PROFILE environment -variable is used. - -Returns a list of 2-3 elements, depending on whether a session -token is needed, with this form: (AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY -AWS_SESSION_TOKEN). - -Convenient to use with `cl-multiple-value-bind'" - (let ((key-id (getenv "AWS_ACCESS_KEY_ID")) - (secret-key (getenv "AWS_SECRET_ACCESS_KEY")) - (token (getenv "AWS_SESSION_TOKEN")) - (profile (or profile (getenv "AWS_PROFILE")))) - (cond - ((and profile) (gptel-bedrock--fetch-aws-profile-credentials profile)) - ((and key-id secret-key) (cl-values key-id secret-key token)) - (t (user-error "Missing AWS credentials; provide them either via environment variables or specify PROFILE when calling gptel-make-bedrock"))))) - -(defvar gptel-bedrock--model-ids - ;; https://docs.aws.amazon.com/bedrock/latest/userguide/models-supported.html - '((claude-sonnet-4-5-20250929 . "anthropic.claude-sonnet-4-5-20250929-v1:0") - (claude-haiku-4-5-20251001 . "anthropic.claude-haiku-4-5-20251001-v1:0") - (claude-opus-4-5-20251101 . "anthropic.claude-opus-4-5-20251101-v1:0") - (claude-opus-4-1-20250805 . "anthropic.claude-opus-4-1-20250805-v1:0") - (claude-sonnet-4-20250514 . "anthropic.claude-sonnet-4-20250514-v1:0") - (claude-opus-4-20250514 . "anthropic.claude-opus-4-20250514-v1:0") - (claude-3-7-sonnet-20250219 . "anthropic.claude-3-7-sonnet-20250219-v1:0") - (claude-3-5-sonnet-20241022 . "anthropic.claude-3-5-sonnet-20241022-v2:0") - (claude-3-5-sonnet-20240620 . "anthropic.claude-3-5-sonnet-20240620-v1:0") - (claude-3-5-haiku-20241022 . "anthropic.claude-3-5-haiku-20241022-v1:0") - (claude-3-opus-20240229 . "anthropic.claude-3-opus-20240229-v1:0") - (claude-3-haiku-20240307 . "anthropic.claude-3-haiku-20240307-v1:0") - (nova-2-lite-v1 . "amazon.nova-2-lite-v1:0") - (mistral-7b . "mistral.mistral-7b-instruct-v0:2") - (mistral-8x7b . "mistral.mixtral-8x7b-instruct-v0:1") - (mistral-large-2402 . "mistral.mistral-large-2402-v1:0") - (mistral-large-2407 . "mistral.mistral-large-2407-v1:0") - (mistral-small-2402 . "mistral.mistral-small-2402-v1:0") - (llama-3-8b . "meta.llama3-8b-instruct-v1:0") - (llama-3-70b . "meta.llama3-70b-instruct-v1:0") - (llama-3-1-8b . "meta.llama3-1-8b-instruct-v1:0") - (llama-3-1-70b . "meta.llama3-1-70b-instruct-v1:0") - (llama-3-1-405b . "meta.llama3-1-405b-instruct-v1:0") - (llama-3-2-1b . "meta.llama3-2-1b-instruct-v1:0") - (llama-3-2-3b . "meta.llama3-2-3b-instruct-v1:0") - (llama-3-2-11b . "meta.llama3-2-11b-instruct-v1:0") - (llama-3-2-90b . "meta.llama3-2-90b-instruct-v1:0") - (llama-3-3-70b . "meta.llama3-3-70b-instruct-v1:0")) - "Map of model name to bedrock id. - -IDs can be added or replaced by calling -\(push (model-name . \"model-id\") gptel-bedrock--model-ids).") - -(defvar gptel--bedrock-models - (mapcar #'car gptel-bedrock--model-ids) - "List of available AWS Bedrock models and associated properties.") - -(defun gptel-bedrock--get-model-id (model &optional region) - "Return the Bedrock model ID for MODEL. - -REGION is one of global, apac, eu or us." - (concat - (when region - (or (member region '(global apac eu us)) - (error "Unknown Bedrock region %s" region)) - (concat (symbol-name region) ".")) - (or (alist-get model gptel-bedrock--model-ids nil nil #'eq) - (error "Unknown Bedrock model: %s" model)))) - -(defun gptel-bedrock--curl-args (region profile bearer-token) - "Generate the curl arguments to get a bedrock request signed for use in REGION. - -PROFILE specifies the aws profile to use for aws configure -export-credentials. BEARER-TOKEN is the token used for authentication." - (let ((bearer-token (or bearer-token (getenv "AWS_BEARER_TOKEN_BEDROCK"))) - (output-args (unless (memq system-type '(windows-nt ms-dos)) - '("--output" "/dev/stdout")))) - (if bearer-token - (append - (list "-H" (format "Authorization: Bearer %s" bearer-token)) - output-args) - (cl-multiple-value-bind (key-id secret token) (gptel-bedrock--get-credentials profile) - (append - (list "--user" (format "%s:%s" key-id secret) - "--aws-sigv4" (format "aws:amz:%s:bedrock" region)) - output-args - (when token (list "-H" (format "x-amz-security-token: %s" token)))))))) - - -(defun gptel-bedrock--curl-version () - "Check Curl version required for gptel-bedrock." - (let* ((output (shell-command-to-string "curl --version")) - (version (and (string-match "^curl \\([0-9.]+\\)" output) - (match-string 1 output)))) - version)) - -;;;###autoload -(cl-defun gptel-make-bedrock - (name &key - region - (models gptel--bedrock-models) - (model-region nil) - stream curl-args request-params - aws-profile aws-bearer-token - (protocol "https")) - "Register an AWS Bedrock backend for gptel with NAME. - -Keyword arguments: - -REGION - AWS region name (e.g. \"us-east-1\") -MODELS - The list of models supported by this backend -MODEL-REGION - one of apac, eu, us or nil -AWS-PROFILE - the aws profile to use for aws configure export-credentials -AWS-BEARER-TOKEN - the aws bearer-token for authenticating with AWS -CURL-ARGS - additional curl args -STREAM - Whether to use streaming responses or not. -REQUEST-PARAMS - a plist of additional HTTP request -parameters (as plist keys) and values supported by the API." - (declare (indent 1)) - (unless (or aws-bearer-token (getenv "AWS_BEARER_TOKEN_BEDROCK")) - (unless (and gptel-use-curl (version<= "8.9" (gptel-bedrock--curl-version))) - (error "Bedrock-backend requires curl >= 8.9, but gptel-use-curl := %s, curl-version := %s" - gptel-use-curl (gptel-bedrock--curl-version)))) - (let ((host (format "bedrock-runtime.%s.amazonaws.com" region))) - (setf (alist-get name gptel--known-backends nil nil #'equal) - (gptel--make-bedrock - :name name - :host host - :header nil ; x-amz-security-token is set in curl-args if needed - :models (gptel--process-models models) - :model-region model-region - :protocol protocol - :endpoint "" ; Url is dynamically constructed based on other args - :stream stream - :coding-system (and stream 'binary) - :curl-args (lambda () (append curl-args (gptel-bedrock--curl-args region aws-profile aws-bearer-token))) - :request-params request-params - :url - (lambda () - (concat protocol "://" host - "/model/" (gptel-bedrock--get-model-id gptel-model model-region) - "/" (if stream "converse-stream" "converse"))))))) - -(provide 'gptel-bedrock) -;;; gptel-bedrock.el ends here diff --git a/elpa/gptel-20260123.739/gptel-context.el b/elpa/gptel-20260123.739/gptel-context.el deleted file mode 100644 index f243ac50..00000000 --- a/elpa/gptel-20260123.739/gptel-context.el +++ /dev/null @@ -1,847 +0,0 @@ -;;; gptel-context.el --- Context aggregator for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: daedsidog -;; Keywords: convenience, buffers - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; The context allows you to conveniently create contexts which can be fed -;; to gptel. - -;;; Code: - -(require 'gptel-request) -(require 'cl-lib) -(require 'project) - -(declare-function gptel-menu "gptel-transient") -(declare-function dired-get-marked-files "dired") -(declare-function ibuffer-get-marked-buffers "ibuffer") -(declare-function ibuffer-current-buffer "ibuffer") -(declare-function image-file-name-regexp "image-file") -(declare-function create-image "image") - -(defface gptel-context-highlight-face - '((((background dark) (min-colors 88)) :background "gray4" :extend t) - (((background light) (min-colors 88)) :background "alice blue" :extend t) - (t :inherit mode-line)) - "Face used to highlight gptel contexts in buffers." - :group 'gptel) - -(defface gptel-context-deletion-face - '((((class color) (min-colors 257) (background light)) - :background "#ffeeee" :extend t) - (((class color) (min-colors 88) (background light)) - :background "#ffdddd" :extend t) - (((class color) (min-colors 88) (background dark)) - :background "#553333" :extend t) - (((class color)) :foreground "red" :extend t)) - "Face used to highlight gptel contexts to be deleted. - -This is used in gptel context buffers." - :group 'gptel) - -(defvar gptel-context-wrap-function nil - "Function to format the context string sent with the gptel request.") -(make-obsolete-variable - 'gptel-context-wrap-function - "Custom functions for wrapping context are no longer supported by gptel.\ - See `gptel-context--wrap-in-buffer' for details." - "0.9.9") - -(defcustom gptel-context-string-function #'gptel-context--string - "Function to prepare the context string sent with the gptel request. - -This function can be synchronous or asynchronous, and receives one or -two arguments respectively. - -Synchronous: An alist of contexts with buffers or files (the context -alist). -Asynchronous: A callback to call with the result, and the context alist. - -Entries in the context alist can have one of these forms: - - (buffer1 overlay1 overlay2 ...) ;text overlays in a buffer - (buffer2) ;a buffer object - (\"/path/to/file\") ;a text file - (\"/path/to/file\" :mime \"text/markdown\") ;with explicit mime type - (\"/path/to/image\" :mime \"image/jpeg\") ;media file - -Each overlay covers a buffer region containing the -context chunk. This is accessible as, for example: - - (with-current-buffer buffer1 - (buffer-substring (overlay-start overlay1) - (overlay-end overlay1)))" - :group 'gptel - :type 'function) - -(defcustom gptel-context-restrict-to-project-files t - "Restrict files eligible to be added to the context to project files. - -When set to t, files in a VCS that are not project files (such as files -listed in `.gitignore' in a Git repository) will not be added to the -context." - :group 'gptel - :type 'boolean) - -(defvar gptel-context--project-files nil - "Cached alist of project files per project.") - -(defvar gptel-context--reset-cache nil - "Whether a project files cache-buster has been scheduled.") - -;;; Commands - -(defun gptel-context-add-current-kill (&optional arg) - "Add current kill to gptel, accumulating if ARG is non-nil." - (interactive "P") - (let ((kill (current-kill 0))) - (with-current-buffer (get-buffer-create " *gptel-kill-ring-context*") - (if (not arg) - (kill-region (point-min) (point-max)) - (goto-char (point-max)) - (unless (bobp) - (insert "\n----\n"))) - (insert kill) - (gptel-context--add-region (current-buffer) - (point-min) (point-max)) - (message "*current-kill* has been added as context.")))) - -(defun gptel-context-add (&optional arg confirm) - "Add context to gptel in a DWIM fashion. - -- If a region is selected, add the selected region to the - context. If there is already a gptel context at point, remove it - instead. - -- If in Dired, add marked files or file at point to the context. If - the selection includes directories, add all their files recursively, - prompting the user for confirmation if called interactively or - CONFIRM is non-nil. With negative prefix ARG, remove all files from - the context instead. - -- If in IBuffer, add marked buffers or buffer at point to the context. - With negative prefix ARG, remove buffers from the context instead. - -- Otherwise add the current buffer to the context. With positive - prefix ARG, prompt for a buffer name and add it to the context. - -- With negative prefix ARG, remove all gptel contexts from the current - buffer, prompting the user for confirmation if called interactively - or CONFIRM is non-nil." - (interactive "P\np") - (cond - ;; A region is selected. - ((use-region-p) - (gptel-context--add-region (current-buffer) - (region-beginning) - (region-end)) - (deactivate-mark) - (message "Current region added as context.")) - ;; If in dired - ((derived-mode-p 'dired-mode) - (let* ((files (dired-get-marked-files)) - (dirs (cl-remove-if-not #'file-directory-p files)) - (remove-p (< (prefix-numeric-value arg) 0)) - (action-fn (if remove-p - #'gptel-context-remove - #'gptel-context-add-file))) - (when (or remove-p (null dirs) (null confirm) - (y-or-n-p (format "Recursively add files from %d director%s? " - (length dirs) - (if (= (length dirs) 1) "y" "ies")))) - (mapc action-fn files)))) - ;; If in ibuffer - ((derived-mode-p 'ibuffer-mode) - (let* ((buffers (or (ibuffer-get-marked-buffers) - (list (ibuffer-current-buffer)))) - (remove-p (< (prefix-numeric-value arg) 0)) - (action-fn (if remove-p - #'gptel-context-remove - #'gptel-context--add-buffer))) - (mapc action-fn buffers))) - ;; If in an image buffer - ((and (derived-mode-p 'image-mode) - (gptel--model-capable-p 'media) - (buffer-file-name) - (not (gptel-context--skip-p (buffer-file-name)))) - (funcall (if (and arg (< (prefix-numeric-value arg) 0)) - #'gptel-context-remove - #'gptel-context-add-file) - (buffer-file-name))) - ;; No region is selected, and ARG is positive. - ((and arg (> (prefix-numeric-value arg) 0)) - (let* ((buffer-name (read-buffer "Choose buffer to add as context: " - (current-buffer) t)) - (start (with-current-buffer buffer-name (point-min))) - (end (with-current-buffer buffer-name (point-max)))) - (gptel-context--add-region - (get-buffer buffer-name) start end t) - (message "Buffer '%s' added as context." buffer-name))) - ;; No region is selected, and ARG is negative. - ((and arg (< (prefix-numeric-value arg) 0)) - (when (or (null confirm) - (y-or-n-p "Remove all contexts from this buffer? ")) - (let ((removed-contexts 0)) - (cl-loop for cov in - (gptel-context--in-region (current-buffer) (point-min) (point-max)) - do (progn - (cl-incf removed-contexts) - (gptel-context-remove cov))) - (message (format "%d context%s removed from current buffer." - removed-contexts - (if (= removed-contexts 1) "" "s")))))) - (t ; Default behavior - (if (gptel-context--at-point) - (progn - (gptel-context-remove - (car (gptel-context--in-region (current-buffer) - (max (point-min) (1- (point))) - (point)))) - (message "Context under point has been removed.")) - (gptel-context--add-buffer (current-buffer)))))) - -;;;###autoload (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t) -(defalias 'gptel-add #'gptel-context-add) - -(defun gptel-context--add-buffer (buffer) - "Add BUFFER to context." - (with-current-buffer buffer - (gptel-context--add-region (current-buffer) (point-min) (point-max) t)) - (message "Buffer \"%s\" added to context." (buffer-name buffer))) - -(defun gptel-context--add-text-file (path) - "Add text file at PATH to context." - (cl-pushnew (list path) gptel-context :test #'equal) - (message "File \"%s\" added to context." path) - path) - -(defun gptel-context--add-binary-file (path) - "Add binary file at PATH to context if supported. -Return PATH if added, nil if ignored." - (if-let* (((gptel--model-capable-p 'media)) - (mime (mailcap-file-name-to-mime-type path)) - ((gptel--model-mime-capable-p mime))) - (prog1 path - (cl-pushnew (list path :mime mime) - gptel-context :test #'equal) - (message "File \"%s\" added to context." path)) - (message "Ignoring unsupported binary file \"%s\"." path) - nil)) - -(defun gptel-context--add-directory (path action) - "Process all files in directory at PATH according to ACTION. -ACTION should be either `add' or `remove'." - (dolist (file (directory-files-recursively path ".")) - (pcase-exhaustive action - ('add - (unless gptel-context--reset-cache - (setq gptel-context--reset-cache t) - (run-at-time - 0 nil - (lambda () (setq gptel-context--reset-cache nil - gptel-context--project-files nil)))) - (if (gptel-context--skip-p file) - ;; Don't message about .git, as this creates thousands of messages - (unless (string-match-p "\\.git/" file) - (gptel-context--message-skipped file)) - (gptel-context-add-file file))) - ('remove - (setf (alist-get file gptel-context nil 'remove #'equal) nil))))) - -(defun gptel-context-add-file (path) - "Add the file at PATH to the gptel context. - -If PATH is a directory, recursively add all files in it. PATH should be -readable as text." - (interactive "fChoose file to add to context: ") - (cond ((file-directory-p path) - (gptel-context--add-directory path 'add)) - ((gptel--file-binary-p path) - (gptel-context--add-binary-file path)) - (t (gptel-context--add-text-file path)))) - -;;;###autoload (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t) -(defalias 'gptel-add-file #'gptel-context-add-file) - -;;; project-related functions -(defun gptel-context--get-project-files (dir) - "Return a list of files in the project DIR, or nil if no project is found." - (when-let* ((project (project-current nil dir))) - (with-memoization (alist-get dir gptel-context--project-files - nil nil #'equal) - (project-files project)))) - -(defun gptel-context--skip-p (file) - "Return non-nil if FILE should not be added to the context." - (when (and gptel-context-restrict-to-project-files - (not (file-remote-p file))) - (and-let* ((file-dir (or (file-name-directory file) default-directory)) - (project (project-current nil file-dir))) - (not (member (expand-file-name file) - (gptel-context--get-project-files (project-root project))))))) - -(defun gptel-context--message-skipped (file) - "Message that FILE is skipped because it is not a project file." - (let* ((type (if (file-directory-p file) "directory" "file")) - (reminder (format "To include it, unset `%S'." - 'gptel-context-restrict-to-project-files))) - (if-let* ((root (cl-some (lambda (dir) (and (file-in-directory-p file dir) dir)) - (map-keys gptel-context--project-files))) - (rel-file (file-relative-name file root))) - (message "Skipping %s \"%s\" in project \"%s\". %s" - type rel-file root reminder) - (message "Skipping %s \"%s\". %s" type file reminder)))) - -;;; Remove context -(defun gptel-context-remove (&optional context) - "Remove the CONTEXT overlay from the contexts list. - -If CONTEXT is nil, removes the context at point. -If selection is active, removes all contexts within selection. -If CONTEXT is a directory, recursively removes all files in it." - (cond - ((overlayp context) ;Overlay in buffer - (when-let* ((buf (overlay-buffer context))) - (delete-overlay context) - ;; FIXME: Quadratic cost when clearing a bunch of contexts at once - (unless - (cl-loop - for ov in - (plist-get (alist-get buf gptel-context) :overlays) - thereis (overlay-start ov)) - (setf (alist-get buf gptel-context nil 'remove) nil)))) - ((bufferp context) ;Full buffer - (setf (alist-get context gptel-context nil 'remove) nil) - (when (buffer-live-p context) - (with-current-buffer context - (without-restriction - (remove-overlays nil nil 'gptel-context t))))) - ((stringp context) ;file or directory - (if (file-directory-p context) - (gptel-context--add-directory context 'remove) - (setf (alist-get context gptel-context nil 'remove #'equal) nil) - (message "File \"%s\" removed from context." context))) - ((region-active-p) ;Overlays in region - (when-let* ((contexts (gptel-context--in-region (current-buffer) - (region-beginning) - (region-end)))) - (cl-loop for ctx in contexts do (delete-overlay ctx)))) - (t ;Anything at point - (when-let* ((ctx (gptel-context--at-point))) - (delete-overlay ctx))))) - -(defun gptel-context-remove-all (&optional verbose) - "Remove all gptel context. - -If VERBOSE is non-nil, ask for confirmation and message -afterwards." - (interactive (list t)) - (if (null gptel-context) - (when verbose (message "No gptel context sources to remove.")) - (when (or (not verbose) (y-or-n-p "Remove all context? ")) - (cl-loop - for context in gptel-context - for (source . spec) = (ensure-list context) - if (bufferp source) do ;Buffers and buffer regions - (mapc #'gptel-context-remove (plist-get spec :overlays)) - else do (gptel-context-remove source) ;files or other types - finally do (setq gptel-context nil)) - (when verbose (message "Removed all gptel context sources."))))) - -;;; Context wrap -(defun gptel-context--make-overlay (start end &optional advance) - "Highlight the region from START to END. - -ADVANCE controls the overlay boundary behavior." - (let ((overlay (make-overlay start end nil (not advance) advance)) - (buf-entry (alist-get (current-buffer) gptel-context))) - (overlay-put overlay 'evaporate t) - (overlay-put overlay 'face 'gptel-context-highlight-face) - (overlay-put overlay 'gptel-context t) - (setf (alist-get (current-buffer) gptel-context) - (plist-put buf-entry :overlays - (cons overlay (plist-get buf-entry :overlays)))) - overlay)) - -;;;###autoload -(defun gptel-context--wrap (callback data-buf) - "Add request context to DATA-BUF and run CALLBACK. - -DATA-BUF is the buffer where the request prompt is constructed." - (if (= (car (func-arity gptel-context-string-function)) 2) - (funcall gptel-context-string-function - (lambda (c) (with-current-buffer data-buf - (gptel-context--wrap-in-buffer c)) - (funcall callback)) - (gptel-context--collect)) - (with-current-buffer data-buf - (thread-last (gptel-context--collect) - (funcall gptel-context-string-function) - (gptel-context--wrap-in-buffer))) - (funcall callback))) - -(defun gptel-context--wrap-in-buffer (context-string &optional method) - "Inject CONTEXT-STRING to current buffer using METHOD. - -METHOD is either system or user, and defaults to `gptel-use-context'. -This modifies the buffer." - (when (length> context-string 0) - (pcase (or method gptel-use-context) - ('system - (if (gptel--model-capable-p 'nosystem) - (gptel-context--wrap-in-buffer context-string 'user) - (if gptel--system-message - (cl-etypecase gptel--system-message - (string - (setq gptel--system-message - (concat context-string "\n\n" gptel--system-message))) - (function - (setq gptel--system-message - (gptel--parse-directive gptel--system-message 'raw)) - (gptel-context--wrap-in-buffer context-string)) - (list - (setq gptel--system-message ;cons a new list to avoid mutation - (cons (concat context-string "\n\n" (car gptel--system-message)) - (cdr gptel--system-message))))) - (setq gptel--system-message context-string)))) - ('user - (goto-char (point-max)) - (text-property-search-backward 'gptel nil t) - (and gptel-mode - (looking-at - (concat "[\n[:blank:]]*" - (and-let* ((prefix (gptel-prompt-prefix-string)) - ((not (string-empty-p prefix)))) - (concat "\\(?:" (regexp-quote prefix) "\\)?")))) - (delete-region (match-beginning 0) (match-end 0))) - (insert "\n" context-string "\n\n"))))) - -(defun gptel-context--collect-media (&optional contexts) - "Collect media CONTEXTS. - -CONTEXTS, which are typically paths to binary files, are -base64-encoded and prepended to the first user prompt." - (cl-loop for context in (or contexts gptel-context) - for (path . props) = (ensure-list context) - when (and (stringp path) (plist-get props :mime)) - collect (cons :media context))) - -(cl-defun gptel-context--add-region (buffer region-beginning region-end &optional advance) - "Add region delimited by REGION-BEGINNING, REGION-END in BUFFER as context. - -If ADVANCE is non-nil, the context overlay envelopes changes at -the beginning and end." - ;; Remove existing contexts in the same region, if any. - (mapc #'gptel-context-remove - (gptel-context--in-region buffer region-beginning region-end)) - (prog1 (with-current-buffer buffer - (gptel-context--make-overlay region-beginning region-end advance)) - (message "Region added to context buffer."))) - -(defun gptel-context--in-region (buffer start end) - "Return the list of context overlays in the given region, if any, in BUFFER. -START and END signify the region delimiters." - (with-current-buffer buffer - (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context)) - (overlays-in start end)))) - -(defun gptel-context--at-point () - "Return the context overlay at point, if any." - (cl-find-if (lambda (ov) (overlay-get ov 'gptel-context)) - (overlays-at (point)))) - -;;;###autoload -(defun gptel-context--collect (&optional context-alist) - "Get the list of all active context sources from CONTEXT-ALIST. - -CONTEXT-ALIST defaults to the current value of `gptel-context'. - -Ignore overlays, buffers and files that are not live or readable." - ;; Get only the non-degenerate overlays, collect them, and update the overlays variable. - (let ((res)) - (dolist (entry (or context-alist gptel-context)) - (pcase entry ;Context entry is: - (`(,buf . ,data) - (cond - ((buffer-live-p buf) - ;; ( :overlays ... :lines ... :bounds ...) - (when-let* ((ovs (plist-get data :overlays))) ;Clear dead overlays - (plist-put data :overlays (cl-remove-if-not #'overlay-start ovs))) - (push (cons buf data) res)) - ((and (stringp buf) (file-readable-p buf)) - ;; ("/file/path" :mime ... :bounds ... :line ...) - (push (cons buf data) res)))) - - ((and (pred stringp) (pred file-readable-p)) ;Just a file, figure out mimetype - (if (file-directory-p entry) - (progn - (unless gptel-context--reset-cache - (setq gptel-context--reset-cache t) - (run-at-time - 0 nil - (lambda () (setq gptel-context--reset-cache nil - gptel-context--project-files nil)))) - (dolist (f (directory-files-recursively entry ".")) - (unless (gptel-context--skip-p f) - (push `(,f ,@(and (gptel--file-binary-p f) - (list :mime (mailcap-file-name-to-mime-type entry)))) - res)))) - (push `(,entry ,@(and (gptel--file-binary-p entry) - (list :mime (mailcap-file-name-to-mime-type entry)))) - res))) - ((pred buffer-live-p) (push (list entry) res)))) ;Just a buffer - res)) - -(defun gptel-context--collect-regions (buffer context-data) - "Collect BUFFER regions from CONTEXT-DATA specification. - -CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds. -Returns a sorted list of (START . END) position pairs." - (let (regions) - (with-current-buffer buffer - (without-restriction - ;; Collect overlays - (dolist (ov (plist-get context-data :overlays)) - (when (overlay-start ov) - (push (cons (overlay-start ov) (overlay-end ov)) - regions))) - ;; Collect bounds (already in position format) - (when-let* ((bounds (plist-get context-data :bounds))) - (if (consp (car bounds)) - (setq regions (nconc regions bounds)) ;((start1 . end1) (start2 . end2) ...) - (push bounds regions))) ;(start1 . end1) - ;; Collect lines (convert line numbers to positions) - (when-let* ((line-bounds (plist-get context-data :lines))) - ;; Convert singleton (start1 . end1) to ((start1 . end1)) - (unless (consp (car line-bounds)) (setq line-bounds (list line-bounds))) - (dolist (pair line-bounds) - (push (cons (progn (goto-char (point-min)) - (forward-line (1- (car pair))) - (point)) - (progn (goto-char (point-min)) - (forward-line (cdr pair)) - (point))) - regions))))) - ;; TODO: Update sort for Emacs 28+ calling convention - ;; Sort by start position. - (sort regions (lambda (a b) (< (car a) (car b)))))) - -(defun gptel-context--insert-buffer-string (buffer context-data &optional header) - "Insert at point a context string from CONTEXT-DATA in BUFFER. - -CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds to -include specific overlays, line ranges or position bounds instead of the -entire buffer. See `gptel-context'. - -HEADER is an optional header to insert before the contents." - (let ((is-top-snippet t) - (previous-line 1) - (regions (gptel-context--collect-regions buffer context-data))) - - ;; Insert header - (insert (or header (format "In buffer `%s`:\n\n```"(buffer-name buffer))) - (gptel--strip-mode-suffix (buffer-local-value - 'major-mode buffer)) - "\n") - (if (not regions) - (insert-buffer-substring-no-properties buffer) - (dolist (region regions) - (let ((start (car region)) (end (cdr region))) - (let (lineno column) - (with-current-buffer buffer - (without-restriction - (setq lineno (line-number-at-pos start t) - column (save-excursion (goto-char start) (current-column))))) - ;; We do not need to insert a line number indicator if we have two regions - ;; on the same line, because the previous region should have already put the - ;; indicator. - (unless (= previous-line lineno) - (unless (= lineno 1) - (unless is-top-snippet (insert "\n")) - (insert (format "... (Line %d)\n" lineno)))) - (setq previous-line lineno) - (unless (zerop column) (insert " ...")) - (if is-top-snippet - (setq is-top-snippet nil) - (unless (= previous-line lineno) (insert "\n")))) - (insert-buffer-substring-no-properties buffer start end))) - (unless (>= (cdr (car (last regions))) (point-max)) - (insert "\n..."))) - (insert "\n```"))) - -(defun gptel-context--insert-file-string (path &optional spec) - "Insert at point the contents of file at PATH as context. - -SPEC is a plist specifying :lines or position :bounds to include instead -of the entire file. See `gptel-context' for details." - (if (not (and spec (or (plist-member spec :lines) - (plist-member spec :bounds)))) - ;; Insert whole file - (gptel--insert-file-string path) - ;; Insert only regions from lines and/or bounds - (let* ((visiting-buf (find-buffer-visiting ;Reuse buffer - path (lambda (b) (not (buffer-modified-p b))))) - (file-buf (or visiting-buf ;temp buf to dump file contents - (gptel--temp-buffer " *gptel-file-context*")))) - (unless visiting-buf - (with-current-buffer file-buf (insert-file-contents path))) - (gptel-context--insert-buffer-string - file-buf spec (format "In file `%s`:\n\n```\n" - (abbreviate-file-name path))) - (unless visiting-buf (kill-buffer file-buf))))) - -(defun gptel-context--string (context-alist) - "Format the aggregated gptel context as annotated markdown fragments. - -Returns a string. CONTEXT-ALIST is a structure containing -context overlays, see `gptel-context'." - (with-temp-buffer - (cl-loop for entry in context-alist - for (source . spec) = (ensure-list entry) - if (bufferp source) - do (gptel-context--insert-buffer-string source spec) - else if (or (not (plist-get spec :mime)) - (string-match-p "^text/" (plist-get spec :mime))) - do (gptel-context--insert-file-string source spec) end - do (insert "\n\n") - finally do - (skip-chars-backward "\n\t\r ") - (delete-region (point) (point-max)) - (unless (bobp) - (goto-char (point-min)) - (insert "Request context:\n\n")) - finally return - (and (> (buffer-size) 0) - (buffer-string))))) - -;;; Major mode for context inspection buffers -(defvar-keymap gptel-context-buffer-mode-map - "C-c C-c" #'gptel-context-confirm - "C-c C-k" #'gptel-context-quit - "RET" #'gptel-context-visit - "n" #'gptel-context-next - "p" #'gptel-context-previous - "d" #'gptel-context-flag-deletion) - -(define-derived-mode gptel-context-buffer-mode special-mode "gptel-context" - "Major-mode for inspecting context used by gptel." - :group 'gptel - (add-hook 'post-command-hook #'gptel-context--post-command - nil t) - (setq-local revert-buffer-function #'gptel-context--buffer-setup)) - -;; FIXME(targeted-context): This does not handle :bounds and :lines. Reuse -;; `gptel-context--insert-buffer-string'? -(defun gptel-context--buffer-setup (&optional _ignore-auto _noconfirm context-alist) - "Set up the gptel context buffer. - -CONTEXT-ALIST is the alist of contexts to use to populate the buffer." - (with-current-buffer (get-buffer-create "*gptel-context*") - (gptel-context-buffer-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (setq header-line-format - (substitute-command-keys - (concat - "\\[gptel-context-flag-deletion]: Mark/unmark deletion, " - "\\[gptel-context-next]/\\[gptel-context-previous]: next/previous, " - "\\[gptel-context-visit]: visit, " - "\\[gptel-context-confirm]: apply, " - "\\[gptel-context-quit]: cancel, " - "\\[quit-window]: quit"))) - (save-excursion - (let ((contexts (gptel-context--collect context-alist))) - (if (length= contexts 0) - (insert "There are no active gptel contexts.") - (let (beg ov l1 l2) - (pcase-dolist (`(,buf . ,spec) contexts) - (cond - ((bufferp buf) - (if (not spec) ;BUF is a full buffer, not specific ranges - (progn - (insert (propertize (format "In buffer %s:\n\n" - (buffer-name buf)) - 'face 'bold)) - (setq beg (point)) - (insert-buffer-substring buf) - (insert "\n") - (setq ov (make-overlay beg (point)))) - (dolist (source-ov (plist-get spec :overlays)) ;BUF is a buffer with some overlay(s) - (with-current-buffer buf - (setq l1 (line-number-at-pos (overlay-start source-ov)) - l2 (line-number-at-pos (overlay-end source-ov)))) - (insert (propertize (format "In buffer %s (lines %d-%d):\n\n" - (buffer-name buf) l1 l2) - 'face 'bold)) - (setq beg (point)) - (insert-buffer-substring - buf (overlay-start source-ov) (overlay-end source-ov)) - (insert "\n") - (setq ov (make-overlay beg (point))) - (overlay-put ov 'gptel-context source-ov) - (overlay-put ov 'gptel-overlay t) - (overlay-put ov 'evaporate t))) - (insert "\n" (make-separator-line) "\n")) - (t ;BUF is a file path, not a buffer - (insert (propertize (format "In file %s:\n\n" (file-name-nondirectory buf)) - 'face 'bold)) - (setq beg (point)) - (if-let* ((mime (plist-get spec :mime)) - ((not (string-match-p "^text/" mime)))) ;BUF is a binary file - (if-let* (((string-match-p (image-file-name-regexp) buf)) - (img (create-image buf))) - (insert-image img "*") ; Can be displayed - (insert - buf " " (propertize "(No preview for binary file)" - 'face '(:inherit shadow :slant italic)))) - (insert-file-contents buf)) - (goto-char (point-max)) - (insert "\n") - (setq ov (make-overlay beg (point))) - (overlay-put ov 'gptel-context buf) - (overlay-put ov 'gptel-overlay t) - (overlay-put ov 'evaporate t) - (insert "\n" (make-separator-line) "\n")))) - (goto-char (point-min))))))) - (display-buffer (current-buffer) - `((display-buffer-reuse-window - display-buffer-reuse-mode-window - display-buffer-below-selected) - (body-function . ,#'select-window) - (window-height . ,#'fit-window-to-buffer))))) - -(defvar gptel-context--buffer-reverse nil - "Last direction of cursor movement in gptel context buffer. - -If non-nil, indicates backward movement.") - -(defalias 'gptel-context--post-command - (let ((highlight-overlay)) - (lambda () - ;; Only update if point moved outside the current region. - (unless (memq highlight-overlay (overlays-at (point))) - (let ((context-overlay - (cl-loop for ov in (overlays-at (point)) - thereis (and (overlay-get ov 'gptel-overlay) ov)))) - (when highlight-overlay - (overlay-put highlight-overlay 'face nil)) - (when context-overlay - (overlay-put context-overlay 'face 'highlight)) - (setq highlight-overlay context-overlay)))))) - -(defun gptel-context-visit () - "Display the location of this gptel context chunk in its original buffer." - (interactive) - (let ((ov-here (car (overlays-at (point))))) - (if-let* ((source (overlay-get ov-here 'gptel-context)) - (buf (if (overlayp source) - (overlay-buffer source) - (find-file-noselect source))) - (offset (- (point) (overlay-start ov-here)))) - (with-selected-window (display-buffer buf) - (goto-char (if (overlayp source) - (overlay-start source) - (point-min))) - (forward-char offset) - (recenter)) - (message "No source location for this gptel context chunk.")))) - -(defun gptel-context-next () - "Move to next gptel context chunk." - (interactive) - (let ((ov-here (car (overlays-at (point)))) - (next-start (next-overlay-change (point)))) - (when (and (/= (point-max) next-start) ov-here) - ;; We were inside the overlay, so we want the next overlay change, which - ;; would be the start of the next overlay. - (setq next-start (next-overlay-change next-start))) - (when (/= next-start (point-max)) - (setq gptel-context--buffer-reverse nil) - (goto-char next-start) - (recenter (floor (window-height) 4))))) - -(defun gptel-context-previous () - "Move to previous gptel context chunk." - (interactive) - (let ((ov-here (car (overlays-at (point))))) - (when ov-here (goto-char (overlay-start ov-here))) - (let ((previous-context-pos (previous-overlay-change - (previous-overlay-change (point))))) - ;; Prevent point from jumping to the start of the buffer. - (unless (= previous-context-pos (point-min)) - (goto-char previous-context-pos) - (recenter (floor (window-height) 4)) - (setq gptel-context--buffer-reverse t))))) - -(defun gptel-context-flag-deletion () - "Mark gptel context chunk at point for removal." - (interactive) - (let* ((overlays (if (use-region-p) - (overlays-in (region-beginning) (region-end)) - (overlays-at (point)))) - (deletion-ov) - (marked-ovs (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context-deletion-mark)) - overlays))) - (if marked-ovs - (mapc #'delete-overlay marked-ovs) - (save-excursion - (dolist (ov overlays) - (when (overlay-get ov 'gptel-context) - (goto-char (overlay-start ov)) - (setq deletion-ov (make-overlay (overlay-start ov) (overlay-end ov))) - (overlay-put deletion-ov 'gptel-context (overlay-get ov 'gptel-context)) - (overlay-put deletion-ov 'priority -80) - (overlay-put deletion-ov 'face 'gptel-context-deletion-face) - (overlay-put deletion-ov 'gptel-context-deletion-mark t))))) - (if (use-region-p) - (deactivate-mark) - (if gptel-context--buffer-reverse - (gptel-context-previous) - (gptel-context-next))))) - -(defun gptel-context-quit () - "Cancel pending operations and return to gptel's menu." - (interactive) - (quit-window) - (call-interactively #'gptel-menu)) - -(defun gptel-context-confirm () - "Confirm pending operations and return to gptel's menu." - (interactive) - ;; Delete all the context overlays that have been marked for deletion. - (when-let* ((deletion-marks - (delq nil (mapcar - (lambda (ov) - (and - (overlay-get ov 'gptel-context-deletion-mark) - (overlay-get ov 'gptel-context))) - (overlays-in (point-min) (point-max)))))) - (mapc #'gptel-context-remove deletion-marks) - (revert-buffer)) - ;; FIXME(context): This should run in the buffer from which the context - ;; inspection buffer was visited. - ;; Update contexts and revert buffer (#482) - (setq gptel-context (nreverse (gptel-context--collect))) - (gptel-context-quit)) - -(provide 'gptel-context) -;;; gptel-context.el ends here. diff --git a/elpa/gptel-20260123.739/gptel-gemini.el b/elpa/gptel-20260123.739/gptel-gemini.el deleted file mode 100644 index 7af66816..00000000 --- a/elpa/gptel-20260123.739/gptel-gemini.el +++ /dev/null @@ -1,635 +0,0 @@ -;;; gptel-gemini.el --- Gemini suppport for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur - -;; 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: - -;; This file adds support for the Gemini API to gptel - -;;; Code: -(require 'gptel) -(require 'cl-generic) -(require 'map) -(eval-when-compile (require 'cl-lib)) - -(declare-function prop-match-value "text-property-search") -(declare-function text-property-search-backward "text-property-search") -(declare-function json-read "json") -(declare-function gptel-context--wrap "gptel-context") -(declare-function gptel-context--collect-media "gptel-context") -(defvar json-object-type) - -;;; Gemini -(cl-defstruct - (gptel-gemini (:constructor gptel--make-gemini) - (:copier nil) - (:include gptel-backend))) - -;; TODO: Using alt=sse in the query url generates an OpenAI style streaming -;; response, with more immediate updates. Maybe we should switch to that and -;; rewrite the stream parser? -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-gemini) info) - "Parse a Gemini data stream. - -Return the text response accumulated since the last call to this -function. Additionally, mutate state INFO to add tool-use -information if the stream contains it." - (let* ((content-strs)) - (condition-case nil - (while (prog1 (search-forward "{" nil t) ; while-let is Emacs 29.1+ only - (backward-char 1)) - (save-match-data - (when-let* ((response (gptel--json-read)) - (text (gptel--parse-response - (plist-get info :backend) - response info 'include))) - (push text content-strs)))) - (error - (goto-char (match-beginning 0)))) - (apply #'concat (nreverse content-strs)))) - -(cl-defmethod gptel--parse-response ((_backend gptel-gemini) response info - &optional include-text) - "Parse an Gemini (non-streaming) RESPONSE and return response text. - -Mutate state INFO with response metadata. - -If INCLUDE-TEXT is non-nil, include response text in the prompts -list." - (let* ((cand0 (map-nested-elt response '(:candidates 0))) - (parts (map-nested-elt cand0 '(:content :parts)))) - (plist-put info :stop-reason (plist-get cand0 :finishReason)) - (plist-put info :output-tokens - (map-nested-elt - response '(:usageMetadata :candidatesTokenCount))) - (cl-loop - for part across parts - for tx = (plist-get part :text) - if (and tx (not (eq tx :null))) - if (plist-get part :thought) - do (unless (plist-get info :reasoning-block) - (plist-put info :reasoning-block 'in)) - (plist-put info :reasoning (concat (plist-get info :reasoning) tx)) - else do - (if (eq (plist-get info :reasoning-block) 'in) - (plist-put info :reasoning-block t)) - and collect tx into content-strs end - else if (plist-get part :functionCall) - collect (copy-sequence it) into tool-use - finally do ;Add text and tool-calls to prompts list - (when (or tool-use include-text) - (let* ((data (plist-get info :data)) - (prompts (plist-get data :contents)) - (last-prompt (aref prompts (1- (length prompts))))) - (if (equal (plist-get last-prompt :role) "model") - ;; When streaming, the last prompt may already have the role - ;; "model" from prior calls to this function. Append to its parts - ;; instead of adding a new model role then. - (plist-put last-prompt :parts - (vconcat (plist-get last-prompt :parts) parts)) - (plist-put ;otherwise create a new "model" role - data :contents - (vconcat prompts `((:role "model" :parts ,parts))))))) - (when tool-use ;Capture tool call data for running tools - (plist-put info :tool-use - (nconc (plist-get info :tool-use) tool-use))) - finally return - (and content-strs (apply #'concat content-strs))))) - -(cl-defmethod gptel--request-data ((backend gptel-gemini) prompts) - "JSON encode PROMPTS for sending to Gemini." - (let ((prompts-plist - (list :contents (vconcat prompts) - :safetySettings [(:category "HARM_CATEGORY_HARASSMENT" - :threshold "BLOCK_NONE") - (:category "HARM_CATEGORY_SEXUALLY_EXPLICIT" - :threshold "BLOCK_NONE") - (:category "HARM_CATEGORY_DANGEROUS_CONTENT" - :threshold "BLOCK_NONE") - (:category "HARM_CATEGORY_HATE_SPEECH" - :threshold "BLOCK_NONE")])) - params) - (if gptel--system-message - (plist-put prompts-plist :systemInstruction - `(:parts [(:text ,gptel--system-message)]))) - (when gptel-use-tools - (when (eq gptel-use-tools 'force) - (plist-put prompts-plist :toolConfig - '(:functionCallingConfig (:mode "ANY")))) - (when gptel-tools - (plist-put prompts-plist :tools - (gptel--parse-tools backend gptel-tools)))) - (when gptel-temperature - (setq params - (plist-put params - :temperature (max gptel-temperature 1.0)))) - (when gptel-max-tokens - (setq params - (plist-put params - :maxOutputTokens gptel-max-tokens))) - (when gptel-include-reasoning - (setq params - (plist-put params :thinkingConfig '(:includeThoughts t)))) - (when gptel--schema - (setq params (nconc params (gptel--gemini-filter-schema - (gptel--parse-schema backend gptel--schema))))) - (when params - (plist-put prompts-plist - :generationConfig params)) - ;; Merge request params with model and backend params. - (gptel--merge-plists - prompts-plist - gptel--request-params - (gptel-backend-request-params gptel-backend) - (gptel--model-request-params gptel-model)))) - -(cl-defmethod gptel--parse-schema ((_backend gptel-gemini) schema) - (list :responseMimeType "application/json" - :responseSchema (gptel--preprocess-schema - (gptel--dispatch-schema-type schema)))) - -(defun gptel--gemini-filter-schema (schema) - "Destructively filter unsupported attributes from SCHEMA. - -Gemini's API does not support `additionalProperties'." - (cl-remf schema :additionalProperties) - (when (plistp schema) - (cl-loop for (key val) on schema by #'cddr - do (cond - ;; Recursively modify schemas within vectors (anyOf/allOf) - ((memq key '(:anyOf :allOf)) - (dotimes (i (length val)) - (aset val i (gptel--gemini-filter-schema (aref val i))))) - ;; Recursively modify plist values, which may contain sub-schemas - ((plistp val) - (when (cl-remf val :additionalProperties) - (cl-remf (plist-get schema key) :additionalProperties)) - (gptel--gemini-filter-schema val)) - ;; Default: do nothing to other key-value pairs yet. - (t nil)))) - schema) - -(cl-defmethod gptel--parse-tools ((_backend gptel-gemini) tools) - "Parse TOOLS to the Gemini API tool definition spec. - -TOOLS is a list of `gptel-tool' structs, which see." - (cl-loop - for tool in (ensure-list tools) - collect - (list - :name (gptel-tool-name tool) - :description (gptel-tool-description tool) - :parameters - (if (not (gptel-tool-args tool)) - :null ;NOTE: Gemini wants :null if the function takes no args - (list :type "object" - ;; See the generic implementation for an explanation of this - ;; transformation. - :properties - (cl-loop - for arg in (gptel-tool-args tool) - for argspec = (copy-sequence arg) - for name = (plist-get arg :name) ;handled differently - for newname = (or (and (keywordp name) name) - (make-symbol (concat ":" name))) - do ;ARGSPEC is ARG without unrecognized keys - (cl-remf argspec :name) - (cl-remf argspec :optional) - if (equal (plist-get arg :type) "object") - do (unless (plist-member argspec :required) - (plist-put argspec :required [])) - if (equal (plist-get arg :type) "string") - do (cl-remf argspec :format) - append (list newname (gptel--gemini-filter-schema argspec))) - :required - (vconcat - (delq nil (mapcar - (lambda (arg) (and (not (plist-get arg :optional)) - (plist-get arg :name))) - (gptel-tool-args tool))))))) - into tool-specs - finally return `[(:functionDeclarations ,(vconcat tool-specs))])) - -(cl-defmethod gptel--parse-tool-results ((_backend gptel-gemini) tool-use) - "Return a prompt containing tool call results in TOOL-USE." - (list - :role "user" - :parts - (vconcat - (mapcar - (lambda (tool-call) - (let ((result (plist-get tool-call :result)) - (name (plist-get tool-call :name))) - `(:functionResponse - (:name ,name :response - (:name ,name :content ,result))))) - tool-use)))) - -(cl-defmethod gptel--inject-prompt ((_backend gptel-gemini) data new-prompt &optional _position) - "Append NEW-PROMPT to existing prompts in query DATA. - -See generic implementation for full documentation." - (let ((prompts (plist-get data :contents))) - (plist-put data :contents (vconcat prompts (list new-prompt))))) - -(cl-defmethod gptel--parse-list ((backend gptel-gemini) prompt-list) - (if (consp (car prompt-list)) - (let ((full-prompt)) ; Advanced format, list of lists - (dolist (entry prompt-list) - (pcase entry - (`(prompt . ,msg) - (push (list :role "user" - :parts `[(:text ,(or (car-safe msg) msg))]) - full-prompt)) - (`(response . ,msg) - (push (list :role "model" - :parts `[(:text ,(or (car-safe msg) msg))]) - full-prompt)) - (`(tool . ,call) - (push (list :role "model" - :parts (vector `(:functionCall ( :name ,(plist-get call :name) - :args ,(plist-get call :args))))) - full-prompt) - (push (gptel--parse-tool-results backend (list (cdr entry))) full-prompt)))) - (nreverse full-prompt)) - (cl-loop for text in prompt-list ; Simple format, list of strings - for role = t then (not role) - if text - if role - collect (list :role "user" :parts `[(:text ,text)]) into prompts - else collect (list :role "model" :parts `[(:text ,text)]) into prompts - finally return prompts))) - -(cl-defmethod gptel--parse-buffer ((backend gptel-gemini) &optional max-entries) - (let ((prompts) (prev-pt (point))) - (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min))) - (not (= (point) prev-pt))) - (pcase (get-char-property (point) 'gptel) - ('response - (when-let* ((content (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt)))) - (push (list :role "model" :parts `[(:text ,content)]) prompts))) - (`(tool . ,_id) - (save-excursion - (condition-case nil - (let* ((tool-call (read (current-buffer))) - (name (plist-get tool-call :name)) - (arguments (plist-get tool-call :args))) - (plist-put tool-call :result - (string-trim (buffer-substring-no-properties - (point) prev-pt))) - (push (gptel--parse-tool-results backend (list tool-call)) - prompts) - (push (list :role "model" - :parts - (vector `(:functionCall ( :name ,name - :args ,arguments)))) - prompts)) - ((end-of-file invalid-read-syntax) - (message (format "Could not parse tool-call on line %s" - (line-number-at-pos (point)))))))) - ('ignore) - ('nil - (if gptel-track-media - (when-let* ((content (gptel--gemini-parse-multipart - (gptel--parse-media-links major-mode (point) prev-pt)))) - (when (> (length content) 0) - (push (list :role "user" :parts content) prompts))) - (when-let* ((content (gptel--trim-prefixes - (buffer-substring-no-properties - (point) prev-pt)))) - (push (list :role "user" :parts `[(:text ,content)]) prompts))))) - (setq prev-pt (point)) - (and max-entries (cl-decf max-entries))) - (let ((content (string-trim (buffer-substring-no-properties - (point-min) (point-max))))) - (push (list :role "user" :parts `[(:text ,content)]) prompts))) - prompts)) - -(defun gptel--gemini-parse-multipart (parts) - "Convert a multipart prompt PARTS to the Gemini API format. - -The input is an alist of the form - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")). - -The output is a vector of entries in a backend-appropriate -format." - (cl-loop - for part in parts - for n upfrom 1 - with last = (length parts) - for text = (plist-get part :text) - for media = (plist-get part :media) - if text do - (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and - if text - collect (list :text text) into parts-array end - else if media - collect - `(:inline_data - (:mime_type ,(plist-get part :mime) - :data ,(gptel--base64-encode media))) - into parts-array - else if (plist-get part :textfile) - collect - (list :text (with-temp-buffer - (gptel--insert-file-string (plist-get part :textfile)) - (buffer-string))) - into parts-array - finally return (vconcat parts-array))) - -(cl-defmethod gptel--inject-media ((_backend gptel-gemini) prompts) - "Wrap the first user prompt in PROMPTS with included media files. - -Media files, if present, are placed in `gptel-context'." - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf (lambda (current) - (vconcat (gptel--gemini-parse-multipart media-list) - current)) - (plist-get (car prompts) :parts)))) - -(defconst gptel--gemini-models - '((gemini-pro-latest - :description "Most powerful Gemini thinking model, always points to latest version" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 1048 ; 65536 output token limit - :input-cost 1.25 ; 2.50 for >200k tokens - :output-cost 10.00 ; 15 for >200k tokens - :cutoff-date "2025-01") - (gemini-flash-latest - :description "Best price / performance, always points to latest version" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 1048 ; 65536 output token limit - :input-cost 0.3 - :output-cost 2.50 - :cutoff-date "2025-01") - (gemini-flash-lite-latest - :description "Fastest, cheapest Gemini model, always points to latest version" - :capabilities (tool-use json media) - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain" - "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg" - "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm" - "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4" - "video/webm" "video/wmv" "video/3gpp") - :context-window 1048 ; 64000 output token limit - :input-cost 0.10 - :output-cost 0.40 - :cutoff-date "2025-01") - (gemini-3-pro-preview - :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 1048 ; 65536 output token limit - :input-cost 2.0 ; 4.0 for >200k tokens - :output-cost 12.00 ; 18.0 for >200k tokens - :cutoff-date "2025-01") - (gemini-3-flash-preview - :description "Most intelligent Gemini model built for speed" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 1048 ; 65536 output token limit - :input-cost 0.50 - :output-cost 3.00 - :cutoff-date "2025-01") - (gemini-2.5-pro - :description "Most powerful Gemini thinking model with state-of-the-art performance" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 1048 ; 65536 output token limit - :input-cost 1.25 ; 2.50 for >200k tokens - :output-cost 10.00 ; 15 for >200k tokens - :cutoff-date "2025-01") - (gemini-2.5-pro-preview-06-05 - :description "Most powerful thinking model with state-of-the-art performance" - :capabilities (tool-use json media) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html") - :context-window 1048 ; 65536 output token limit - :input-cost 1.25 ; 2.50 for >200k tokens - :output-cost 10.00 ; 15 for >200k tokens - :cutoff-date "2025-01") - (gemini-2.5-flash - :description "Best in terms of price-performance, with well-rounded capabilities" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 1048 ; 65536 output token limit - :input-cost 0.3 - :output-cost 2.50 - :cutoff-date "2025-01") - (gemini-2.5-flash-preview-09-2025 - :description "DEPRECATED: Please use gemini-2.5-flash instead" - :capabilities (tool-use json media) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html") - :context-window 1048 ; 65536 output token limit - :input-cost 0.15 - :output-cost 0.60 ; 3.50 for thinking - :cutoff-date "2025-01") - (gemini-2.5-flash-lite - :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks" - :capabilities (tool-use json media) - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain" - "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg" - "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm" - "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4" - "video/webm" "video/wmv" "video/3gpp") - :context-window 1048 ; 64000 output token limit - :input-cost 0.10 - :output-cost 0.40 - :cutoff-date "2025-01") - (gemini-2.5-flash-lite-preview-09-2025 - :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain" - "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg" - "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm" - "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4" - "video/webm" "video/wmv" "video/3gpp") - :context-window 1048 ; 65536 output token limit - :input-cost 0.10 - :output-cost 0.40 - :cutoff-date "2025-01") - (gemini-2.0-flash - :description "Next gen, high speed, multimodal for a diverse variety of tasks" - :capabilities (tool-use json media) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html") - :context-window 1000 - :input-cost 0.10 - :output-cost 0.40 - :cutoff-date "2024-08") - (gemini-2.0-flash-exp - :description "Next generation features, superior speed, native tool use" - :capabilities (tool-use json media) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html") - :context-window 1000 - :input-cost 0.00 - :output-cost 0.00) - (gemini-2.0-flash-thinking-exp - :description "DEPRECATED: Please use gemini-2.0-flash-thinking-exp-01-21 instead" - :capabilities (tool-use media) - :context-window 32 - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "text/plain" "text/csv" "text/html") - :input-cost 0.00 - :output-cost 0.00)) - "List of available Gemini models and associated properties. -Keys: - -- `:description': a brief description of the model. - -- `:capabilities': a list of capabilities supported by the model. - -- `:mime-types': a list of supported MIME types for media files. - -- `:context-window': the context window size, in thousands of tokens. - -- `:input-cost': the input cost, in US dollars per million tokens. - -- `:output-cost': the output cost, in US dollars per million tokens. - -- `:cutoff-date': the knowledge cutoff date. - -- `:request-params': a plist of additional request parameters to - include when using this model. - -Information about the Gemini models was obtained from the following -source: - -- -- ") - -;;;###autoload -(cl-defun gptel-make-gemini - (name &key curl-args header key request-params - (stream nil) - (host "generativelanguage.googleapis.com") - (protocol "https") - (models gptel--gemini-models) - (endpoint "/v1beta/models")) - - "Register a Gemini backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, defaults to -\"generativelanguage.googleapis.com\". - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--gemini-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(gemini-2.0-flash-lite ;Simple specs - gemini-1.5-flash - (gemini-1.5-pro-latest ;Full spec - :description - \"Complex reasoning tasks, problem solving and data extraction\" - :capabilities (tool json) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\"))) - - -STREAM is a boolean to enable streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, \"https\" by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1beta/models\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for." - (declare (indent 1)) - (let ((backend (gptel--make-gemini - :curl-args curl-args - :name name - :host host - :header header - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :key key - :url (lambda () - (let ((method - (if (and stream gptel-use-curl gptel-stream) - "streamGenerateContent" - "generateContent"))) - (format "%s://%s%s/%s:%s?key=%s" - protocol - host - endpoint - gptel-model - method - (gptel--get-api-key))))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -(provide 'gptel-gemini) -;;; gptel-gemini.el ends here diff --git a/elpa/gptel-20260123.739/gptel-gh.el b/elpa/gptel-20260123.739/gptel-gh.el deleted file mode 100644 index 5136bcf3..00000000 --- a/elpa/gptel-20260123.739/gptel-gh.el +++ /dev/null @@ -1,435 +0,0 @@ -;;; gptel-gh.el --- Github Copilot AI suppport for gptel -*- lexical-binding: t; -*- - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This file adds support for Github Copilot API to gptel - -;;; Code: - -(eval-when-compile - (require 'cl-lib)) -(require 'map) -(require 'gptel) -(require 'browse-url) - -;;; Github Copilot -(defconst gptel--gh-models - '((gpt-4o - :description - "Advanced model for complex tasks; cheaper & faster than GPT-Turbo" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 128 :input-cost 0 :output-cost 0 :cutoff-date "2023-10") - (gpt-4.1 - :description "Flagship model for complex tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 128 - :input-cost 0 - :output-cost 0 - :cutoff-date "2024-05") - (gpt-41-copilot - :description "Flagship model for complex tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 200 - :input-cost 0 - :output-cost 0 - :cutoff-date "2024-05") - (gpt-5 - :description "Flagship model for coding, reasoning, and agentic tasks across domains" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 264 - :input-cost 1 - :output-cost 1 - :cutoff-date "2024-09") - (gpt-5.1-codex-max - :description "Flagship model for coding, reasoning, and agentic tasks across domains" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 1 - :output-cost 1 - :cutoff-date "2024-09") - (gpt-5-mini - :description "Faster, more cost-efficient version of GPT-5" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 264 - :input-cost 0 - :output-cost 0 - :cutoff-date "2024-09") - (gpt-5.1 - :description "The best model for coding and agentic tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 1 - :output-cost 1 - :cutoff-date "2024-09") - (gpt-5.2 - :description "The best model for coding and agentic tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 1.75 - :output-cost 14 - :cutoff-date "2025-08") - (claude-sonnet-4 - :description "High-performance model with exceptional reasoning and efficiency" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 216 - :input-cost 1 - :output-cost 1 - :cutoff-date "2025-03") - (claude-sonnet-4.5 - :description "High-performance model with exceptional reasoning and efficiency" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 144 - :input-cost 1 - :output-cost 1 - :cutoff-date "2025-07") - (claude-haiku-4.5 - :description "Near-frontier intelligence at blazing speeds with extended thinking" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 144 - :input-cost 0.33 - :output-cost 0.33 - :cutoff-date "2025-02") - (claude-opus-41 - :description "Most capable model for complex reasoning and advanced coding" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 80 - :input-cost 10 - :output-cost 10 - :cutoff-date "2025-03") - (claude-opus-4.5 - :description "Most capable model for complex reasoning and advanced coding" - :capabilities (media tool-use cache) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") - :context-window 144 - :input-cost 3 - :output-cost 3 - :cutoff-date "2025-05") - (gemini-2.5-pro - :description "Next gen, high speed, multimodal for a diverse variety of tasks" - :capabilities (tool-use json media) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html") - :context-window 128 - :input-cost 1 - :output-cost 1 - :cutoff-date "2024-08") - (gemini-3-flash-preview - :description "Most intelligent Gemini model built for speed" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 128 - :input-cost 0.33 - :output-cost 0.33 - :cutoff-date "2025-01") - (gemini-3-pro-preview - :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding" - :capabilities (tool-use json media audio video) - :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" - "application/pdf" "text/plain" "text/csv" "text/html" - "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" - "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") - :context-window 128 - :input-cost 1 - :output-cost 1 - :cutoff-date "2025-01") - (grok-code-fast-1 - :description "Fast reasoning model for agentic coding" - :capabilities '(tool-use json reasoning) - :context-window 128 - :input-cost 0.2 - :output-cost 1.5))) - -(cl-defstruct (gptel--gh (:include gptel-openai) - (:copier nil) - (:constructor gptel--make-gh)) - token github-token sessionid machineid) - -(defcustom gptel-gh-github-token-file (expand-file-name ".cache/copilot-chat/github-token" - user-emacs-directory) - "File where the GitHub token is stored." - :type 'string - :group 'gptel) - -(defcustom gptel-gh-token-file (expand-file-name ".cache/copilot-chat/token" - user-emacs-directory) - "File where the chat token is cached." - :type 'string - :group 'gptel) - -(defconst gptel--gh-auth-common-headers - `(("editor-plugin-version" . "gptel/*") - ("editor-version" . ,(concat "emacs/" emacs-version)))) - -(defconst gptel--gh-client-id "Iv1.b507a08c87ecfe98") - -;; https://en.wikipedia.org/wiki/Universally_unique_identifier#Version_4_(random) -(defun gptel--gh-uuid () - "Generate a UUID v4-1." - (format "%04x%04x-%04x-4%03x-8%03x-%04x%04x%04x" - (random #x10000) (random #x10000) - (random #x10000) - (random #x1000) - (random #x1000) - (random #x10000) (random #x10000) (random #x10000))) - -(defun gptel--gh-machine-id () - "Generate a machine ID." - (let ((hex-chars "0123456789abcdef") - (length 65) - hex) - (dotimes (_ length) - (setq hex (nconc hex (list (aref hex-chars (random 16)))))) - (apply #'string hex))) - -(defun gptel--gh-restore (file) - "Restore saved object from FILE." - (when (file-exists-p file) - ;; We set the coding system to `utf-8-auto-dos' when reading so that - ;; files with CR EOL can still be read properly - (let ((coding-system-for-read 'utf-8-auto-dos)) - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-file-contents-literally file) - (goto-char (point-min)) - (read (current-buffer)))))) - -(defun gptel--gh-save (file obj) - "Save OBJ to FILE." - (let ((print-length nil) - (print-level nil) - (coding-system-for-write 'utf-8-unix)) - (make-directory (file-name-directory file) t) - (write-region (prin1-to-string obj) nil file nil :silent) - obj)) - -(defun gptel-gh-login () - "Login to GitHub Copilot API. - -This will prompt you to authorize in a browser and store the token. - -In SSH sessions, the URL and code will be displayed for manual entry -instead of attempting to open a browser automatically." - (interactive) - ;; Determine which GitHub backend to use - (let ((gh-backend - (cond - ;; If current backend is GitHub, use it - ((and (boundp 'gptel-backend) - gptel-backend - (gptel--gh-p gptel-backend)) - gptel-backend) - ;; Otherwise, find any GitHub backend - ((cl-find-if (lambda (b) (gptel--gh-p b)) - (mapcar #'cdr gptel--known-backends))) - ;; No GitHub backend found - (t (user-error "No GitHub Copilot backend found. \ -Please set one up with `gptel-make-gh-copilot' first")))) - ;; Detect SSH sessions - (in-ssh-session (or (getenv "SSH_CLIENT") - (getenv "SSH_CONNECTION") - (getenv "SSH_TTY")))) - (pcase-let (((map :device_code :user_code :verification_uri) - (gptel--url-retrieve - "https://github.com/login/device/code" - :method 'post - :headers gptel--gh-auth-common-headers - :data `( :client_id ,gptel--gh-client-id - :scope "read:user")))) - (gui-set-selection 'CLIPBOARD user_code) - (if in-ssh-session - ;; SSH session: display URL and code, don't auto-open browser - (progn - (message "GitHub Device Code: %s (copied to clipboard)" user_code) - (read-from-minibuffer - (format "Code %s is copied. Visit https://github.com/login/device \ -in your local browser, enter the code, and authorize. Press ENTER after authorizing. " - user_code))) - ;; Local session: auto-open browser - (read-from-minibuffer - (format "Your one-time code %s is copied. \ -Press ENTER to open GitHub in your browser. \ -If your browser does not open automatically, browse to %s." - user_code verification_uri)) - (browse-url verification_uri) - (read-from-minibuffer "Press ENTER after authorizing. ")) - ;; Use gh-backend for token storage - (thread-last - (plist-get - (gptel--url-retrieve - "https://github.com/login/oauth/access_token" - :method 'post - :headers gptel--gh-auth-common-headers - :data `( :client_id ,gptel--gh-client-id - :device_code ,device_code - :grant_type "urn:ietf:params:oauth:grant-type:device_code")) - :access_token) - (gptel--gh-save gptel-gh-github-token-file) - (setf (gptel--gh-github-token gh-backend)))) - ;; Check gh-backend for success - (if (and (gptel--gh-github-token gh-backend) - (not (string-empty-p - (gptel--gh-github-token gh-backend)))) - (message "Successfully logged in to GitHub Copilot.") - (user-error "Error: You might not have access to GitHub Copilot Chat!")))) - -(defun gptel--gh-renew-token () - "Renew session token." - (let ((token - (gptel--url-retrieve - "https://api.github.com/copilot_internal/v2/token" - :method 'get - :headers `(("authorization" - . ,(format "token %s" (gptel--gh-github-token gptel-backend))) - ,@gptel--gh-auth-common-headers)))) - (if (not (plist-get token :token)) - (progn - (setf (gptel--gh-github-token gptel-backend) nil) - (user-error "Error: You might not have access to GitHub Copilot Chat!")) - (thread-last - (gptel--gh-save gptel-gh-token-file token) - (setf (gptel--gh-token gptel-backend)))))) - -(defun gptel--gh-auth () - "Authenticate with GitHub Copilot API. - -We first need github authorization (github token). -Then we need a session token." - (unless (gptel--gh-github-token gptel-backend) - (let ((token (gptel--gh-restore gptel-gh-github-token-file))) - (if token - (setf (gptel--gh-github-token gptel-backend) token) - (gptel-gh-login)))) - - (when (null (gptel--gh-token gptel-backend)) - ;; try to load token from `gptel-gh-token-file' - (setf (gptel--gh-token gptel-backend) - (gptel--gh-restore gptel-gh-token-file))) - - (pcase-let (((map :token :expires_at) - (gptel--gh-token gptel-backend))) - (when (or (null token) - (and expires_at - (> (round (float-time (current-time))) - expires_at))) - (gptel--gh-renew-token)))) - -;;;###autoload -(cl-defun gptel-make-gh-copilot - (name &key curl-args request-params - (header (lambda () - (gptel--gh-auth) - `(("openai-intent" . "conversation-panel") - ("authorization" . ,(concat "Bearer " - (plist-get (gptel--gh-token gptel-backend) :token))) - ("x-request-id" . ,(gptel--gh-uuid)) - ("vscode-sessionid" . ,(or (gptel--gh-sessionid gptel-backend) "")) - ("vscode-machineid" . ,(or (gptel--gh-machineid gptel-backend) "")) - ,@(when (and gptel-track-media - (gptel--model-capable-p 'media)) - `(("copilot-vision-request" . "true"))) - ("copilot-integration-id" . "vscode-chat")))) - (host "api.githubcopilot.com") - (protocol "https") - (endpoint "/chat/completions") - (stream t) - (models gptel--gh-models)) - "Register a Github Copilot chat backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, typically \"api.githubcopilot.com\". - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--openai-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(gpt-3.5-turbo ;Simple specs - gpt-4-turbo - (gpt-4o-mini ;Full spec - :description - \"Affordable and intelligent small model for lightweight tasks\" - :capabilities (media tool json url) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) - -Defaults to a list of models supported by GitHub Copilot. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/chat/completions\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that returns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -Defaults to headers required by GitHub Copilot. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for." - (declare (indent 1)) - (let ((backend (gptel--make-gh - :name name - :host host - :header header - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :curl-args curl-args - :url (concat protocol "://" host endpoint) - :machineid (gptel--gh-machine-id)))) - (setf (alist-get name gptel--known-backends nil nil #'equal) backend) - backend)) - -(provide 'gptel-gh) -;;; gptel-gh.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not docstrings) -;; End: diff --git a/elpa/gptel-20260123.739/gptel-integrations.el b/elpa/gptel-20260123.739/gptel-integrations.el deleted file mode 100644 index 65b7de38..00000000 --- a/elpa/gptel-20260123.739/gptel-integrations.el +++ /dev/null @@ -1,275 +0,0 @@ -;;; gptel-transient.el --- Integrations for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2025 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: - -;; Integrations with related packages for gptel. To use these, run -;; -;; (require 'gptel-integrations) -;; -;; For MCP integration: -;; - Run M-x `gptel-mcp-connect' and M-x `gptel-mcp-disconnect', OR -;; - Use gptel's tools menu, M-x `gptel-tools', OR -;; - Access tools from `gptel-menu' - -;;; Code: -(require 'gptel) -(require 'cl-lib) -(eval-when-compile (require 'transient)) - -;;;; MCP integration - requires the mcp package -(declare-function mcp-hub-get-all-tool "mcp-hub") -(declare-function mcp-hub-get-servers "mcp-hub") -(declare-function mcp-hub-start-all-server "mcp-hub") -(declare-function mcp-stop-server "mcp") -(declare-function mcp-hub "mcp-hub") -(declare-function mcp--status "mcp-hub") -(declare-function mcp--tools "mcp-hub") -(declare-function mcp-make-text-tool "mcp-hub") -(defvar mcp-hub-servers) -(defvar mcp-server-connections) - -(defun gptel-mcp-connect (&optional servers server-callback interactive) - "Add gptel tools from MCP servers using the mcp package. - -MCP servers are started if required. SERVERS is a list of server -names (strings) to connect to. If nil, all known servers are -considered. - -If INTERACTIVE is non-nil (or called interactively), guide the user -through setting up mcp, and query for servers to retrieve tools from. - -Call SERVER-CALLBACK after starting MCP servers. If SERVER-CALLBACK is -not a function and non-nil, start SERVERS synchronously." - (interactive (list nil nil t)) - (if (locate-library "mcp-hub") - (unless (require 'mcp-hub nil t) - (user-error "Could not load `mcp-hub'! Please install\ - or configure the mcp package")) - (user-error "Could not find mcp! Please install or configure the mcp package")) - (if (null mcp-hub-servers) - (user-error "No MCP servers available! Please configure `mcp-hub-servers'") - (setq servers - (if servers - (mapcar (lambda (s) (assoc s mcp-hub-servers)) servers) - mcp-hub-servers)) - (let ((unregistered-servers ;Available servers minus servers already registered with gptel - (cl-loop for server in servers - with registered-names = - (cl-loop for (cat . _tools) in gptel--known-tools - if (string-prefix-p "mcp-" cat) - collect (substring cat 4)) - unless (member (car server) registered-names) - collect server))) - (if unregistered-servers - (let* ((servers - (if interactive - (let ((picks - (completing-read-multiple - "Add tools from MCP servers (separate with \",\"): " - (cons '("ALL") unregistered-servers) nil t))) - (if (member "ALL" picks) - unregistered-servers - (mapcar (lambda (s) (assoc s mcp-hub-servers)) picks))) - unregistered-servers)) - (server-active-p - (lambda (server) - (when-let* ((server (gethash (car server) mcp-server-connections))) - (equal (mcp--status server) 'connected)))) - (inactive-servers (cl-remove-if server-active-p servers)) - (add-all-tools - (lambda (&optional server-names) - "Register and add tools from servers. Report failures." - (let ((tools (gptel-mcp--get-tools - (or server-names (mapcar #'car inactive-servers)))) - (now-active (cl-remove-if-not server-active-p mcp-hub-servers))) - (mapc (lambda (tool) (apply #'gptel-make-tool tool)) tools) - (gptel-mcp--activate-tools tools) - (if-let* ((failed (cl-set-difference inactive-servers now-active - :test #'equal))) - (progn - (message "Inactive-before: %S, Now-Active: %S" inactive-servers now-active) - (message (substitute-command-keys - "%d/%d server%s failed to start: %s. Run \\[mcp-hub] to investigate.") - (length failed) (length inactive-servers) - (if (= (length failed) 1) "" "s") - (mapconcat #'car failed ", "))) - (let ((added (or server-names (mapcar #'car now-active)))) - (message "Added %d tools from %d MCP server%s: %s" - (length tools) (length added) - (if (= (length added) 1) "" "s") - (mapconcat #'identity added ", ")))) - (when (functionp server-callback) (funcall server-callback)))))) - - (if inactive-servers ;start servers - (let ((syncp (and server-callback (not (functionp server-callback)) t))) - (mcp-hub-start-all-server - add-all-tools (mapcar #'car inactive-servers) syncp)) - (funcall add-all-tools (mapcar #'car servers)))) - (when interactive (message "All MCP tools are already available to gptel!")) - (when (functionp server-callback) (funcall server-callback)))))) - -(defun gptel-mcp-disconnect (&optional servers interactive) - "Unregister gptel tools provided by MCP servers using the mcp package. - -SERVERS is a list of server names (strings) to disconnect from. - -If INTERACTIVE is non-nil, query the user about which tools to remove." - (interactive (list nil t)) - (if-let* ((names-alist - (cl-loop - for (category . _tools) in gptel--known-tools - if (and (string-match "^mcp-\\(.*\\)" category) - (or (null servers) ;Consider all if nil - (member (match-string 1 category) servers))) - collect (cons (match-string 1 category) category)))) - (let ((remove-fn (lambda (cat-names) - (setq gptel-tools ;Remove from gptel-tools - (cl-delete-if (lambda (tool) (member (gptel-tool-category tool) - cat-names)) - gptel-tools)) - (mapc (lambda (category) ;Remove from registry - (setf (alist-get category gptel--known-tools - nil t #'equal) - nil)) - cat-names)))) - (if interactive - (when-let* ((server-names - (completing-read-multiple - "Remove MCP server tools for (separate with \",\"): " - (cons '("ALL" . nil) names-alist) - nil t))) - (when (member "ALL" server-names) - (setq server-names (mapcar #'car names-alist))) - (funcall remove-fn ;remove selected tool categories - (mapcar (lambda (s) (cdr (assoc s names-alist))) server-names)) - (if (y-or-n-p - (format "Removed MCP tools from %d server%s. Also shut down MCP servers?" - (length server-names) - (if (= (length server-names) 1) "" "s"))) - (progn (mapc #'mcp-stop-server server-names) - (message "Shut down MCP servers: %S" server-names)) - (message "Removed MCP tools for: %S" server-names))) - (funcall remove-fn (mapcar #'cdr names-alist)))) - ;; No MCP tools, ask to shut down servers - (if (cl-loop - for v being the hash-values of mcp-server-connections - never v) - (when interactive (message "No MCP servers active!")) - (when (or (not interactive) - (y-or-n-p "No MCP tools in gptel! Shut down all MCP servers? ")) - (dolist (server mcp-hub-servers) - (when (gethash (car server) mcp-server-connections) - (mcp-stop-server (car server)))))))) - -(defun gptel-mcp--get-tools (&optional server-names) - "Return tools from running MCP servers. - -SERVER-NAMES is a list of server names to add tools from. Add tools -from all connected servers if it is nil." - (unless server-names - (setq server-names (hash-table-keys mcp-server-connections))) - (let ((servers (mapcar (lambda (n) (gethash n mcp-server-connections)) - server-names))) - (cl-mapcan - (lambda (name server) - (when (and server (equal (mcp--status server) 'connected)) - (when-let* ((tools (mcp--tools server)) - (tool-names (mapcar #'(lambda (tool) (plist-get tool :name)) tools))) - (mapcar (lambda (tool-name) - (plist-put (mcp-make-text-tool name tool-name t) - :category (format "mcp-%s" name))) - tool-names)))) - server-names servers))) - -(defun gptel-mcp--activate-tools (&optional tools) - "Activate TOOLS or all MCP tools in current gptel session." - (unless tools (setq tools (gptel-mcp--get-tools))) - (dolist (tool tools) - (cl-pushnew (gptel-get-tool (list (plist-get tool :category) - (plist-get tool :name))) - gptel-tools))) - -(with-eval-after-load 'gptel-transient - (transient-define-suffix gptel--suffix-mcp-connect () - "Register tools provided by MCP servers." - :key "M+" - :description "Add MCP server tools" - :transient t - (interactive) - ;; gptel-tools stores its state in its scope slot. Retain the scope but - ;; update it with the newly selected tools. Then set up gptel-tools. - (condition-case err - (gptel-mcp-connect - nil (lambda () (when-let* ((transient--prefix) - ((eq (oref transient--prefix command) - 'gptel-tools))) - (let ((state (transient-scope 'gptel-tools))) - (plist-put state :tools - (delete-dups - (nconc (mapcar (lambda (tool) - (list (gptel-tool-category tool) - (gptel-tool-name tool))) - gptel-tools) - (plist-get state :tools)))) - (transient-setup 'gptel-tools nil nil :scope state)))) - t) - (user-error (message "%s" (cadr err))))) - - (transient-define-suffix gptel--suffix-mcp-disconnect () - "Remove tools provided by MCP servers from gptel." - :key "M-" - :description (lambda () (if (cl-some (lambda (cat) (string-match-p "^mcp-" cat)) - (map-keys gptel--known-tools)) - "Remove MCP server tools" - "Shut down MCP servers")) - :transient t - :inapt-if - (lambda () (or (not (boundp 'mcp-hub-servers)) - (null mcp-hub-servers) - (cl-loop - for v being the hash-values of mcp-server-connections - never v))) - (interactive) - (call-interactively #'gptel-mcp-disconnect) - ;; gptel-tools stores its state in its scope slot. Retain the scope but - ;; remove tools from it that no longer exist, then set up gptel-tools - (cl-loop with state = (transient-scope 'gptel-tools) - with tools = (plist-get state :tools) - for tool-spec in tools - if (map-nested-elt gptel--known-tools tool-spec) - collect tool-spec into valid-tools - finally do (plist-put state :tools valid-tools) - (transient-setup 'gptel-tools nil nil :scope state))) - - (transient-remove-suffix 'gptel-tools '(0 2)) - (transient-append-suffix 'gptel-tools '(0 -1) - ["" - (gptel--suffix-mcp-connect) - (gptel--suffix-mcp-disconnect)])) - -(provide 'gptel-integrations) -;;; gptel-integrations.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not noruntime) -;; End: diff --git a/elpa/gptel-20260123.739/gptel-kagi.el b/elpa/gptel-20260123.739/gptel-kagi.el deleted file mode 100644 index 97a8d9a7..00000000 --- a/elpa/gptel-20260123.739/gptel-kagi.el +++ /dev/null @@ -1,188 +0,0 @@ -;;; gptel-kagi.el --- Kagi support for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur -;; Keywords: hypermedia - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This file adds support for the Kagi FastGPT LLM API to gptel - -;;; Code: -(require 'gptel) -(require 'cl-generic) -(eval-when-compile - (require 'cl-lib)) - -(declare-function gptel-context--wrap "gptel-context") - -;;; Kagi -(cl-defstruct (gptel-kagi (:constructor gptel--make-kagi) - (:copier nil) - (:include gptel-backend))) - -(cl-defmethod gptel--parse-response ((_backend gptel-kagi) response info) - (let* ((data (plist-get response :data)) - (output (plist-get data :output)) - (references (plist-get data :references))) - (if (eq references :null) (setq references nil)) - (if (eq output :null) (setq output nil)) - (when references - (setq references - (cl-loop with linker = - (pcase (buffer-local-value 'major-mode - (plist-get info :buffer)) - ('org-mode - (lambda (text url) - (format "[[%s][%s]]" url text))) - ('markdown-mode - (lambda (text url) - (format "[%s](%s)" text url))) - (_ (lambda (text url) - (buttonize - text (lambda (data) (browse-url data)) - url)))) - for ref across references - for title = (plist-get ref :title) - for snippet = (plist-get ref :snippet) - for url = (plist-get ref :url) - for n upfrom 1 - collect - (concat (format "[%d] " n) - (funcall linker title url) ": " - (replace-regexp-in-string - "" "*" snippet)) - into ref-strings - finally return - (concat "\n\n" (mapconcat #'identity ref-strings "\n"))))) - (concat output references))) - -;; TODO: Add support for model/backend-specific request-params and -;; gptel--request-params -(cl-defmethod gptel--request-data ((_backend gptel-kagi) prompts) - "JSON encode PROMPTS for Kagi." - (pcase-exhaustive (gptel--model-name gptel-model) - ("fastgpt" - `(,@prompts :web_search t :cache t)) - ((and model (guard (string-prefix-p "summarize" model))) - `(,@prompts :engine ,(substring model 10))))) - -(cl-defmethod gptel--parse-buffer ((_backend gptel-kagi) &optional _max-entries) - (let ((url (or (thing-at-point 'url) - (get-text-property (point) 'shr-url) - (get-text-property (point) 'image-url))) - ;; (filename (thing-at-point 'existing-filename)) ;no file upload support yet - (prop (text-property-search-backward - 'gptel 'response - (when (get-char-property (max (point-min) (1- (point))) - 'gptel) - t)))) - (if (and url (string-prefix-p "summarize" (gptel--model-name gptel-model))) - (list :url url) - (if (and (or gptel-mode gptel-track-response) - (prop-match-p prop) - (prop-match-value prop)) - (user-error "No user prompt found!") - (let ((prompts - (if (or gptel-mode gptel-track-response) - (or (gptel--trim-prefixes - (buffer-substring-no-properties (prop-match-beginning prop) - (prop-match-end prop))) - "") - (string-trim (buffer-substring-no-properties (point-min) (point-max)))))) - (pcase-exhaustive (gptel--model-name gptel-model) - ("fastgpt" (setq prompts (list :query (if (prop-match-p prop) prompts "")))) - ((and model (guard (string-prefix-p "summarize" model))) - ;; If the entire contents of the prompt looks like a url, send the url - ;; Else send the text of the region - (setq prompts - (if-let* (((prop-match-p prop)) - (engine (substring model 10))) - ;; It's a region of text - (list :text prompts) - "")))) - prompts))))) - -;;;###autoload -(cl-defun gptel-make-kagi - (name &key curl-args stream key - (host "kagi.com") - (header (lambda () `(("Authorization" . ,(concat "Bot " (gptel--get-api-key)))))) - (models '((fastgpt :capabilities (nosystem)) - (summarize:cecil :capabilities (nosystem)) - (summarize:agnes :capabilities (nosystem)) - (summarize:daphne :capabilities (nosystem)) - (summarize:muriel :capabilities (nosystem)))) - (protocol "https") - (endpoint "/api/v0/")) - "Register a Kagi FastGPT backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is the Kagi host (with port), defaults to \"kagi.com\". - -MODELS is a list of available Kagi models: only fastgpt is supported. - -STREAM is a boolean to toggle streaming responses, defaults to -false. Kagi does not support a streaming API yet. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/api/v0/fastgpt\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -Example: -------- - - (gptel-make-kagi \"Kagi\" :key my-kagi-key)" - (declare (indent 1)) - stream ;Silence byte-compiler - (let ((backend (gptel--make-kagi - :curl-args curl-args - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :url - (lambda () - (concat protocol "://" host endpoint - (if (equal gptel-model 'fastgpt) - "fastgpt" "summarize")))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -(provide 'gptel-kagi) -;;; gptel-kagi.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not docstrings) -;; End: diff --git a/elpa/gptel-20260123.739/gptel-ollama.el b/elpa/gptel-20260123.739/gptel-ollama.el deleted file mode 100644 index abecfb6c..00000000 --- a/elpa/gptel-20260123.739/gptel-ollama.el +++ /dev/null @@ -1,366 +0,0 @@ -;;; gptel-ollama.el --- Ollama support for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur -;; Keywords: hypermedia - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This file adds support for the Ollama LLM API to gptel - -;;; Code: -(require 'gptel) -(require 'cl-generic) - -(declare-function json-read "json" ()) -(declare-function gptel-context--wrap "gptel-context") -(declare-function gptel-context--collect-media "gptel-context") -(defvar json-object-type) - -;;; Ollama -(cl-defstruct (gptel-ollama (:constructor gptel--make-ollama) - (:copier nil) - (:include gptel-backend))) - -;; FIXME(fsm) Remove this variable -(defvar-local gptel--ollama-token-count 0 - "Token count for ollama conversations. - -This variable holds the total token count for conversations with -Ollama models. - -Intended for internal use only.") - -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-ollama) info) - "Parse response stream for the Ollama API." - (when (and (bobp) (re-search-forward "^{" nil t)) - (forward-line 0)) - (let* ((content-strs) (content) (pt (point))) - (condition-case nil - (while (setq content (gptel--json-read)) - (setq pt (point)) - (let ((done (map-elt content :done)) - (reasoning (map-nested-elt content '(:message :thinking))) - (response (map-nested-elt content '(:message :content))) - (tool-calls (map-nested-elt content '(:message :tool_calls)))) - (when (and response (not (eq response :null))) - (push response content-strs)) - (when (and tool-calls (not (eq tool-calls :null))) - (gptel--inject-prompt - (plist-get info :backend) (plist-get info :data) - `(:role "assistant" :content :null :tool_calls ,(vconcat tool-calls))) - (cl-loop - for tool-call across tool-calls ;replace ":arguments" with ":args" - for call-spec = (copy-sequence (plist-get tool-call :function)) - do (plist-put call-spec :args - (plist-get call-spec :arguments)) - (plist-put call-spec :arguments nil) - collect call-spec into tool-use - finally (plist-put info :tool-use tool-use))) - (if (and reasoning (not (eq reasoning :null))) - (plist-put info :reasoning - (concat (plist-get info :reasoning) reasoning)) - (if (eq 'in (plist-get info :reasoning-block)) - (plist-put info :reasoning-block t) - (plist-put info :reasoning-block nil))) - (unless (eq done :json-false) - (with-current-buffer (plist-get info :buffer) - (cl-incf gptel--ollama-token-count - (+ (or (map-elt content :prompt_eval_count) 0) - (or (map-elt content :eval_count) 0)))) - (goto-char (point-max))))) - (error (goto-char pt))) - (apply #'concat (nreverse content-strs)))) - -(cl-defmethod gptel--parse-response ((_backend gptel-ollama) response info) - "Parse a one-shot RESPONSE from the Ollama API and return text. - -Store response metadata in state INFO." - (plist-put info :stop-reason (plist-get response :done_reason)) - (plist-put info :output-tokens (plist-get response :eval_count)) - (let* ((message (plist-get response :message)) - (reasoning (plist-get message :thinking)) - (content (plist-get message :content))) - (when reasoning - (plist-put info :reasoning reasoning)) - (when-let* ((tool-calls (plist-get message :tool_calls))) - ;; First add the tool call to the prompts list - (let* ((data (plist-get info :data)) - (prompts (plist-get data :messages))) - (plist-put data :messages (vconcat prompts `(,message)))) - ;; Then capture the tool call data for running the tool - (cl-loop - for tool-call across tool-calls ;replace ":arguments" with ":args" - for call-spec = (copy-sequence (plist-get tool-call :function)) - do (plist-put call-spec :args - (plist-get call-spec :arguments)) - (plist-put call-spec :arguments nil) - collect call-spec into tool-use - finally (plist-put info :tool-use tool-use))) - (when (and content (not (or (eq content :null) (string-empty-p content)))) - content))) - -(cl-defmethod gptel--request-data ((backend gptel-ollama) prompts) - "JSON encode PROMPTS for sending to Ollama." - (when gptel--system-message - (push (list :role "system" - :content gptel--system-message) - prompts)) - (let* ((prompts-plist - (gptel--merge-plists - `(:model ,(gptel--model-name gptel-model) - :messages [,@prompts] - :stream ,(or gptel-stream :json-false) - ,@(and gptel--schema - `(:format ,(gptel--preprocess-schema - (gptel--dispatch-schema-type gptel--schema))))) - gptel--request-params - (gptel-backend-request-params gptel-backend) - (gptel--model-request-params gptel-model))) - ;; the initial options (if any) from request params - (options-plist (plist-get prompts-plist :options))) - - (when (and gptel-use-tools gptel-tools) - ;; TODO(tool): Find out how to force tool use for Ollama - (plist-put prompts-plist :tools - (gptel--parse-tools backend gptel-tools))) - ;; if the temperature and max-tokens aren't set as - ;; backend/model-specific, use the global settings - (when (and gptel-temperature (not (plist-get options-plist :temperature))) - (setq options-plist - (plist-put options-plist :temperature gptel-temperature))) - (when (and gptel-max-tokens (not (plist-get options-plist :num_predict))) - (setq options-plist - (plist-put options-plist :num_predict gptel-max-tokens))) - (plist-put prompts-plist :options options-plist))) - -;; NOTE: No `gptel--parse-tools' method required for gptel-ollama, since this is -;; handled by its defgeneric implementation - -(cl-defmethod gptel--parse-tool-results ((_backend gptel-ollama) tool-use) - "Return a prompt containing tool call results in TOOL-USE." - (mapcar (lambda (tool-call) - (list :role "tool" :content (plist-get tool-call :result))) - tool-use)) - -;; NOTE: No `gptel--inject-prompt' method required for gptel-ollama, since this is -;; handled by its defgeneric implementation - -(cl-defmethod gptel--parse-list ((backend gptel-ollama) prompt-list) - (if (consp (car prompt-list)) - (let ((full-prompt)) ; Advanced format, list of lists - (dolist (entry prompt-list) - (pcase entry - (`(prompt . ,msg) - (push (list :role "user" :content (or (car-safe msg) msg)) - full-prompt)) - (`(response . ,msg) - (push (list :role "assistant" :content (or (car-safe msg) msg)) - full-prompt)) - (`(tool . ,call) - (push (list :role "assistant" - :content "" - :tool_calls `[(:function (:name ,(plist-get call :name) - :arguments ,(plist-get call :args)))]) - full-prompt) - (push (car (gptel--parse-tool-results backend (list (cdr entry)))) - full-prompt)))) - (nreverse full-prompt)) - (cl-loop for text in prompt-list ; Simple format, list of strings - for role = t then (not role) - if text collect - (list :role (if role "user" "assistant") :content text)))) - -(cl-defmethod gptel--parse-buffer ((backend gptel-ollama) &optional max-entries) - (let ((prompts) (prev-pt (point))) - (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min))) - (not (= (point) prev-pt))) - (pcase (get-char-property (point) 'gptel) - ('response - (when-let* ((content (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt)))) - (push (list :role "assistant" :content content) prompts))) - (`(tool . ,_id) - (save-excursion - (condition-case nil - (let* ((tool-call (read (current-buffer))) - (name (plist-get tool-call :name)) - (arguments (plist-get tool-call :args))) - (plist-put tool-call :result - (string-trim (buffer-substring-no-properties - (point) prev-pt))) - (push (car (gptel--parse-tool-results backend (list tool-call))) - prompts) - (push (list :role "assistant" - :content "" - :tool_calls `[(:function (:name ,name :arguments ,arguments))]) - prompts)) - ((end-of-file invalid-read-syntax) - (message (format "Could not parse tool-call on line %s" - (line-number-at-pos (point)))))))) - ('ignore) - ('nil - (if gptel-track-media - (when-let* ((content (gptel--ollama-parse-multipart - (gptel--parse-media-links major-mode (point) prev-pt)))) - (when (> (length content) 0) - (push (append '(:role "user") content) prompts))) - (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties - (point) prev-pt)))) - (push (list :role "user" :content content) prompts))))) - (setq prev-pt (point)) - (and max-entries (cl-decf max-entries))) - (let ((content (string-trim (buffer-substring-no-properties - (point-min) (point-max))))) - (push (list :role "user" :content content) prompts))) - prompts)) - -(defun gptel--ollama-parse-multipart (parts) - "Convert a multipart prompt PARTS to the Ollama API format. - -The input is an alist of the form - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")). - -The output is a vector of entries in a backend-appropriate -format." - (cl-loop - for part in parts - for n upfrom 1 - with last = (length parts) - for text = (plist-get part :text) - for media = (plist-get part :media) - if text do - (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and - if text - collect text into text-array end - else if media - collect (gptel--base64-encode media) into media-array - else if (plist-get part :textfile) - collect - (with-temp-buffer - (gptel--insert-file-string (plist-get part :textfile)) - (buffer-string)) - into text-array - finally return - `(,@(and text-array (list :content (mapconcat #'identity text-array " "))) - ,@(and media-array (list :images (vconcat media-array)))))) - -(cl-defmethod gptel--inject-media ((_backend gptel-ollama) prompts) - "Wrap the first user prompt in PROMPTS with included media files. - -Media files, if present, are placed in `gptel-context'." - (when-let* ((media-list (gptel-context--collect-media)) - (media-processed (gptel--ollama-parse-multipart media-list))) - (cl-callf (lambda (images) - (vconcat (plist-get media-processed :images) - images)) - (plist-get (car prompts) :images)))) - -;;;###autoload -(cl-defun gptel-make-ollama - (name &key curl-args header key models stream request-params - (host "localhost:11434") - (protocol "http") - (endpoint "/api/chat")) - "Register an Ollama backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is where Ollama runs (with port), defaults to localhost:11434 - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -Currently recognized plist keys are :description, :capabilities -and :mime-types. An example of a model specification including -both kinds of specs: - -:models -\\='(mistral:latest ;Simple specs - openhermes:latest - (llava:13b ;Full spec - :description - \"Llava 1.6: Large Lanuage and Vision Assistant\" - :capabilities (media) - :mime-types (\"image/jpeg\" \"image/png\"))) - - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, http by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/api/generate\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. This is typically not required -for local models like Ollama. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -Example: -------- - - (gptel-make-ollama - \"Ollama\" - :host \"localhost:11434\" - :models \\='(mistral:latest) - :stream t)" - (declare (indent 1)) - (let ((backend (gptel--make-ollama - :curl-args curl-args - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :url (if protocol - (concat protocol "://" host endpoint) - (concat host endpoint))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -(provide 'gptel-ollama) -;;; gptel-ollama.el ends here - - diff --git a/elpa/gptel-20260123.739/gptel-openai-extras.el b/elpa/gptel-20260123.739/gptel-openai-extras.el deleted file mode 100644 index f8ed4d38..00000000 --- a/elpa/gptel-20260123.739/gptel-openai-extras.el +++ /dev/null @@ -1,430 +0,0 @@ -;;; gptel-openai-extras.el --- Extensions to the OpenAI API -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Authors: Karthik Chikmagalur and pirminj - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This file adds support for Privategpt's Messages API and -;; Perplexity's Citations feature to gptel - -;;; Code: -(require 'cl-generic) -(eval-when-compile - (require 'cl-lib)) -(require 'map) -(require 'gptel) - -(defvar json-object-type) - -(declare-function prop-match-value "text-property-search") -(declare-function text-property-search-backward "text-property-search") -(declare-function json-read "json" ()) - - - -;;; Privategpt (Messages API) -(cl-defstruct (gptel-privategpt (:constructor gptel--make-privategpt) - (:copier nil) - (:include gptel-openai)) - context sources) - -(defun gptel--privategpt-parse-sources (response) - (cl-loop with source-alist - for source across (map-nested-elt response '(:choices 0 :sources)) - for name = (map-nested-elt source '(:document :doc_metadata :file_name)) - for page = (map-nested-elt source '(:document :doc_metadata :page_label)) - do (push page (alist-get name source-alist nil nil #'equal)) - finally return - (cl-loop for (file-name . file-pages) in source-alist - for pages = (delete-dups (delq nil file-pages)) - if pages - collect (format "- %s (page %s)" file-name (mapconcat #'identity pages ", ")) - into source-items - else collect (format "- %s" file-name) into source-items - finally return (mapconcat #'identity (cons "\n\nSources:" source-items) "\n")))) - -;; FIXME(tool) add tool use -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-privategpt) info) - (let* ((content-strs)) - (condition-case nil - (while (re-search-forward "^data:" nil t) - (save-match-data - (if (looking-at " *\\[DONE\\]") - (when-let* ((sources-string (plist-get info :sources))) - (push sources-string content-strs)) - (let ((response (gptel--json-read))) - (unless (or (plist-get info :sources) - (not (gptel-privategpt-sources (plist-get info :backend)))) - (plist-put info :sources (gptel--privategpt-parse-sources response))) - (let* ((delta (map-nested-elt response '(:choices 0 :delta))) - (content (plist-get delta :content))) - (push content content-strs)))))) - (error - (goto-char (match-beginning 0)))) - (apply #'concat (nreverse content-strs)))) - -;; FIXME(tool) add tool use -(cl-defmethod gptel--parse-response ((_backend gptel-privategpt) response info) - (let ((response-string (map-nested-elt response '(:choices 0 :message :content))) - (sources-string (and (gptel-privategpt-sources (plist-get info :backend)) - (gptel--privategpt-parse-sources response)))) - (concat response-string sources-string))) - -(cl-defmethod gptel--request-data ((_backend gptel-privategpt) prompts) - "JSON encode PROMPTS for sending to ChatGPT." - (let ((prompts-plist - `(:model ,(gptel--model-name gptel-model) - :messages [,@prompts] - :use_context ,(or (gptel-privategpt-context gptel-backend) :json-false) - :include_sources ,(or (gptel-privategpt-sources gptel-backend) :json-false) - :stream ,(or gptel-stream :json-false)))) - (when (and gptel--system-message - (not (gptel--model-capable-p 'nosystem))) - (plist-put prompts-plist :system gptel--system-message)) - (when gptel-temperature - (plist-put prompts-plist :temperature gptel-temperature)) - (when gptel-max-tokens - (plist-put prompts-plist :max_tokens gptel-max-tokens)) - ;; Merge request params with model and backend params. - (gptel--merge-plists - prompts-plist - (gptel-backend-request-params gptel-backend) - (gptel--model-request-params gptel-model)))) - - -;;;###autoload -(cl-defun gptel-make-privategpt - (name &key curl-args stream key request-params - (header - (lambda () (when-let* ((key (gptel--get-api-key))) - `(("Authorization" . ,(concat "Bearer " key)))))) - (host "localhost:8001") - (protocol "http") - (models '(private-gpt)) - (endpoint "/v1/chat/completions") - (context t) (sources t)) - "Register an Privategpt API-compatible backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, \"api.privategpt.com\" by default. - -MODELS is a list of available model names. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1/messages\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: -((\"Content-Type\" . \"application/json\")) - -KEY is a variable whose value is the API key, or function that -returns the key. - -CONTEXT and SOURCES: if true (the default), use available context -and provide sources used by the model to generate the response. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for." - (declare (indent 1)) - (let ((backend (gptel--make-privategpt - :curl-args curl-args - :name name - :host host - :header header - :key key - :models models - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :url (if protocol - (concat protocol "://" host endpoint) - (concat host endpoint)) - :context context - :sources sources))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - - -;;; Perplexity -(cl-defstruct (gptel-perplexity (:constructor gptel--make-perplexity) - (:copier nil) - (:include gptel-openai))) - -(defsubst gptel--perplexity-parse-citations (citations) - (let ((counter 0)) - (concat "\n\nCitations:\n" - (mapconcat (lambda (url) - (setq counter (1+ counter)) - (format "[%d] %s" counter url)) - citations "\n")))) - -(cl-defmethod gptel--parse-response ((_backend gptel-perplexity) response _info) - "Parse Perplexity response RESPONSE." - (let ((response-string (map-nested-elt response '(:choices 0 :message :content))) - (citations-string (when-let* ((citations (map-elt response :citations))) - (gptel--perplexity-parse-citations citations)))) - (concat response-string citations-string))) - -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-perplexity) info) - "Parse a Perplexity API data stream with INFO. - -If available, collect citations at the end and include them with -the response." - (let ((resp (cl-call-next-method))) - (unless (plist-get info :citations) - (save-excursion - (goto-char (point-max)) - (when (search-backward (plist-get info :token) - (line-beginning-position) t) - (forward-line 0) - (when (re-search-backward "^data: " nil t) - (goto-char (match-end 0)) - (ignore-errors - (when-let* ((chunk (gptel--json-read)) - (citations (map-elt chunk :citations))) - (plist-put info :citations t) - (setq resp (concat resp (gptel--perplexity-parse-citations - citations))))))))) - resp)) - -;;;###autoload -(cl-defun gptel-make-perplexity - (name &key curl-args stream key - (header - (lambda () (when-let* ((key (gptel--get-api-key))) - `(("Authorization" . ,(concat "Bearer " key)))))) - (host "api.perplexity.ai") - (protocol "https") - ;; https://docs.perplexity.ai/guides/model-cards - (models '(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research)) - (endpoint "/chat/completions") - request-params) - "Register a Perplexity backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, \"api.perplexity.ai\" by default. - -MODELS is a list of available model names. - -STREAM is a boolean to toggle streaming responses. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions. - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that returns an -alist. - -KEY is a variable whose value is the API key, or function that -returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters." - (declare (indent 1)) - (let ((backend (gptel--make-perplexity - :curl-args curl-args - :name name - :host host - :header header - :key key - :models models - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :url (if protocol - (concat protocol "://" host endpoint) - (concat host endpoint))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -;;; Deepseek -(cl-defstruct (gptel-deepseek (:include gptel-openai) - (:copier nil) - (:constructor gptel--make-deepseek))) - -(cl-defmethod gptel--parse-buffer :around ((_backend gptel-deepseek) _max-entries) - "Merge successive prompts in the prompts list that have the same role. - -The Deepseek API requires strictly alternating roles (user/assistant) in messages." - (let* ((prompts (cl-call-next-method)) - (index prompts)) - (prog1 prompts - (while index - (let ((p1 (car index)) - (p2 (cadr index)) - (rest (cdr index))) - (when (and p2 (equal (plist-get p1 :role) - (plist-get p2 :role))) - (setf (plist-get p1 :content) - (concat (plist-get p1 :content) "\n" - (plist-get p2 :content))) - (setcdr index (cdr rest))) - (setq index (cdr index))))))) - -;;;###autoload -(cl-defun gptel-make-deepseek - (name &key curl-args stream key request-params - (header (lambda () (when-let* ((key (gptel--get-api-key))) - `(("Authorization" . ,(concat "Bearer " key)))))) - (host "api.deepseek.com") - (protocol "https") - (endpoint "/v1/chat/completions") - (models '((deepseek-reasoner - :capabilities (tool reasoning) - :context-window 128 - :input-cost 0.56 - :output-cost 1.68) - (deepseek-chat - :capabilities (tool) - :context-window 128 - :input-cost 0.56 - :output-cost 1.68)))) - "Register a DeepSeek backend for gptel with NAME. - -For the meanings of the keyword arguments, see `gptel-make-openai'." - (declare (indent 1)) - (let ((backend (gptel--make-deepseek - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :curl-args curl-args - :url (concat protocol "://" host endpoint)))) - (setf (alist-get name gptel--known-backends nil nil #'equal) backend) - backend)) - -;;; xAI -;;;###autoload -(cl-defun gptel-make-xai - (name &key curl-args stream key request-params - (header (lambda () (when-let* ((key (gptel--get-api-key))) - `(("Authorization" . ,(concat "Bearer " key)))))) - (host "api.x.ai") - (protocol "https") - (endpoint "/v1/chat/completions") - (models - '((grok-4 - :description "Grok Flagship model" - :capabilities (tool-use json reasoning) - :context-window 256 - :input-cost 3 - :output-cost 15) - - (grok-code-fast-1 - :description "Fast reasoning model for agentic coding" - :capabilities (tool-use json reasoning) - :context-window 256 - :input-cost 0.2 - :output-cost 1.5) - - (grok-3 - :description "Grok 3" - :capabilities (tool-use json reasoning) - :context-window 131 - :input-cost 3 - :output-cost 15) - - (grok-3-fast - :description "Faster Grok 3" - :capabilities (tool-use json reasoning) - :context-window 131 - :input-cost 5 - :output-cost 25) - - (grok-3-mini - :description "Mini Grok 3" - :capabilities (tool-use json reasoning) - :context-window 131 - :input-cost 0.3 - :output-cost 0.5) - - (grok-3-mini-fast - :description "Faster mini Grok 3" - :capabilities (tool-use json reasoning) - :context-window 131072 - :input-cost 0.6 - :output-cost 4) - - (grok-2-vision-1212 - :description "Grok 2 Vision" - :capabilities (tool-use json media) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 32768 - :input-cost 2 - :output-cost 10)))) - "Register an xAI backend for gptel with NAME. - -Keyword arguments: - -KEY is a variable whose value is the API key, or function that -returns the key. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -The other keyword arguments are all optional. For their meanings -see `gptel-make-openai'." - (declare (indent 1)) - (let ((backend (gptel--make-deepseek - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :curl-args curl-args - :url (concat protocol "://" host endpoint)))) - (setf (alist-get name gptel--known-backends nil nil #'equal) backend) - backend)) - - -(provide 'gptel-openai-extras) -;;; gptel-openai-extras.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not docstrings) -;; End: diff --git a/elpa/gptel-20260123.739/gptel-openai.el b/elpa/gptel-20260123.739/gptel-openai.el deleted file mode 100644 index 6f96bf19..00000000 --- a/elpa/gptel-20260123.739/gptel-openai.el +++ /dev/null @@ -1,728 +0,0 @@ -;;; gptel-openai.el --- ChatGPT suppport for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur - -;; 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: - -;; This file adds support for the ChatGPT API to gptel - -;;; Code: -(require 'cl-generic) -(eval-when-compile - (require 'cl-lib)) -(require 'map) - -(defvar gptel-model) -(defvar gptel-stream) -(defvar gptel-use-curl) -(defvar gptel-backend) -(defvar gptel-temperature) -(defvar gptel-max-tokens) -(defvar gptel--system-message) -(defvar json-object-type) -(defvar gptel-mode) -(defvar gptel-track-response) -(defvar gptel-track-media) -(defvar gptel-use-tools) -(defvar gptel-tools) -(defvar gptel--schema) -(defvar gptel--request-params) -(declare-function gptel-context--collect-media "gptel-context") -(declare-function gptel--base64-encode "gptel") -(declare-function gptel--trim-prefixes "gptel") -(declare-function gptel--parse-media-links "gptel") -(declare-function gptel--model-capable-p "gptel") -(declare-function gptel--model-name "gptel") -(declare-function gptel--get-api-key "gptel") -(declare-function gptel--insert-file-string "gptel") -(declare-function prop-match-value "text-property-search") -(declare-function text-property-search-backward "text-property-search") -(declare-function json-read "json") -(declare-function gptel-prompt-prefix-string "gptel") -(declare-function gptel-response-prefix-string "gptel") -(declare-function gptel--merge-plists "gptel") -(declare-function gptel--model-request-params "gptel") -(declare-function gptel-context--wrap "gptel-context") -(declare-function gptel--inject-prompt "gptel") -(declare-function gptel--parse-tools "gptel") -(declare-function gptel--parse-schema "gptel") -(declare-function gptel--preprocess-schema "gptel") -(declare-function gptel--dispatch-schema-type "gptel") - -;; JSON conversion semantics used by gptel -;; empty object "{}" => empty list '() == nil -;; null => :null -;; false => :json-false - -;; TODO(tool) Except when reading JSON from a string, where null => nil - -(defmacro gptel--json-read () - (if (fboundp 'json-parse-buffer) - `(json-parse-buffer - :object-type 'plist - :null-object :null - :false-object :json-false) - (require 'json) - (defvar json-object-type) - (defvar json-null) - (declare-function json-read "json" ()) - `(let ((json-object-type 'plist) - (json-null :null)) - (json-read)))) - -(defmacro gptel--json-read-string (str) - (if (fboundp 'json-parse-string) - `(json-parse-string ,str - :object-type 'plist - :null-object nil - :false-object :json-false) - (require 'json) - (defvar json-object-type) - (declare-function json-read-from-string "json" ()) - `(let ((json-object-type 'plist)) - (json-read-from-string ,str)))) - -(defmacro gptel--json-encode (object) - (if (fboundp 'json-serialize) - `(json-serialize ,object - :null-object :null - :false-object :json-false) - (require 'json) - (defvar json-false) - (defvar json-null) - (declare-function json-encode "json" (object)) - `(let ((json-false :json-false) - (json-null :null)) - (json-encode ,object)))) - -(defun gptel--process-models (models) - "Convert items in MODELS to symbols with appropriate properties." - (let ((models-processed)) - (dolist (model models) - (cl-etypecase model - (string (push (intern model) models-processed)) - (symbol (push model models-processed)) - (cons - (cl-destructuring-bind (name . props) model - (setf (symbol-plist name) - ;; MAYBE: Merging existing symbol plists is safer, but makes it - ;; difficult to reset a symbol plist, since removing keys from - ;; it (as opposed to setting them to nil) is more work. - ;; - ;; (map-merge 'plist (symbol-plist name) props) - props) - (push name models-processed))))) - (nreverse models-processed))) - -;;; Common backend struct for LLM support -(defvar gptel--known-backends nil - "Alist of LLM backends known to gptel. - -This is an alist mapping user-provided names to backend structs, -see `gptel-backend'. - -You can have more than one backend pointing to the same resource -with differing settings.") - -(defun gptel-get-backend (name) - "Return gptel backend with NAME. - -Throw an error if there is no match." - (or (alist-get name gptel--known-backends nil nil #'equal) - (user-error "Backend %s is not known to be defined" - name))) - -(gv-define-setter gptel-get-backend (val name) - `(setf (alist-get ,name gptel--known-backends - nil t #'equal) - ,val)) - -(cl-defstruct - (gptel-backend (:constructor gptel--make-backend) - (:copier gptel--copy-backend)) - name host header protocol stream - endpoint key models url request-params - curl-args - (coding-system nil :documentation "Can be set to `binary' if the backend expects non UTF-8 output.")) - -;;; OpenAI (ChatGPT) -(cl-defstruct (gptel-openai (:constructor gptel--make-openai) - (:copier nil) - (:include gptel-backend))) - -;; How the following function works: -;; -;; The OpenAI API returns a stream of data chunks. Each data chunk has a -;; component that can be parsed as JSON. Besides metadata, each chunk has -;; either some text or part of a tool call. -;; -;; If we find text, we collect it in a list, concat them at the end and return -;; it. -;; -;; If we find part of a tool call, we begin collecting the pieces in -;; INFO -> :tool-use. -;; -;; Tool call arguments are themselves JSON encoded strings can be spread across -;; chunks. We collect them in INFO -> :partial_json. The end of a tool call -;; chunk is marked by the beginning of another, or by the end of the stream. In -;; either case we flaten the :partial_json we have thus far, add it to the tool -;; call spec in :tool-use and reset it. -;; -;; If we find reasoning text, collect it in INFO -> :reasoning, to be consumed -;; by the stream filter (and eventually the callback). We also collect it in -;; INFO -> :reasoning-chunks, in case we need to send it back along with tool -;; call results. -;; -;; Finally we append any tool calls and accumulated reasoning text (from -;; :reasoning-chunks) to the (INFO -> :data -> :messages) list of prompts. - -(cl-defmethod gptel-curl--parse-stream ((_backend gptel-openai) info) - "Parse an OpenAI API data stream. - -Return the text response accumulated since the last call to this -function. Additionally, mutate state INFO to add tool-use -information if the stream contains it." - (let* ((content-strs)) - (condition-case nil - (while (re-search-forward "^data:" nil t) - (save-match-data - (if (looking-at " *\\[DONE\\]") - ;; The stream has ended, so we do the following thing (if we found tool calls) - ;; - pack tool calls into the messages prompts list to send (INFO -> :data -> :messages) - ;; - collect tool calls (formatted differently) into (INFO -> :tool-use) - ;; - Clear any reasoning content chunks we've captured - (progn - (when-let* ((tool-use (plist-get info :tool-use)) - (args (apply #'concat (nreverse (plist-get info :partial_json)))) - (func (plist-get (car tool-use) :function))) - (plist-put func :arguments args) ;Update arguments for last recorded tool - (gptel--inject-prompt - (plist-get info :backend) (plist-get info :data) - `( :role "assistant" :content :null :tool_calls ,(vconcat tool-use) ; :refusal :null - ;; Return reasoning if available - ,@(and-let* ((chunks (nreverse (plist-get info :reasoning-chunks))) - (reasoning-field (pop chunks))) ;chunks is (:reasoning.* "chunk1" "chunk2" ...) - (list reasoning-field (apply #'concat chunks))))) - (cl-loop - for tool-call in tool-use ; Construct the call specs for running the function calls - for spec = (plist-get tool-call :function) - collect (list :id (plist-get tool-call :id) - :name (plist-get spec :name) - :args (ignore-errors (gptel--json-read-string - (plist-get spec :arguments)))) - into call-specs - finally (plist-put info :tool-use call-specs))) - (when (plist-member info :reasoning-chunks) (plist-put info :reasoning-chunks nil))) - (when-let* ((response (gptel--json-read)) - (delta (map-nested-elt response '(:choices 0 :delta)))) - (if-let* ((content (plist-get delta :content)) - ((not (or (eq content :null) (string-empty-p content))))) - (push content content-strs) - ;; No text content, so look for tool calls - (when-let* ((tool-call (map-nested-elt delta '(:tool_calls 0))) - (func (plist-get tool-call :function))) - (if (and-let* ((func-name (plist-get func :name)) ((not (eq func-name :null)))) - ;; TEMP: This check is for litellm compatibility, should be removed - (not (equal func-name "null"))) ; new tool block begins - (progn - (when-let* ((partial (plist-get info :partial_json))) - (let* ((prev-tool-call (car (plist-get info :tool-use))) - (prev-func (plist-get prev-tool-call :function))) - (plist-put prev-func :arguments ;update args for old tool block - (apply #'concat (nreverse (plist-get info :partial_json))))) - (plist-put info :partial_json nil)) ;clear out finished chain of partial args - ;; Start new chain of partial argument strings - (plist-put info :partial_json (list (plist-get func :arguments))) - ;; NOTE: Do NOT use `push' for this, it prepends and we lose the reference - (plist-put info :tool-use (cons tool-call (plist-get info :tool-use)))) - ;; old tool block continues, so continue collecting arguments in :partial_json - (push (plist-get func :arguments) (plist-get info :partial_json))))) - ;; Check for reasoning blocks, currently only used by Openrouter - (unless (eq (plist-get info :reasoning-block) 'done) - (if-let* ((reasoning-plist ;reasoning-plist is (:reasoning.* "chunk" ...) or nil - (or (plist-member delta :reasoning) ;for Openrouter and co - (plist-member delta :reasoning_content))) ;for Deepseek, Llama.cpp - (reasoning-chunk (cadr reasoning-plist)) - ((not (or (eq reasoning-chunk :null) (string-empty-p reasoning-chunk))))) - (progn (plist-put info :reasoning ;For stream filter consumption - (concat (plist-get info :reasoning) reasoning-chunk)) - (plist-put info :reasoning-chunks ;To include with tool call results, if any - (cons reasoning-chunk (or (plist-get info :reasoning-chunks) - (list (car reasoning-plist)))))) - ;; Done with reasoning if we get non-empty content - (if-let* (((plist-member info :reasoning)) ;Is this a reasoning model? - (c (plist-get delta :content)) ;Started receiving text content? - ((not (or (eq c :null) (string-blank-p c))))) - (plist-put info :reasoning-block t)))))))) ;Signal end of reasoning block - (error (goto-char (match-beginning 0)))) - (apply #'concat (nreverse content-strs)))) - -(cl-defmethod gptel--parse-response ((_backend gptel-openai) response info) - "Parse an OpenAI (non-streaming) RESPONSE and return response text. - -Mutate state INFO with response metadata." - (let* ((choice0 (map-nested-elt response '(:choices 0))) - (message (plist-get choice0 :message)) - (content (plist-get message :content))) - (plist-put info :stop-reason - (plist-get choice0 :finish_reason)) - (plist-put info :output-tokens - (map-nested-elt response '(:usage :completion_tokens))) - ;; OpenAI returns either non-blank text content or a tool call, not both. - ;; However OpenAI-compatible APIs like llama.cpp can include both (#819), so - ;; we check for both tool calls and responses independently. - (when-let* ((tool-calls (plist-get message :tool_calls)) - ((not (eq tool-calls :null)))) - (gptel--inject-prompt ; First add the tool call to the prompts list - (plist-get info :backend) (plist-get info :data) message) - (cl-loop ;Then capture the tool call data for running the tool - for tool-call across tool-calls ;replace ":arguments" with ":args" - for call-spec = (copy-sequence (plist-get tool-call :function)) - do (ignore-errors (plist-put call-spec :args - (gptel--json-read-string - (plist-get call-spec :arguments)))) - (plist-put call-spec :arguments nil) - (plist-put call-spec :id (plist-get tool-call :id)) - collect call-spec into tool-use - finally (plist-put info :tool-use tool-use))) - (when-let* ((reasoning (or (plist-get message :reasoning) ;for Openrouter and co - (plist-get message :reasoning_content))) ;for Deepseek, Llama.cpp - ((and (stringp reasoning) (not (string-empty-p reasoning))))) - (plist-put info :reasoning reasoning)) - (when (and content (not (or (eq content :null) (string-empty-p content)))) - content))) - -(cl-defmethod gptel--request-data ((backend gptel-openai) prompts) - "JSON encode PROMPTS for sending to ChatGPT." - (when gptel--system-message - (push (list :role "system" - :content gptel--system-message) - prompts)) - (let ((prompts-plist - `(:model ,(gptel--model-name gptel-model) - :messages [,@prompts] - :stream ,(or gptel-stream :json-false))) - (reasoning-model-p ; TODO: Embed this capability in the model's properties - (memq gptel-model '(o1 o1-preview o1-mini o3-mini o3 o4-mini - gpt-5 gpt-5-mini gpt-5-nano gpt-5.1 gpt-5.2)))) - (when (and gptel-temperature (not reasoning-model-p)) - (plist-put prompts-plist :temperature gptel-temperature)) - (when gptel-use-tools - (when (eq gptel-use-tools 'force) - (plist-put prompts-plist :tool_choice "required")) - (when gptel-tools - (plist-put prompts-plist :tools - (gptel--parse-tools backend gptel-tools)) - (unless reasoning-model-p - (plist-put prompts-plist :parallel_tool_calls t)))) - (when gptel-max-tokens - ;; HACK: The OpenAI API has deprecated max_tokens, but we still need it - ;; for OpenAI-compatible APIs like GPT4All (#485) - (plist-put prompts-plist - (if reasoning-model-p :max_completion_tokens :max_tokens) - gptel-max-tokens)) - (when gptel--schema - (plist-put prompts-plist - :response_format (gptel--parse-schema backend gptel--schema))) - ;; Merge request params with model and backend params. - (gptel--merge-plists - prompts-plist - gptel--request-params - (gptel-backend-request-params gptel-backend) - (gptel--model-request-params gptel-model)))) - -(cl-defmethod gptel--parse-schema ((_backend gptel-openai) schema) - (list :type "json_schema" - :json_schema - (list :name (md5 (format "%s" (random))) - :schema (gptel--preprocess-schema - (gptel--dispatch-schema-type schema)) - :strict t))) - -;; NOTE: No `gptel--parse-tools' method required for gptel-openai, since this is -;; handled by its defgeneric implementation - -(cl-defmethod gptel--parse-tool-results ((_backend gptel-openai) tool-use) - "Return a prompt containing tool call results in TOOL-USE." - ;; (declare (side-effect-free t)) - (mapcar - (lambda (tool-call) - (list - :role "tool" - :tool_call_id (plist-get tool-call :id) - :content (plist-get tool-call :result))) - tool-use)) - -;; TODO: Remove these functions (#792) -(defun gptel--openai-format-tool-id (tool-id) - "Format TOOL-ID for OpenAI. - -If the ID has the format used by a different backend, use as-is." - (unless tool-id - (setq tool-id (substring - (md5 (format "%s%s" (random) (float-time))) - nil 24))) - (if (or (string-prefix-p "toolu_" tool-id) ;#747 - (string-prefix-p "call_" tool-id)) - tool-id - (format "call_%s" tool-id))) - -(defun gptel--openai-unformat-tool-id (tool-id) - (or (and (string-match "call_\\(.+\\)" tool-id) - (match-string 1 tool-id)) - tool-id)) - -;; NOTE: No `gptel--inject-prompt' method required for gptel-openai, since this -;; is handled by its defgeneric implementation - -(cl-defmethod gptel--parse-list ((backend gptel-openai) prompt-list) - (if (consp (car prompt-list)) - (let ((full-prompt)) ; Advanced format, list of lists - (dolist (entry prompt-list) - (pcase entry - (`(prompt . ,msg) - (push (list :role "user" :content (or (car-safe msg) msg)) full-prompt)) - (`(response . ,msg) - (push (list :role "assistant" :content (or (car-safe msg) msg)) full-prompt)) - (`(tool . ,call) - (unless (plist-get call :id) - (plist-put call :id (gptel--openai-format-tool-id nil))) - (push - (list - :role "assistant" - :tool_calls - (vector - (list :type "function" - :id (plist-get call :id) - :function `( :name ,(plist-get call :name) - :arguments ,(decode-coding-string - (gptel--json-encode (plist-get call :args)) - 'utf-8 t))))) - full-prompt) - (push (car (gptel--parse-tool-results backend (list (cdr entry)))) full-prompt)))) - (nreverse full-prompt)) - (cl-loop for text in prompt-list ; Simple format, list of strings - for role = t then (not role) - if text collect - (list :role (if role "user" "assistant") :content text)))) - -(cl-defmethod gptel--parse-buffer ((backend gptel-openai) &optional max-entries) - (let ((prompts) (prev-pt (point))) - (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (/= prev-pt (point-min)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min)))) - (pcase (get-char-property (point) 'gptel) - ('response - (when-let* ((content (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt)))) - (push (list :role "assistant" :content content) prompts))) - (`(tool . ,id) - (save-excursion - (condition-case nil - (let* ((tool-call (read (current-buffer))) - (name (plist-get tool-call :name)) - (arguments (decode-coding-string - (gptel--json-encode (plist-get tool-call :args)) - 'utf-8 t))) - (setq id (gptel--openai-format-tool-id id)) - (plist-put tool-call :id id) - (plist-put tool-call :result - (string-trim (buffer-substring-no-properties - (point) prev-pt))) - (push (car (gptel--parse-tool-results backend (list tool-call))) - prompts) - (push (list :role "assistant" - :tool_calls - (vector (list :type "function" - :id id - :function `( :name ,name - :arguments ,arguments)))) - prompts)) - ((end-of-file invalid-read-syntax) - (message (format "Could not parse tool-call %s on line %s" - id (line-number-at-pos (point)))))))) - ('ignore) - ('nil - (and max-entries (cl-decf max-entries)) - (if gptel-track-media - (when-let* ((content (gptel--openai-parse-multipart - (gptel--parse-media-links major-mode - (point) prev-pt)))) - (when (> (length content) 0) - (push (list :role "user" :content content) prompts))) - (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties - (point) prev-pt)))) - (push (list :role "user" :content content) prompts))))) - (setq prev-pt (point))) - (let ((content (string-trim (buffer-substring-no-properties - (point-min) (point-max))))) - (push (list :role "user" :content content) prompts))) - prompts)) - -;; TODO This could be a generic function -(defun gptel--openai-parse-multipart (parts) - "Convert a multipart prompt PARTS to the OpenAI API format. - -The input is an alist of the form - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")). - -The output is a vector of entries in a backend-appropriate -format." - (cl-loop - for part in parts - for n upfrom 1 - with last = (length parts) - for text = (plist-get part :text) - for media = (plist-get part :media) - if text do - (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) - and if text - collect `(:type "text" :text ,text) into parts-array end - else if media collect - `(:type "image_url" - :image_url (:url ,(concat "data:" (plist-get part :mime) - ";base64," (gptel--base64-encode media)))) - into parts-array - else if (plist-get part :textfile) collect - `(:type "text" - :text ,(with-temp-buffer - (gptel--insert-file-string (plist-get part :textfile)) - (buffer-string))) - into parts-array end and - if (plist-get part :url) - collect - `(:type "image_url" - :image_url (:url ,(plist-get part :url))) - into parts-array - finally return (vconcat parts-array))) - -(cl-defmethod gptel--inject-media ((_backend gptel-openai) prompts) - "Wrap the first user prompt in PROMPTS with included media files. - -Media files, if present, are placed in `gptel-context'." - (when-let* ((media-list (gptel-context--collect-media))) - (cl-callf (lambda (current) - (vconcat - (gptel--openai-parse-multipart media-list) - (cl-typecase current - (string `((:type "text" :text ,current))) - (vector current) - (t current)))) - (plist-get (car prompts) :content)))) - -;;;###autoload -(cl-defun gptel-make-openai - (name &key curl-args models stream key request-params - (header - (lambda () (when-let* ((key (gptel--get-api-key))) - `(("Authorization" . ,(concat "Bearer " key)))))) - (host "api.openai.com") - (protocol "https") - (endpoint "/v1/chat/completions")) - "Register an OpenAI API-compatible backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST (optional) is the API host, typically \"api.openai.com\". - -MODELS is a list of available model names, as symbols. -Additionally, you can specify supported LLM capabilities like -vision or tool-use by appending a plist to the model with more -information, in the form - - (model-name . plist) - -For a list of currently recognized plist keys, see -`gptel--openai-models'. An example of a model specification -including both kinds of specs: - -:models -\\='(gpt-3.5-turbo ;Simple specs - gpt-4-turbo - (gpt-4o-mini ;Full spec - :description - \"Affordable and intelligent small model for lightweight tasks\" - :capabilities (media tool json url) - :mime-types - (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/v1/chat/completions\". - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that returns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for." - (declare (indent 1)) - (let ((backend (gptel--make-openai - :curl-args curl-args - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :url (if protocol - (concat protocol "://" host endpoint) - (concat host endpoint))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -;;; Azure -;;;###autoload -(cl-defun gptel-make-azure - (name &key curl-args host - (protocol "https") - (header (lambda () `(("api-key" . ,(gptel--get-api-key))))) - (key 'gptel-api-key) - models stream endpoint request-params) - "Register an Azure backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is the API host. - -MODELS is a list of available model names, as symbols. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL (optional) specifies the protocol, https by default. - -ENDPOINT is the API endpoint for completions. - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: - ((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -Example: -------- - - (gptel-make-azure - \"Azure-1\" - :protocol \"https\" - :host \"RESOURCE_NAME.openai.azure.com\" - :endpoint - \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\" - :stream t - :models \\='(gpt-3.5-turbo gpt-4))" - (declare (indent 1)) - (let ((backend (gptel--make-openai - :curl-args curl-args - :name name - :host host - :header header - :key key - :models (gptel--process-models models) - :protocol protocol - :endpoint endpoint - :stream stream - :request-params request-params - :url (if protocol - (concat protocol "://" host endpoint) - (concat host endpoint))))) - (prog1 backend - (setf (alist-get name gptel--known-backends - nil nil #'equal) - backend)))) - -;; GPT4All -;;;###autoload -(defalias 'gptel-make-gpt4all 'gptel-make-openai - "Register a GPT4All backend for gptel with NAME. - -Keyword arguments: - -CURL-ARGS (optional) is a list of additional Curl arguments. - -HOST is where GPT4All runs (with port), typically localhost:4891 - -MODELS is a list of available model names, as symbols. - -STREAM is a boolean to toggle streaming responses, defaults to -false. - -PROTOCOL specifies the protocol, https by default. - -ENDPOINT (optional) is the API endpoint for completions, defaults to -\"/api/v1/completions\" - -HEADER (optional) is for additional headers to send with each -request. It should be an alist or a function that retuns an -alist, like: -((\"Content-Type\" . \"application/json\")) - -KEY (optional) is a variable whose value is the API key, or -function that returns the key. This is typically not required for -local models like GPT4All. - -REQUEST-PARAMS (optional) is a plist of additional HTTP request -parameters (as plist keys) and values supported by the API. Use -these to set parameters that gptel does not provide user options -for. - -Example: -------- - -(gptel-make-gpt4all - \"GPT4All\" - :protocol \"http\" - :host \"localhost:4891\" - :models \\='(mistral-7b-openorca.Q4_0.gguf))") - -(provide 'gptel-openai) -;;; gptel-openai.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not docstrings) -;; End: diff --git a/elpa/gptel-20260123.739/gptel-org.el b/elpa/gptel-20260123.739/gptel-org.el deleted file mode 100644 index e46f81f2..00000000 --- a/elpa/gptel-20260123.739/gptel-org.el +++ /dev/null @@ -1,846 +0,0 @@ -;;; gptel-org.el --- Org functions for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur -;; Keywords: - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: -(eval-when-compile (require 'gptel)) -(require 'cl-lib) -(require 'org-element) -(require 'outline) -(require 'mailcap) ;FIXME Avoid this somehow - -;; Functions used for saving/restoring gptel state in Org buffers -(defvar gptel--num-messages-to-send) -(defvar org-entry-property-inherited-from) -(defvar gptel-backend) -(defvar gptel--known-backends) -(defvar gptel--system-message) -(defvar gptel-model) -(defvar gptel-temperature) -(defvar gptel-max-tokens) -(defvar gptel--link-type-cache) - -(defvar org-link-angle-re) -(defvar org-link-bracket-re) -(declare-function mailcap-file-name-to-mime-type "mailcap") -(declare-function gptel--model-capable-p "gptel") -(declare-function gptel--model-mime-capable-p "gptel") -(declare-function gptel--model-name "gptel") -(declare-function gptel--to-string "gptel") -(declare-function gptel--to-number "gptel") -(declare-function gptel--intern "gptel") -(declare-function gptel--get-buffer-bounds "gptel") -(declare-function gptel-backend-name "gptel") -(declare-function gptel--parse-buffer "gptel") -(declare-function gptel--parse-directive "gptel") -(declare-function gptel--restore-props "gptel") -(declare-function gptel--with-buffer-copy "gptel") -(declare-function gptel--file-binary-p "gptel") -(declare-function org-entry-get "org") -(declare-function org-entry-put "org") -(declare-function org-with-wide-buffer "org-macs") -(declare-function org-set-property "org") -(declare-function org-property-values "org") -(declare-function org-open-line "org") -(declare-function org-at-heading-p "org") -(declare-function org-get-heading "org") -(declare-function org-at-heading-p "org") - -;; Bundle `org-element-lineage-map' if it's not available (for Org 9.67 or older) -(eval-and-compile - (if (fboundp 'org-element-lineage-map) - (progn (declare-function org-element-lineage-map "org-element-ast") - (defalias 'gptel-org--element-lineage-map 'org-element-lineage-map)) - (defun gptel-org--element-lineage-map (datum fun &optional types with-self first-match) - "Map FUN across ancestors of DATUM, from closest to furthest. - -DATUM is an object or element. For TYPES, WITH-SELF and -FIRST-MATCH see `org-element-lineage-map'. - -This function is provided for compatibility with older versions -of Org." - (declare (indent 2)) - (setq fun (if (functionp fun) fun `(lambda (node) ,fun))) - (let ((up (if with-self datum (org-element-parent datum))) - acc rtn) - (catch :--first-match - (while up - (when (or (not types) (org-element-type-p up types)) - (setq rtn (funcall fun up)) - (if (and first-match rtn) - (throw :--first-match rtn) - (when rtn (push rtn acc)))) - (setq up (org-element-parent up))) - (nreverse acc))))) - (if (fboundp 'org-element-begin) - (progn (declare-function org-element-begin "org-element") - (declare-function org-element-end "org-element") - (declare-function org-element-parent "org-element") - (defalias 'gptel-org--element-begin 'org-element-begin) - (defalias 'gptel-org--element-end 'org-element-end) - (defalias 'gptel-org--element-parent 'org-element-parent)) - (defsubst gptel-org--element-begin (node) - "Get `:begin' property of NODE." - (org-element-property :begin node)) - (defsubst gptel-org--element-end (node) - "Get `:end' property of NODE." - (org-element-property :end node)) - (defsubst gptel-org--element-parent (node) - "Return `:parent' property of NODE." - (org-element-property :parent node)))) - - -;;; User options -(defcustom gptel-org-branching-context nil - "Use the lineage of the current heading as the context for gptel in Org buffers. - -This makes each same level heading a separate conversation -branch. - -By default, gptel uses a linear context: all the text up to the -cursor is sent to the LLM. Enabling this option makes the -context the hierarchical lineage of the current Org heading. In -this example: - ------ -Top level text - -* Heading 1 -heading 1 text - -* Heading 2 -heading 2 text - -** Heading 2.1 -heading 2.1 text -** Heading 2.2 -heading 2.2 text ------ - -With the cursor at the end of the buffer, the text sent to the -LLM will be limited to - ------ -Top level text - -* Heading 2 -heading 2 text - -** Heading 2.2 -heading 2.2 text ------ - -This makes it feasible to have multiple conversation branches." - :type 'boolean - :group 'gptel) - -(defcustom gptel-org-ignore-elements '(property-drawer) - "Types of Org elements to be stripped from the prompt before sending. - -By default gptel will remove Org property drawers from the -prompt. For the full list of available elements, please see -`org-element-all-elements'. - -Please note: Removing property-drawer elements is fast, but -adding elements to this list can significantly slow down -`gptel-send'." - :group 'gptel - :type '(repeat symbol)) - -(defcustom gptel-org-validate-link #'always - "Validate links to be sent as context with gptel queries. - -When `gptel-track-media' is enabled, this option determines if a -supported link will be followed and its source included with gptel -queries from Org buffers. Currently only \"file\" and \"attachment\" -link types are supported (along with web URLs if the model supports -them). - -It should be a function that accepts an Org link object and return -non-nil if the link should be followed. - -By default, all links are considered valid. - -Set this to `gptel-org--link-standalone-p' to only follow links placed -on a line by themselves, separated from surrounding text." - :group 'gptel - :type '(choice - (const :tag "All links" always) - (const :tag "Standalone links" gptel-org--link-standalone-p) - (function :tag "Function"))) - -(defconst gptel-org--link-regex - (concat "\\(?:" org-link-bracket-re "\\|" org-link-angle-re "\\)") - "Link regex for `gptel-mode' in Org mode.") - - -;;; Setting context and creating queries -(defun gptel-org--get-topic-start () - "If a conversation topic is set, return it." - (when (org-entry-get (point) "GPTEL_TOPIC" 'inherit) - (marker-position org-entry-property-inherited-from))) - -(defun gptel-org-set-topic (topic) - "Set a TOPIC and limit this conversation to the current heading. - -This limits the context sent to the LLM to the text between the current -heading (i.e. the heading with the topic set) and the cursor position." - (interactive - (list - (progn - (or (derived-mode-p 'org-mode) - (user-error "Support for multiple topics per buffer is only implemented for `org-mode'")) - (completing-read "Set topic as: " - (org-property-values "GPTEL_TOPIC") - nil nil (downcase - (truncate-string-to-width - (substring-no-properties - (replace-regexp-in-string - "\\s-+" "-" - (org-entry-get nil "ITEM"))) - 50)))))) - (when (stringp topic) (org-set-property "GPTEL_TOPIC" topic))) - -;; NOTE: This can be converted to a cl-defmethod for -;; `gptel--create-prompt-buffer' (conceptually cleaner), but will cause -;; load-order issues in gptel.el and might be harder to debug. -(defun gptel-org--create-prompt-buffer (&optional prompt-end) - "Return a buffer with the conversation prompt to be sent. - -If the region is active limit the prompt text to the region contents. -Otherwise the prompt text is constructed from the contents of the -current buffer up to point, or PROMPT-END if provided. Its contents -depend on the value of `gptel-org-branching-context', which see." - (when (use-region-p) - (narrow-to-region (region-beginning) (region-end)) - (setq prompt-end (point-max))) - (goto-char (or prompt-end (setq prompt-end (point)))) - (let ((topic-start (gptel-org--get-topic-start))) - (when topic-start - ;; narrow to GPTEL_TOPIC property scope - (narrow-to-region topic-start prompt-end)) - (if (and gptel-org-branching-context - (or (fboundp 'org-element-lineage-map) - (prog1 nil - (display-warning - '(gptel org) - "Using `gptel-org-branching-context' requires Org version 9.7 or higher, it will be ignored.")))) - ;; Create prompt from direct ancestors of point - (save-excursion - (let* ((org-buf (current-buffer)) - ;; Collect all heading start positions in the lineage - (full-bounds (gptel-org--element-lineage-map - (org-element-at-point) #'gptel-org--element-begin - '(headline) 'with-self) ) - ;; lineage-map returns the full lineage in the unnarrowed - ;; buffer. Remove heading start positions before (point-min) - ;; that are invalid due to narrowing, and add (point-min) if - ;; it's not already included in the lineage - (start-bounds - (nconc (cl-delete-if (lambda (p) (< p (point-min))) - full-bounds) - (unless (save-excursion (goto-char (point-min)) - (looking-at-p outline-regexp)) - (list (point-min))))) - (end-bounds - (cl-loop - ;; (car start-bounds) is the begining of the current element, - ;; not relevant - for pos in (cdr start-bounds) - do (goto-char pos) (outline-next-heading) - collect (point) into ends - finally return (cons prompt-end ends)))) - (gptel--with-buffer-copy org-buf nil nil - (cl-loop for start in start-bounds - for end in end-bounds - do (insert-buffer-substring org-buf start end) - (goto-char (point-min))) - (goto-char (point-max)) - (gptel-org--unescape-tool-results) - (gptel-org--strip-block-headers) - (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy - (buffer-local-value 'gptel-org-ignore-elements - org-buf))) - (gptel-org--strip-elements)) - (setq org-complex-heading-regexp ;For org-element-context to run - (buffer-local-value 'org-complex-heading-regexp org-buf)) - (current-buffer)))) - ;; Create prompt the usual way - (let ((org-buf (current-buffer)) - (beg (point-min))) - (gptel--with-buffer-copy org-buf beg prompt-end - (gptel-org--unescape-tool-results) - (gptel-org--strip-block-headers) - (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy - (buffer-local-value 'gptel-org-ignore-elements - org-buf))) - (gptel-org--strip-elements)) - (setq org-complex-heading-regexp ;For org-element-context to run - (buffer-local-value 'org-complex-heading-regexp org-buf)) - (current-buffer)))))) - -(defun gptel-org--strip-elements () - "Remove all elements in `gptel-org-ignore-elements' from the prompt." - (let ((major-mode 'org-mode) element-markers) - (if (equal '(property-drawer) gptel-org-ignore-elements) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-property-drawer-re nil t) - ;; ;; Slower but accurate - ;; (let ((drawer (org-element-at-point))) - ;; (when (org-element-type-p drawer 'property-drawer) - ;; (delete-region (org-element-begin drawer) (org-element-end drawer)))) - - ;; Fast but inexact, can have false positives - (delete-region (match-beginning 0) (match-end 0)))) - ;; NOTE: Parsing the buffer is extremely slow. Avoid this path unless - ;; required. - ;; NOTE: `org-element-map' takes a third KEEP-DEFERRED argument in newer - ;; Org versions - (org-element-map (org-element-parse-buffer 'element nil) - gptel-org-ignore-elements - (lambda (node) - (push (list (gptel-org--element-begin node) - (gptel-org--element-end node)) - element-markers))) - (dolist (bounds element-markers) - (apply #'delete-region bounds))))) - -(defun gptel-org--strip-block-headers () - "Remove all gptel-specific block headers and footers. -Every line that matches will be removed entirely. - -This removal is necessary to avoid auto-mimicry by LLMs." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - (rx line-start (literal "#+") - (or (literal "begin") (literal "end")) - (or (literal "_tool") (literal "_reasoning"))) - nil t) - (delete-region (match-beginning 0) - (min (point-max) (1+ (line-end-position))))))) - -(defun gptel-org--unescape-tool-results () - "Undo escapes done to keep results from escaping blocks. -Scans backward for gptel tool text property, then unescapes the block -contents." - (save-excursion - (goto-char (point-max)) - (let ((prev-pt (point))) - (while (> prev-pt (point-min)) - (goto-char - (previous-single-char-property-change (point) 'gptel)) - (let ((prop (get-text-property (point) 'gptel)) - (backward-progress (point))) - (when (eq (car-safe prop) 'tool) - ;; User edits to clean up can potentially insert a tool-call header - ;; that is propertized. Tool call headers should not be - ;; propertized. - (when (looking-at-p "[[:space:]]*#\\+begin_tool") - (goto-char (match-end 0))) - ;; TODO this code is able to put the point behind prev-pt, which - ;; makes the region inverted. The `max' catches this, but really - ;; `read' and `looking-at' are the culprits. Badly formed tool - ;; blocks can lead to this being necessary. - (org-unescape-code-in-region - (min prev-pt (point)) prev-pt)) - (goto-char (setq prev-pt backward-progress))))))) - -(defun gptel-org--link-standalone-p (object) - "Check if link OBJECT is on a line by itself." - (when-let* ((par (gptel-org--element-parent object)) - ((eq (org-element-type par) 'paragraph))) - (and (= (gptel-org--element-begin object) - (save-excursion - (goto-char (org-element-property :contents-begin par)) - (skip-chars-forward "\t ") - (point))) ;account for leading space before object - (<= (- (org-element-property :contents-end par) - (org-element-property :end object)) - 1)))) - -(defsubst gptel-org--validate-link (link) - "Validate an Org LINK as sendable under the current gptel settings. - -Return a form (validp link-type path . REST), where REST is a list -explaining why sending the link is not supported by gptel. Only the -first nil value in REST is guaranteed to be correct." - (let ((mime)) - (if-let* ((link-type (org-element-property :type link)) - (resource-type - (or (and (member link-type '("attachment" "file")) 'file) - (and (gptel--model-capable-p 'url) - (member link-type '("http" "https" "ftp")) 'url))) - (path (org-element-property :path link)) - (user-check (funcall gptel-org-validate-link link)) - (readablep (or (eq resource-type 'url) (file-remote-p path) - (file-readable-p path))) - (mime-valid - (if (or (eq resource-type 'url) - (cdr (with-memoization - (alist-get (expand-file-name path) - gptel--link-type-cache - nil nil #'string=) - (cons t (gptel--file-binary-p path))))) - (gptel--model-mime-capable-p - (setq mime (mailcap-file-name-to-mime-type path))) - t))) - (list t link-type path resource-type user-check readablep mime-valid mime) - (list nil link-type path resource-type user-check readablep mime-valid mime)))) - -(cl-defmethod gptel--parse-media-links ((_mode (eql 'org-mode)) beg end) - "Parse text and actionable links between BEG and END. - -Return a list of the form - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")) -for inclusion into the user prompt for the gptel request." - (let ((parts) (from-pt)) - (save-excursion - (setq from-pt (goto-char beg)) - (while (re-search-forward gptel-org--link-regex end t) - (let* ((link (org-element-context)) - (link-status (gptel-org--validate-link link))) - (cl-destructuring-bind - (valid type path resource-type user-check readablep mime-valid mime) - link-status - (cond - ((and valid (member type '("file" "attachment"))) - ;; Text file or supported binary file: collect text up to link - (when-let* ((text (buffer-substring-no-properties - from-pt (gptel-org--element-begin link)))) - (unless (string-blank-p text) (push (list :text text) parts))) - ;; collect link - (push (if mime (list :media path :mime mime) (list :textfile path)) - parts) - (setq from-pt (point))) - ((and valid (member type '("http" "https" "ftp"))) - ;; Collect text up to this image, and collect this image url - (when-let* ((text (buffer-substring-no-properties - from-pt (gptel-org--element-begin link)))) - (unless (string-blank-p text) (push (list :text text) parts))) - (push (list :url (org-element-property :raw-link link) :mime mime) parts) - (setq from-pt (point))) - ((not resource-type) - (message "Link source not followed for unsupported link type \"%s\"." type)) - ((not user-check) - (message (if (eq gptel-org-validate-link 'gptel--link-standalone-p) - "Ignoring non-standalone link \"%s\"." - "Link %s failed to validate, see `gptel-org-validate-link'.") - path)) - ((not readablep) - (message "Ignoring inaccessible file \"%s\"." path)) - ((and (not mime-valid) (eq resource-type 'file)) - (message "Ignoring unsupported binary file \"%s\"." path)))))) - (unless (= from-pt end) - (push (list :text (buffer-substring-no-properties from-pt end)) parts))) - (nreverse parts))) - -(defun gptel-org--annotate-links (beg end) - "Annotate Org links whose sources will be sent with `gptel-send'. - -Search between BEG and END." - (when gptel-track-media - (save-excursion - (goto-char beg) (forward-line -1) - (let ((link-ovs (cl-loop for o in (overlays-in (point) end) - if (overlay-get o 'gptel-track-media) - collect o into os finally return os))) - (while (re-search-forward gptel-org--link-regex end t) - (unless (gptel--in-response-p (1- (point))) - (let* ((link (org-element-context)) - (from (org-element-begin link)) - (to (org-element-end link)) - (link-status (gptel-org--validate-link link)) - (ov (cl-loop for o in (overlays-in from to) - if (overlay-get o 'gptel-track-media) - return o))) - (if ov ; Ensure overlay over each link - (progn (move-overlay ov from to) - (setq link-ovs (delq ov link-ovs))) - (setq ov (make-overlay from to nil t)) - (overlay-put ov 'gptel-track-media t) - (overlay-put ov 'evaporate t) - (overlay-put ov 'priority -80)) - ;; Check if link will be sent, and annotate accordingly - (gptel--annotate-link ov link-status)))) - (and link-ovs (mapc #'delete-overlay link-ovs)))) - `(jit-lock-bounds ,beg . ,end))) - -(defun gptel-org--send-with-props (send-fun &rest args) - "Conditionally modify SEND-FUN's calling environment. - -If in an Org buffer under a heading containing a stored gptel -configuration, use that for requests instead. This includes the -system message, model and provider (backend), among other -parameters. - -ARGS are the original function call arguments." - (if (derived-mode-p 'org-mode) - (pcase-let ((`(,gptel--system-message ,gptel-backend ,gptel-model - ,gptel-temperature ,gptel-max-tokens - ,gptel--num-messages-to-send ,gptel-tools) - (seq-mapn (lambda (a b) (or a b)) - (gptel-org--entry-properties) - (list gptel--system-message gptel-backend gptel-model - gptel-temperature gptel-max-tokens - gptel--num-messages-to-send gptel-tools)))) - (apply send-fun args)) - (apply send-fun args))) - -(advice-add 'gptel-send :around #'gptel-org--send-with-props) -(advice-add 'gptel--suffix-send :around #'gptel-org--send-with-props) - -;; ;; NOTE: Basic uses in org-mode are covered by advising gptel-send and -;; ;; gptel--suffix-send. For custom commands it might be necessary to advise -;; ;; gptel-request instead. -;; (advice-add 'gptel-request :around #'gptel-org--send-with-props) - - -;;; Saving and restoring state -(defun gptel-org--entry-properties (&optional pt) - "Find gptel configuration properties stored at PT." - (pcase-let - ((`(,system ,backend ,model ,temperature ,tokens ,num ,tools) - (mapcar - (lambda (prop) (org-entry-get (or pt (point)) prop 'selective)) - '("GPTEL_SYSTEM" "GPTEL_BACKEND" "GPTEL_MODEL" - "GPTEL_TEMPERATURE" "GPTEL_MAX_TOKENS" - "GPTEL_NUM_MESSAGES_TO_SEND" "GPTEL_TOOLS")))) - (when system - (setq system (string-replace "\\n" "\n" system))) - (when backend - (setq backend (alist-get backend gptel--known-backends - nil nil #'equal))) - (when model (setq model (gptel--intern model))) - (when temperature - (setq temperature (gptel--to-number temperature))) - (when tokens (setq tokens (gptel--to-number tokens))) - (when num (setq num (gptel--to-number num))) - (when tools - (setq tools (cl-loop - for tname in (split-string tools) - for tool = (with-demoted-errors "gptel: %S" - (gptel-get-tool tname)) - if tool collect tool else do - (display-warning - '(gptel org tools) - (format "Tool %s not found, ignoring" tname))))) - (list system backend model temperature tokens num tools))) - -(defun gptel-org--restore-state () - "Restore gptel state for Org buffers when turning on `gptel-mode'." - (save-restriction - (let ((modified (buffer-modified-p))) - (widen) - (condition-case status - (progn - (when-let* ((bounds (org-entry-get (point-min) "GPTEL_BOUNDS"))) - (gptel--restore-props (read bounds))) - (pcase-let ((`(,system ,backend ,model ,temperature ,tokens ,num ,tools) - (gptel-org--entry-properties (point-min)))) - (when system (setq-local gptel--system-message system)) - (if backend (setq-local gptel-backend backend) - (message - (substitute-command-keys - (concat - "Could not activate gptel backend \"%s\"! " - "Switch backends with \\[universal-argument] \\[gptel-send]" - " before using gptel.")) - backend)) - (when model (setq-local gptel-model model)) - (when temperature (setq-local gptel-temperature temperature)) - (when tokens (setq-local gptel-max-tokens tokens)) - (when num (setq-local gptel--num-messages-to-send num)) - (when tools (setq-local gptel-tools tools)))) - (:success (message "gptel chat restored.")) - (error (message "Could not restore gptel state, sorry! Error: %s" status))) - (set-buffer-modified-p modified)))) - -(defun gptel-org-set-properties (pt &optional msg) - "Store the active gptel configuration under the current heading. - -The active gptel configuration includes the current system -message, language model and provider (backend), and additional -settings when applicable. - -PT is the cursor position by default. If MSG is -non-nil (default), display a message afterwards." - (interactive (list (point) t)) - (org-entry-put pt "GPTEL_MODEL" (gptel--model-name gptel-model)) - (org-entry-put pt "GPTEL_BACKEND" (gptel-backend-name gptel-backend)) - (org-entry-put pt "GPTEL_SYSTEM" ;TODO: Handle nil case correctly - (and-let* ((msg (car-safe - (gptel--parse-directive - gptel--system-message)))) - (string-replace "\n" "\\n" msg))) - (if gptel-tools - (org-entry-put - pt "GPTEL_TOOLS" (mapconcat #'gptel-tool-name gptel-tools " ")) - (org-entry-delete pt "GPTEL_TOOLS")) - (if (equal (default-value 'gptel-temperature) gptel-temperature) - (org-entry-delete pt "GPTEL_TEMPERATURE") - (org-entry-put pt "GPTEL_TEMPERATURE" - (number-to-string gptel-temperature))) - (if (natnump gptel--num-messages-to-send) - (org-entry-put pt "GPTEL_NUM_MESSAGES_TO_SEND" - (number-to-string gptel--num-messages-to-send)) - (org-entry-delete pt "GPTEL_NUM_MESSAGES_TO_SEND")) - (if gptel-max-tokens - (org-entry-put - pt "GPTEL_MAX_TOKENS" (number-to-string gptel-max-tokens)) - (org-entry-delete pt "GPTEL_MAX_TOKENS")) - (when msg - (message "Added gptel configuration to current headline."))) - -(defun gptel-org--save-state () - "Write the gptel state to the Org buffer as Org properties." - (org-with-wide-buffer - (goto-char (point-min)) - (when (org-at-heading-p) - (org-open-line 1)) - (gptel-org-set-properties (point-min)) - ;; Save response boundaries - (letrec ((write-bounds - (lambda (attempts) - (when-let* ((bounds (gptel--get-buffer-bounds)) - ;; first value of ((prop . ((beg end val)...))...) - (offset (caadar bounds)) - (offset-marker (set-marker (make-marker) offset))) - (org-entry-put (point-min) "GPTEL_BOUNDS" - (prin1-to-string (gptel--get-buffer-bounds))) - (when (and (not (= (marker-position offset-marker) offset)) - (> attempts 0)) - (funcall write-bounds (1- attempts))))))) - (funcall write-bounds 6)))) - - -;;; Transforming responses -;;;###autoload -(defun gptel--convert-markdown->org (str) - "Convert string STR from markdown to org markup. - -This is a very basic converter that handles only a few markup -elements." - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (while (re-search-forward "`+\\|\\*\\{1,2\\}\\|_\\|^#+" nil t) - (pcase (match-string 0) - ;; Handle backticks - ((and (guard (eq (char-before) ?`)) ticks) - (gptel--replace-source-marker (length ticks)) - (save-match-data - (catch 'block-end - (while (search-forward ticks nil t) - (unless (or (eq (char-before (match-beginning 0)) ?`) - (eq (char-after) ?`)) - (gptel--replace-source-marker (length ticks) 'end) - (throw 'block-end nil)))))) - ;; Handle headings - ((and (guard (eq (char-before) ?#)) heading) - (cond - ((looking-at "[[:space:]]") ;Handle headings - (delete-region (line-beginning-position) (point)) - (insert (make-string (length heading) ?*))) - ((looking-at "\\+begin_src") ;Overeager LLM switched to using Org src blocks - (save-match-data (re-search-forward "^#\\+end_src" nil t))))) - ;; Handle emphasis - ("**" (cond - ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)") - ;; (delete-char 1)) - ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}" - (max (- (point) 3) (point-min))) - (delete-char -1)))) - ("*" - (cond - ((save-match-data - (and (or (= (point) 2) - (looking-back "\\(?:[[:space:]]\\|\s\\)\\(?:_\\|\\*\\)" - (max (- (point) 2) (point-min)))) - (not (looking-at "[[:space:]]\\|\s")))) - ;; Possible beginning of emphasis - (and - (save-excursion - (when (and (re-search-forward (regexp-quote (match-string 0)) - (line-end-position) t) - (looking-at "[[:space:][:punct:]]\\|\s") - (not (looking-back "\\(?:[[:space]]\\|\s\\)\\(?:_\\|\\*\\)" - (max (- (point) 2) (point-min))))) - (delete-char -1) (insert "/") t)) - (progn (delete-char -1) (insert "/")))) - ((save-excursion - (ignore-errors (backward-char 2)) - (or (and (bobp) (looking-at "\\*[[:space:]]")) - (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]"))) - ;; Bullet point, replace with hyphen - (delete-char -1) (insert "-")))))) - (buffer-string))) - -(defun gptel--replace-source-marker (num-ticks &optional end) - "Replace markdown style backticks with Org equivalents. - -NUM-TICKS is the number of backticks being replaced. If END is -true these are \"ending\" backticks. - -This is intended for use in the markdown to org stream converter." - (let ((from (match-beginning 0))) - (delete-region from (point)) - (if (and (= num-ticks 3) - (save-excursion (beginning-of-line) - (skip-chars-forward " \t") - (eq (point) from))) - (insert (if end "#+end_src" "#+begin_src ")) - (insert "=")))) - -;;;###autoload -(defun gptel--stream-convert-markdown->org (start-marker) - "Return a Markdown to Org converter. - -This function parses a stream of Markdown text to Org -continuously when it is called with successive chunks of the -text stream. - -START-MARKER is used to identify the corresponding process when -cleaning up after." - (letrec ((in-src-block nil) ;explicit nil to address BUG #183 - (in-org-src-block nil) - (temp-buf ; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 - (gptel--temp-buffer " *gptel-temp*")) - (start-pt (make-marker)) - (ticks-total 0) ;MAYBE should we let-bind case-fold-search here? - (cleanup-fn - (lambda (beg _) - (when (and (equal beg (marker-position start-marker)) - (eq (current-buffer) (marker-buffer start-marker))) - (when (buffer-live-p (get-buffer temp-buf)) - (set-marker start-pt nil) - (kill-buffer temp-buf)) - (remove-hook 'gptel-post-response-functions cleanup-fn))))) - (add-hook 'gptel-post-response-functions cleanup-fn) - (lambda (str) - (let ((noop-p) (ticks 0)) - (with-current-buffer (get-buffer temp-buf) - (save-excursion (goto-char (point-max)) (insert str)) - (when (marker-position start-pt) (goto-char start-pt)) - (when in-src-block (setq ticks ticks-total)) - (save-excursion - (while (re-search-forward "`\\|\\*\\{1,2\\}\\|_\\|^#+" nil t) - (pcase (match-string 0) - ("`" - ;; Count number of consecutive backticks - (backward-char) - (while (and (char-after) (eq (char-after) ?`)) - (forward-char) - (if in-src-block (cl-decf ticks) (cl-incf ticks))) - ;; Set the verbatim state of the parser - (if (and (eobp) - ;; Special case heuristic: If the response ends with - ;; ^``` we don't wait for more input. - ;; FIXME: This can have false positives. - (not (save-excursion (beginning-of-line) - (looking-at "^```$")))) - ;; End of input => there could be more backticks coming, - ;; so we wait for more input - (progn (setq noop-p t) (set-marker start-pt (match-beginning 0))) - ;; We reached a character other than a backtick - (cond - ;; Ticks balanced, end src block - ((= ticks 0) - (progn (setq in-src-block nil) - (gptel--replace-source-marker ticks-total 'end))) - ;; Positive number of ticks, start an src block - ((and (> ticks 0) (not in-src-block)) - (setq ticks-total ticks - in-src-block t) - (gptel--replace-source-marker ticks-total)) - ;; Negative number of ticks or in a src block already, - ;; reset ticks - (t (setq ticks ticks-total))))) - ;; Handle headings and misguided #+begin_src text - ((and (guard (and (eq (char-before) ?#) (or (not in-src-block) in-org-src-block))) - heading) - (if in-org-src-block - ;; If we are inside an Org-style src block, look for #+end_src - (cond - ((< (- (point-max) (point)) 8) ;not enough information to close Org src block - (setq noop-p t) (set-marker start-pt (match-beginning 0))) - ((looking-at "\\+end_src") ;Close Org src block - (setq in-src-block nil in-org-src-block nil))) - ;; Otherwise check for Markdown headings, or for #+begin_src - (cond - ((eobp) ; Not enough information about the heading yet - (setq noop-p t) (set-marker start-pt (match-beginning 0))) - ((looking-at "[[:space:]]") ; Convert markdown heading to Org heading - (delete-region (line-beginning-position) (point)) - (insert (make-string (length heading) ?*))) - ((< (- (point-max) (point)) 11) ;Not enough information to check if Org src block - (setq noop-p t) (set-marker start-pt (match-beginning 0))) - ((looking-at "\\+begin_src ") ;Overeager LLM switched to using Org src blocks - (setq in-src-block t in-org-src-block t))))) - ;; Handle other chars: emphasis, bold and bullet items - ((and "**" (guard (not in-src-block))) - (cond - ;; TODO Not sure why this branch was needed - ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)") (delete-char 1)) - - ;; Looking back at "w**" or " **" - ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}" - (max (- (point) 3) (point-min))) - (delete-char -1)))) - ((and "*" (guard (not in-src-block))) - (if (eobp) - ;; Not enough information about the "*" yet - (progn (setq noop-p t) (set-marker start-pt (match-beginning 0))) - ;; "*" is either emphasis or a bullet point - (save-match-data - (save-excursion - (ignore-errors (backward-char 2)) - (cond - ((and ; At bob, underscore/asterisk followed by word - (or (and (bobp) (looking-at "\\(?:_\\|\\*\\)\\([^[:space:][:punct:]]\\|$\\)")) - (looking-at ; word followed by underscore/asterisk - "[^[:space:]\n]\\(?:_\\|\\*\\)\\(?:[[:space:][:punct:]]\\|$\\)") - (looking-at ; underscore/asterisk followed by word - "\\(?:[[:space:]]\\)\\(?:_\\|\\*\\)\\([^[:space:]]\\|$\\)")) - (not (looking-at "[[:punct:]]\\(?:_\\|\\*\\)[[:punct:]]"))) - ;; Emphasis, replace with slashes - (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "/")) - ((or (and (bobp) (looking-at "\\*[[:space:]]")) - (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]")) - ;; Bullet point, replace with hyphen - (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "-")))))))))) - (if noop-p - (buffer-substring (point) start-pt) - (prog1 (buffer-substring (point) (point-max)) - (set-marker start-pt (point-max))))))))) - -(provide 'gptel-org) -;;; gptel-org.el ends here - -;; Silence warnings about `org-element-type-p' and `org-element-parent', see #294. -;; Local Variables: -;; byte-compile-warnings: (not unresolved) -;; End: diff --git a/elpa/gptel-20260123.739/gptel-pkg.el b/elpa/gptel-20260123.739/gptel-pkg.el deleted file mode 100644 index af2614c2..00000000 --- a/elpa/gptel-20260123.739/gptel-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "gptel" "20260123.739" - "Interact with ChatGPT or other LLMs." - '((emacs "27.1") - (transient "0.7.4") - (compat "30.1.0.0")) - :url "https://github.com/karthink/gptel" - :commit "96199593c107767ffe0b59ab2a1f996c112e4fdf" - :revdesc "96199593c107" - :keywords '("convenience" "tools") - :authors '(("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) - :maintainers '(("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com"))) diff --git a/elpa/gptel-20260123.739/gptel-request.el b/elpa/gptel-20260123.739/gptel-request.el deleted file mode 100644 index 041e03ae..00000000 --- a/elpa/gptel-20260123.739/gptel-request.el +++ /dev/null @@ -1,2875 +0,0 @@ -;;; gptel-request.el --- LLM request library for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 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: - -(require 'gptel-openai) -(eval-when-compile - (require 'subr-x)) -(require 'compat nil t) -(require 'cl-lib) -(require 'url) -(require 'text-property-search) -(require 'cl-generic) -(require 'map) -(require 'mailcap) ;FIXME Avoid this somehow - -(declare-function json-read "json" ()) -(defvar json-object-type) - -(declare-function gptel--stream-convert-markdown->org "gptel-org") -(declare-function gptel--convert-markdown->org "gptel-org") -(declare-function gptel-org--create-prompt-buffer "gptel-org") -(declare-function gptel-context--wrap "gptel-context") -(declare-function gptel--transform-apply-preset "gptel") -(declare-function gptel--insert-response "gptel") -(declare-function gptel-curl--stream-insert-response "gptel") - - -;;; User options -(defgroup gptel nil - "Interact with LLMs from anywhere in Emacs." - :group 'hypermedia) - -(defcustom gptel-proxy "" - "Path to a proxy to use for gptel interactions. -Passed to curl via --proxy arg, for example \"proxy.yourorg.com:80\" -Leave it empty if you don't use a proxy." - :type 'string) - -(defcustom gptel-api-key #'gptel-api-key-from-auth-source - "An API key (string) for the default LLM backend. - -OpenAI by default. - -Can also be a function of no arguments that returns an API -key (more secure) for the active backend." - :type '(choice - (string :tag "API key") - (function :tag "Function that returns the API key"))) - -(defcustom gptel-stream t - "Stream responses from the LLM as they are received. - -This option is ignored unless -- the LLM backend supports streaming, and -- Curl is in use (see `gptel-use-curl') - -When set to nil, Emacs waits for the full response and inserts it -all at once. This wait is asynchronous. - -\='tis a bit silly." - :type 'boolean) - -(defcustom gptel-use-curl (and (executable-find "curl") t) - "Whether gptel should prefer Curl when available. - -Can be set to t, nil, or a string path to the curl executable." - :type '(choice - (const :tag "Do not use Curl" nil) - (const :tag "Use Curl" t) - (string :tag "Specify path to the Curl executable"))) - -(defcustom gptel-org-convert-response t - "Whether gptel should convert Markdown responses to Org markup. - -This only affects requests originating from Org mode buffers." - :type 'boolean) - -(defcustom gptel-curl-file-size-threshold - (if (memq system-type '(windows-nt ms-dos)) #x6ffe 130000) - "Size threshold for using file input with Curl. - -Specifies the size threshold for when to use a temporary file to pass data to -Curl in gptel queries. If the size of the data to be sent exceeds this -threshold, the data is written to a temporary file and passed to Curl using the -`--data-binary' option with a file reference. Otherwise, the data is passed -directly as a command-line argument. - -The value is an integer representing the number of bytes. - -Adjusting this value may be necessary depending on the environment -and the typical size of the data being sent in gptel queries. -A larger value may improve performance by avoiding the overhead of creating -temporary files for small data payloads, while a smaller value may be needed -if the command-line argument size is limited by the operating system. - -The default of #x8000 for windows comes from Microsoft documentation -located here: -https://learn.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-createprocessa - -It is set to (#x8000 - #x1000 - 2) to account for other (non-data) Curl -command line arguments." - :type 'natnum) - -(define-obsolete-variable-alias 'gptel-prompt-filter-hook - 'gptel-prompt-transform-functions "0.9.9") - -(defcustom gptel-prompt-transform-functions - '(gptel--transform-apply-preset gptel--transform-add-context) - "Handlers to augment or transform a query before sending it. - -This hook is called in a temporary buffer containing the text to -be sent, with the cursor at the end of the prompt. You can use -it to modify the buffer or buffer-local variables as required. - -Since these functions modify the prompt construction buffer, the order -in which they run is significant! In particular, you may want to add -your function before (the default) or after -`gptel--transform-add-context', which adds gptel's context (other -buffers, files etc) to this buffer. - -Example: A typical use case might be to search for occurrences of $(cmd) -and replace it with the output of the shell command cmd, making it easy -to send the output of shell commands to the LLM. - -Transform functions can be synchronous or asynchronous. - -Synchronous hook functions must accept zero or one argument: the INFO -plist for the current request. - -Asynchronous hook functions must accept two arguments: a callback to -call after the transformation is complete, and the INFO plist for the -current request. - -Note that while this set of handlers can certainly be set with a global -value to be applied to all queries in all buffers, it meant to be set -locally for a specific buffer, or chat topic, or only the context of a -certain task." - :type 'hook) - -(defcustom gptel-post-request-hook nil - "Hook run after sending a gptel request. - -This runs (possibly) before any response is received." - :type 'hook) - -;; TODO(v1.0): Remove this. -(defvar gptel-response-filter-functions nil) -(make-obsolete-variable - 'gptel-response-filter-functions - "Response filtering is no longer supported in gptel. To toggle -markdown to Org conversion, see `gptel-org-convert-response'. To -filter LLM response text, either use `gptel-request' with a -custom callback, or use `gptel-post-response-functions'." - "0.9.7") - -;; TODO: Handle `prog-mode' using the `comment-start' variable -(defcustom gptel-prompt-prefix-alist - '((markdown-mode . "### ") - (org-mode . "*** ") - (text-mode . "### ")) - "String used as a prefix to the query being sent to the LLM. - -This is meant for the user to distinguish between queries and -responses, and is removed from the query before it is sent. - -This is an alist mapping major modes to the prefix strings. This -is only inserted in dedicated gptel buffers." - :type '(alist :key-type symbol :value-type string)) - -(defcustom gptel-response-prefix-alist - '((markdown-mode . "") - (org-mode . "") - (text-mode . "")) - "String inserted before the response from the LLM. - -This is meant for the user to distinguish between queries and -responses. - -This is an alist mapping major modes to the reply prefix strings. This -is only inserted in dedicated gptel buffers before the AI's response." - :type '(alist :key-type symbol :value-type string)) - -(defcustom gptel-response-separator "\n\n" - "String inserted before responses. - -Also inserted before and after non-consecutive tool calls." - :type 'string) - -;; Model and interaction parameters -(defcustom gptel-directives - '((default . "You are a large language model living in Emacs and a helpful assistant. Respond concisely.") - (programming . "You are a large language model and a careful programmer. Provide code and only code as output without any additional text, prompt or note.") - (writing . "You are a large language model and a writing assistant. Respond concisely.") - (chat . "You are a large language model and a conversation partner. Respond concisely.")) - "System prompts or directives for the LLM. - -Each entry in this alist maps a symbol naming the directive to -the directive itself. By default, gptel uses the directive with -the key \\+`default'. - -To set the directive for a chat session interactively call -`gptel-send' with a prefix argument, or call `gptel-menu'. - -A \"directive\" is typically the system message (also called -system prompt or system instruction) sent at the beginning of -each request to the LLM. It is used to set general instructions, -expectations and the overall tone. - -gptel's idea of the directive is more general. A directive in -`gptel-directives' can be - -- A string, interpreted as the system message. - -- A list of strings, whose first (possibly nil) element is - interpreted as the system message, and the remaining elements - as (possibly nil) alternating user prompts and LLM responses. - This can be used to template the initial part of a conversation. - -- A function that returns a string or a list of strings, - interpreted as the above. This can be used to dynamically - generate a system message and/or conversation template based on - the current context. See the definition of - `gptel--rewrite-directive-default' for an example." - :safe #'always - :type '(alist :key-type symbol :value-type string)) - -(defcustom gptel-max-tokens nil - "Max tokens per response. - -This is roughly the number of words in the response. 100-300 is a -reasonable range for short answers, 400 or more for longer -responses. - -To set the target token count for a chat session interactively -call `gptel-send' with a prefix argument." - :safe #'always - :type '(choice (natnum :tag "Specify Token count") - (const :tag "Default" nil))) - -(defcustom gptel-temperature 1.0 - "\"Temperature\" of the LLM response. - -This is a number between 0.0 and 2.0 that controls the randomness -of the response, with 2.0 being the most random. - -To set the temperature for a chat session interactively call -`gptel-send' with a prefix argument." - :safe (lambda (v) (or (null v) (numberp v))) - :type '(choice (number :tag "Temperature value") - (const :tag "Use default" nil))) - -(defcustom gptel-cache nil - "Whether the LLM should cache request content. - -Some LLM backends can cache content sent to it by gptel, so that -only the newly included part of the text needs to be processed on -subsequent conversation turns. This results in faster and -significantly cheaper processing. - -NOTE: Manual or client-configurable caching is currently -supported only by the Anthropic API and thus the -`gptel-anthropic' backend. This variable has no effect on the -behavior of other backends. - -This variable controls which parts of the query will be cached, -and can be the symbols t or nil to cache everything or nothing -respectively. It can also be a list of symbols: - -- message: Cache conversation messages -- system: Cache the system message -- tool: Cache tool definitions - -Examples: - -Setting it to (message system) will cache the system message and -the conversation text. - -Setting it to (message system tool) will cache everything and is -the same as t." - :type '(choice - (const :tag "Cache everything" t) - (const :tag "Do not cache" nil) - (repeat symbol)) - :group 'gptel) - -(defvar gptel--known-backends) - -(defconst gptel--openai-models - '((gpt-4o - :description "Advanced model for complex tasks; cheaper & faster than GPT-Turbo" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 128 - :input-cost 2.50 - :output-cost 10 - :cutoff-date "2023-10") - (gpt-4o-mini - :description "Cheap model for fast tasks; cheaper & more capable than GPT-3.5 Turbo" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 128 - :input-cost 0.15 - :output-cost 0.60 - :cutoff-date "2023-10") - (gpt-4.1 - :description "Flagship model for complex tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 1024 - :input-cost 2.0 - :output-cost 8.0 - :cutoff-date "2024-05") - (gpt-4.5-preview - :description "DEPRECATED: Use gpt-4.1 instead" - :capabilities (media tool-use url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 128 - :input-cost 75 - :output-cost 150 - :cutoff-date "2023-10") - (gpt-4.1-mini - :description "Balance between intelligence, speed and cost" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 1024 - :input-cost 0.4 - :output-cost 1.6) - (gpt-4.1-nano - :description "Fastest, most cost-effective GPT-4.1 model" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 1024 - :input-cost 0.10 - :output-cost 0.40 - :cutoff-date "2024-05") - (gpt-4-turbo - :description "Previous high-intelligence model" - :capabilities (media tool-use url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 128 - :input-cost 10 - :output-cost 30 - :cutoff-date "2023-11") - (gpt-4 - :description "GPT-4 snapshot from June 2023 with improved function calling support" - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :capabilities (media url) - :context-window 8.192 - :input-cost 30 - :output-cost 60 - :cutoff-date "2023-11") - (gpt-5 - :description "Flagship model for coding, reasoning, and agentic tasks across domains" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 1.25 - :output-cost 10 - :cutoff-date "2024-09") - (gpt-5-mini - :description "Faster, more cost-efficient version of GPT-5" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 0.25 - :output-cost 2.0 - :cutoff-date "2024-09") - (gpt-5-nano - :description "Fastest, cheapest version of GPT-5" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 0.05 - :output-cost 0.40 - :cutoff-date "2024-09") - (gpt-5.1 - :description "The best model for coding and agentic tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 1.25 - :output-cost 10 - :cutoff-date "2024-09") - (gpt-5.2 - :description "The best model for coding and agentic tasks" - :capabilities (media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 400 - :input-cost 1.75 - :output-cost 14 - :cutoff-date "2025-08") - (o1 - :description "Reasoning model designed to solve hard problems across domains" - :capabilities (media reasoning) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 200 - :input-cost 15 - :output-cost 60 - :cutoff-date "2023-10") - (o1-mini - :description "Faster and cheaper reasoning model good at coding, math, and science" - :context-window 128 - :input-cost 3 - :output-cost 12 - :cutoff-date "2023-10" - :capabilities (nosystem reasoning)) - (o3 - :description "Well-rounded and powerful model across domains" - :capabilities (reasoning media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 200 - :input-cost 2 - :output-cost 8 - :cutoff-date "2024-05") - (o3-mini - :description "High intelligence at the same cost and latency targets of o1-mini" - :context-window 200 - :input-cost 1.10 - :output-cost 4.40 - :cutoff-date "2023-10" - :capabilities (reasoning tool-use json)) - (o4-mini - :description "Fast, effective reasoning with efficient performance in coding and visual tasks" - :capabilities (reasoning media tool-use json url) - :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") - :context-window 200 - :input-cost 1.10 - :output-cost 4.40 - :cutoff-date "2024-05") - (gpt-3.5-turbo - :description "More expensive & less capable than GPT-4o-mini; use that instead" - :capabilities (tool-use) - :context-window 16.358 - :input-cost 0.50 - :output-cost 1.50 - :cutoff-date "2021-09") - (gpt-3.5-turbo-16k - :description "More expensive & less capable than GPT-4o-mini; use that instead" - :capabilities (tool-use) - :context-window 16.385 - :input-cost 3 - :output-cost 4 - :cutoff-date "2021-09")) - "List of available OpenAI models and associated properties. -Keys: - -- `:description': a brief description of the model. - -- `:capabilities': a list of capabilities supported by the model. - -- `:mime-types': a list of supported MIME types for media files. - -- `:context-window': the context window size, in thousands of tokens. - -- `:input-cost': the input cost, in US dollars per million tokens. - -- `:output-cost': the output cost, in US dollars per million tokens. - -- `:cutoff-date': the knowledge cutoff date. - -- `:request-params': a plist of additional request parameters to - include when using this model. - -Information about the OpenAI models was obtained from the following -sources: - -- -- ") - -(defcustom gptel-model 'gpt-4o-mini - (concat - "Model for chat. - -The name of the model, as a symbol. This is the name as expected -by the LLM provider's API. - -To set the model for a chat session interactively call -`gptel-send' with a prefix argument.") - :safe #'always - :type `(choice - (symbol :tag "Specify model name") - ,@(mapcar (lambda (model) - (list 'const :tag (symbol-name (car model)) - (car model))) - gptel--openai-models))) - -(defvar gptel--openai - (gptel-make-openai - "ChatGPT" - :key 'gptel-api-key - :stream t - :models gptel--openai-models)) - -(defcustom gptel-backend gptel--openai - "LLM backend to use. - -This is the default \"backend\", an object of type -`gptel-backend' containing connection, authentication and model -information. - -A backend for ChatGPT is pre-defined by gptel. Backends for -other LLM providers (local or remote) may be constructed using -one of the available backend creation functions: -- `gptel-make-openai' -- `gptel-make-azure' -- `gptel-make-ollama' -- `gptel-make-gpt4all' -- `gptel-make-gemini' -See their documentation for more information and the package -README for examples." - :safe #'always - :type `(choice - (const :tag "ChatGPT" ,gptel--openai) - (restricted-sexp :match-alternatives (gptel-backend-p 'nil) - :tag "Other backend"))) - -(defvar gptel-expert-commands nil - "Whether experimental gptel options should be enabled. - -This opens up advanced options in `gptel-menu'.") - -(defvar gptel--num-messages-to-send nil) -(put 'gptel--num-messages-to-send 'safe-local-variable #'always) - -(defcustom gptel-log-level nil - "Logging level for gptel. - -This is one of nil or the symbols info and debug: - -nil: Don't log responses -info: Log request and response bodies -debug: Log request/response bodies, headers and all other - connection settings. - -When non-nil, information is logged to `gptel--log-buffer-name', -which see." - :type '(choice - (const :tag "No logging" nil) - (const :tag "Limited" info) - (const :tag "Full" debug))) - -(defcustom gptel-track-response t - "Distinguish between user messages and LLM responses. - -When creating a prompt to send to the LLM, gptel distinguishes -between text entered by the user and past LLM responses. This -distinction is necessary for back-and-forth conversation with an -LLM. - -In regular Emacs buffers you can turn this behavior off by -setting `gptel-track-response' to nil. All text, including -past LLM responses, is then treated as user input when sending -queries. - -This variable has no effect in dedicated chat buffers (buffers -with `gptel-mode' enabled), where user prompts and responses are -always handled separately." - :type 'boolean) - -(defcustom gptel-track-media nil - "Whether supported media in chat buffers should be sent. - -When this is non-nil, gptel will send text, images or other media from -links in chat buffers to the LLM. - -Sending images or other binary media from links requires the -active `gptel-model' to support it. See `gptel-make-openai', -`gptel-make-anthropic', `gptel-make-ollama' or `gptel-make-gemini' for -details on how to specify media support for models. - -This option has no effect in non-chat buffers. To include -media (including images) more generally, use `gptel-add' or -`gptel-add-file'." - :type 'boolean) - -(defcustom gptel-use-context 'system - "Where in the request to inject gptel's additional context. - -gptel always includes the active region or the buffer up to the -cursor in the request to the LLM. Additionally, you can add -other buffers or their regions to the context with -`gptel-add-context', or from gptel's menu. This data will be -sent with every request. - -This option controls whether and where this additional context is -included in the request. - -Currently supported options are: - - nil - Do not use the context. - system - Include the context with the system message. - user - Include the context with the user prompt." - :group 'gptel - :type '(choice - (const :tag "Don't include context" nil) - (const :tag "With system message" system) - (const :tag "With user prompt" user))) - -(defcustom gptel-include-reasoning t - "How to handle LLM reasoning or \"thinking\" text blocks. - -Some LLMs include in their response a \"thinking\" section. This -text improves the quality of the LLM's final output, but may not -be interesting to you by itself. - -Supported options are the symbols - - t - Include with the response, the default - nil - Do not include - ignore - Include with the response but ignore on subsequent - conversation turns - -It can also be a string naming a buffer, in which case the -reasoning text will be inserted at the end of that buffer." - :group 'gptel - :type '(choice - (const :tag "Include with response" t) - (const :tag "Don't include" nil) - (const :tag "Include but ignore" ignore) - (string :tag "Include in buffer"))) - -(define-obsolete-variable-alias 'gptel-context--alist 'gptel-context - "0.9.9.3") - -(defcustom gptel-context nil - "List of gptel's context sources. - -The items in this list (file names or buffers) are included with gptel -queries as additional context. - -Each entry can be a file path (string) or a buffer (object, not buffer -name): - - \\='(\"~/path/to/file1\" - \"./file2\" - # - ...) - -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 - (if (memq system-type '(windows-nt ms-dos)) - '("--disable" "--location" "--silent" "-XPOST" - "-y7200" "-Y1" "-D-") - '("--disable" "--location" "--silent" "--compressed" - "-XPOST" "-y7200" "-Y1" "-D-")) - "Arguments always passed to Curl for gptel queries.") - -(defvar gptel--link-type-cache nil - "Cache of checks for binary files. - -Each alist entry maps an absolute file path to a cons cell of the -form (t . binaryp), where binaryp is non-nil if the file is -binary-encoded.") - -;; The following is derived from: -;; -;; (concat "\\(?:" markdown-regex-link-inline "\\|" markdown-regex-angle-uri "\\)") -;; -;; Since we want this known at compile time, when markdown-mode is not -;; guaranteed to be available, we have to hardcode it. -(defconst gptel-markdown--link-regex - "\\(?:\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)\\|\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^] \n <>,;()]+\\)\\(>\\)\\)" - "Link regex for `gptel-mode' in Markdown mode.") - - -;;; Utility functions - -(defun gptel-api-key-from-auth-source (&optional host user) - "Lookup api key in the auth source. -By default, the LLM host for the active backend is used as HOST, -and \"apikey\" as USER." - (if-let* ((secret - (plist-get - (car (auth-source-search - :host (or host (gptel-backend-host gptel-backend)) - :user (or user "apikey") - :require '(:secret))) - :secret))) - (if (functionp secret) - (encode-coding-string (funcall secret) 'utf-8) - secret) - (user-error "No `gptel-api-key' found in the auth source"))) - -;; FIXME Should we utf-8 encode the api-key here? -(defun gptel--get-api-key (&optional key) - "Get api key from KEY, or from `gptel-api-key'." - (when-let* ((key-sym (or key (gptel-backend-key gptel-backend)))) - (cl-typecase key-sym - (function (string-trim-right (funcall key-sym) "[\n\r]+")) - (string (string-trim-right key-sym "[\n\r]+")) - (symbol (if-let* ((val (symbol-value key-sym))) - (gptel--get-api-key val) - (error "`gptel-api-key' is not valid"))) - (t (error "`gptel-api-key' is not valid"))))) - -(defsubst gptel--to-number (val) - "Ensure VAL is a number." - (cond - ((numberp val) val) - ((stringp val) (string-to-number val)) - ((error "%S cannot be converted to a number" val)))) - -(defsubst gptel--to-string (s) - "Convert S to a string, if possible." - (cl-typecase s - (symbol (symbol-name s)) - (string s) - (otherwise (prin1-to-string s)))) - -(defsubst gptel--intern (s) - "Intern S, if possible." - (cl-etypecase s - (symbol s) - (string (intern s)))) - -(defun gptel--merge-plists (&rest plists) - "Merge PLISTS, altering the first one. - -Later plists in the sequence take precedence over earlier ones." - (let (;; (rtn (copy-sequence (pop plists))) - (rtn (pop plists)) - p v ls) - (while plists - (setq ls (pop plists)) - (while ls - (setq p (pop ls) v (pop ls)) - (setq rtn (plist-put rtn p v)))) - rtn)) - -(defun gptel--file-binary-p (path) - "Check if file at PATH is readable and binary." - ;; HACK Image files with ICC color profiles are characterized as ASCII - ;; (#1223), so until we find a better solution we just match these files by - ;; extension. - (or (string-match-p "\\.\\(jpe?g\\|png\\|gif\\|webp\\)\\'" path) - (condition-case nil - (with-temp-buffer - (insert-file-contents path nil 1 512 'replace) - (memq buffer-file-coding-system - '(no-conversion no-conversion-multibyte))) - (file-missing (message "File \"%s\" is not readable." path) - nil)))) - -(defun gptel--insert-file-string (path) - "Insert at point the contents of the file at PATH as context." - (insert (format "In file `%s`:" (abbreviate-file-name path)) - "\n\n```\n") - (let ((pm (point-marker))) - (set-marker-insertion-type pm t) - (insert-file-contents path) - (goto-char pm)) - (insert "\n```\n")) - -(defun gptel--strip-mode-suffix (mode-sym) - "Remove the -mode suffix from MODE-SYM. - -MODE-SYM is typically a major-mode symbol." - (or (alist-get mode-sym gptel--mode-description-alist) - (let ((mode-name (thread-last - (symbol-name mode-sym) - (string-remove-suffix "-mode") - (string-remove-suffix "-ts")))) - ;; NOTE: The advertised calling convention of provided-mode-derived-p - ;; has changed in Emacs 30, this needs to be updated eventually - (if (provided-mode-derived-p - mode-sym 'prog-mode 'text-mode 'tex-mode) - mode-name "")))) - -(defvar url-http-end-of-headers) -(defvar url-http-response-status) -(cl-defun gptel--url-retrieve (url &key method data headers) - "Retrieve URL synchronously with METHOD, DATA and HEADERS." - (declare (indent 1)) - (let ((url-request-method (if (eq method 'post) "POST" "GET")) - (url-request-data (when (eq method 'post) (encode-coding-string (gptel--json-encode data) 'utf-8))) - (url-mime-accept-string "application/json") - (url-request-extra-headers - `(("content-type" . "application/json") - ,@headers))) - (with-current-buffer (url-retrieve-synchronously url 'silent) - (goto-char url-http-end-of-headers) - (gptel--json-read)))) - -(defsubst gptel-prompt-prefix-string () - "Prefix before user prompts in `gptel-mode'." - (declare (side-effect-free t)) - (or (alist-get major-mode gptel-prompt-prefix-alist) "")) - -(defsubst gptel-response-prefix-string () - "Prefix before LLM responses in `gptel-mode'." - (declare (side-effect-free t)) - (or (alist-get major-mode gptel-response-prefix-alist) "")) - -(defmacro gptel--at-word-end (&rest body) - "Execute BODY at end of the current word or punctuation." - `(save-excursion - (skip-syntax-forward "w.") - ,(macroexp-progn body))) - -(defmacro gptel--temp-buffer (buf) - "Generate a temp buffer BUF. - -Compatibility macro for Emacs 27.1." - (if (< emacs-major-version 28) - `(generate-new-buffer ,buf) - `(generate-new-buffer ,buf t))) - -;; This is defined in gptel, but we define it here as well as it's required by -;; `gptel--with-buffer-copy'. -(defvar gptel-mode nil) - -(defmacro gptel--with-buffer-copy (buf start end &rest body) - "Copy gptel's local variables from BUF to a temp buffer and run BODY. - -If positions START and END are provided, insert that part of BUF first." - (declare (indent 3)) - `(gptel--with-buffer-copy-internal ,buf ,start ,end (lambda () ,@body))) - -(defun gptel--with-buffer-copy-internal (buf start end body-thunk) - "Prepare a temp buffer for a gptel request. - -For BUF, START, END and BODY-THUNK see `gptel--with-buffer-copy'." - (let ((temp-buffer (gptel--temp-buffer " *gptel-prompt*"))) - (with-current-buffer temp-buffer - (dolist (sym '( gptel-backend gptel--system-message gptel-model - gptel-mode gptel-track-response gptel-track-media - gptel-use-tools gptel-tools gptel-use-curl gptel--schema - gptel-use-context gptel-context gptel--num-messages-to-send - gptel-stream gptel-include-reasoning gptel--request-params - gptel-temperature gptel-max-tokens gptel-cache)) - (set (make-local-variable sym) (buffer-local-value sym buf))) - (when (and start end) (insert-buffer-substring buf start end)) - (setq major-mode (buffer-local-value 'major-mode buf)) - (funcall body-thunk)))) - -(defsubst gptel--trim-prefixes (s) - "Remove prompt/response prefixes from string S. - -Return nil if string collapses to empty string." - (let* ((trimmed (string-trim-left - s (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*" - (regexp-quote - (gptel-prompt-prefix-string))))) - (trimmed (string-trim-right - trimmed (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*" - (regexp-quote - (gptel-response-prefix-string)))))) - (unless (string-empty-p trimmed) - trimmed))) - -(defun gptel--link-standalone-p (link) - "Return non-nil if Markdown LINK is isolated. - -This means the extent from the link beginning to end is the only -non-whitespace content on its line." - (let ((beg (car link)) (end (cadr link))) - (save-excursion - (and (= beg (progn (goto-char beg) (beginning-of-line) - (skip-chars-forward "\t ") - (point))) - (= end (progn (goto-char end) (end-of-line) - (skip-chars-backward "\t ") - (point))))))) - -(defsubst gptel--curl-path () - "Curl executable to use." - (if (stringp gptel-use-curl) gptel-use-curl "curl")) - -(defun gptel--transform-add-context (callback fsm) - (if (and gptel-use-context gptel-context) - (gptel-context--wrap callback (plist-get (gptel-fsm-info fsm) :data)) - (funcall callback))) - -;;;; Model interface -;; NOTE: This interface would be simpler to implement as a defstruct. But then -;; users cannot set `gptel-model' to a symbol/string directly, or we'd need -;; another map from these symbols to the actual model structs. - -(defsubst gptel--model-name (model) - "Get name of gptel MODEL." - (gptel--to-string model)) - -(defsubst gptel--model-capabilities (model) - "Get MODEL capabilities." - (get model :capabilities)) - -(defsubst gptel--model-mimes (model) - "Get supported mime-types for MODEL." - (get model :mime-types)) - -(defsubst gptel--model-capable-p (cap &optional model) - "Return non-nil if MODEL supports capability CAP." - (memq cap (gptel--model-capabilities - (or model gptel-model)))) - -;; TODO Handle model mime specifications like "image/*" -(defsubst gptel--model-mime-capable-p (mime &optional model) - "Return non nil if MODEL can understand MIME type." - (car-safe (member mime (gptel--model-mimes - (or model gptel-model))))) - -(defsubst gptel--model-request-params (model) - "Get model-specific request parameters for MODEL." - (get model :request-params)) - -;;;; File handling -(defun gptel--base64-encode (file) - "Encode FILE as a base64 string. - -FILE is assumed to exist and be a regular file." - (with-temp-buffer - (insert-file-contents-literally file) - (base64-encode-region (point-min) (point-max) - :no-line-break) - (buffer-string))) - -;;;; Directive handling - -(defvar gptel--system-message - (or (alist-get 'default gptel-directives) - "You are a large language model living in Emacs and a helpful assistant. Respond concisely.") - "The system message used by gptel.") -(put 'gptel--system-message 'safe-local-variable #'always) - -(defun gptel--describe-directive (directive width &optional replacement) - "Find description for DIRECTIVE, truncated to WIDTH. - -DIRECTIVE is a gptel directive, and can be a string, a function -or a list of strings. See `gptel-directives'. - -The result is a string intended for display. Newlines are -replaced with REPLACEMENT." - (cl-typecase directive - (string - (string-replace - "\n" (or replacement " ") - (substring directive 0 (min width (length directive))))) - (function - (concat - "λ: " - (string-replace - "\n" (or replacement " ") - (truncate-string-to-width - (or (and-let* ((doc (documentation directive))) - (substring doc nil (string-match-p "\n" doc))) - "[Dynamically generated; no preview available]") - width nil nil t)))) - (list (and-let* ((from-template (car directive))) - (gptel--describe-directive - from-template width))) - (t ""))) - -(defun gptel--parse-directive (directive &optional raw) - "Parse DIRECTIVE into a backend-appropriate form. - -DIRECTIVE is a gptel directive: it can be a string, a list or a -function that returns either, see `gptel-directives'. - -Return a cons cell consisting of the system message (a string) -and a template consisting of alternating user/LLM -records (a list of strings or nil). - -If RAW is non-nil, the user/LLM records are not processed and are -returned as a list of strings." - (and directive - (cl-etypecase directive - (string (list directive)) - (function (gptel--parse-directive (funcall directive) raw)) - (cons (if raw directive - (cons (car directive) - ;; FIXME(augment) do this elsewhere - (gptel--parse-list - gptel-backend (cdr directive)))))))) - - -;;; 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 or nil, results of tool calls are always or never -included in the LLM response, respectively. - -If set to the symbol auto (the default), a tool call result is -included only when the corresponding tool spec has a non-nil -:include slot. See `gptel-make-tool'." - :type '(choice - (const :tag "Tool decides" auto) - (const :tag "Always" t) - (const :tag "Never" nil))) - -(defcustom gptel-tools nil - "A list of tools to include with gptel requests. - -Each tool should be a `gptel-tool' struct, which see. To specify -a tool, use `gptel-make-tool', which see." - :group 'gptel - :type '(repeat gptel-tool)) - -(cl-defstruct (gptel-tool (:constructor nil) - (:constructor gptel--make-tool-internal - (&key function name description args - async category confirm include - &allow-other-keys)) - (:copier gptel--copy-tool)) - "Struct to specify tools for LLMs to run. - -A tool is a function specification sent to the LLM along with -a (plain language) task. If the LLM decides to use the tool to -accomplish the task, gptel will run the tool and (optionally) -feed the LLM the results. You can add tools via -`gptel-make-tool', which see." - (function nil :type function :documentation "Function that runs the tool") - (name nil :type string :documentation "Tool name, snake_case recommended") - (description nil :type string :documentation "What the tool does, intended for the LLM") - (args nil :type list :documentation "List of plists specifying function arguments") - (async nil :type boolean :documentation "Whether the function runs asynchronously") - (category nil :type string :documentation "Use to group tools by purpose") - (confirm nil :type boolean :documentation "Seek confirmation before running tool?") - (include nil :type boolean :documentation "Include tool results in buffer?")) - -(defun gptel--preprocess-tool-args (spec) - "Convert symbol :type values in tool SPEC to strings destructively." - ;; NOTE: Do not use `sequencep' here, as that covers strings too and breaks - ;; things. - (when (or (listp spec) (vectorp spec)) - (cond - ((vectorp spec) - (cl-loop for element across spec - for idx upfrom 0 - do (aset spec idx (gptel--preprocess-tool-args element)))) - ((keywordp (car spec)) - (let ((tail spec)) - (while tail - (when (and (eq (car tail) :type) (symbolp (cadr tail))) - (setcar (cdr tail) (symbol-name (cadr tail)))) - ;; TODO: Handle :enum ("provided" "as" "list") here, convert to - ;; :enum ["provided" "as" "array"] - (when (or (listp (cadr tail)) (vectorp (cadr tail))) - (gptel--preprocess-tool-args (cadr tail))) - (setq tail (cddr tail))))) - ((listp spec) (dolist (element spec) - (when (listp element) - (gptel--preprocess-tool-args element)))))) - spec) - -(defun gptel--make-tool (&rest spec) - "Construct a gptel-tool according to SPEC." - (gptel--preprocess-tool-args (plist-get spec :args)) - (apply #'gptel--make-tool-internal spec)) - -(defvar gptel--known-tools nil - "Alist of gptel tools arranged by category. - -A \"tool\" is a function spec (definition and description) -provided by gptel to an LLM. See `gptel-tool'. Each tool is -assigned a category when it is created, with a category of -\"misc\" if none is specified. - -This is a two-level alist mapping categories and tool names to -the tool itself. It is used as a global register of available -tools and in gptel's UI, see variable `gptel-tools'. - -In this example structure, cat-tool and the rest are cl-structs -of type `gptel-tool': - - CATEGORY TOOL NAME TOOL - ((\"filesystem\" . ((\"read_file\" . cat-tool) - (\"list_directory\" . ls-tool))) - (\"emacs\" . ((\"read_buffer\" . buffer-substring-tool) - (\"send_message\" . message-tool)))) - -This variable is for internal use only, to define a tool use -`gptel-make-tool'.") - -(defun gptel-get-tool (path) - "Find tool in gptel's tool registry at PATH. - -PATH can be specified -- as a string representing the tool name, like \"search_db\", -- or as a list representing a category and tool name, - like \\='(\"emacs\" \"read_buffer\"). -In both cases, the first matching gptel-tool is returned. - -- as a string representing a category, like \"filesystem\". -In this case a list of all gptel-tools with this category is -returned." - (or (cl-etypecase path - (cons (let ((tc (map-nested-elt gptel--known-tools path))) - (if (consp tc) (map-values tc) tc))) - (string (if-let* ((category (assoc path gptel--known-tools))) - (map-values (cdr category)) - (cl-loop for (_ . tools) in gptel--known-tools - if (assoc path tools) - return (cdr it))))) - (error "No tool matches for %S" path))) - -(defun gptel-make-tool (&rest slots) - "Make a gptel tool for LLM use. - -The following keyword arguments are available, of which the first -four SLOTS are required. - -NAME: The name of the tool, recommended to be in Javascript style snake_case. - -FUNCTION: The function itself (lambda or symbol) that runs the tool. - -DESCRIPTION: A verbose description of what the tool does, how to -call it and what it returns. - -ARGS: A list of plists specifying the arguments, or nil for a function that -takes no arguments. Each plist in ARGS requires the following keys: -- argument :name and :description, as strings. -- argument :type, as a symbol. Allowed types are those understood by the JSON - schema: string, number, integer, boolean, array, object or null - -The following plist keys are conditional/optional: -- :optional, boolean indicating if argument is optional -- :enum for enumerated types, whose value is a vector of strings representing - allowed values. Note that :type is still required for enums. -- :items, if the :type is array. Its value must be a plist including at least - the item's :type. -- :properties, if the type is object. Its value must be a plist that can be - serialized into a JSON object specification by `json-serialize'. - -ASYNC: boolean indicating if the elisp function is asynchronous. -If ASYNC is t, the function should take a callback as its first -argument, along with the arguments specified in ARGS, and run the -callback with the tool call result when it's ready. The callback -itself is an implementation detail and must not be included in -ARGS. - -The following keys are optional - -CATEGORY: A string indicating a category for the tool. This is -used only for grouping in gptel's UI. Defaults to \"misc\". - -CONFIRM: Whether the tool call should wait for the user to run it. If -true, the user will be prompted with the proposed tool call, which can -be examined, accepted, deferred or canceled. It can also be a function -that receives the same arguments as FUNCTION and returns true if the -user should be prompted. - -INCLUDE: Whether the tool results should be included as part of -the LLM output. This is useful for logging and as context for -subsequent requests in the same buffer. This is primarily useful -in chat buffers. - -Here is an example definition: - - (gptel-make-tool - :function (lambda (location unit) - (url-retrieve-synchronously \"api.weather.com/...\" - location unit)) - :name \"get_weather\" - :description \"Get the current weather in a given location\" - :args (list \\='(:name \"location\" - :type string - :description \"The city and state, e.g. San Francisco, CA\") - \\='(:name \"unit\" - :type string - :enum [\"celsius\" \"farenheit\"] - :description - \"The unit of temperature, either \\='celsius\\=' or \\='fahrenheit\\='\" - :optional t))) - -If the tool is asynchronous, the function is modified to take a -callback as its first argument, which it runs with the result: - - (lambda (callback location unit) - (url-retrieve \"api.weather.com/...\" - (lambda (_) - (let ((result (parse-this-buffer))) - (funcall callback result)))))" - (let* ((tool (apply #'gptel--make-tool slots)) - (category (or (gptel-tool-category tool) "misc"))) - (setf (alist-get - (gptel-tool-name tool) - (alist-get category gptel--known-tools nil nil #'equal) - nil nil #'equal) - tool))) - -(cl-defgeneric gptel--parse-tools (_backend tools) - "Parse TOOLS and return a list of prompts. - -TOOLS is a list of `gptel-tool' structs, which see. - -_BACKEND is the LLM backend in use. This is the default -implementation, used by OpenAI-compatible APIs and Ollama." - (vconcat - (mapcar - (lambda (tool) - (list - :type "function" - :function - (append - (list - :name (gptel-tool-name tool) - :description (gptel-tool-description tool)) - (if (gptel-tool-args tool) - (list - :parameters - (list :type "object" - ;; gptel's tool args spec is close to the JSON schema, except - ;; that we use (:name "argname" ...) - ;; instead of (:argname (...)), and - ;; (:optional t) for each arg instead of (:required [...]) - ;; for all args at once. Handle this difference by - ;; modifying a copy of the gptel tool arg spec. - :properties - (cl-loop - for arg in (gptel-tool-args tool) - for argspec = (copy-sequence arg) - for name = (plist-get arg :name) ;handled differently - for newname = (or (and (keywordp name) name) - (make-symbol (concat ":" name))) - do ;ARGSPEC is ARG without unrecognized keys - (cl-remf argspec :name) - (cl-remf argspec :optional) - if (equal (plist-get arg :type) "object") - do (unless (plist-member argspec :required) - (plist-put argspec :required [])) - (plist-put argspec :additionalProperties :json-false) - append (list newname argspec)) - :required - (vconcat - (delq nil (mapcar - (lambda (arg) (and (not (plist-get arg :optional)) - (plist-get arg :name))) - (gptel-tool-args tool)))) - :additionalProperties :json-false)) - (list :parameters (list :type "object" :properties nil)))))) - (ensure-list tools)))) - -(cl-defgeneric gptel--parse-tool-results (backend results) - "Return a BACKEND appropriate prompt containing tool call RESULTS. - -This will be injected into the messages list in the prompt to -send to the LLM.") - -;; FIXME(fsm) unify this with `gptel--inject-media', which is a mess -(cl-defgeneric gptel--inject-prompt - (_backend data new-prompt &optional _position) - "Append NEW-PROMPT to existing prompts in query DATA. - -NEW-PROMPT can be a single message or a list of messages. - -Not implemented: if POSITION is -- a non-negative number, insert it at that position in PROMPTS. -- a negative number, insert it there counting from the end. - -This generic implementation handles the Anthropic, -OpenAI-compatible and Ollama message formats." - ;; ;TODO(fsm): implement _POSITION - (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many? - (setq new-prompt (list new-prompt))) - (let ((prompts (plist-get data :messages))) - (plist-put data :messages (vconcat prompts new-prompt)))) - - -;;; State machine for driving requests -(defvar gptel-request--transitions - `((INIT . ((t . WAIT))) - (WAIT . ((t . TYPE))) - (TYPE . ((,#'gptel--error-p . ERRS) - (,#'gptel--tool-use-p . TOOL) - (t . DONE))) - (TOOL . ((,#'gptel--error-p . ERRS) - (,#'gptel--tool-result-p . WAIT) - (t . DONE)))) - "Alist specifying gptel's default state transition table for requests. - -Each entry is a list whose car is a request state (any symbol) -and whose cdr is an alist listing possible next states. Each key -is either a predicate function or t. When `gptel--fsm-next' is -called, the predicates are called in the order they appear here -to find the next state. Each predicate is called with the state -machine's INFO, see `gptel-fsm'. A predicate of t is -considered a success and acts as a default.") - -(defvar gptel-request--handlers - `((WAIT ,#'gptel--handle-wait) - (TOOL ,#'gptel--handle-tool-use) - (DONE ,#'gptel--handle-post) - (ERRS ,#'gptel--handle-post) - (ABRT ,#'gptel--handle-post)) - "Alist specifying handlers for gptel's default state transitions. - -Each entry is a list whose car is a request state (a symbol) and -whose cdr is a list of handler functions called when -transitioning to that state. The handlers are called in the -sequence that they appear in the list, and each function receives -the state machine as its only argument. Information about the -request state can be retrieved via the machine's INFO slot, see -`gptel-fsm'. - -Handlers are responsible for doing state-related tasks (like -logging errors or inserting responses) and transitioning to the -next state by calling `gptel--fsm-transition'. - -Handlers can be asynchronous, in which case the transition call -should typically be placed in its callback.") - -(cl-defstruct (gptel-fsm (:constructor gptel-make-fsm) - (:copier gptel-copy-fsm)) - "State machine for gptel requests. - -STATE: The current state of the machine, can be any symbol. - -TABLE: Alist mapping states to possible next states -along with predicates to determine the next state. See -`gptel-request--transitions' for an example. - -HANDLERS: Alist mapping states to state handler functions. -Handlers are called when entering each state. See -`gptel-request--handlers' for an example - -INFO: The state machine's current context. This is a plist -holding all the information required for the ongoing request, and -can be used to tweak and resume a paused request. This should be -called \"context\", but context means too many things already in -gptel's code! - -Each gptel request is passed an instance of this -state machine and driven by it." - (state 'INIT) - (table gptel-request--transitions) - (handlers gptel-request--handlers) info) - -(defun gptel--fsm-transition (machine &optional new-state) - "Move MACHINE to its next state. - -MACHINE is an instance of `gptel-fsm'. - -The next state is NEW-STATE if given. Otherwise it is determined -automatically from MACHINE's transition table." - (unless new-state (setq new-state (gptel--fsm-next machine))) - (push (gptel-fsm-state machine) - (plist-get (gptel-fsm-info machine) :history)) - (setf (gptel-fsm-state machine) new-state) - (when-let* ((handlers (alist-get new-state (gptel-fsm-handlers machine)))) - (mapc (lambda (h) (funcall h machine)) handlers))) - -(defun gptel--fsm-next (machine) - "Determine MACHINE's next state according to its transition table. - -MACHINE is an instance of `gptel-fsm'" - (let* ((current (gptel-fsm-state machine)) - (transitions (alist-get current (gptel-fsm-table machine)))) - (cl-loop - with info = (gptel-fsm-info machine) - for (pred . next) in transitions - when (or (eq pred t) (funcall pred info)) - return next))) - -;;;; State machine handlers -;; The next few functions are default state handlers for gptel's state machine, -;; see `gptel-request--handlers'. - -(defun gptel--handle-wait (fsm) - "Fire the request contained in state machine FSM's info." - ;; Reset some flags in info. This is necessary when reusing fsm's context for - ;; a second network request: gptel tests for the presence of these flags to - ;; handle state transitions. (NOTE: Don't add :token to this.) - (let ((info (gptel-fsm-info fsm))) - (dolist (key '(:tool-success :tool-use :error :http-status :reasoning)) - (when (plist-get info key) - (plist-put info key nil)))) - (funcall - (if gptel-use-curl - #'gptel-curl-get-response - #'gptel--url-get-response) - fsm) - (run-hooks 'gptel-post-request-hook)) - -(defun gptel--handle-tool-use (fsm) - "Run tool calls captured in FSM, and advance the state machine with the results." - (when-let* ((info (gptel-fsm-info fsm)) - (backend (plist-get info :backend)) - ;; This function might run many times, so only act on the remaining tool calls. - (tool-use (cl-remove-if (lambda (tc) (plist-get tc :result)) - (plist-get info :tool-use))) - (ntools (length tool-use)) - (tool-idx 0)) - (with-current-buffer (plist-get info :buffer) - (let ((result-alist) (pending-calls)) - (mapc ; Construct function calls - (lambda (tool-call) - (letrec ((args (plist-get tool-call :args)) - (name (plist-get tool-call :name)) - (arg-values nil) - (tool-spec - (cl-find-if - (lambda (ts) (equal (gptel-tool-name ts) name)) - (plist-get info :tools))) - (process-tool-result - (lambda (result) - (plist-put info :tool-success t) - (let ((result (gptel--to-string result))) - (plist-put tool-call :result result) - (push (list tool-spec args result) result-alist)) - (cl-incf tool-idx) - (when (>= tool-idx ntools) ; All tools have run - (gptel--inject-prompt - backend (plist-get info :data) - (gptel--parse-tool-results - backend (plist-get info :tool-use))) - (funcall (plist-get info :callback) - (cons 'tool-result result-alist) info) - (gptel--fsm-transition fsm))))) - (if (null tool-spec) - (if (equal name gptel--ersatz-json-tool) ;Could be a JSON response - ;; Handle structured JSON output supplied as tool call - (funcall (plist-get info :callback) - (gptel--json-encode (plist-get tool-call :args)) - info) - (message "Unknown tool called by model: %s" name)) - (setq arg-values - (mapcar - (lambda (arg) - (let ((key (intern (concat ":" (plist-get arg :name))))) - (plist-get args key))) - (gptel-tool-args tool-spec))) - ;; Check if tool requires confirmation - (if (and gptel-confirm-tool-calls - (or (eq gptel-confirm-tool-calls t) ;always confirm, or - (and-let* ((confirm (gptel-tool-confirm tool-spec))) - (or (not (functionp confirm)) (apply confirm arg-values))))) - (push (list tool-spec arg-values process-tool-result) - pending-calls) - ;; If not, run the tool - (if (gptel-tool-async tool-spec) - (apply (gptel-tool-function tool-spec) - process-tool-result arg-values) - (let ((result - (condition-case errdata - (apply (gptel-tool-function tool-spec) arg-values) - (error (mapconcat #'gptel--to-string errdata " "))))) - (funcall process-tool-result result))))))) - tool-use) - (when pending-calls - (plist-put info :tool-pending t) - (funcall (plist-get info :callback) - (cons 'tool-call pending-calls) info)))))) - -(defun gptel--handle-post (fsm) - "Run cleanup for `gptel-request' with FSM." - (when-let* ((info (gptel-fsm-info fsm)) - (post (plist-get info :post))) - (mapc (lambda (f) (funcall f info)) post))) - -;;;; State machine predicates -;; Predicates used to find the next state to transition to, see -;; `gptel-request--transitions'. - -(defun gptel--error-p (info) (plist-get info :error)) - -(defun gptel--tool-use-p (info) (plist-get info :tool-use)) - -(defun gptel--tool-result-p (info) (plist-get info :tool-success)) - - -;;; Send gptel requests -(cl-defun gptel-request - (&optional prompt &key callback - (buffer (current-buffer)) - position context dry-run - (stream nil) (in-place nil) - (system gptel--system-message) - schema transforms (fsm (gptel-make-fsm))) - "Request a response from the `gptel-backend' for PROMPT. - -The request is asynchronous, this function returns immediately. - -If PROMPT is -- a string, it is used to create a full prompt suitable for - sending to the LLM. -- A list of strings, it is interpreted as a conversation, i.e. a - series of alternating user prompts and LLM responses. - (\"user msg 1\" \"llm msg 1\" \"user msg 2\" \"llm msg 2\" ...) -- nil but region is active, the region contents are used. -- nil, the current buffer's contents up to (point) are used. - Previous responses from the LLM are identified as responses. - -Keyword arguments: - -CALLBACK, if supplied, is a function of two arguments, called -with the RESPONSE (usually a string) and INFO (a plist): - - (funcall CALLBACK RESPONSE INFO) - -RESPONSE is - -- A string if the request was successful -- nil if there was no response or an error. - -These are the only two cases you typically need to consider, -unless you need to clean up after aborted requests, use LLM -tools, handle \"reasoning\" content specially or stream -responses (see STREAM). In these cases, RESPONSE can be - -- The symbol `abort' if the request is aborted, see `gptel-abort'. - -- A cons cell of the form - - (tool-call . ((TOOL ARGS CB) ...)) - - where TOOL is a gptel-tool struct, ARGS is a plist of - arguments, and CB is a function for handling the results. You - can call CB with the result of calling the tool to continue the - request. - -- A cons cell of the form - - (tool-result . ((TOOL ARGS RESULT) ...)) - - where TOOL is a gptel-tool struct, ARGS is a plist of - arguments, and RESULT was returned from calling the tool - function. - -- A cons cell of the form - - (reasoning . text) - - where text is the contents of the reasoning block. (Also see - STREAM if you are using streaming.) - -See `gptel--insert-response' for an example callback handling all -cases. - -The INFO plist has (at least) the following keys: -:data - The request data included with the query -:position - marker at the point the request was sent, unless - POSITION is specified. -:buffer - The buffer current when the request was sent, - unless BUFFER is specified. -:status - Short string describing the result of the request, - including possible HTTP errors. - -Example of a callback that messages the user with the response -and info: - - (lambda (response info) - (if (stringp response) - (let ((posn (marker-position (plist-get info :position))) - (buf (buffer-name (plist-get info :buffer)))) - (message \"Response for request from %S at %d: %s\" - buf posn response)) - (message \"gptel-request failed with message: %s\" - (plist-get info :status)))) - -Or, for just the response: - - (lambda (response _) - ;; Do something with response - (message (rot13-string response))) - -If CALLBACK is omitted, the response is inserted at the point the -request was sent. - -STREAM is a boolean that determines if the response should be -streamed, as in `gptel-stream'. If the model or the backend does -not support streaming, this will be ignored. - -When streaming responses - -- CALLBACK will be called repeatedly with each RESPONSE text - chunk (a string) as it is received. -- When the HTTP request ends successfully, CALLBACK will be - called with a RESPONSE argument of t to indicate success. -- Similarly, CALLBACK will be called with - (reasoning . text-chunk) for each reasoning chunk, and - (reasoning . t) to indicate the end of the reasoning block. - -BUFFER and POSITION are the buffer and position (integer or -marker) at which the response is inserted. If a CALLBACK is -specified, no response is inserted and these arguments are -ignored, but they are still available in the INFO plist passed -to CALLBACK for you to use. - -BUFFER defaults to the current buffer, and POSITION to the value -of (point) or (region-end), depending on whether the region is -active. - -CONTEXT is any additional data needed for the callback to run. It -is included in the INFO argument to the callback. -Note: This is intended for storing Emacs state to be used by -CALLBACK, and unrelated to the context supplied to the LLM. - -SYSTEM is the system message or extended chat directive sent to -the LLM. This can be a string, a list of strings or a function -that returns either; see `gptel-directives' for more -information. If SYSTEM is omitted, the value of -`gptel--system-message' for the current buffer is used. - -The following keywords are mainly for internal use: - -IN-PLACE is a boolean used by the default callback when inserting -the response to determine if delimiters are needed between the -prompt and the response. - -If DRY-RUN is non-nil, do not send the request. Construct and -return a state machine object that can be introspected and -resumed. - -TRANSFORMS is a list of functions used to transform the prompt or query -parameters dynamically. Each function is called in a temporary buffer -containing the prompt to be sent, and can conditionally modify this -buffer. This can include changing the (buffer-local) values of the -model, backend or system prompt, or augmenting the prompt with -additional information (such as from a RAG engine). - -- Synchronous transformers are called with zero or one argument, the - state machine for the request. - -- Asynchronous transformers are called with two arguments, a callback - and the state machine. It should run the callback after finishing its - transformation. - -See `gptel-prompt-transform-functions' for more. - -If provided, SCHEMA forces the LLM to generate JSON output. Its value -is a JSON schema, which can be provided as -- an elisp object, a nested plist structure. -- A JSON schema serialized to a string -- A shorthand object/array description, see `gptel--dispatch-schema-type'. -See the manual or the wiki for examples. - -Note: SCHEMA is presently experimental and subject to change, and not -all providers support structured output. - -FSM is the state machine driving the request. This can be used -to define a custom request control flow, see `gptel-fsm' for -details. You can safely ignore this -- FSM is an unstable -feature and subject to change. - -Note: - -1. This function is not fully self-contained. Consider -let-binding the parameters `gptel-backend', `gptel-model', -`gptel-use-tools' and `gptel-use-context' around calls to it as -required. - -2. The return value of this function is a state machine that may -be used to rerun or continue the request at a later time." - (declare (indent 1)) - ;; TODO Remove this check in version 1.0 - (gptel--sanitize-model) - (let* ((start-marker - (cond - ((null position) - (if (use-region-p) - (set-marker (make-marker) (region-end)) - (gptel--at-word-end (point-marker)))) - ((markerp position) position) - ((integerp position) - (set-marker (make-marker) position buffer)))) - (gptel--schema schema) - (prompt-buffer - (cond ;prompt from buffer or explicitly supplied - ((null prompt) - (gptel--create-prompt-buffer (point))) - ((stringp prompt) - (gptel--with-buffer-copy buffer nil nil - (insert prompt) - (current-buffer))) - ((consp prompt) - ;; (gptel--parse-list gptel-backend prompt) - (gptel--with-buffer-copy buffer nil nil - ;; TEMP Decide on the annoated prompt-list format - (gptel--parse-list-and-insert prompt) - (current-buffer))))) - (system-list (gptel--parse-directive system 'raw)) ;eval function-valued system prompts - (info (list :data prompt-buffer - :buffer buffer - :position start-marker))) - (when transforms (plist-put info :transforms transforms)) - (with-current-buffer prompt-buffer - (setq gptel--system-message ;guaranteed to be buffer-local - ;; Retain single-part system messages as strings to avoid surprises - ;; when applying presets - (if (cdr system-list) system-list (car system-list)))) - (when stream (plist-put info :stream stream)) - ;; This context should not be confused with the context aggregation context! - (when callback (plist-put info :callback callback)) - (when context (plist-put info :context context)) - (when in-place (plist-put info :in-place in-place)) - ;; Add info to state machine context - (when dry-run (plist-put info :dry-run dry-run)) - (setf (gptel-fsm-info fsm) info)) - - ;; TEMP: Augment in separate let block for now. Are we overcapturing? - ;; FIXME(augment): Call augmentors with INFO, not FSM - (let ((info (gptel-fsm-info fsm))) - (with-current-buffer (plist-get info :data) - (setq-local gptel-prompt-transform-functions (plist-get info :transforms)) - ;; Preset has highest priority because it can change prompt-transform-functions - (when (memq 'gptel--transform-apply-preset gptel-prompt-transform-functions) - (gptel--transform-apply-preset fsm) - (setq gptel-prompt-transform-functions ;avoid mutation, copy transforms - (remq 'gptel--transform-apply-preset gptel-prompt-transform-functions))) - (let ((augment-total ;act like a hook, count total - (if (memq t gptel-prompt-transform-functions) - (length - (setq gptel-prompt-transform-functions - (nconc (remq t gptel-prompt-transform-functions) - (default-value 'gptel-prompt-transform-functions)))) - (length gptel-prompt-transform-functions))) - (augment-idx 0)) - (if (null gptel-prompt-transform-functions) - (gptel--realize-query fsm) - ;; FIXME(request-lib): Cannot use gptel--update-status from this file - ;; (with-current-buffer (plist-get info :buffer) ;Apply prompt transformations - ;; (gptel--update-status " Augmenting..." 'mode-line-emphasis)) - - ;; FIXME(augment): This needs to be converted into a linear callback - ;; chain to avoid race conditions with multiple async augmentors. - (run-hook-wrapped - 'gptel-prompt-transform-functions - (lambda (func fsm-arg) - (with-current-buffer (plist-get info :data) - (goto-char (point-max)) - (if (= (car (func-arity func)) 2) ;async augmentor - (funcall func (lambda () - (cl-incf augment-idx) - (when (>= augment-idx augment-total) ;All augmentors have run - (gptel--realize-query fsm-arg))) - fsm-arg) - (if (= (car (func-arity func)) 0) - (funcall func) - (funcall func fsm-arg)) ;sync augmentor - (cl-incf augment-idx) - (when (>= augment-idx augment-total) ;All augmentors have run - (gptel--realize-query fsm-arg)))) - nil) ;always return nil so run-hook-wrapped doesn't abort - fsm))))) - fsm) - -(defun gptel--realize-query (fsm) - "Realize the query payload for FSM from its prompt buffer. - -Initiate the request when done." - (let ((info (gptel-fsm-info fsm))) - (with-current-buffer (plist-get info :data) - (let* ((directive (gptel--parse-directive gptel--system-message 'raw)) - ;; DIRECTIVE contains both the system message and the template prompts - (gptel--system-message - (unless (gptel--model-capable-p 'nosystem) (car directive))) - ;; TODO(tool) Limit tool use to capable models after documenting :capabilities - ;; (gptel-use-tools (and (gptel--model-capable-p 'tool-use) gptel-use-tools)) - (stream (and (plist-get info :stream) gptel-use-curl gptel-stream - ;; Check model-specific request-params for streaming preference - (let* ((model-params (gptel--model-request-params gptel-model)) - (stream-spec (plist-get model-params :stream))) - ;; If not present, there is no model-specific preference - (or (not (memq :stream model-params)) - ;; If present, it must not be :json-false or nil - (and stream-spec (not (eq stream-spec :json-false))))) - ;; Check backend-specific streaming settings - (gptel-backend-stream gptel-backend))) - (gptel-stream stream) - (full-prompt)) - (when (cdr directive) ; prompt constructed from directive/template - (save-excursion (goto-char (point-min)) - (gptel--parse-list-and-insert (cdr directive)))) - (goto-char (point-max)) - (setq full-prompt (gptel--parse-buffer ;prompt from buffer or explicitly supplied - gptel-backend (and gptel--num-messages-to-send - (* 2 gptel--num-messages-to-send)))) - ;; Inject media chunks into the first user prompt if required. Media - ;; chunks are always included with the first user message, - ;; irrespective of the preference in `gptel-use-context'. This is - ;; because media cannot be included (in general) with system messages. - ;; TODO(augment): Find a way to do this in the prompt-buffer? - (when (and gptel-context gptel-use-context (gptel--model-capable-p 'media)) - (gptel--inject-media gptel-backend full-prompt)) - (unless stream (cl-remf info :stream)) - (plist-put info :backend gptel-backend) - (plist-put info :model gptel-model) - (when gptel-include-reasoning ;Required for next-request-only scope - (plist-put info :include-reasoning gptel-include-reasoning)) - (when (and gptel-use-tools gptel-tools) - (plist-put info :tools gptel-tools)) - (plist-put info :data - (gptel--request-data gptel-backend full-prompt))) - (kill-buffer (current-buffer))) - ;; INIT -> WAIT - (unless (plist-get info :dry-run) (gptel--fsm-transition fsm)) - fsm)) - -(defun gptel-abort (buf) - "Stop any active gptel process associated with buffer BUF. - -BUF defaults to the current buffer." - (interactive (list (current-buffer))) - (when-let* ((proc-attrs - (cl-find-if - (lambda (entry) - ;; each entry has the form (PROC . (FSM ABORT-FN)) - (eq (thread-first (cadr entry) ; FSM - (gptel-fsm-info) - (plist-get :buffer)) - buf)) - gptel--request-alist)) - (proc (car proc-attrs)) - (fsm (cadr proc-attrs)) - (info (gptel-fsm-info fsm)) - (abort-fn (cddr proc-attrs))) - ;; Run :callback with abort signal - (with-demoted-errors "Callback error: %S" - (and-let* ((cb (plist-get info :callback)) - ((functionp cb))) - (funcall cb 'abort info))) - (funcall abort-fn) - (setf (alist-get proc gptel--request-alist nil 'remove) nil) - (gptel--fsm-transition fsm 'ABRT) - (message "Stopped gptel request in buffer %S" (buffer-name buf)))) - - -;;; Prompt creation -(defun gptel--create-prompt-buffer (&optional prompt-end) - "Return a buffer with the conversation prompt to be sent. - -If the region is active limit the prompt text to the region contents. -Otherwise the prompt text is constructed from the contents of the -current buffer up to point, or PROMPT-END if provided." - (save-excursion - (save-restriction - (let ((buf (current-buffer))) - (cond - ((derived-mode-p 'org-mode) - (require 'gptel-org) - ;; Also handles regions in Org mode - (gptel-org--create-prompt-buffer prompt-end)) - ((use-region-p) - (let ((rb (region-beginning)) (re (region-end))) - (gptel--with-buffer-copy buf rb re - (current-buffer)))) - (t (unless prompt-end (setq prompt-end (point))) - (gptel--with-buffer-copy buf (point-min) prompt-end - (current-buffer)))))))) - -(defun gptel--create-prompt (&optional prompt-end) - "Return a full conversation prompt from the contents of this buffer. - -If `gptel--num-messages-to-send' is set, limit to that many -recent exchanges. - -If PROMPT-END (a marker) is provided, end the prompt contents -there. This defaults to (point)." - (with-current-buffer (gptel--create-prompt-buffer prompt-end) - (unwind-protect - (gptel--parse-buffer - gptel-backend (and gptel--num-messages-to-send - (* 2 gptel--num-messages-to-send))) - (kill-buffer (current-buffer))))) - -(make-obsolete 'gptel--create-prompt 'gptel--create-prompt-buffer - "0.9.9") - -(cl-defgeneric gptel--parse-buffer (backend max-entries) - "Parse current buffer backwards from point and return a list of prompts. - -BACKEND is the LLM backend in use. - -MAX-ENTRIES is the number of queries/responses to include for -contexbt.") - -(defun gptel--parse-list-and-insert (prompts) - "Insert PROMPTS, a list of messages into the current buffer. - -Propertize the insertions in a format gptel can parse into a -conversation. - -PROMPTS is typically the input to `gptel-request', either a list of strings -representing a conversation with alternate prompt/response turns, or a list of -lists with explicit roles (prompt/response/tool). See the documentation of -`gptel-request' for the latter." - (if (stringp (car prompts)) ; Simple format, list of strings - (cl-loop for text in prompts - for response = nil then (not response) - when text - if response - do (insert gptel-response-separator - (propertize text 'gptel 'response) - gptel-response-separator) - else do (insert text)) - (dolist (entry prompts) ; Advanced format, list of lists - (pcase entry - (`(prompt . ,msg) (insert (or (car-safe msg) msg))) - (`(response . ,msg) - (insert gptel-response-separator - (propertize (or (car-safe msg) msg) 'gptel 'response))) - (`(tool . ,call) - (insert gptel-response-separator - (propertize - (concat - "(:name " (plist-get call :name) " :args " - (prin1-to-string (plist-get call :args)) ")\n\n" - (plist-get call :result)) - 'gptel `(tool . ,(plist-get call :id))))))))) - -(cl-defgeneric gptel--parse-list (backend prompt-list) - "Parse PROMPT-LIST and return a list of prompts for BACKEND. - -PROMPT-LIST is interpreted as a conversation, i.e. an alternating -series of user prompts and LLM responses. The returned structure -is suitable for including in the request payload. - -BACKEND is the LLM backend in use.") - -(cl-defgeneric gptel--parse-media-links (mode beg end) - "Find media links between BEG and END. - -MODE is the major-mode of the buffer. - -Returns a plist where each entry is of the form - (:text \"some text\") -or - (:media \"media uri or file path\")." - (ignore mode) ;byte-compiler - (list `(:text ,(buffer-substring-no-properties - beg end)))) - -(declare-function markdown-link-at-pos "markdown-mode") -(declare-function mailcap-file-name-to-mime-type "mailcap") - -(defsubst gptel-markdown--validate-link (link) - "Validate a Markdown LINK as sendable under the current gptel settings. - -Return a form (validp link-type path . REST), where REST is a list -explaining why sending the link is not supported by gptel. Only the -first nil value in REST is guaranteed to be correct." - (let ((mime)) - (if-let* ((path (nth 3 link)) - (prefix (or (string-search "://" path) 0)) - (link-type (if (= prefix 0) "file" (substring path 0 prefix))) - (path (if (and (equal link-type "file") (> prefix 0)) - (substring path (+ prefix 3)) path)) - (resource-type - (or (and (equal link-type "file") 'file) - (and (gptel--model-capable-p 'url) - (member link-type '("http" "https" "ftp")) 'url))) - (user-check (funcall gptel-markdown-validate-link link)) - (readablep (or (member link-type '("http" "https" "ftp")) - (file-remote-p path) - (file-readable-p path))) - (mime-valid - (if (or (eq resource-type 'url) - (cdr (with-memoization - (alist-get (expand-file-name path) - gptel--link-type-cache - nil nil #'string=) - (cons t (gptel--file-binary-p path))))) - (gptel--model-mime-capable-p - (setq mime (mailcap-file-name-to-mime-type path))) - t))) - (list t link-type path resource-type user-check readablep mime-valid mime) - (list nil link-type path resource-type user-check readablep mime-valid mime)))) - -(cl-defmethod gptel--parse-media-links ((_mode (eql 'markdown-mode)) beg end) - "Parse text and actionable links between BEG and END. - -Return a list of the form - ((:text \"some text\") - (:media \"/path/to/media.png\" :mime \"image/png\") - (:text \"More text\")) -for inclusion into the user prompt for the gptel request." - (let ((parts) (from-pt)) - (save-excursion - (setq from-pt (goto-char beg)) - (while (re-search-forward gptel-markdown--link-regex end t) - (let* ((link-at-pt (markdown-link-at-pos (point))) - (link-status (gptel-markdown--validate-link link-at-pt))) - (cl-destructuring-bind - (valid type path resource-type user-check readablep mime-valid mime) - link-status - (cond - ((and valid (member type '("http" "https" "ftp"))) - ;; Collect text up to this image, and collect this image url - (let ((text (buffer-substring-no-properties from-pt (car link-at-pt)))) - (unless (string-blank-p text) (push (list :text text) parts)) - (push (list :url path :mime mime) parts) - (setq from-pt (cadr link-at-pt)))) - (valid ; Collect text up to this link, and collect this link data - (let ((text (buffer-substring-no-properties from-pt (car link-at-pt)))) - (unless (string-blank-p text) (push (list :text text) parts)) - (push (if mime (list :media path :mime mime) (list :textfile path)) parts) - (setq from-pt (cadr link-at-pt)))) - ((not resource-type) - (message "Link source not followed for unsupported link type \"%s\"." type)) - ((not user-check) - (message - (if (eq gptel-markdown-validate-link 'gptel--link-standalone-p) - "Ignoring non-standalone link \"%s\"." - "Link %s failed to validate, see `gptel-markdown-validate-link'.") - path)) - ((not readablep) (message "Ignoring inaccessible file \"%s\"." path)) - ((and (not mime-valid) (eq resource-type 'file)) - (message "Ignoring unsupported binary file \"%s\"." path))))))) - (unless (= from-pt end) - (push (list :text (buffer-substring-no-properties from-pt end)) parts)) - (nreverse parts))) - -(cl-defgeneric gptel--inject-media (backend _prompts) - "Wrap the last prompt in PROMPTS with gptel's context. - -PROMPTS is a structure as returned by `gptel--parse-buffer'. -Typically this is a list of plists. - -BACKEND is the gptel backend in use." - (display-warning - '(gptel context) - (format "Context support not implemented for backend %s, ignoring context" - (gptel-backend-name backend)))) - -(cl-defgeneric gptel--request-data (backend prompts) - "Generate a plist of all data for an LLM query. - -BACKEND is the LLM backend in use. - -PROMPTS is the plist of previous user queries and LLM responses.") - -(cl-defun gptel--sanitize-model (&key (backend gptel-backend) - (model gptel-model) - (shoosh t)) - "Check if MODEL is available in BACKEND, adjust accordingly. - -If SHOOSH is true, don't issue a warning." - (let ((available (gptel-backend-models backend))) - (when (stringp model) - (unless shoosh - (display-warning - 'gptel - (format "`gptel-model' expects a symbol, found string \"%s\" - Resetting `gptel-model' to %s" - model model))) - (setq gptel-model (gptel--intern model) - model gptel-model)) - (unless (member model available) - (let ((fallback (car available))) - (unless shoosh - (display-warning - 'gptel - (format (concat "Preferred `gptel-model' \"%s\" not" - "supported in \"%s\", using \"%s\" instead") - model (gptel-backend-name backend) fallback))) - (setq-local gptel-model fallback))))) - - -;;; url-retrieve response handling -(defun gptel--url-get-response (fsm) - "Fetch response to prompt in state FSM from the LLM. - -FSM is the state machine driving this request. Its INFO slot -contains the data required for setting up the request. INFO is a -plist with the following keys, among others: -- :data (the data being sent) -- :buffer (the gptel buffer) -- :position (marker at which to insert the response). -- :callback (optional, the request callback) - -Call CALLBACK with the response and INFO afterwards. If omitted -the response is inserted into the current buffer after point." - (let* ((inhibit-message t) - (message-log-max nil) - (url-request-method "POST") - (info (gptel-fsm-info fsm)) - ;; We have to let-bind the following two since their dynamic - ;; values are used for key lookup and url resolution - (gptel-backend (plist-get info :backend)) - (gptel-model (plist-get info :model)) - (url-request-extra-headers - (append '(("Content-Type" . "application/json")) - (when-let* ((header (gptel-backend-header gptel-backend))) - (if (functionp header) - (funcall header) header)))) - (callback (or (plist-get info :callback) ;if not the first run - #'gptel--insert-response)) ;default callback - ;; NOTE: We don't need the decode-coding-string dance here since we - ;; don't pass it to the OS environment and Curl. - (url-request-data - (gptel--json-encode (plist-get info :data)))) - (when (with-current-buffer (plist-get info :buffer) - (and (derived-mode-p 'org-mode) - gptel-org-convert-response)) - (plist-put info :transformer #'gptel--convert-markdown->org)) - (plist-put info :callback callback) - (when gptel-log-level ;logging - (when (eq gptel-log-level 'debug) - (gptel--log (gptel--json-encode - (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair))) - url-request-extra-headers)) - "request headers")) - (gptel--log url-request-data "request body")) - (let ((proc-buf - (url-retrieve (let ((backend-url (gptel-backend-url gptel-backend))) - (if (functionp backend-url) - (funcall backend-url) backend-url)) - (lambda (_) - (set-buffer-multibyte t) - (set-buffer-file-coding-system 'utf-8-unix) - (pcase-let ((`(,response ,http-status ,http-msg ,error) - (gptel--url-parse-response - (plist-get info :backend) info)) - (buf (current-buffer))) - (plist-put info :http-status http-status) - (plist-put info :status http-msg) - (gptel--fsm-transition fsm) ;WAIT -> TYPE - (when error (plist-put info :error error)) - (when response ;Look for a reasoning block - (if (string-match-p "^\\s-*" 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 - (cond ((plistp response) (plist-get response :error)) - ((arrayp response) - (cl-some (lambda (el) (plist-get el :error)) response))))) - (list nil http-status http-msg error-data))) - ((eq response 'json-read-error) - (list nil http-status (concat "(" http-msg ") Malformed JSON in response.") "json-read-error")) - (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.") - "Could not parse HTTP response."))) - (list nil (concat "(" http-msg ") Could not parse HTTP response.") - "Could not parse HTTP response."))) - - -;;; Curl request response handling - -(defun gptel-curl--get-args (info token) - "Produce list of arguments for calling Curl. - -INFO contains the request data, TOKEN is a unique identifier." - (let* ((data (plist-get info :data)) - ;; We have to let-bind the following three since their dynamic - ;; values are used for key lookup and url resolution - (gptel-backend (plist-get info :backend)) - (gptel-model (plist-get info :model)) - (gptel-stream (plist-get info :stream)) - (url (let ((backend-url (gptel-backend-url gptel-backend))) - (if (functionp backend-url) - (funcall backend-url) backend-url))) - (data-json (decode-coding-string (gptel--json-encode data) 'utf-8 t)) - (headers - (append '(("Content-Type" . "application/json")) - (when-let* ((header (gptel-backend-header gptel-backend))) - (if (functionp header) - (funcall header) header))))) - (when gptel-log-level - (when (eq gptel-log-level 'debug) - (gptel--log (gptel--json-encode - (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair))) - headers)) - "request headers")) - (gptel--log data-json "request body")) - (append - gptel-curl--common-args - gptel-curl-extra-args - (and-let* ((curl-args (gptel-backend-curl-args gptel-backend))) - (if (functionp curl-args) (funcall curl-args) curl-args)) - (list (format "-w(%s . %%{size_header})" token)) - (if (< (string-bytes data-json) gptel-curl-file-size-threshold) - (list (format "-d%s" data-json)) - (let* ((write-region-inhibit-fsync t) - (file-name-handler-alist nil) - (inhibit-message t) - (temp-filename (make-temp-file "gptel-curl-data" nil ".json" data-json)) - (cleanup-fn (lambda (&rest _) (when (file-exists-p temp-filename) - (delete-file temp-filename))))) - (plist-put info :post (cons cleanup-fn (plist-get info :post))) - (list "--data-binary" (format "@%s" temp-filename)))) - (when (not (string-empty-p gptel-proxy)) - (list "--proxy" gptel-proxy - "--proxy-negotiate" - "--proxy-user" ":")) - (cl-loop for (key . val) in headers - collect (format "-H%s: %s" key val)) - (list url)))) - -;;;###autoload -(defun gptel-curl-get-response (fsm) - "Fetch response to prompt in state FSM from the LLM using Curl. - -FSM is the state machine driving this request. - -FSM is the state machine driving this request. Its INFO slot -contains the data required for setting up the request. INFO is a -plist with the following keys, among others: -- :data (the data being sent) -- :buffer (the gptel buffer) -- :position (marker at which to insert the response). -- :callback (optional, the request callback) - -Call CALLBACK with the response and INFO afterwards. If omitted -the response is inserted into the current buffer after point." - (let* ((token (md5 (format "%s%s%s%s" - (random) (emacs-pid) (user-full-name) - (recent-keys)))) - (info (gptel-fsm-info fsm)) - (backend (plist-get info :backend)) - (args (gptel-curl--get-args info token)) - (stream (plist-get info :stream)) - (process (apply #'start-process "gptel-curl" - (gptel--temp-buffer " *gptel-curl*") (gptel--curl-path) args))) - (when (eq gptel-log-level 'debug) - (gptel--log (mapconcat #'shell-quote-argument (cons (gptel--curl-path) args) " \\\n") - "request Curl command" 'no-json)) - (with-current-buffer (process-buffer process) - (cond - ((eq (gptel-backend-coding-system backend) 'binary) - ;; set-buffer-file-coding-system is not needed since we don't save this buffer - (set-buffer-multibyte nil) - (set-process-coding-system process 'binary 'binary)) - (t - ;; Don't try to convert cr-lf to cr on Windows so that curl's "header size - ;; in bytes" stays correct. Explicitly set utf-8 for non-win systems too, - ;; for cases when buffer coding system is not set to utf-8. - (set-process-coding-system process 'utf-8-unix 'utf-8-unix))) - (set-process-query-on-exit-flag process nil) - (if (plist-get info :token) ;not the first run, set only the token - (plist-put info :token token) - (setf (gptel-fsm-info fsm) ;fist run, set all process parameters - (nconc (list :token token - :transformer - (when (with-current-buffer (plist-get info :buffer) - (and (derived-mode-p 'org-mode) - gptel-org-convert-response)) - (gptel--stream-convert-markdown->org - (plist-get info :position)))) - (unless (plist-get info :callback) - (list :callback (if stream - #'gptel-curl--stream-insert-response - #'gptel--insert-response))) - info))) - (if stream - (progn (set-process-sentinel process #'gptel-curl--stream-cleanup) - (set-process-filter process #'gptel-curl--stream-filter)) - (set-process-sentinel process #'gptel-curl--sentinel)) - (setf (alist-get process gptel--request-alist) - (cons fsm - #'(lambda () - ;; Clean up Curl process - (set-process-sentinel process #'ignore) - (delete-process process) - (kill-buffer (process-buffer process)))))))) - -;; ;; Ahead-Of-Time dispatch code for the parsers -;; :parser ; FIXME `cl--generic-*' are internal functions -;; (cl--generic-method-function -;; (if stream -;; (cl-loop -;; for type in -;; (cl--class-allparents (get (type-of backend) 'cl--class)) -;; with methods = (cl--generic-method-table -;; (cl--generic 'gptel-curl--parse-stream)) -;; when (cl--generic-member-method `(,type t) nil methods) -;; return (car it)) -;; (cl-loop -;; for type in -;; (cl--class-allparents (get (type-of backend) 'cl--class)) -;; with methods = (cl--generic-method-table -;; (cl--generic 'gptel--parse-response)) -;; when (cl--generic-member-method `(,type t t) nil methods) -;; return (car it)))) - -(defun gptel-curl--log-response (proc-buf proc-info) - "Parse response buffer PROC-BUF and log response. - -PROC-INFO is the plist containing process metadata." - (with-current-buffer proc-buf - (save-excursion - (goto-char (point-min)) - (when (re-search-forward " ?\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 :token) nil t) - (goto-char (1- (match-beginning 0))) - (gptel--log (buffer-substring-no-properties p (point)) - "response body"))))))) - -;; TODO: Separate user-messaging from this function -(defun gptel-curl--stream-cleanup (process _status) - "Process sentinel for gptel curl requests. - -PROCESS and _STATUS are process parameters." - (let ((proc-buf (process-buffer process))) - (let* ((fsm (car (alist-get process gptel--request-alist))) - (info (gptel-fsm-info fsm)) - (http-status (plist-get info :http-status))) - (when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging - (if (member http-status '("200" "100")) ;Finish handling response - ;; Run the callback one last time to signal that the process has ended - (with-demoted-errors "gptel callback error: %S" - (funcall (plist-get info :callback) t info)) - (with-current-buffer proc-buf ; Or Capture error message - (goto-char (point-max)) - (search-backward (plist-get info :token)) - (backward-char) - (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))) - (response (progn (goto-char header-size) - (condition-case nil (gptel--json-read) - (error 'json-read-error)))) - (error-data - (cond ((plistp response) (plist-get response :error)) - ((arrayp response) - (cl-some (lambda (el) (plist-get el :error)) response))))) - (cond - (error-data - (plist-put info :error error-data)) - ((eq response 'json-read-error) - (plist-put info :error "Malformed JSON in response.")) - (t (plist-put info :error "Could not parse HTTP response."))))) - (with-demoted-errors "gptel callback error: %S" - (funcall (plist-get info :callback) nil info))) - (gptel--fsm-transition fsm)) ; Move to next state - (setf (alist-get process gptel--request-alist nil 'remove) nil) - (kill-buffer proc-buf))) - -(defun gptel-curl--stream-filter (process output) - (let* ((fsm (car (alist-get process gptel--request-alist))) - (proc-info (gptel-fsm-info fsm)) - (callback (or (plist-get proc-info :callback) - #'gptel-curl--stream-insert-response))) - (with-current-buffer (process-buffer process) - ;; Insert output - (save-excursion - (goto-char (process-mark process)) - (insert output) - (set-marker (process-mark process) (point))) - - ;; Find HTTP status - (unless (plist-get proc-info :http-status) - (save-excursion - (goto-char (point-min)) - (when-let* (((not (= (line-end-position) (point-max)))) - (http-msg (buffer-substring (line-beginning-position) - (line-end-position))) - (http-status - (save-match-data - (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) - (match-string 1 http-msg))))) - (plist-put proc-info :http-status http-status) - (plist-put proc-info :status (string-trim http-msg)) - (gptel--fsm-transition fsm)))) - - (when-let* ((http-msg (plist-get proc-info :status)) - (http-status (plist-get proc-info :http-status))) - ;; Find data chunk(s) and run callback - ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 - (when (member http-status '("200" "100")) - (let ((response (gptel-curl--parse-stream - (plist-get proc-info :backend) proc-info)) - (reasoning-block (plist-get proc-info :reasoning-block))) - ;; Depending on the API, there are two modes that reasoning or - ;; chain-of-thought content appears: as part of the main response - ;; but surrounded by ... 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 - (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)))) - (gptel--fsm-transition fsm)) ;TYPE -> next - (setf (alist-get process gptel--request-alist nil 'remove) nil) - (kill-buffer proc-buf))) - -(defun gptel-curl--parse-response (proc-info) - "Parse the buffer BUF with curl's response. - -PROC-INFO is a plist with contextual information." - (let ((token (plist-get proc-info :token))) - (goto-char (point-max)) - (search-backward token) - (backward-char) - (pcase-let* ((`(,_ . ,header-size) (read (current-buffer)))) - (goto-char (point-min)) - - (if-let* ((http-msg (string-trim - (buffer-substring (line-beginning-position) - (line-end-position)))) - (http-status - (save-match-data - (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) - (match-string 1 http-msg)))) - (response (progn (goto-char header-size) - (condition-case nil - (gptel--json-read) - (error 'json-read-error))))) - (cond - ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 - ((member http-status '("200" "100")) - (list (and-let* ((resp (gptel--parse-response - (plist-get proc-info :backend) response proc-info)) - ((not (string-blank-p resp)))) - (string-trim resp)) - http-status http-msg)) - ((and-let* ((error-data - (cond ((plistp response) (plist-get response :error)) - ((arrayp response) - (cl-some (lambda (el) (plist-get el :error)) response))))) - (list nil http-status http-msg error-data))) - ((eq response 'json-read-error) - (list nil http-status (concat "(" http-msg ") Malformed JSON in response.") - "Malformed JSON in response")) - (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.") - "Could not parse HTTP response."))) - (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.") - "Could not parse HTTP response."))))) - -(provide 'gptel-request) -;;; gptel-request.el ends here diff --git a/elpa/gptel-20260123.739/gptel-rewrite.el b/elpa/gptel-20260123.739/gptel-rewrite.el deleted file mode 100644 index acd08b24..00000000 --- a/elpa/gptel-20260123.739/gptel-rewrite.el +++ /dev/null @@ -1,796 +0,0 @@ -;;; gptel-rewrite.el --- Refactoring functions for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur -;; Keywords: hypermedia, convenience, tools - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: -(require 'gptel-transient) -(require 'cl-lib) - -(defvar eldoc-documentation-functions) -(defvar diff-entire-buffers) -(defvar ediff-window-setup-function) -(defvar ediff-split-window-function) - -(declare-function diff-no-select "diff") -(declare-function rmc--add-key-description "rmc") -(declare-function ediff-setup-windows-plain "ediff-wind") - -;; * User options - -(defcustom gptel-rewrite-directives-hook nil - "Hook run to generate gptel's default rewrite directives. - -Each function in this hook is called with no arguments until one -returns a non-nil value, the base string to use as the -rewrite instruction. - -Use this hook to tailor context-specific rewrite directives. -For example, you can specialize the default rewrite directive -for a particular major-mode or project." - :group 'gptel - :type 'hook) - -(defcustom gptel-post-rewrite-functions nil - "Abnormal hook run after a `gptel-rewrite' action. - -This hook is called after the LLM response for the rewrite action -has been fully received in a temporary buffer. Each function is -called with two arguments: the response beginning and end -positions. - -Note: this hook only runs if the rewrite request succeeds." - :type 'hook - :group 'gptel) - -(defcustom gptel-rewrite-default-action nil - "Action to take when rewriting a text region using gptel. - -When the LLM response with the rewritten text is received, you can -- merge it with the current region, possibly creating a merge conflict, -- diff or ediff against the original region, -- or accept it in place, replacing the original region. -- display a dispatch menu with the above choices. - -If this option is nil (the default), gptel waits for an explicit -command. Set it to the symbol `merge', `diff', `ediff', `accept' -or `dispatch' to automatically do one of these things instead. - -You can also set it to a function of your choosing for a custom -action. This function receives one argument, the rewrite -overlay." - :group 'gptel - :type '(choice - (const :tag "Wait" nil) - (const :tag "Merge with current region" merge) - (const :tag "Diff against current region" diff) - (const :tag "Ediff against current region" ediff) - (const :tag "Accept rewrite" accept) - (const :tag "Dispatch" dispatch) - (function :tag "Custom action"))) - -(defface gptel-rewrite-highlight-face - '((((class color) (min-colors 88) (background dark)) - :background "#041714" :extend t :inherit default) - (((class color) (min-colors 88) (background light)) - :background "light goldenrod yellow" :extend t :inherit default) - (t :inherit secondary-selection)) - "Face for highlighting regions with pending rewrites." - :group 'gptel) - -;; * Variables - -(defvar-keymap gptel-rewrite-actions-map - :doc "Keymap for gptel rewrite actions at point." - "RET" #'gptel--rewrite-dispatch - "" #'gptel--rewrite-dispatch - "C-c C-a" #'gptel--rewrite-accept - "C-c C-r" #'gptel--rewrite-iterate - "C-c C-k" #'gptel--rewrite-reject - "C-c C-d" #'gptel--rewrite-diff - "C-c C-e" #'gptel--rewrite-ediff - "C-c C-n" #'gptel--rewrite-next - "C-c C-p" #'gptel--rewrite-previous - "C-c C-m" #'gptel--rewrite-merge) - -(defvar-local gptel--rewrite-overlays nil - "List of active rewrite overlays in the buffer.") - -(defvar-local gptel--rewrite-message nil - "Request-specific instructions for a gptel-rewrite action.") - -;; Add the rewrite directive to `gptel-directives' -(unless (alist-get 'rewrite gptel-directives) - (add-to-list 'gptel-directives `(rewrite . ,#'gptel--rewrite-directive-default))) - -(defvar gptel--rewrite-directive - (or (alist-get 'rewrite gptel-directives) - #'gptel--rewrite-directive-default) - "Active system message for rewrite actions. - -This variable is for internal use only. To customize the rewrite -system message, set a system message (or function that generates -the system message) as the value of the `rewrite' key in -`gptel-directives': - - (setf (alist-get \\='rewrite gptel-directives) - #\\='my-rewrite-message-generator) - -You can also customize `gptel-rewrite-directives-hook' to -dynamically inject a rewrite-specific system message.") - -(defun gptel--rewrite-directive-default () - "Generic directive for rewriting or refactoring. - -These are instructions not specific to any particular required -change. - -The returned string is interpreted as the system message for the -rewrite request. To use your own, add a different directive to -`gptel-directives', or add to `gptel-rewrite-directives-hook', -which see." - (or (save-mark-and-excursion - (run-hook-with-args-until-success - 'gptel-rewrite-directives-hook)) - (let* ((lang (downcase (gptel--strip-mode-suffix major-mode))) - (article (if (and lang (not (string-empty-p lang)) - (memq (aref lang 0) '(?a ?e ?i ?o ?u))) - "an" "a"))) - (if (derived-mode-p 'prog-mode) - (format (concat "You are %s %s programmer. " - "Follow my instructions and refactor %s code I provide.\n" - "- Generate ONLY %s code as output, without " - "any explanation or markdown code fences.\n" - "- Generate code in full, do not abbreviate or omit code.\n" - "- Do not produce intermediate text or report on your progress.\n" - "- Do not ask for further clarification, and make " - "any assumptions you need to follow instructions.") - article lang lang lang) - (concat - (if (string-empty-p lang) - "You are an editor." - (format "You are %s %s editor." article lang)) - " Follow my instructions and improve or rewrite the text I provide." - " Do not produce intermediate text or report on your progress." - " Generate ONLY the replacement text," - " without any explanation or markdown code fences."))))) - -(defvar gptel--rewrite-handlers - `((WAIT ,#'gptel--handle-wait) - (TOOL ,#'gptel--update-tool-call ,#'gptel--handle-tool-use)) - "Alist specifying FSM handlers for `gptel-rewrite' state transitions.") - -;; * Helper functions - -(defun gptel--rewrite-key-help (callback) - "Eldoc documentation function for gptel rewrite actions. - -CALLBACK is supplied by Eldoc, see -`eldoc-documentation-functions'." - (when (and gptel--rewrite-overlays - (get-char-property (point) 'gptel-rewrite)) - (funcall callback - (format (substitute-command-keys "%s rewrite available: accept \\[gptel--rewrite-accept], iterate \\[gptel--rewrite-iterate], clear \\[gptel--rewrite-reject], merge \\[gptel--rewrite-merge], diff \\[gptel--rewrite-diff] or ediff \\[gptel--rewrite-ediff]") - (propertize (gptel--model-name gptel-model) 'face 'mode-line-emphasis))))) - -(defun gptel--rewrite-move (search-func) - "Move directionally to a gptel rewrite location using SEARCH-FUNC." - (let* ((ov (cdr (get-char-property-and-overlay (point) 'gptel-rewrite))) - (pt (save-excursion - (if ov - (goto-char - (funcall search-func (overlay-start ov) 'gptel-rewrite)) - (goto-char - (max (1- (funcall search-func (point) 'gptel-rewrite)) - (point-min)))) - (funcall search-func (point) 'gptel-rewrite)))) - (if (get-char-property pt 'gptel-rewrite) - (goto-char pt) - (user-error "No further rewrite regions!")))) - -(defun gptel--rewrite-next () - "Go to next pending LLM rewrite in buffer, if one exists." - (interactive) - (gptel--rewrite-move #'next-single-char-property-change)) - -(defun gptel--rewrite-previous () - "Go to previous pending LLM rewrite in buffer, if one exists." - (interactive) - (gptel--rewrite-move #'previous-single-char-property-change)) - -(defun gptel--rewrite-overlay-at (&optional pt) - "Check for a gptel rewrite overlay at PT and return it. - -If no suitable overlay is found, raise an error." - (pcase-let ((`(,response . ,ov) - (get-char-property-and-overlay (or pt (point)) 'gptel-rewrite)) - (diff-entire-buffers nil)) - (unless ov (user-error "Could not find region being rewritten.")) - (unless response (user-error "No LLM output available for this rewrite.")) - ov)) - -(defun gptel--rewrite-prepare-buffer (ovs &optional buf) - "Prepare new buffer with LLM changes applied and return it. - -This is used for (e)diff purposes. - -RESPONSE is the LLM response. OVS are the overlays specifying -the changed regions. BUF is the (current) buffer." - (setq buf (or buf (overlay-buffer (or (car-safe ovs) ovs)))) - (with-current-buffer buf - (let ((pmin (point-min)) - (pmax (point-max)) - (pt (point)) - ;; (mode major-mode) - (newbuf (get-buffer-create "*gptel-diff*")) - (inhibit-read-only t) - (inhibit-message t)) - (save-restriction - (widen) - (with-current-buffer newbuf - (erase-buffer) - (insert-buffer-substring buf))) - (with-current-buffer newbuf - (narrow-to-region pmin pmax) - (goto-char pt) - ;; We mostly just want font-locking - ;; (delay-mode-hooks (funcall mode)) - ;; Apply the changes to the new buffer - (save-excursion - (gptel--rewrite-accept ovs newbuf))) - newbuf))) - -(defun gptel--rewrite-read-message (prompt &optional _ history) - "Read a rewrite message from the minibuffer with custom keybindings for -cycling, editing, and submitting the gptel rewrite. - -PROMPT is the prompt string to display. HISTORY, if provided, is the -input history list." - (let* ((rewrite-directive - (car-safe (gptel--parse-directive gptel--rewrite-directive 'raw))) - (cb (current-buffer)) - (cycle-prefix (lambda () (interactive) - (gptel--read-with-prefix rewrite-directive) - (push-mark) (goto-char (point-max)) - (activate-mark))) - (set-rewrite-message - (lambda () - (let ((message (buffer-substring-no-properties - (minibuffer-prompt-end) (point-max)))) - (with-current-buffer cb (setq gptel--rewrite-message message)) - (setf (alist-get 'gptel--infix-rewrite-extra transient-history) - (delete-dups (cons message transient--history)))))) - (start-rewrite-maybe - (lambda () (interactive) - (if transient--prefix ;Called from transient? Don't start rewrite - (run-at-time 0 nil #'transient-setup 'gptel-rewrite) - (run-at-time 0 nil #'gptel--suffix-rewrite gptel--rewrite-message)) - (when (minibufferp) - (funcall set-rewrite-message) - (exit-minibuffer)))) - (start-transient - (lambda () (interactive) - (run-at-time 0 nil #'transient-setup 'gptel-rewrite) - (when (minibufferp) - (funcall set-rewrite-message) - (exit-minibuffer)))) - (edit-in-buffer - (lambda () (interactive) - (let ((offset (- (point) (minibuffer-prompt-end)))) - (gptel--edit-directive 'gptel--rewrite-message - :prompt rewrite-directive :initial (minibuffer-contents) - :buffer cb :setup (lambda () (ignore-errors (forward-char offset))) - :callback - (lambda (msg) - (when msg - (run-at-time 0 nil #'gptel--suffix-rewrite) - (push (buffer-local-value 'gptel--rewrite-message cb) - (alist-get 'gptel--infix-rewrite-extra transient-history))) - (when (minibufferp) (exit-minibuffer))))))) - (minibuffer-local-map - (make-composed-keymap (define-keymap - "TAB" cycle-prefix "" cycle-prefix - "C-c C-e" edit-in-buffer - " " start-rewrite-maybe - "M-RET" start-transient) - minibuffer-local-map))) - (minibuffer-with-setup-hook cycle-prefix - (read-string - prompt (or gptel--rewrite-message "Rewrite: ") - history)))) - -;; * Rewrite action functions - -(defun gptel--rewrite-reject (&optional ovs) - "Clear pending LLM responses in OVS or at point." - (interactive (list (gptel--rewrite-overlay-at))) - (dolist (ov (ensure-list ovs)) - (setq gptel--rewrite-overlays (delq ov gptel--rewrite-overlays)) - (delete-overlay ov)) - (unless gptel--rewrite-overlays - (remove-hook 'eldoc-documentation-functions 'gptel--rewrite-key-help 'local)) - (message "Cleared pending LLM response(s).")) - -(defun gptel--rewrite-accept (&optional ovs buf) - "Apply pending LLM responses in OVS or at point. - -BUF is the buffer to modify, defaults to the overlay buffer." - (interactive (list (gptel--rewrite-overlay-at))) - (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) - (buf (or buf ov-buf)) - ((buffer-live-p buf))) - (with-current-buffer ov-buf - (cl-loop for ov in (ensure-list ovs) - for ov-beg = (overlay-start ov) - for ov-end = (overlay-end ov) - for response = (overlay-get ov 'gptel-rewrite) - do (overlay-put ov 'before-string nil) - (with-current-buffer buf - (goto-char ov-beg) - (delete-region ov-beg ov-end) - (insert response)))) - (message "Replaced region(s) with LLM output in buffer: %s." - (buffer-name ov-buf)))) - -(defalias 'gptel--rewrite-iterate 'gptel-rewrite - "Iterate on pending LLM response at point.") - -(defun gptel--rewrite-diff (&optional ovs switches) - "Diff pending LLM responses in OVS or at point." - (interactive (list (gptel--rewrite-overlay-at))) - (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) - ((buffer-live-p ov-buf))) - (require 'diff) - (let* ((newbuf (gptel--rewrite-prepare-buffer ovs)) - (diff-buf (diff-no-select ov-buf newbuf switches))) - (with-current-buffer diff-buf - (setq-local diff-jump-to-old-file t)) - (display-buffer diff-buf)))) - -(defun gptel--rewrite-ediff (&optional ovs) - "Ediff pending LLM responses in OVS or at point." - (interactive (list (gptel--rewrite-overlay-at))) - (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) - ((buffer-live-p ov-buf))) - (letrec ((newbuf (gptel--rewrite-prepare-buffer ovs)) - (cwc (current-window-configuration)) - (hideshow - (lambda (&optional restore) - (dolist (ov (ensure-list ovs)) - (when-let* ((overlay-buffer ov)) - (let ((disp (overlay-get ov 'display)) - (stored (overlay-get ov 'gptel--ediff))) - (overlay-put ov 'face (and restore 'gptel-rewrite-highlight-face)) - (overlay-put ov 'display (and restore stored)) - (overlay-put ov 'gptel--ediff (unless restore disp))))))) - (gptel--ediff-restore - (lambda () - (when (window-configuration-p cwc) - (set-window-configuration cwc)) - (funcall hideshow 'restore) - (remove-hook 'ediff-quit-hook gptel--ediff-restore)))) - (funcall hideshow) - (add-hook 'ediff-quit-hook gptel--ediff-restore) - (let ((ediff-window-setup-function #'ediff-setup-windows-plain) - (ediff-split-window-function #'split-window-horizontally)) - (ediff-buffers ov-buf newbuf))))) - -(defun gptel--rewrite-merge-git (beg end new-str) - "Produce a merge conflict region between BEG and END. - -Merge the region with NEW-STR using git merge-file." - (let ((original-temp-file (make-temp-file "gptel-merge-")) - (empty-temp-file (make-temp-file "gptel-merge-")) ; use /dev/null? (windows?) - (new-temp-file (make-temp-file "gptel-merge-"))) - (unwind-protect - (progn (write-region beg end original-temp-file) - (with-temp-file empty-temp-file (insert "")) - (with-temp-file new-temp-file (insert new-str)) - (goto-char beg) - (delete-region beg end) - (call-process - "git" nil (list (current-buffer) nil) nil - "merge-file" "--no-diff3" "-L" "original" "-L" "Empty" "-L" - (gptel-backend-name gptel-backend) "-p" - original-temp-file empty-temp-file new-temp-file) - ;; Make merge marker active if required - (goto-char beg) (unless (bolp) (insert "\n"))) - (delete-file original-temp-file) - (delete-file empty-temp-file) - (delete-file new-temp-file)))) - -(defun gptel--rewrite-merge-simple (beg end new-str) - "Produce a merge conflict region between BEG and END. - -NEW-STR is the new string intended to replace the region." - (goto-char end) ;End first to preserve ordering - (unless (bolp) (insert "\n")) - (insert "=======\n" new-str "\n>>>>>>> " - (gptel-backend-name gptel-backend) "\n") - (goto-char beg) - (unless (bolp) (insert "\n")) - (insert-before-markers "<<<<<<< original\n")) - -(defun gptel--rewrite-merge (&optional ovs) - "Insert pending LLM responses in OVS as merge conflicts." - (interactive (list (gptel--rewrite-overlay-at))) - (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) - ((buffer-live-p ov-buf))) - (with-current-buffer ov-buf - (let ((changed)) - (dolist (ov (ensure-list ovs)) - (save-excursion - (when-let* ((new-str (overlay-get ov 'gptel-rewrite))) - (if (executable-find "git") ;Replace overlay content with merge result - (gptel--rewrite-merge-git (overlay-start ov) (overlay-end ov) new-str) - (gptel--rewrite-merge-simple (overlay-start ov) (overlay-end ov) new-str)) - (setq changed t)))) - (when changed (smerge-mode 1))) - (gptel--rewrite-reject ovs)))) - -(defun gptel--rewrite-dispatch (&optional ov ci) - "Dispatch actions for gptel rewrites. - -OV is the rewrite overlay, CI is true for interactive calls." - (interactive (list (gptel--rewrite-overlay-at) t)) - (let ((choice)) - (unwind-protect - (pcase-let ((choices '((?a "accept") (?k "reject") (?r "iterate") - (?m "merge") (?d "diff") (?e "ediff"))) - (hint-str (concat "[" (gptel--model-name gptel-model) "]\n"))) - (overlay-put - ov 'before-string - (concat - (unless (eq (char-before (overlay-start ov)) ?\n) "\n") - (propertize "REWRITE READY: " 'face 'success) - (when (fboundp #'rmc--add-key-description) ; introduced in Emacs 29 - (mapconcat (lambda (e) (cdr e)) (mapcar #'rmc--add-key-description choices) ", ")) - (propertize - " " 'display `(space :align-to (- right ,(1+ (length hint-str))))) - (propertize hint-str 'face 'success))) - (setq choice (read-multiple-choice "Action: " choices))) - (overlay-put ov 'before-string nil)) - (if ci - (call-interactively (intern (concat "gptel--rewrite-" (cadr choice)))) - (funcall (intern (concat "gptel--rewrite-" (cadr choice))) ov)))) - -(defun gptel--rewrite-callback (response info) - "Callback for gptel rewrite actions. - -Show the rewrite result in an overlay over the original text, and -set up dispatch actions. - -RESPONSE is the response received. It may also be t (to indicate -success) nil (to indicate failure), or the symbol `abort'. - -INFO is the async communication channel for the rewrite request." - (when-let* ((ov-and-buf (plist-get info :context)) - (ov (car ov-and-buf)) - (proc-buf (cdr ov-and-buf)) - (buf (overlay-buffer ov))) - (cond - ((stringp response) ;partial or fully successful result - (with-current-buffer proc-buf ;auxiliary buffer, insert text here and copy to overlay - (let ((inhibit-modification-hooks nil) - (inhibit-read-only t)) - (when (= (buffer-size) 0) - (buffer-disable-undo) - (overlay-put ov 'gptel-rewrite nil) - (insert-buffer-substring buf (overlay-start ov) (overlay-end ov)) - (when (eq (char-before (point-max)) ?\n) - (plist-put info :newline t)) - (setq major-mode (buffer-local-value 'major-mode buf)) ;Don't turn on major-mode (#730, #722) - (add-text-properties (point-min) (point-max) '(face shadow font-lock-face shadow)) - (goto-char (point-min))) - (insert response) - (unless (eobp) (ignore-errors (delete-char (length response)))) - (font-lock-ensure) - (overlay-put ov 'display (buffer-string)))) - (unless (plist-get info :stream) (gptel--rewrite-callback t info))) - - ((eq response 'abort) ;request aborted - (when-let* ((proc-buf (cdr-safe (plist-get info :context)))) - (kill-buffer proc-buf)) - (delete-overlay ov)) - - ((eq (car-safe response) 'tool-call) ;tool call confirmation - (gptel--display-tool-calls ;use minibuffer if buffer is read-only - (cdr response) info (buffer-local-value 'buffer-read-only buf))) - - ((null response) ;finished with error - (message (concat "LLM response error: %s. Rewrite in buffer %s canceled.") - (plist-get info :status) (plist-get info :buffer)) - (gptel--rewrite-callback 'abort info)) - - ((consp response)) ;reasoning or tool call result -- don't care - - (t - (if (plist-get info :tool-use) ;stopped to use tools - ;; Clear text inserted so far - (with-current-buffer proc-buf (delete-region (point-min) (point))) - (let ((mkb (propertize "" 'face 'help-key-binding))) ;or finished successfully - (with-current-buffer proc-buf - (let ((inhibit-read-only t)) - (delete-region (point) (point-max)) - ;; Run post-rewrite-functions on rewritten text in its buffer - (setq-local gptel-post-rewrite-functions - (buffer-local-value 'gptel-post-rewrite-functions buf)) - (with-demoted-errors "gptel-post-rewrite-functions: %S" - (run-hook-with-args 'gptel-post-rewrite-functions (point-min) (point-max))) - (when (and (plist-get info :newline) - (not (eq (char-before (point-max)) ?\n))) - (insert "\n")) - (font-lock-ensure)) - (overlay-put ov 'display (buffer-string)) - (overlay-put ov 'gptel-rewrite (buffer-string)) - (kill-buffer proc-buf)) - (when (buffer-live-p buf) - (with-current-buffer buf - (pulse-momentary-highlight-region (overlay-start ov) (overlay-end ov)) - (add-hook 'eldoc-documentation-functions #'gptel--rewrite-key-help nil 'local) - ;; (overlay-put ov 'gptel-rewrite response) - (overlay-put ov 'face 'gptel-rewrite-highlight-face) - (overlay-put ov 'priority 2000) - (overlay-put ov 'keymap gptel-rewrite-actions-map) - (overlay-put ov 'mouse-face 'highlight) - (overlay-put - ov 'help-echo - (format (concat "%s rewrite available: %s or \\[gptel--rewrite-dispatch] for options") - (concat (gptel-backend-name gptel-backend) ":" (gptel--model-name gptel-model)) - mkb)) - (push ov gptel--rewrite-overlays)) - (if-let* ((sym gptel-rewrite-default-action)) - (if-let* ((action (intern (concat "gptel--rewrite-" (symbol-name sym)))) - ((functionp action))) - (funcall action ov) (funcall sym ov)) - (message (concat - "LLM rewrite output" - (unless (eq (current-buffer) buf) - (format " in buffer %s " (buffer-name buf))) - (concat " ready: " mkb ", " (propertize "RET" 'face 'help-key-binding) - " or " (substitute-command-keys "\\[gptel-rewrite] to continue.")))))))))))) - -;; * Transient Prefixes for rewriting - -(transient-define-prefix gptel--rewrite-directive-menu () - "Set the directive (system message) for rewrite actions. - -By default, gptel uses the directive associated with the `rewrite' - key in `gptel-directives'. You can add more rewrite-specific - directives to `gptel-directives' and pick one from here." - [:description gptel-system-prompt--format - [(gptel--suffix-rewrite-directive)] - [(gptel--infix-variable-scope)]] - [:class transient-column - :setup-children - (lambda (_) (transient-parse-suffixes - 'gptel--rewrite-directive-menu - (gptel--setup-directive-menu - 'gptel--rewrite-directive "Rewrite directive"))) - :pad-keys t]) - -;;;###autoload (autoload 'gptel-rewrite "gptel-rewrite" nil t) -(transient-define-prefix gptel-rewrite () - "Rewrite or refactor text region using an LLM." - [:description - (lambda () - (gptel--describe-directive - gptel--rewrite-directive (max (- (window-width) 14) 20) " ")) - ["" - (gptel--preset - :if (lambda () (or (get-char-property (point) 'gptel-rewrite) - (use-region-p))) - :key "@" :format "%d" - :description - (lambda () - (concat (propertize "Instructions" 'face 'transient-heading) - (gptel--format-preset-string)))) - ("s" "Set full directive" gptel--rewrite-directive-menu) - (gptel--infix-rewrite-extra)]] - ;; FIXME: We are requiring `gptel-transient' because of this suffix, perhaps - ;; we can get find some way around that? - [:description "Context for rewrite" - :if use-region-p - (gptel--infix-context-remove-all :key "-d") - (gptel--suffix-context-buffer :key "C" :format " %k %d")] - [[:description "Diff Options" - :if (lambda () gptel--rewrite-overlays) - ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) - ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) - ("-i" "Ignore case" ("-i" "--ignore-case")) - (gptel--infix-rewrite-diff:-U)] - [:description "Accept all" - :if (lambda () gptel--rewrite-overlays) - (gptel--suffix-rewrite-merge) - (gptel--suffix-rewrite-accept) - "Reject all" - (gptel--suffix-rewrite-reject)]] - [[:description "Diff rewrite regions" - :if (lambda () gptel--rewrite-overlays) - (gptel--suffix-rewrite-diff) - (gptel--suffix-rewrite-ediff)]] - [[:description "Rewrite" - :if (lambda () (or (get-char-property (point) 'gptel-rewrite) - (use-region-p))) - (gptel--suffix-rewrite)] - ["Dry Run" - :if (lambda () (and (or gptel-log-level gptel-expert-commands) - (or (get-char-property (point) 'gptel-rewrite) - (use-region-p)))) - ("I" "Inspect query (Lisp)" - (lambda () - "Inspect the query that will be sent as a lisp object." - (interactive) - (gptel--sanitize-model) - (gptel--inspect-query - (gptel--suffix-rewrite gptel--rewrite-message t)))) - ("J" "Inspect query (JSON)" - (lambda () - "Inspect the query that will be sent as a JSON object." - (interactive) - (gptel--sanitize-model) - (gptel--inspect-query - (gptel--suffix-rewrite gptel--rewrite-message t) - 'json)))]] - (interactive) - (gptel--rewrite-sanitize-overlays) - (cond - ((use-region-p) ;Start a/another rewrite - (let ((transient--history ;No transient reader, so We manage history ourselves - (alist-get 'gptel--infix-rewrite-extra transient-history))) - (gptel--rewrite-read-message - (concat "Instructions (" gptel--read-with-prefix-help - (format " %s%s) " - (propertize "M-RET" 'face 'help-key-binding) - (propertize ": More options" 'face 'default))) - nil (cons 'transient--history 1)))) - (gptel--rewrite-overlays ;Rewrite actions pending, show options - (transient-setup 'gptel-rewrite)) - (t (user-error - "`gptel-rewrite' requires an active region or rewrite in progress.")))) - -;; * Transient infixes for rewriting - -(transient-define-infix gptel--infix-rewrite-extra () - "Chat directive (system message) to use for rewriting or refactoring." - :description "Rewrite instruction" - :class 'gptel-lisp-variable - :variable 'gptel--rewrite-message - :set-value #'gptel--set-with-scope - :display-nil "(None)" - :key "d" - :format " %k %d %v" - :prompt (concat "Instructions (" gptel--read-with-prefix-help ") ") - :reader #'gptel--rewrite-read-message) - -(transient-define-argument gptel--infix-rewrite-diff:-U () - :description "Context lines" - :class 'transient-option - :argument "-U" - :reader #'transient-read-number-N0) - -;; * Transient suffixes for rewriting - -(transient-define-suffix gptel--suffix-rewrite-directive (&optional cancel) - "Edit Rewrite directive. - -CANCEL is used to avoid touching dynamic rewrite directives, -generated from functions." - :transient 'transient--do-exit - :description "Edit full rewrite directive" - :key "s" - (interactive - (list (and - (functionp gptel--rewrite-directive) - (not (y-or-n-p - "Rewrite directive is dynamically generated: Edit its current value instead?"))))) - (if cancel (progn (message "Edit canceled") - (call-interactively #'gptel-rewrite)) - (gptel--edit-directive 'gptel--rewrite-directive - :callback (lambda (_) (call-interactively #'gptel-rewrite)) - :setup #'activate-mark))) - -(transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message dry-run) - "Rewrite or refactor region contents." - :key "r" - :description (lambda () (if (get-char-property (point) 'gptel-rewrite) "Iterate" "Rewrite")) - (interactive (list gptel--rewrite-message)) - (let* ((nosystem (gptel--model-capable-p 'nosystem)) - ;; Try to send context with system message - (gptel-use-context - (and gptel-use-context (if nosystem 'user 'system))) - (prompt (list (or (get-char-property (point) 'gptel-rewrite) - (buffer-substring-no-properties (region-beginning) (region-end))) - "What is the required change? I will generate only the final replacement." - (or rewrite-message gptel--rewrite-message)))) - (when nosystem - (setcar prompt (concat (car-safe (gptel--parse-directive - gptel--rewrite-directive 'raw)) - "\n\n" (car prompt)))) - (prog1 (gptel-request prompt - :dry-run dry-run - :system gptel--rewrite-directive - :stream gptel-stream - :context - (let ((ov (or (cdr-safe (get-char-property-and-overlay (point) 'gptel-rewrite)) - (make-overlay (region-beginning) (region-end) nil t)))) - (overlay-put ov 'category 'gptel) - (overlay-put ov 'evaporate t) - ;; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 (#724) - (cons ov (gptel--temp-buffer " *gptel-rewrite*"))) - :transforms gptel-prompt-transform-functions - :fsm (gptel-make-fsm :handlers gptel--rewrite-handlers) - :callback #'gptel--rewrite-callback) - ;; Move back so that the cursor is on the overlay when done. - (unless (get-char-property (point) 'gptel-rewrite) - (when (= (point) (region-end)) (backward-char 1))) - (deactivate-mark)))) - -;; Allow this to be called non-interactively for dry runs -(put 'gptel--suffix-rewrite 'interactive-only nil) - -(transient-define-suffix gptel--suffix-rewrite-diff (&optional switches) - "Diff LLM output against buffer." - :if (lambda () gptel--rewrite-overlays) - :key "D" - :description "Diff LLM rewrites" - (interactive (list (transient-args transient-current-command))) - (gptel--rewrite-diff gptel--rewrite-overlays switches)) - -(transient-define-suffix gptel--suffix-rewrite-ediff () - "Ediff LLM output against buffer." - :if (lambda () gptel--rewrite-overlays) - :key "E" - :description "Ediff LLM rewrites" - (interactive) - (gptel--rewrite-ediff gptel--rewrite-overlays)) - -(transient-define-suffix gptel--suffix-rewrite-merge () - "Insert LLM output as merge conflicts" - :if (lambda () gptel--rewrite-overlays) - :key "M" - :description "Merge with conflicts" - (interactive) - (gptel--rewrite-merge gptel--rewrite-overlays)) - -(transient-define-suffix gptel--suffix-rewrite-accept () - "Accept pending LLM rewrites." - :if (lambda () gptel--rewrite-overlays) - :key "A" - :description "Accept and replace" - (interactive) - (gptel--rewrite-accept gptel--rewrite-overlays)) - -(transient-define-suffix gptel--suffix-rewrite-reject () - "Clear pending LLM rewrites." - :if (lambda () gptel--rewrite-overlays) - :key "K" - :description "Clear pending rewrites" - (interactive) - (gptel--rewrite-reject gptel--rewrite-overlays)) - -(provide 'gptel-rewrite) -;;; gptel-rewrite.el ends here - -;; Local Variables: -;; outline-regexp: "^;; \\*+" -;; End: diff --git a/elpa/gptel-20260123.739/gptel-transient.el b/elpa/gptel-20260123.739/gptel-transient.el deleted file mode 100644 index 881d3478..00000000 --- a/elpa/gptel-20260123.739/gptel-transient.el +++ /dev/null @@ -1,1993 +0,0 @@ -;;; gptel-transient.el --- Transient menu for gptel -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 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: - -;; - -;;; Code: -(require 'cl-lib) -(require 'gptel) -(require 'transient) - -(declare-function ediff-regions-internal "ediff") -(declare-function ediff-make-cloned-buffer "ediff-utils") -(declare-function org-escape-code-in-string "org-src") - - -;; * Helper functions and vars - -(defvar-local gptel--rewrite-overlays nil - "List of active rewrite overlays in the buffer.") - -(defun gptel--rewrite-sanitize-overlays () - "Ensure gptel's rewrite overlays in buffer are consistent." - (setq gptel--rewrite-overlays - (cl-delete-if-not #'overlay-buffer - gptel--rewrite-overlays))) - -(defvar gptel--set-buffer-locally nil - "Set model parameters from `gptel-menu' buffer-locally. - -Affects the system message too.") - -(defun gptel--set-with-scope (sym value &optional scope) - "Set SYM's symbol value to VALUE with SCOPE. - -If SCOPE is t, set it buffer-locally. -If SCOPE is 1, reset it after the next gptel request. (oneshot) -Otherwise, clear any buffer-local value and set its default -global value." - (pcase scope - (1 (put sym 'gptel-history (symbol-value sym)) - (set sym value) - (letrec ((restore-value - (lambda () - (remove-hook 'gptel-post-request-hook restore-value) - (run-at-time ; Required to work around let bindings - 0 nil (lambda (s) ; otherwise this change is overwritten! - (set s (get s 'gptel-history)) - (put s 'gptel-history nil)) - sym)))) - (add-hook 'gptel-post-request-hook restore-value))) - ('t (set (make-local-variable sym) value)) - (_ (kill-local-variable sym) - (set sym value)))) - -(defvar gptel--preset nil - "Name of last applied gptel preset. - -For internal use only.") - -(defun gptel--preset-mismatch-p (name) - "Check if gptel preset with NAME is in effect." - (let ((elm (or (gptel-get-preset name) - (gptel-get-preset (intern-soft name)))) - key val) - (catch 'mismatch - (while elm - (setq key (pop elm) val (pop elm)) - (cond - ((memq key '(:description :parents)) 'nil) - ((eq key :system) - (or (equal gptel--system-message val) - (functionp val) ; Ignore functions, modify-specs for speed here - (and (consp val) (keywordp (car val))) - (and-let* (((symbolp val)) - (p (assq val gptel-directives))) - (equal gptel--system-message (cdr p))) - (throw 'mismatch t))) - ((eq key :backend) - (or (if (stringp val) - (equal (gptel-backend-name gptel-backend) val) - (eq gptel-backend val)) - (throw 'mismatch t))) - ((eq key :tools) - (setq val (cl-loop ; Check against tool names, not tools (faster with sorting) - for tool in (ensure-list (gptel--modify-value gptel-tools val)) - for tool-name = (or (and (stringp tool) tool) - (ignore-errors (gptel-tool-name tool))) - if (not (member tool-name uniq-tool-names)) - collect tool-name into uniq-tool-names - finally return uniq-tool-names)) - (or (equal (sort val #'string-lessp) ;preset tools same as gptel-tools? - (sort (mapcar #'gptel-tool-name gptel-tools) - #'string-lessp)) - (throw 'mismatch t))) - (t (let* ((suffix (substring - (if (symbolp key) (symbol-name key) key) 1)) - (sym (or (intern-soft (concat "gptel-" suffix)) - (intern-soft (concat "gptel--" suffix))))) - ;; FIXME(modify-list): Fix for values specified with a spec, like :eval - (or (null sym) - (and (boundp sym) (equal (eval sym) val)) - (throw 'mismatch t))))))))) - -(defun gptel--get-directive (args) - "Find the additional directive in the transient ARGS. - -Meant to be called when `gptel-menu' is active." - (cl-some (lambda (s) (and (stringp s) (string-prefix-p ":" s) - (substring s 1))) - args)) - -(defun gptel--instructions-make-overlay (text &optional ov) - "Make or move overlay OV with TEXT." - (save-excursion - ;; Move point to overlay position - (cond - ((use-region-p) - (if (pos-visible-in-window-p (region-beginning)) - (goto-char (region-beginning)))) - ((gptel--in-response-p) - (gptel-beginning-of-response) - (skip-chars-forward "\n \t")) - (t (text-property-search-backward 'gptel 'response) - (skip-chars-forward "\n \t"))) - ;; Make overlay - (if (and ov (overlayp ov)) - (move-overlay ov (point) (point) (current-buffer)) - (setq ov (make-overlay (point) (point) nil t))) - (overlay-put ov 'before-string nil) - ;; (unless (or (bobp) (eq (char-before) "\n")) - ;; (overlay-put ov 'before-string (propertize "\n" 'font-lock-face 'shadow))) - (overlay-put ov 'category 'gptel) - (overlay-put - ov 'after-string - (concat (propertize (concat "DIRECTIVE: " text) - 'font-lock-face '(:inherit shadow :weight bold :box t)) - "\n")) - ov)) - -(defconst gptel--read-with-prefix-help - (concat - (propertize "TAB" 'face 'help-key-binding) - (propertize ": expand, " 'face 'default) - (propertize "M-n" 'face 'help-key-binding) - (propertize "/" 'face 'default) - (propertize "M-p" 'face 'help-key-binding) - (propertize ": next/previous" 'face 'default)) - "Help string (TODO).") - -(defun gptel--read-with-prefix (prefix) - "Show string PREFIX in the minibuffer after the minibuffer prompt. - -PREFIX is shown in an overlay. Repeated calls to this function -will toggle its visibility state." - (unless (minibufferp) - (user-error "This command is intended to be used in the minibuffer")) - (let* ((update - (lambda (ov s) - (overlay-put - ov 'after-string - (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow) - (make-separator-line)))))) - (max-width (- (window-width) (minibuffer-prompt-end))) - (max (or max-mini-window-height 0.4)) - (max-height (- (or (and (natnump max) max) - (floor (* max (frame-height)))) - 5))) - (if (and prefix (not (string-empty-p prefix)) (> max-height 1)) - (progn - (unless visual-line-mode (visual-line-mode 1)) - (goto-char (minibuffer-prompt-end)) - (pcase-let ((`(,prop . ,ov) - (get-char-property-and-overlay - (point-min) 'gptel))) - (unless ov - (setq ov (make-overlay - (point-min) (minibuffer-prompt-end) nil t))) - (pcase prop - ('partial - (if (> (length prefix) max-width) - (progn - (overlay-put ov 'gptel 'prefix) - (let ((disp-size - (cl-loop for char across prefix - for idx upfrom 0 - with n = 0 with max-length = (* max-height max-width) - if (eq char ?\n) do (cl-incf n) - if (> n max-height) return idx - if (> idx max-length) - return idx - finally return nil))) - (funcall update ov - (if disp-size - (truncate-string-to-width - prefix disp-size nil nil 'ellipsis) - prefix)))) - (overlay-put ov 'gptel 'hide) - (funcall update ov nil))) - ('prefix (overlay-put ov 'gptel 'hide) - (funcall update ov nil)) - (_ (overlay-put ov 'gptel 'partial) - (funcall update ov (truncate-string-to-width - prefix max-width nil nil - 'ellipsis)))))) - (when-let* ((prop-ov (get-char-property-and-overlay (point-min) 'gptel))) - (when (overlayp (cdr prop-ov)) (delete-overlay (cdr prop-ov))))))) - -(defvar gptel--minibuffer-prompt-history nil - "History of prompts read from the minibuffer by gptel.") - -(defun gptel--read-minibuffer-prompt (&optional read-prompt) - "Read a user prompt from the minibuffer. - -Prompt with READ-PROMPT if supplied. Return a cons cell of the buffer -region (if included) and the provided instructions." - (let* ((include-region (use-region-p)) - (cb (current-buffer)) - (get-region (lambda () (with-current-buffer cb - (and include-region - (buffer-substring-no-properties - (region-beginning) (region-end)))))) - (cycle-prefix (lambda () (interactive) - (let ((p (point))) - (gptel--read-with-prefix (funcall get-region)) - (goto-char p)))) - (toggle-region (lambda () (interactive) - (if include-region - (progn (setq include-region nil) - (gptel--read-with-prefix nil)) - (setq include-region t) - (funcall cycle-prefix)))) - (edit-in-buffer - (lambda () (interactive) - (gptel--edit-directive nil - :initial (minibuffer-contents) - :prompt (if include-region - (with-current-buffer cb (buffer-substring-no-properties - (region-beginning) (region-end))) - "# Edit prompt below") - :setup (lambda () (goto-char (point-max)) (run-at-time 0 nil #'recenter)) - :callback (lambda (msg) - (if (not msg) - (minibuffer-quit-recursive-edit) - (delete-region (minibuffer-prompt-end) (point-max)) - (insert msg) (exit-minibuffer)))))) - (minibuffer-local-map - (make-composed-keymap (define-keymap - "M-RET" toggle-region "C-c C-e" edit-in-buffer) - minibuffer-local-map))) - (let ((user-prompt - (minibuffer-with-setup-hook - (lambda () (add-hook 'completion-at-point-functions - #'gptel-preset-capf nil t) - (funcall cycle-prefix) - ;; HACK for lucid Emacs, where `make-separator-line' is wonky. The - ;; minibuffer prompt gets cut off -- force redisplay to fix: - (insert " ") (redisplay) (delete-char -1)) - (read-string - (or read-prompt - (concat (format "Ask %s" (gptel-backend-name gptel-backend)) - (if (use-region-p) ;NOTE: not "include-region" as this is only read once - (concat " (" (propertize "M-RET" 'face 'help-key-binding) - (propertize ": Include/Ignore selection" 'face 'default) - "): ") - ": "))) - nil 'gptel--minibuffer-prompt-history)))) - (cons (funcall get-region) user-prompt)))) - -(defun gptel--transient-read-number (prompt _initial-input history) - "Read a numeric value from the minibuffer. - -PROMPT, _INITIAL-INPUT and HISTORY are as in the transient reader -documention. Return nil if user does not provide a number, for default." - ;; Workaround for buggy transient behaviour when dealing with - ;; non-string values. See: https://github.com/magit/transient/issues/172 - (when-let* ((val (symbol-value history))) - (when (not (stringp (car val))) - (setcar val (number-to-string (car val))))) - (let* ((minibuffer-default-prompt-format "") - (num (read-number prompt -1 history))) - (if (= num -1) nil num))) - -(defun gptel-system-prompt--format (&optional message) - "Format the system MESSAGE for display in gptel's transient menus. - -Handle formatting for system messages when the active -`gptel-model' does not support system messages." - (setq message (or message gptel--system-message)) - (if (gptel--model-capable-p 'nosystem) - (concat (propertize "[No system message support for model " - 'face 'transient-heading) - (propertize (gptel--model-name gptel-model) - 'face 'warning) - (propertize "]" 'face 'transient-heading)) - (if message - (gptel--describe-directive - message (max (- (window-width) 12) 14) "⮐ ") - "[No system message set]"))) - -(defun gptel--tools-init-value (obj) - "Set the initial state of a tool OBJ in variable `gptel-tools'. - -OBJ is a tool-infix of type `gptel--switch'." - (when-let* ((name (car (member (oref obj argument) - (mapcar #'cadr - (plist-get (transient-scope) :tools)))))) - (oset obj value (list (oref obj category) name)))) - -(defvar gptel--crowdsourced-prompts-url - "https://raw.githubusercontent.com/f/awesome-chatgpt-prompts/main/prompts.csv" - "URL for crowdsourced LLM system prompts.") - -(defvar gptel--crowdsourced-prompts - (make-hash-table :test #'equal) - "Crowdsourced LLM system prompts.") - -(defun gptel--read-csv-column () - "Read next CSV column in the current buffer. - -Supports both quoted and non-quoted columns (RFC 4180)." - (let ((start (point))) - (unless (eolp) - (let ((column - (if (eq (char-after) ?\") - (when (re-search-forward "\",\\|\"$" nil t) - (let ((end (match-beginning 0))) - (buffer-substring-no-properties (+ start 1) (if (eolp) (- end 1) end)))) - (when (search-forward "," (line-end-position) t) - (let ((end (match-beginning 0))) - (buffer-substring-no-properties start end)))))) - (string-replace "\"\"" "\"" column))))) - -(defun gptel--crowdsourced-prompts () - "Acquire and read crowdsourced LLM system prompts. - -These are stored in the variable `gptel--crowdsourced-prompts', -which see." - (when (hash-table-p gptel--crowdsourced-prompts) - (when (hash-table-empty-p gptel--crowdsourced-prompts) - (unless gptel-crowdsourced-prompts-file - (run-at-time 0 nil #'gptel-system-prompt) - (user-error "No crowdsourced prompts available")) - (unless (and (file-exists-p gptel-crowdsourced-prompts-file) - (time-less-p - (time-subtract (current-time) (days-to-time 14)) - (file-attribute-modification-time - (file-attributes gptel-crowdsourced-prompts-file)))) - (when (y-or-n-p - (concat - "Fetch crowdsourced system prompts from " - (propertize "https://github.com/f/awesome-chatgpt-prompts" 'face 'link) - "?")) - ;; Fetch file - (message "Fetching prompts...") - (let ((dir (file-name-directory gptel-crowdsourced-prompts-file))) - (unless (file-exists-p dir) (mkdir dir 'create-parents)) - (if (url-copy-file gptel--crowdsourced-prompts-url - gptel-crowdsourced-prompts-file - 'ok-if-already-exists) - (message "Fetching prompts... done.") - (message "Could not retrieve new prompts."))))) - (if (not (file-readable-p gptel-crowdsourced-prompts-file)) - (progn (message "No crowdsourced prompts available") - (call-interactively #'gptel-system-prompt)) - (with-temp-buffer - (insert-file-contents gptel-crowdsourced-prompts-file) - (goto-char (point-min)) - (forward-line 1) - (while (not (eobp)) - (when-let* ((act (gptel--read-csv-column)) - (prompt (gptel--read-csv-column))) - (puthash act prompt gptel--crowdsourced-prompts)) - (forward-line 1))))) - gptel--crowdsourced-prompts)) - -;; FIXME(targeted-context): This does not handle :bounds and :lines. -(defun gptel--describe-infix-context () - "Return a count of the number of context chunks." - (if (null gptel-context) "Context" - (pcase-let* - ((buffer-count (length gptel-context)) - (`(,file-count ,ov-count) - (if (> buffer-count 0) - (cl-loop for entry in gptel-context - for (buf-file . spec) = (ensure-list entry) - if (bufferp buf-file) - sum (max (length (plist-get spec :overlays)) 1) - into ov-count - else count (stringp buf-file) into file-count - finally return (list file-count ov-count)) - (list 0 0)))) - (concat "Context (" - (propertize - (concat - (and (> ov-count 0) - (format "%d region%s in %d buffer%s" - ov-count (if (> ov-count 1) "s" "") - (- buffer-count file-count) - (if (> ( - buffer-count file-count) 1) "s" ""))) - (and (> file-count 0) - (format "%s%d file%s" - (if (> ov-count 0) ", " "") file-count - (if (> file-count 1) "s" "")))) - 'face 'warning) - ")")))) - -(defun gptel--describe-suffix-send () - "Describe the action of `gptel--suffix-send'." - (cl-flet ((ptv (s) (propertize s 'face 'warning)) - (pth (s) (propertize s 'face 'transient-heading))) - (let* ((args (or (and transient-current-command - (transient-args transient-current-command)) - ;; Not yet exported, simulate. HACK: We are accessing - ;; Transient's internal variables here for live updates. - (let* ((transient-current-command (oref transient--prefix command)) - (transient-current-suffixes transient--suffixes)) - (transient-args transient-current-command)))) - (lbeg (line-number-at-pos (if (use-region-p) (region-beginning) - (point-min)))) - (lend (line-number-at-pos (if (use-region-p) (region-end) - (point)))) - (ltext (ptv (if (> lend lbeg) - (format " (lines %d-%d)" lbeg lend) - (format " (line %d)" lbeg)))) - (dest) (context)) - (setq dest (cond - ((member "e" args) (ptv "echo area")) - ((member "k" args) (ptv "kill-ring")) - ((cl-some (lambda (s) - (and (stringp s) (memq (aref s 0) '(?g ?b)) - (not (equal (substring s 1) (buffer-name))) - (concat (pth "buffer ") (ptv (substring s 1))))) - args)))) - (setq context - (and gptel-context - (let ((lc (length gptel-context))) - (concat (pth " along with ") (ptv (format "%d" lc)) - (pth (concat " context source" (and (/= lc 1) "s"))))))) - (cond ((member "m" args) - (concat (pth "Read prompt from ") (ptv "minibuffer") - context - (if dest (concat (pth ", response to ") dest) - (concat (pth ", insert response at point"))))) - ((member "y" args) - (concat (pth "Send prompt from ") - (concat (ptv "kill-ring (") - (if-let* ((val (current-kill 0)) - (val (substring-no-properties val)) - (len (length val))) - (ptv (concat - "\"" (string-replace - "\n" "⮐" - (truncate-string-to-width - val 20 nil nil t)) - "\"" (when (> len 20) - (concat - ", " - (file-size-human-readable len 'si " ") - " chars")))) - (propertize "empty" 'face 'error)) - (ptv ")")) - context - (if dest (concat (pth ", response to ") dest) - (concat (pth ", insert response at point"))))) - ((member "i" args) - (let* ((reg (use-region-p)) - (src (ptv (if reg "selection" (buffer-name))))) - (if dest (concat (pth "Send ") src ltext context (pth ", with response to ") - (ptv dest) (pth "; kill") ltext - (and (not reg) (concat (pth " in ") src))) - (concat (pth "Replace ") src ltext (pth " with response") - (and context - (concat (pth " ( with") (substring context 11) " )")))))) - ((use-region-p) - (concat (pth "Send ") (ptv "selection") ltext - context (if dest (concat (pth ", with response to ") dest) - (concat (pth ", insert response at region end"))))) - (t (concat (pth "Send ") (ptv (buffer-name)) ltext - context (if dest (concat (pth ", with response to ") dest) - (concat (pth ", insert response at point"))))))))) - -(defun gptel--format-preset-string () - "Format the preset indicator display for `gptel-menu'." - (if (and gptel--known-presets gptel--preset) - (apply - #'format " (%s%s)" - (let ((mismatch (gptel--preset-mismatch-p gptel--preset))) - (list (propertize "@" 'face (if mismatch 'transient-key - '( :inherit transient-key - :inherit secondary-selection - :box -1 :weight bold))) - (propertize (format "%s" gptel--preset) 'face - (if mismatch - '(:inherit warning :strike-through t) - '(:inherit secondary-selection :box -1)))))) - (format " (%s%s)" - (propertize "@" 'face 'transient-key) - (propertize "preset" 'face 'transient-inactive-value)))) - -;; TODO(preset): Unify this with `gptel--apply-preset'? -(defun gptel--read-apply-preset (name) - "Read gptel preset NAME and apply it." - (interactive - (list - (let ((completion-extra-properties - `(:annotation-function - ,(lambda (comp) - (and-let* ((desc - (plist-get (gptel-get-preset (intern-soft comp)) - :description))) - (concat (propertize " " 'display '(space :align-to 32)) - (if (string-match "\\(\n\\)" desc) - (substring desc 0 (match-beginning 1)) - desc))))))) - (intern - (completing-read (format "Apply preset (%s): " - (pcase gptel--set-buffer-locally - (1 "for next request only") - ('t "buffer-locally") - (_ "globally"))) - gptel--known-presets nil t))))) - (gptel--set-with-scope 'gptel--preset name gptel--set-buffer-locally) - (gptel--apply-preset - name (lambda (sym val) - (gptel--set-with-scope sym val gptel--set-buffer-locally))) - (message "Applied gptel preset %s" - (propertize (symbol-name name) 'face 'transient-value)) - (when transient--stack (run-at-time 0 nil #'transient-setup))) - - -;; * Transient classes and methods for gptel - -;; ** Class for generic gptel elisp variables - -(defclass gptel-lisp-variable (transient-lisp-variable) - ((display-nil :initarg :display-nil) ;String to display if value if nil - (display-map :initarg :display-map :initform nil)) ;Display string from alist display-map - "Lisp variables that show :display-nil instead of nil.") - -(cl-defmethod transient-format-value ((obj gptel-lisp-variable)) - (let ((display-value - (with-slots (value display-nil display-map) obj - (cond ((null value) display-nil) - (display-map (or (cdr (assoc value display-map)) value)) - (t value))))) - (propertize - (if (stringp display-value) display-value (prin1-to-string display-value)) - 'face 'transient-value))) - -(cl-defmethod transient-infix-set ((obj gptel-lisp-variable) value) - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value value) - gptel--set-buffer-locally)) - -;; ** Class for managing gptel tools - -(defclass gptel--switch (transient-switch) - ((category :initarg :category)) - "Class used for arguments that share a category.") - -(cl-defmethod transient-infix-set ((obj gptel--switch) value) - "Set VALUE of a `gptel--switch' OBJ. - -It is a list of the category and argument, e.g. - (\"filesystem\" \"read_file\")." - (let ((state (transient-scope)) - (category (oref obj category))) - (if value - (progn - (cl-pushnew (list category value) - (plist-get state :tools) :test #'equal) - (oset obj value (list category value))) - (plist-put state :tools - (delete (list category (oref obj argument)) - (plist-get state :tools))) - (oset obj value nil)) - (oset transient--prefix scope state))) - -;; ** Class for managing gptel tool categories - -(defclass gptel--switch-category (transient-switch) - ((category :initarg :category)) - "Class used for arguments that switch a group of other arguments. - -Their own value is ignored") - -(cl-defmethod transient-format-value ((obj gptel--switch-category)) - (let* ((category (oref obj category)) - (active-count - (cl-count-if (lambda (tl) (equal (car tl) category)) - (plist-get (transient-scope) :tools))) - (total-count (length (cdr (assoc category gptel--known-tools))))) - (if (> active-count 0) - (propertize (format "(%d/%d)" active-count total-count) 'face 'transient-value) - (propertize (format "(0/%d)" total-count) 'face 'transient-inactive-value)))) - -;; Pressing a tool category key should have different behaviors in different -;; contexts: -;; - If the tools for the category are not shown, show them, do nothing else -;; - If the tools are showing and any of them are selected, deselect all -;; - If the tools are showing and none of them are selected, select all - -;; To do this we independently track whether the category tools are visible -;; ("active"), and whether any category tools have been "selected": -(cl-defmethod transient-infix-read ((obj gptel--switch-category)) - "Determine OBJ value according to category toggle settings." - (let* ((category (oref obj category)) - (active (equal category (plist-get (transient-scope) :category))) - (selected (cl-some (lambda (tool-spec) (equal category (car tool-spec))) - (plist-get (transient-scope) :tools)))) - (if (not active) - (oref obj value) - (if selected nil (oref obj argument))))) - -(cl-defmethod transient-infix-set ((obj gptel--switch-category) value) - "When setting VALUE, set all options in the category of OBJ." - (dolist (suffix-obj transient--suffixes) - ;; Find all suffixes that have this category - (when-let* (((cl-typep suffix-obj 'gptel--switch)) - ((equal (oref suffix-obj category) - (oref obj category))) - (arg (if (slot-boundp suffix-obj 'argument) - (oref suffix-obj argument) - (oref obj argument-format)))) - (if value ; Turn on/off all members in category - (transient-infix-set suffix-obj arg) - (transient-infix-set suffix-obj nil)))) - ;; Update the active menu category and key in the prefix scope - (plist-put (transient-scope) :category (oref obj category)) - (plist-put (transient-scope) :key (oref obj key)) - ;; Finally set the "value" of the category itself - (oset obj value value)) - -;; ** Class for gptel options that are three-way switches - -(defclass gptel--switches (gptel-lisp-variable) - ((display-if-true :initarg :display-if-true :initform "True") - (display-if-false :initarg :display-if-false :initform "False")) - "Boolean Lisp variable class for gptel-transient.") - -(cl-defmethod transient-infix-read ((obj gptel--switches)) - "Cycle through the mutually exclusive switches for OBJ." - (not (oref obj value))) - -(cl-defmethod transient-format-value ((obj gptel--switches)) - (with-slots (value display-if-true display-if-false) obj - (format - (propertize "(%s)" 'face 'transient-delimiter) - (concat - (propertize display-if-false - 'face (if value 'transient-inactive-value 'transient-value)) - (propertize "|" 'face 'transient-delimiter) - (propertize display-if-true - 'face (if value 'transient-value 'transient-inactive-value)))))) - -;; ** Class for gptel's scope management, singleton - -(defclass gptel--scope (gptel--switches) - ((display-if-true :initarg :display-if-true :initform "buffer") - (display-if-false :initarg :display-if-false :initform "global")) - "Singleton Lisp variable class for `gptel--set-buffer-locally'. - -This is used only for setting this variable via `gptel-menu'.") - -(cl-defmethod transient-infix-read ((obj gptel--scope)) - "Cycle through the mutually exclusive switches for OBJ." - (with-slots (value) obj - (pcase value - ('t (message "Parameters will be set for the next request only")) - ('nil (message "Parameters will be set buffer-locally")) - (1 (message "Parameters will be set globally"))) - (pcase value ('t 1) ('nil t) (1 nil)))) - -(cl-defmethod transient-format-value ((obj gptel--scope)) - (with-slots (value display-if-true display-if-false) obj - (format - (propertize "(%s)" 'face 'transient-delimiter) - (concat - (propertize display-if-false - 'face (if (null value) 'transient-value 'transient-inactive-value)) - (propertize "|" 'face 'transient-delimiter) - (propertize display-if-true - 'face (if (eq value t) 'transient-value 'transient-inactive-value)) - (propertize "|" 'face 'transient-delimiter) - (propertize "oneshot" 'face - (if (eql value 1) 'transient-value 'transient-inactive-value)))))) - -(cl-defmethod transient-infix-set ((obj gptel--scope) value) - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value value))) - -;; ** Class for managing gptel's backend and model, singleton - -(defclass gptel-provider-variable (transient-lisp-variable) - ((backend :initarg :backend) - (backend-value :initarg :backend-value) - (always-read :initform t) - (set-value :initarg :set-value :initform #'set)) - "Class used for gptel-backends.") - -(cl-defmethod transient-format-value ((obj gptel-provider-variable)) - (propertize (concat - (gptel-backend-name - (buffer-local-value (oref obj backend) transient--original-buffer)) ":" - (gptel--model-name (oref obj value))) - 'face 'transient-value)) - -(cl-defmethod transient-infix-set ((obj gptel-provider-variable) value) - (pcase-let ((`(,backend-value ,model-value) value)) - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value model-value) - gptel--set-buffer-locally) - (funcall (oref obj set-value) - (oref obj backend) - (oset obj backend-value backend-value) - gptel--set-buffer-locally)) - (transient-setup)) - -;; ** Class for infix options with in-buffer overlay display - -(defclass gptel-option-overlaid (transient-option) - ((display-nil :initarg :display-nil) - (overlay :initarg :overlay)) - "Transient options for overlays displayed in the working buffer.") - -(cl-defmethod transient-format-value ((obj gptel-option-overlaid)) - "Set up the in-buffer overlay for additional directive, a string. - -Also format the value of OBJ in the transient menu." - (let ((value (oref obj value)) - (ov (oref obj overlay)) - (argument (oref obj argument))) - ;; Making an overlay - (if (or (not value) (string-empty-p value)) - (when ov (delete-overlay ov)) - (with-current-buffer transient--original-buffer - (oset obj overlay (gptel--instructions-make-overlay value ov))) - (letrec ((ov-clear-hook - (lambda () (when-let* ((ov (oref obj overlay)) - ((overlayp ov))) - (remove-hook 'transient-exit-hook - ov-clear-hook) - (delete-overlay ov))))) - (add-hook 'transient-exit-hook ov-clear-hook))) - ;; Updating transient menu display - (if value - (propertize (concat argument (truncate-string-to-width value 35 nil nil t)) - 'face 'transient-value) - (propertize - (concat "(" (symbol-name (oref obj display-nil)) ")") - 'face 'transient-inactive-value)))) - - -;; * Transient Prefixes - -;;;###autoload (autoload 'gptel-menu "gptel-transient" nil t) -(transient-define-prefix gptel-menu () - "Change parameters of prompt to send to the LLM." - :incompatible '(("m" "y" "i") ("e" "g" "b" "k")) - ;; :value (list (concat "b" (buffer-name))) - [:description gptel-system-prompt--format - ["" - :if (lambda () (not (gptel--model-capable-p 'nosystem))) - "Instructions" - ("s" "Set system message" gptel-system-prompt :transient t) - (gptel--infix-add-directive)] - [:pad-keys t "" - (:info #'gptel--describe-infix-context - :face transient-heading :format "%d") - (gptel--infix-context-add-current-kill) - (gptel--infix-context-add-region) - (gptel--infix-context-add-buffer) - (gptel--infix-context-add-file) - (gptel--infix-context-remove-all) - (gptel--suffix-context-buffer)] - [:pad-keys t - :if (lambda () (and gptel-use-tools - (or gptel--known-tools (featurep 'gptel-integrations)))) - "" (:info - (lambda () - (concat - "Tools" (and gptel-tools - (concat " (" (propertize (format "%d selected" - (length gptel-tools)) - 'face 'warning) - ")")))) - :format "%d" :face transient-heading) - ("t" "Select tools" gptel-tools :transient t) - ("T" "Continue tool calls" - (lambda () (interactive) (gptel--handle-tool-use gptel--fsm-last)) - :if (lambda () (and gptel--fsm-last - (eq (gptel-fsm-state gptel--fsm-last) 'TOOL))))]] - [[(gptel--preset - :key "@" :format "%d" - :description - (lambda () - (concat (propertize "Request Parameters" 'face 'transient-heading) - (gptel--format-preset-string)))) - (gptel--infix-variable-scope) - (gptel--infix-provider) - (gptel--infix-max-tokens) - (gptel--infix-num-messages-to-send - :if (lambda () (and gptel-expert-commands - (or gptel-mode gptel-track-response)))) - (gptel--infix-temperature :if (lambda () gptel-expert-commands)) - (gptel--infix-use-context) - (gptel--infix-include-reasoning) - (gptel--infix-use-tools) - (gptel--infix-track-response - :if (lambda () (and gptel-expert-commands (not gptel-mode)))) - (gptel--infix-track-media :if (lambda () gptel-mode))] - [" Response to" - ("e" "Echo area" "e") - ("b" "Other buffer" "b" - :class transient-option - :prompt "Output to buffer: " - :reader (lambda (prompt _ _history) - (read-buffer prompt (buffer-name (other-buffer)) nil))) - ("g" "gptel session" "g" - :class transient-option - :prompt "Existing or new gptel session: " - :reader - (lambda (prompt _ _history) - (read-buffer - prompt (generate-new-buffer-name - (concat "*" (gptel-backend-name gptel-backend) "*")) - nil (lambda (buf-name) - (if (consp buf-name) (setq buf-name (car buf-name))) - (let ((buf (get-buffer buf-name))) - (and (buffer-local-value 'gptel-mode buf) - (not (eq (current-buffer) buf)))))))) - ("k" "Kill-ring" "k")]] - [[:description (lambda () (concat (and gptel--rewrite-overlays "Continue ") - "Rewrite")) - :if (lambda () (or (use-region-p) - (and gptel--rewrite-overlays - (gptel--rewrite-sanitize-overlays)))) - ("r" - (lambda () (if (get-char-property (point) 'gptel-rewrite) - "Iterate" "Rewrite")) - gptel-rewrite)] - ["Tweak Response" :if gptel--in-response-p :pad-keys t - ("SPC" "Mark" gptel--mark-response) - ("M-RET" "Regenerate" gptel--regenerate :if gptel--in-response-p) - ("P" "Previous variant" gptel--previous-variant - :if gptel--at-response-history-p - :transient t) - ("N" "Next variant" gptel--previous-variant - :if gptel--at-response-history-p - :transient t) - ("E" "Ediff previous" gptel--ediff - :if gptel--at-response-history-p)] - ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands)) - ("I" "Inspect query (Lisp)" - (lambda () - "Inspect the query that will be sent as a lisp object." - (interactive) - (gptel--sanitize-model) - (gptel--inspect-query - (gptel--suffix-send - (cons "I" (transient-args transient-current-command)))))) - ("J" "Inspect query (JSON)" - (lambda () - "Inspect the query that will be sent as a JSON object." - (interactive) - (gptel--sanitize-model) - (gptel--inspect-query - (gptel--suffix-send - (cons "I" (transient-args transient-current-command))) - 'json)))] - ["Logging" - :if (lambda () (or gptel-log-level gptel-expert-commands)) - ("-l" "Log level" "-l" - :class gptel-lisp-variable - :variable gptel-log-level - :set-value gptel--set-with-scope - :display-nil "Off" - :prompt "Log level: " - :reader - (lambda (prompt _ _) - "Manage gptel's logging." - (let ((state (completing-read - prompt '("off" "info" "debug") nil t))) - (message "Log level set to %s" state) - (if (string= state "off") nil (intern state))))) - ("L" "Inspect Log" - (lambda () (interactive) - (pop-to-buffer (get-buffer-create gptel--log-buffer-name))) - :format " %k %d")]] - [(gptel--suffix-send)] - (interactive) - (gptel--sanitize-model) - (when gptel-context ;MAYBE: Move this to a dedicated sanitize function? - (setq gptel-context - (cl-delete-if - (lambda (entry) - (let ((first (or (car-safe entry) entry))) - (and (bufferp first) (not (buffer-live-p first))))) - gptel-context))) - (transient-setup 'gptel-menu)) - -;; ** Prefix for setting the system prompt. - -(defun gptel--setup-directive-menu (sym msg &optional external) - "Return a list of infix definitions for setting gptel directives. - -SYM is the symbol whose value is set to the selected directive.. -MSG is the meaning of symbol, used when messaging. -If EXTERNAL is non-nil, include external sources of directives." - (cl-loop for (type . prompt) in gptel-directives - ;; Avoid clashes with the custom directive key - with unused-keys = (delete ?s (nconc (number-sequence ?a ?z) - (number-sequence ?0 ?9))) - with width = (window-width) - for name = (symbol-name type) - for key = (seq-find (lambda (k) (member k unused-keys)) name (seq-first unused-keys)) - do (setq unused-keys (delete key unused-keys)) - ;; The explicit declaration ":transient transient--do-return" here - ;; appears to be required for Transient v0.5 and up. Without it, these - ;; are treated as suffixes when invoking `gptel-system-prompt' directly, - ;; and infixes when going through `gptel-menu'. - ;; TODO: Raise an issue with Transient. - collect - (list (key-description (list key)) - (concat (capitalize name) " " - (propertize " " 'display '(space :align-to 20)) - (propertize - (concat "(" (gptel--describe-directive prompt (- width 30)) ")") - 'face 'shadow)) - `(lambda () (interactive) - (message "%s: %s" ,msg ,(gptel--describe-directive prompt 100 "⮐ ")) - (gptel--set-with-scope ',sym ',prompt gptel--set-buffer-locally)) - :transient 'transient--do-return) - into prompt-suffixes - finally return - (nconc - prompt-suffixes - (list (list "DEL" "None" - `(lambda () (interactive) - (message "%s unset" ,msg) - (gptel--set-with-scope ',sym nil gptel--set-buffer-locally)) - :transient 'transient--do-return)) - (and external - (list (list "SPC" "Pick crowdsourced prompt" - 'gptel--read-crowdsourced-prompt - ;; NOTE: Quitting the completing read when picking a - ;; crowdsourced prompt will cause the transient to exit - ;; instead of returning to the system prompt menu. - :transient 'transient--do-exit)))))) - -;;;###autoload (autoload 'gptel-system-prompt "gptel-transient" nil t) -(transient-define-prefix gptel-system-prompt () - "Set the LLM system message for LLM interactions. - -The \"system message\" establishes directives for the chat -session and modifies the behavior of the LLM. Some examples of -system prompts are: - -You are a helpful assistant. Answer as concisely as possible. -Reply only with shell commands and no prose. -You are a poet. Reply only in verse. - -More extensive system messages can be useful for specific tasks. - -Customize `gptel-directives' for task-specific prompts." - [:description gptel-system-prompt--format - [(gptel--suffix-system-message)] - [(gptel--infix-variable-scope)]] - [:class transient-column - :setup-children - (lambda (_) (transient-parse-suffixes - 'gptel-system-prompt - (gptel--setup-directive-menu - 'gptel--system-message "Directive" t))) - :pad-keys t]) - -;; ** Prefix for saving and applying presets - -(transient-define-prefix gptel--preset () - "Apply a gptel preset, or save the current configuration as a preset. - -A \"preset\" is a collection of gptel settings, such as the model, -backend, system message and enabled tools, that are applied and used -together. See `gptel-make-preset' for details." - :transient-suffix #'transient--do-return - [:description "Save or apply a preset collection of gptel options" - [:pad-keys t - ("@" "Select via completing-read" gptel--read-apply-preset) - ("C-s" "Save current settings as new preset" gptel--save-preset)]] - [:if (lambda () gptel--known-presets) - :class transient-column - :setup-children - (lambda (_) - (transient-parse-suffixes - 'gptel--preset - (cl-loop - for (name-sym . preset) in gptel--known-presets - for name = (format "%s" name-sym) - with unused-keys = (nconc (number-sequence ?a ?z) - (number-sequence ?0 ?9)) - for description = (plist-get preset :description) - for key = (seq-find (lambda (k) (member k unused-keys)) - name (seq-first unused-keys)) - do (setq unused-keys (delq key unused-keys)) - collect - (list - (key-description (list key)) - (concat name - (propertize " " 'display '(space :align-to 20)) - (and description - (propertize (concat - "(" (gptel--describe-directive - description (- (window-width) 30)) - ")") - 'face 'shadow))) - `(lambda () (interactive) - (gptel--set-with-scope 'gptel--preset ',name-sym - gptel--set-buffer-locally) - (gptel--apply-preset ',preset - (lambda (sym val) (gptel--set-with-scope - sym val gptel--set-buffer-locally))) - (message "Applied gptel preset %s" - (propertize ,name 'face 'transient-value)) - (when transient--stack - (run-at-time 0 nil #'transient-setup)))) - into generated - finally return - (nconc (list '(gptel--infix-variable-scope - :format "%d %k %v" - :description - (lambda () (format "%s %s" - (propertize "Apply preset" 'face 'transient-heading) - (propertize "Scope" 'face 'transient-active-prefix))))) - generated))))]) - -;; ** Prefix for selecting tools - -;; gptel-tools offers a two-level menu for selecting tools, its design is a -;; little convoluted so here's an explanation: -;; -;; Normally a transient prefix exports its value via transient-args, to be -;; consumed by suffixes, where these args are determined by the state of the -;; menu at the time of export. The gptel-tools menu is dynamic and needs to -;; store tool selections that may not be visible in the meny any more, so we -;; cannot use the transient-args. -;; -;; We can not (should not?) control the value of the prefix directly, so we -;; instead use the scope (a secondary value) of the prefix to maintain the -;; history of selections. When running a suffix, we gather tool selections from -;; the scope. The scope is also used as a message channel for connecting the -;; category menu and the tool list menu for that category. - -;;;###autoload (autoload 'gptel-tools "gptel-transient" nil t) -(transient-define-prefix gptel-tools () - "Select tools to include with gptel requests. - -Tools are organized into categories. Selecting the category -toggles all the tools with that category. - -To add tools to this list, use `gptel-make-tool', which see. - -Using the scope option, you can set tools to use with gptel -requests globally, in this buffer or for the next request -only (\"oneshot\")." - :refresh-suffixes t - [:description "Provide the LLM with tools to run tasks for you" - ["" - (gptel--infix-variable-scope) - (gptel--infix-use-tools) - (gptel--infix-confirm-tool-calls) - (gptel--infix-include-tool-results)] - ["" - ("RET" "Confirm selection" - (lambda (tools) - ;; We don't care about the transient args of this prefix at all, since - ;; the state is managed entirely through its transient-scope: - (interactive (list (plist-get (transient-scope 'gptel-tools) :tools))) - (gptel--set-with-scope - 'gptel-tools - (mapcar (lambda (category-and-name) - (map-nested-elt gptel--known-tools category-and-name)) - (cl-delete-if-not #'consp tools)) - gptel--set-buffer-locally)) - :transient transient--do-return) - ("q" "Cancel" transient-quit-one)]] - [[:class transient-column ;Display known categories - :setup-children - (lambda (_) - (transient-parse-suffixes - 'gptel-tools - (cl-loop ;loop through gptel--known tools and collect categories - for (category . tools-alist) in gptel--known-tools - with unused-keys = (nconc (delete ?q (number-sequence ?a ?z)) - (number-sequence ?0 ?9) - (delete ?M (number-sequence ?A ?Z))) ;M used by MCP integration - for category-key = (seq-find (lambda (k) (member k unused-keys)) - (string-remove-prefix "mcp-" category) - (seq-first unused-keys)) - do (setq unused-keys (delete category-key unused-keys)) - collect (list (key-description (list category-key)) - (concat (propertize category 'face 'transient-heading) - (make-string (max (- 14 (length category)) 0) ? )) - (char-to-string category-key) - :format " %k %d %v" - :class 'gptel--switch-category - :category category) - into categories - finally do (plist-put (transient-scope) :keys unused-keys) - finally return categories)))] - [:class transient-column ;Display known tools for selected category - :setup-children - (lambda (_) - (transient-parse-suffixes - 'gptel-tools - (when-let* ((category (plist-get (transient-scope) :category)) - (tool-keys (plist-get (transient-scope) :keys))) - (cl-loop ;for each category, collect tools as infixes - with tools-alist = (cdr (assoc category gptel--known-tools)) - for (name . tool) in tools-alist - for tool-key = (seq-find (lambda (k) (member k tool-keys)) name (seq-first tool-keys)) - do (setq tool-keys (delete tool-key tool-keys)) - collect ;Each list is a transient infix of type gptel--switch - (list (key-description (list tool-key)) - (concat (make-string (max (- 20 (length name)) 0) ? ) - (propertize - (concat "(" (gptel--describe-directive - (gptel-tool-description tool) (- (window-width) 60)) - ")") - 'face 'shadow)) - (gptel-tool-name tool) - :format " %k %v %d" - :init-value #'gptel--tools-init-value - :class 'gptel--switch - :category category) - into infixes-for-category - finally return - (cons (list :info - (lambda () (concat - (propertize (plist-get (transient-scope) :key) - 'face 'transient-key) - (propertize " toggle all" 'face 'transient-heading))) - :format " %d") - infixes-for-category)))))]] - (interactive) - (transient-setup - 'gptel-tools nil nil - :scope (list :tools (mapcar (lambda (tool) (list (or (gptel-tool-category tool) "misc") - (gptel-tool-name tool))) - gptel-tools)))) - - -;; * Transient Infixes - -;; ** Infixes for context aggregation - -(transient-define-infix gptel--infix-use-context () - "Describe target destination for context injection. - -gptel will include with the LLM request any additional context -added with `gptel-add'. This context can be ignored, included -with the system message or included with the user prompt. - -Where in the request this context is included depends on the -value of `gptel-use-context', set from here." - :description "Include context" - :class 'gptel-lisp-variable - :variable 'gptel-use-context - :format " %k %d %v" - :set-value #'gptel--set-with-scope - :display-nil "No" - :display-map '((nil . "No") - (system . "with system message") - (user . "with user prompt")) - :key "-i" - :reader (lambda (prompt &rest _) - (let* ((choices '(("No" . nil) - ("with system message" . system) - ("with user prompt" . user))) - (destination (completing-read prompt choices nil t))) - (cdr (assoc destination choices))))) - -;; ** Infixes for model parameters - -(transient-define-infix gptel--infix-variable-scope () - "Set gptel's model parameters and system message in this buffer or globally." - :argument "scope" - :variable 'gptel--set-buffer-locally - :class 'gptel--scope - :format " %k %d %v" - :key "=" - :description (propertize "Scope" 'face 'transient-inactive-argument)) - -(transient-define-infix gptel--infix-num-messages-to-send () - "Number of recent messages to send with each exchange. - -By default, the full conversation history is sent with every new -prompt. This retains the full context of the conversation, but -can be expensive in token size. Set how many recent messages to -include." - :description "previous responses" - :class 'gptel-lisp-variable - :variable 'gptel--num-messages-to-send - :set-value #'gptel--set-with-scope - :display-nil 'all - :format " %k %v %d" - :key "-n" - :prompt "Number of past messages to include for context (leave empty for all): " - :reader 'gptel--transient-read-number) - -(transient-define-infix gptel--infix-max-tokens () - "Max tokens per response. - -This is roughly the number of words in the response. 100-300 is a -reasonable range for short answers, 400 or more for longer -responses." - :description "Response length (tokens)" - :class 'gptel-lisp-variable - :variable 'gptel-max-tokens - :set-value #'gptel--set-with-scope - :display-nil 'auto - :key "-c" - :prompt "Response length in tokens (leave empty: default, 80-200: short, 200-500: long): " - :reader 'gptel--transient-read-number) - -;; TODO(links): Run `gptel-refresh-buffer-hook' after a model change -(transient-define-infix gptel--infix-provider () - "AI Provider for Chat." - :description "Model" - :class 'gptel-provider-variable - :prompt "Model: " - :variable 'gptel-model - :set-value #'gptel--set-with-scope - :backend 'gptel-backend - :key "-m" - :reader (lambda (prompt &rest _) - (cl-loop - for (name . backend) in gptel--known-backends - nconc (cl-loop for model in (gptel-backend-models backend) - collect (list (concat name ":" (gptel--model-name model)) - backend model)) - into models-alist - with completion-extra-properties = - `(:annotation-function - ,(lambda (comp) - (let* ((model (nth 2 (assoc comp models-alist))) - (desc (get model :description)) - (caps (get model :capabilities)) - (context (get model :context-window)) - (input-cost (get model :input-cost)) - (output-cost (get model :output-cost)) - (cutoff (get model :cutoff-date))) - (when (or desc caps context input-cost output-cost cutoff) - (concat - (propertize " " 'display `(space :align-to 40)) - (when desc (truncate-string-to-width desc 70 nil ? t t)) - " " (propertize " " 'display `(space :align-to 112)) - (when caps (truncate-string-to-width (prin1-to-string caps) 21 nil ? t t)) - " " (propertize " " 'display `(space :align-to 134)) - (when context (format "%5dk" context)) - " " (propertize " " 'display `(space :align-to 142)) - (when input-cost (format "$%5.2f in" input-cost)) - (if (and input-cost output-cost) "," " ") - " " (propertize " " 'display `(space :align-to 153)) - (when output-cost (format "$%6.2f out" output-cost)) - " " (propertize " " 'display `(space :align-to 166)) - cutoff))))) - finally return - (cdr (assoc (completing-read prompt models-alist nil t nil nil - (concat (gptel-backend-name gptel-backend) ":" - (gptel--model-name gptel-model))) - models-alist))))) - -(transient-define-infix gptel--infix-temperature () - "Temperature of request." - :description "Temperature (0 - 2.0)" - :display-nil "default" - :class 'gptel-lisp-variable - :variable 'gptel-temperature - :set-value #'gptel--set-with-scope - :key "-T" - :prompt "Temperature controls the response randomness (0.0-2.0, leave empty for API default): " - :reader 'gptel--transient-read-number) - -(transient-define-infix gptel--infix-track-response () - "Distinguish between user messages and LLM responses. - -When creating a prompt to send to the LLM, gptel distinguishes -between text entered by the user and past LLM responses. This is -required for multi-turn conversations, and is always the case in -dedicated chat buffers (in `gptel-mode'). - -In regular buffers, you can toggle this behavior here or by -customizing `gptel-track-response'. When response tracking is -turned off, all text will be assigned the \"user\" role when -querying the LLM." - :description "Track LLM responses" - :class 'gptel--switches - :variable 'gptel-track-response - :set-value #'gptel--set-with-scope - :display-if-true "Yes" - :display-if-false "No" - :key "-R") - -(transient-define-suffix gptel--infix-track-media () - "Send media from links in the prompt. - -gptel can send images or other media from links in the buffer to the -LLM. What link types are sent depends on the mime-types the model -supports. See `gptel-track-media' for more information." - :description "Send media from links" - :transient t - :class 'gptel--switches - :variable 'gptel-track-media - :set-value #'gptel--set-with-scope - :display-if-true "Yes" - :display-if-false "No" - :key "-I" - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj)) - (transient--show)) - (if gptel-track-media - (run-hooks 'gptel-refresh-buffer-hook) - (gptel--annotate-link-clear))) - -;; ** Infixes for adding and removing context - -(declare-function gptel-context--at-point "gptel-context") -(declare-function gptel-add "gptel-context") -(declare-function gptel-context-add-current-kill "gptel-context") - -(transient-define-suffix gptel--infix-context-add-current-kill (&optional arg) - "Add current kill to gptel's context." - :transient 'transient--do-stay - :key "C-y" - :if (lambda () gptel-expert-commands) - :description - "Yank to context" - (interactive "P") - (require 'gptel-context) - (gptel-context-add-current-kill arg) - (transient-setup)) - -(transient-define-suffix gptel--infix-context-add-region () - "Add current region to gptel's context." - :transient 'transient--do-stay - :key "-r" - :if (lambda () (or (use-region-p) - (and (fboundp 'gptel-context--at-point) - (gptel-context--at-point)))) - :description - (lambda () - (if (and (fboundp 'gptel-context--at-point) - (gptel-context--at-point)) - "Remove context at point" - "Add region to context")) - (interactive) - (gptel-add) - (transient-setup)) - -(transient-define-suffix gptel--infix-context-add-buffer () - "Add a buffer to gptel's context." - :transient 'transient--do-stay - :key "-b" - :description "Add a buffer to context" - (interactive) - (gptel-add '(4)) - (transient-setup)) - -(declare-function gptel-add-file "gptel-context") -(declare-function gptel-context-remove-all "gptel-context") - -(transient-define-suffix gptel--infix-context-add-file () - "Add a file to gptel's context." - :transient 'transient--do-stay - :key "-f" - :description "Add a file to context" - (interactive) - (call-interactively #'gptel-add-file) - (transient-setup)) - -(transient-define-suffix gptel--infix-context-remove-all () - "Clear gptel's context." - :if (lambda () gptel-context) - :transient 'transient--do-stay - :key "-d" - :description "Remove all" - (interactive) - (gptel-context-remove-all t) - (transient-setup)) - -;; ** Infix for additional directive - -(transient-define-infix gptel--infix-add-directive () - "Additional directive intended for the next query only. - -This is useful to define a quick task on top of a more extensive -or detailed system message. - -For example, with code/text selected: - -- Rewrite this function to do X while avoiding Y. -- Change the tone of the following paragraph to be more direct. - -Or in an extended conversation: - -- Phrase you next response in ten words or less. -- Pretend for now that you're an anthropologist." - :class 'gptel-option-overlaid - ;; :variable 'gptel--instructions - :display-nil 'none - :overlay nil - :argument ":" - :prompt (concat "Add instructions for next request only (" - gptel--read-with-prefix-help ") ") - ;; TODO: Add the ability to edit this in a separate buffer, with - ;; `gptel--edit-directive'. This requires setting up gptel-menu with the - ;; result as the :scope. - :reader (lambda (prompt initial history) - (let* ((directive - (car-safe (gptel--parse-directive gptel--system-message 'raw))) - (cycle-prefix (lambda () (interactive) - (gptel--read-with-prefix directive))) - (minibuffer-local-map - (make-composed-keymap - (define-keymap "TAB" cycle-prefix "" cycle-prefix) - minibuffer-local-map)) - (extra (minibuffer-with-setup-hook cycle-prefix - (read-string prompt (or initial " ") history)))) - (unless (string-empty-p extra) extra))) - :format " %k %d %v" - :key "d" - :argument ":" - :description "Add instruction" - :transient t) - -;; ** Infix for reasoning block control - -(transient-define-infix gptel--infix-include-reasoning () - "How to handle reasoning/thinking response blocks. - -Some LLMs include in their response a \"thinking\" section. This -text improves the quality of the LLM's final output, but may not -be interesting to you by itself. - -You can control how gptel should handle the thinking blocks via -this option, or by setting the variable `gptel-include-reasoning' -via elisp, which see. - -Available behaviors are -- to include thinking blocks with the response, -- to omit them entirely, -- to include them but ignore them in consequent conversation turns, and -- to append them to a buffer of your choosing." - :description "Include reasoning" - :class 'gptel-lisp-variable - :variable 'gptel-include-reasoning - :format " %k %d %v" - :set-value #'gptel--set-with-scope - :display-nil "No" - :display-map '((nil . "No") - (ignore . "and ignore") - (t . "with response")) - :key "-v" - :prompt "Include reasoning: " - :reader (lambda (prompt &rest _) - (let* ((choices '(("no" . nil) - ("ignore" . ignore) - ("yes" . t) - ("other buffer" . buffer))) - (destination - (completing-read prompt choices nil t))) - (if (equal destination "other buffer") - (read-buffer "Append reasoning to buffer: ") - (cdr (assoc destination choices)))))) - -;; ** Infixes for tool use - -(transient-define-infix gptel--infix-use-tools () - "Whether LLM tool use with gptel is enabled. - -This is a three-way toggle. Assuming one or more tools to be -sent with requests have been selected, tool use can be - -- disabled, -- enabled, where the LLM may choose to respond with tool calls -- forced, where the LLM must respond with one or more tool calls. - -You can set this here or by customizing `gptel-use-tools', which -see." - :description "Use tools" - :class 'gptel-lisp-variable - :variable 'gptel-use-tools - :set-value (lambda (sym value scope) - (gptel--set-with-scope sym value scope) - (transient-setup)) - :display-nil "off" - :display-map '((nil . "off") - (t . "on") - (force . "force")) - :prompt "Use tools? " - :reader (lambda (prompt &rest _) - (let* ((choices '(("disable" . nil) - ("enable" . t) - ("force" . force))) - (pref (completing-read prompt choices nil t))) - (cdr (assoc pref choices)))) - :key "-t") - -(transient-define-infix gptel--infix-confirm-tool-calls () - "Whether tool calls should wait for the user to run them. - -This is a three-way toggle between these behaviors: - -- All tool calls run without confirmation. -- All tool calls wait for confirmation. -- Decided per-tool, according to the value of the tool spec's - :confirm slot. - -This sets the variable `gptel-confirm-tool-calls', which see." - :key "-c" - :description "Confirm tool calls" - :class 'gptel-lisp-variable - :variable 'gptel-confirm-tool-calls - :set-value #'gptel--set-with-scope - :display-nil "never" - :display-map '((nil . "never") - (t . "always") - (auto . "auto")) - :prompt "Tool calls require confirmation? " - :reader (lambda (prompt &rest _) - (let* ((choices '(("no" . nil) - ("always" . t) - ("tool decides" . auto))) - (pref (completing-read prompt choices nil t))) - (cdr (assoc pref choices))))) - -(transient-define-infix gptel--infix-include-tool-results () - "Whether tool call results should be included in the response. - -This is a three-way toggle between these behaviors: - -- All tool results are included. -- No tool results are included. -- Decided per-tool, according to the value of the tool spec's - :include slot. - -This sets the variable `gptel-include-tool-results', which see." - :key "-i" - :description "Include results " - :class 'gptel-lisp-variable - :variable 'gptel-include-tool-results - :set-value #'gptel--set-with-scope - :display-nil "never" - :display-map '((nil . "never") - (t . "always") - (auto . "auto")) - :prompt "Include tool results in LLM response? " - :reader (lambda (prompt &rest _) - (let* ((choices '(("never" . nil) - ("always" . t) - ("tool decides" . auto))) - (pref (completing-read prompt choices nil t))) - (cdr (assoc pref choices))))) - - -;; * Transient Suffixes - -;; ** Suffix to send prompt - -(transient-define-suffix gptel--suffix-send (args) - "Send ARGS." - :key "RET" - :description #'gptel--describe-suffix-send - (interactive (list (transient-args - (or transient-current-command 'gptel-menu)))) - (let ((stream gptel-stream) - (in-place (and (member "i" args) t)) - (redirect-output) - (backend gptel-backend) - (model gptel-model) - (backend-name (gptel-backend-name gptel-backend)) - (buffer) (position) - (callback) (gptel-buffer-name) - (system-extra (gptel--get-directive args)) - (dry-run (and (member "I" args) t)) - ;; Input redirection: grab prompt from elsewhere? - (prompt - (cond - ((member "m" args) (gptel--read-minibuffer-prompt)) - ((member "y" args) - (unless (car-safe kill-ring) - (user-error "`kill-ring' is empty! Nothing to send")) - (if current-prefix-arg - (read-from-kill-ring "Prompt from kill-ring: ") - (current-kill 0)))))) - - ;; Output redirection: Send response elsewhere? - (cond - ((member "e" args) - (setq redirect-output t) - (setq stream nil) - (setq callback - (lambda (resp info &optional _raw) - (pcase resp - ((pred stringp) (message "%s response: %s" backend-name resp)) - (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer)) - (_ (when (and (null resp) (plist-get info :error)) - (message "%s response error: %s" - backend-name (plist-get info :status)))))))) - ((member "k" args) - (setq redirect-output t) - (setq stream nil) - (setq callback - (let ((accum)) - (lambda (resp info &optional _raw) - (pcase resp - ((pred stringp) (push resp accum) - (unless (plist-get info :tool-use) - (kill-new (apply #'concat (nreverse accum))) - (message "%s response: \"%s\" copied to kill-ring." backend-name - (truncate-string-to-width resp 30 nil nil t)))) - (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer)) - (_ (when (and (null resp) (plist-get info :error)) - (if accum (kill-new (apply #'concat (nreverse accum)))) - (message - (concat "%s response error: %s." - (and accum " Partial response copied to kill-ring.")) - backend-name (plist-get info :status))))))))) - ((setq gptel-buffer-name - (cl-some (lambda (s) (and (stringp s) (string-prefix-p "g" s) - (substring s 1))) - args)) - (setq redirect-output t) - (let* ((reduced-prompt ;For inserting into the gptel buffer as - ;context, not the prompt used for the - ;request itself - (or prompt - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) - (region-end)) - (buffer-substring-no-properties - (save-excursion - (text-property-search-backward - 'gptel 'response - (when (get-char-property (max (point-min) (1- (point))) - 'gptel) - t)) - (point)) - (gptel--at-word-end (point)))))) - (gptel-buffer (get-buffer gptel-buffer-name)) - (gptel-buffer-mode - (if (buffer-live-p gptel-buffer) - (buffer-local-value 'major-mode gptel-buffer) - gptel-default-mode))) - ;; Add code fences or Org src markers around the reduced-prompt - (cond ((and (stringp prompt) (eq major-mode gptel-buffer-mode))) - ((provided-mode-derived-p gptel-buffer-mode 'org-mode) - (setq reduced-prompt - (if (consp reduced-prompt);either (region . prompt) or prompt - (concat (and (car reduced-prompt) - (concat "#+begin_src " (gptel--strip-mode-suffix major-mode) - "\n" (org-escape-code-in-string (car reduced-prompt)) - "\n#+end_src\n\n")) - (cdr reduced-prompt)) - (concat "#+begin_src " (gptel--strip-mode-suffix major-mode) - "\n" (org-escape-code-in-string - (or (cdr-safe reduced-prompt) reduced-prompt)) - "\n#+end_src")))) - (t (setq reduced-prompt - (if (consp reduced-prompt);either (region . prompt) or prompt - (concat (and (car reduced-prompt) - (concat "``` " (gptel--strip-mode-suffix major-mode) "\n" - (car reduced-prompt) "\n```\n\n")) - (cdr reduced-prompt)) - (concat "``` " (gptel--strip-mode-suffix major-mode) "\n" - (or (cdr-safe reduced-prompt) reduced-prompt) "\n```" ))))) - (cond - ((buffer-live-p gptel-buffer) - ;; Insert into existing gptel session - (setq buffer gptel-buffer) - (with-current-buffer buffer - (goto-char (point-max)) - (unless (or buffer-read-only - (get-char-property (point) 'read-only)) - (unless (bolp) (insert "\n")) - (insert reduced-prompt)) - (setq position (point)) - (when (and gptel-mode (not dry-run)) - (gptel--update-status " Waiting..." 'warning)))) - ;; Insert into new gptel session - (t (setq buffer - (gptel gptel-buffer-name - (condition-case nil - (gptel--get-api-key) - ((error user-error) - (setq gptel-api-key - (read-passwd - (format "%s API key: " - (gptel-backend-name - gptel-backend)))))) - reduced-prompt)) - ;; Set backend and model in new session from current buffer - (with-current-buffer buffer - (setq gptel-backend backend) - (setq gptel-model model) - (unless dry-run - (gptel--update-status " Waiting..." 'warning)) - (setq position (point))))))) - ((setq gptel-buffer-name - (cl-some (lambda (s) (and (stringp s) (string-prefix-p "b" s) - (substring s 1))) - args)) - (setq redirect-output t) - (setq buffer (get-buffer-create gptel-buffer-name)) - (with-current-buffer buffer (setq position (point))))) - - ;; MAYBE: This is no a good way to handle two-part (region + instruction) prompts - ;; If the prompt is a cons (region-text . instructions), collapse it - (when (consp prompt) (setq prompt (concat (car prompt) "\n\n" (cdr prompt)))) - - (prog1 (gptel-request prompt - :buffer (or buffer (current-buffer)) - :position position - :in-place in-place - :stream stream - :system - (if system-extra - (gptel--merge-additional-directive system-extra) - gptel--system-message) - :callback callback - :transforms gptel-prompt-transform-functions - :fsm (gptel-make-fsm :handlers gptel-send--handlers) - :dry-run dry-run) - - (unless dry-run - (gptel--update-status " Waiting..." 'warning)) - - ;; NOTE: Possible future race condition here if Emacs ever drops the GIL. - ;; The HTTP request callback might modify the buffer before the in-place - ;; text is killed below. - (when in-place - (if (or buffer-read-only (get-char-property (point) 'read-only)) - (message "Not replacing prompt: region is read-only") - (let ((beg (if (use-region-p) - (region-beginning) - (max (previous-single-property-change - (point) 'gptel nil (point-min)) - (previous-single-property-change - (point) 'read-only nil (point-min))))) - (end (if (use-region-p) (region-end) (point)))) - (unless redirect-output - ;; store the killed text in gptel-history - (gptel--attach-response-history - (list (buffer-substring-no-properties beg end)))) - (kill-region beg end)))) - - (when (and redirect-output gptel-buffer-name) - (message (concat "Prompt sent to buffer: " - (propertize gptel-buffer-name 'face 'help-key-binding))) - (display-buffer - buffer '((display-buffer-reuse-window - display-buffer-pop-up-window) - (reusable-frames . visible))))))) - -(defun gptel--merge-additional-directive (additional &optional full) - "Merge ADDITIONAL gptel directive with the full system message. - -The ADDITIONAL directive is typically specified from `gptel-menu' -and applies only to the next gptel request, see -`gptel--infix-add-directive'. - -FULL defaults to the active, full system message. It may be a -string, a list of prompts or a function, see `gptel-directives' -for details." - (setq full (or full gptel--system-message)) - (cl-typecase full - (string (concat full "\n\n" additional)) - (cons (let ((copy (copy-sequence full))) - (setcar copy (concat (car copy) "\n\n" additional)) - copy)) - (function (lambda () (gptel--merge-additional-directive - additional (funcall full)))) - (otherwise additional))) - -;; Allow calling from elisp -(put 'gptel--suffix-send 'interactive-only nil) - -;; ** Suffix to regenerate response - -(defun gptel--regenerate () - "Regenerate gptel response at point." - (interactive) - (when (gptel--in-response-p) - (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds)) - (history (get-char-property (point) 'gptel-history)) - (prev-responses (cons (buffer-substring-no-properties beg end) - history))) - (when gptel-mode ;Remove prefix/suffix - (save-excursion - (goto-char beg) - (when (looking-back (concat "\n+" (regexp-quote (gptel-response-prefix-string))) - (point-min) 'greedy) - (setq beg (match-beginning 0))) - (goto-char end) - (when (looking-at - (concat "\n+" (regexp-quote (gptel-prompt-prefix-string)))) - (setq end (match-end 0))))) - (delete-region beg end) - (gptel--attach-response-history prev-responses) - (call-interactively #'gptel--suffix-send)))) - -;; ** Set system message -(defun gptel--read-crowdsourced-prompt () - "Pick a crowdsourced system prompt for gptel. - -This uses the prompts in the variable -`gptel--crowdsourced-prompts', which see." - (interactive) - (if (not (hash-table-empty-p (gptel--crowdsourced-prompts))) - (let ((choice - (completing-read - "Pick and edit prompt: " - (lambda (str pred action) - (if (eq action 'metadata) - `(metadata - (affixation-function . - (lambda (cands) - (mapcar - (lambda (c) - (list c "" - (concat (propertize " " 'display '(space :align-to 22)) - " " (propertize (gethash c gptel--crowdsourced-prompts) - 'face 'completions-annotations)))) - cands)))) - (complete-with-action action gptel--crowdsourced-prompts str pred))) - nil t))) - (when-let* ((prompt (gethash choice gptel--crowdsourced-prompts))) - (gptel--set-with-scope - 'gptel--system-message prompt gptel--set-buffer-locally) - (gptel--edit-directive 'gptel--system-message - :callback (lambda (_) (call-interactively #'gptel-menu))))) - (message "No prompts available."))) - -(transient-define-suffix gptel--suffix-system-message (&optional cancel) - "Edit LLM system message. - -CANCEL is used to avoid touching dynamic system messages, -generated from functions." - :transient 'transient--do-exit - :description "Set or edit system message" - :format " %k %d" - :key "s" - (interactive - (list (and (functionp gptel--system-message) - (not (y-or-n-p - "Active directive is dynamically generated: Edit its current value instead?"))))) - (if cancel (progn (message "Edit canceled") - (call-interactively #'gptel-menu)) - (gptel--edit-directive 'gptel--system-message - :setup #'activate-mark - :callback (lambda (_) (call-interactively #'gptel-menu))))) - -;; MAYBE: Eventually can be simplified with string-edit, after we drop support -;; for Emacs 28.2. -(cl-defun gptel--edit-directive (&optional sym &key prompt initial callback setup buffer) - "Edit a gptel directive in a dedicated buffer. - -Store the result in SYM, a symbol. PROMPT and INITIAL are the heading -and initial text. If SETUP is a function, run it after setting up the -buffer. If CALLBACK is specified, it is run after exiting the edit. It -is called with one argument: the buffer text or with nil depending on -whether the action is confirmed/cancelled." - (declare (indent 1)) - (let ((orig-buf (or buffer (current-buffer))) - (msg-start (make-marker)) - (directive (symbol-value sym))) - (when (functionp directive) - (setq directive (funcall directive))) - ;; TODO: Handle editing list-of-strings directives - (with-current-buffer (get-buffer-create "*gptel-prompt*") - (let ((inhibit-read-only t) (inhibit-message t)) - (erase-buffer) - (text-mode) - (visual-line-mode 1) - (setq header-line-format - (concat "Edit your instructions below and press " - (propertize "C-c C-c" 'face 'help-key-binding) - " when ready, or " - (propertize "C-c C-k" 'face 'help-key-binding) - " to abort.")) - (insert - (or prompt - (concat - "# Example: You are a helpful assistant. Answer as concisely as possible.\n" - "# Example: Reply only with shell commands and no prose.\n" - "# Example: You are a poet. Reply only in verse.")) - "\n\n") - (add-text-properties - (point-min) (point) - (list 'read-only t 'face 'font-lock-comment-face 'front-sticky t 'rear-nonsticky t)) - (set-marker msg-start (point)) - (save-excursion - ;; If it's a list, insert only the system message part - ;; If all is nil, insert "" at least - (insert (or initial (car-safe (gptel--parse-directive directive 'raw)) "")) - (push-mark nil 'nomsg)) - (and (functionp setup) (funcall setup))) - (display-buffer (current-buffer) - `((display-buffer-below-selected - display-buffer-use-some-window) - (some-window . lru) - (body-function . ,#'select-window) - (window-height . ,#'fit-window-to-buffer))) - (let ((quit-to-menu - (lambda () "Cancel system message update and return." - (quit-window) - (unless (minibufferp) - (display-buffer orig-buf - `((display-buffer-reuse-window - display-buffer-use-some-window) - (body-function . ,#'select-window))))))) - (use-local-map - (make-composed-keymap - (define-keymap - "C-c C-c" - (lambda () "Confirm system message and return." - (interactive) - (let ((system-message - (buffer-substring-no-properties msg-start (point-max)))) - (when sym - (with-current-buffer orig-buf - (gptel--set-with-scope - sym (if (cdr-safe directive) ;Handle list of strings - (prog1 directive (setcar directive system-message)) - system-message) - gptel--set-buffer-locally))) - (funcall quit-to-menu) - (when (functionp callback) (funcall callback system-message)))) - "C-c C-k" (lambda () (interactive) - (funcall quit-to-menu) - (when (functionp callback) (funcall callback nil)))) - text-mode-map)))))) - -;; ** Suffix for displaying and removing context -(declare-function gptel-context--buffer-setup "gptel-context") -(declare-function gptel-context--collect "gptel-context") - -(transient-define-suffix gptel--suffix-context-buffer () - "Display all contexts from all buffers & files." - :transient 'transient--do-exit - :key " C" - :if (lambda () gptel-context) - :description "Inspect context" - (interactive) - (gptel-context--buffer-setup nil nil gptel-context)) - -(provide 'gptel-transient) -;;; gptel-transient.el ends here - -;; Local Variables: -;; outline-regexp: "^;; \\*+" -;; eval: (outline-minor-mode 1) -;; End: diff --git a/elpa/gptel-20260123.739/gptel.el b/elpa/gptel-20260123.739/gptel.el deleted file mode 100644 index ff2e55e2..00000000 --- a/elpa/gptel-20260123.739/gptel.el +++ /dev/null @@ -1,2444 +0,0 @@ -;;; gptel.el --- Interact with ChatGPT or other LLMs -*- lexical-binding: t; -*- - -;; Copyright (C) 2023-2025 Karthik Chikmagalur - -;; Author: Karthik Chikmagalur -;; Package-Version: 20260123.739 -;; Package-Revision: 96199593c107 -;; Package-Requires: ((emacs "27.1") (transient "0.7.4") (compat "30.1.0.0")) -;; Keywords: convenience, tools -;; URL: https://github.com/karthink/gptel - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is NOT part of GNU Emacs. - -;;; Commentary: - -;; gptel is a simple Large Language Model chat client, with support for multiple -;; models and backends. -;; -;; It works in the spirit of Emacs, available at any time and in any buffer. -;; -;; gptel supports: -;; -;; - The services ChatGPT, Azure, Gemini, Anthropic AI, Together.ai, Perplexity, -;; AI/ML API, Anyscale, OpenRouter, Groq, PrivateGPT, DeepSeek, Cerebras, Github Models, -;; GitHub Copilot chat, AWS Bedrock, Novita AI, xAI, Sambanova, Mistral Le -;; Chat and Kagi (FastGPT & Summarizer). -;; - Local models via Ollama, Llama.cpp, Llamafiles or GPT4All -;; -;; Additionally, any LLM service (local or remote) that provides an -;; OpenAI-compatible API is supported. -;; -;; Features: -;; -;; - Interact with LLMs from anywhere in Emacs (any buffer, shell, minibuffer, -;; wherever). -;; - LLM responses are in Markdown or Org markup. -;; - Supports conversations and multiple independent sessions. -;; - Supports tool-use to equip LLMs with agentic capabilities. -;; - Supports Model Context Protocol (MCP) integration using the mcp.el package. -;; - Supports multi-modal models (send images, documents). -;; - Supports "reasoning" content in LLM responses. -;; - Save chats as regular Markdown/Org/Text files and resume them later. -;; - You can go back and edit your previous prompts or LLM responses when -;; continuing a conversation. These will be fed back to the model. -;; - Redirect prompts and responses easily -;; - Rewrite, refactor or fill in regions in buffers. -;; - Write your own commands for custom tasks with a simple API. -;; -;; Requirements for ChatGPT, Azure, Gemini or Kagi: -;; -;; - You need an appropriate API key. Set the variable `gptel-api-key' to the -;; key or to a function of no arguments that returns the key. (It tries to -;; use `auth-source' by default) -;; -;; ChatGPT is configured out of the box. For the other sources: -;; -;; - For Azure: define a gptel-backend with `gptel-make-azure', which see. -;; - For Gemini: define a gptel-backend with `gptel-make-gemini', which see. -;; - For Anthropic (Claude): define a gptel-backend with `gptel-make-anthropic', -;; which see. -;; - For AI/ML API, Together.ai, Anyscale, Groq, OpenRouter, DeepSeek, Cerebras or -;; Github Models: define a gptel-backend with `gptel-make-openai', which see. -;; - For PrivateGPT: define a backend with `gptel-make-privategpt', which see. -;; - For Perplexity: define a backend with `gptel-make-perplexity', which see. -;; - For Deepseek: define a backend with `gptel-make-deepseek', which see. -;; - For Kagi: define a gptel-backend with `gptel-make-kagi', which see. -;; -;; For local models using Ollama, Llama.cpp or GPT4All: -;; -;; - The model has to be running on an accessible address (or localhost) -;; - Define a gptel-backend with `gptel-make-ollama' or `gptel-make-gpt4all', -;; which see. -;; - Llama.cpp or Llamafiles: Define a gptel-backend with `gptel-make-openai'. -;; -;; Consult the package README for examples and more help with configuring -;; backends. -;; -;; Usage: -;; -;; gptel can be used in any buffer or in a dedicated chat buffer. The -;; interaction model is simple: Type in a query and the response will be -;; inserted below. You can continue the conversation by typing below the -;; response. -;; -;; To use this in any buffer: -;; -;; - Call `gptel-send' to send the buffer's text up to the cursor. Select a -;; region to send only the region. -;; -;; - You can select previous prompts and responses to continue the conversation. -;; -;; - Call `gptel-send' with a prefix argument to access a menu where you can set -;; your backend, model and other parameters, or to redirect the -;; prompt/response. -;; -;; To use this in a dedicated buffer: -;; -;; - M-x gptel: Start a chat session. -;; -;; - In the chat session: Press `C-c RET' (`gptel-send') to send your prompt. -;; Use a prefix argument (`C-u C-c RET') to access a menu. In this menu you -;; can set chat parameters like the system directives, active backend or -;; model, or choose to redirect the input or output elsewhere (such as to the -;; kill ring or the echo area). -;; -;; - You can save this buffer to a file. When opening this file, turn on -;; `gptel-mode' before editing it to restore the conversation state and -;; continue chatting. -;; -;; - To include media files with your request, you can add them to the context -;; (described next), or include them as links in Org or Markdown mode chat -;; buffers. Sending media is disabled by default, you can turn it on globally -;; via `gptel-track-media', or locally in a chat buffer via the header line. -;; -;; Include more context with requests: -;; -;; If you want to provide the LLM with more context, you can add arbitrary -;; regions, buffers, files or directories to the query with `gptel-add'. To add -;; text or media files, call `gptel-add' in Dired or use the dedicated -;; `gptel-add-file'. -;; -;; You can also add context from gptel's menu instead (`gptel-send' with a -;; prefix arg), as well as examine or modify context. -;; -;; When context is available, gptel will include it with each LLM query. -;; -;; LLM Tool use: -;; -;; gptel supports "tool calling" behavior, where LLMs can specify arguments with -;; which to call provided "tools" (elisp functions). The results of running the -;; tools are fed back to the LLM, giving it capabilities and knowledge beyond -;; what is available out of the box. For example, tools can perform web -;; searches or API lookups, modify files and directories, and so on. -;; -;; Tools can be specified via `gptel-make-tool', or obtained from other -;; repositories, or from Model Context Protocol (MCP) servers using the mcp.el -;; package. See the README for details. -;; -;; Tools can be included with LLM queries using gptel's menu, or from -;; `gptel-tools'. -;; -;; Rewrite interface -;; -;; In any buffer: with a region selected, you can rewrite prose, refactor code -;; or fill in the region. This is accessible via `gptel-rewrite', and also from -;; the `gptel-send' menu. -;; -;; Presets -;; -;; Define a bundle of configuration (model, backend, system message, tools etc) -;; as a "preset" that can be applied together, making it easy to switch between -;; tasks in gptel. Presets can be saved and applied from gptel's transient -;; menu. You can also include a cookie of the form "@preset-name" in the prompt -;; to send a request with a preset applied. This feature works everywhere, but -;; preset cookies are also fontified in chat buffers. -;; -;; gptel in Org mode: -;; -;; gptel offers a few extra conveniences in Org mode: -;; -;; - You can limit the conversation context to an Org heading with -;; `gptel-org-set-topic'. -;; -;; - You can have branching conversations in Org mode, where each hierarchical -;; outline path through the document is a separate conversation branch. -;; See the variable `gptel-org-branching-context'. -;; -;; - You can declare the gptel model, backend, temperature, system message and -;; other parameters as Org properties with the command -;; `gptel-org-set-properties'. gptel queries under the corresponding heading -;; will always use these settings, allowing you to create mostly reproducible -;; LLM chat notebooks. -;; -;; Finally, gptel offers a general purpose API for writing LLM ineractions that -;; suit your workflow. See `gptel-request', and `gptel-fsm' for more advanced -;; usage. - -;;; Code: -(defconst gptel-version "0.9.9.3") - -(declare-function markdown-mode "markdown-mode") -(declare-function gptel-menu "gptel-transient") -(declare-function gptel-system-prompt "gptel-transient") -(declare-function gptel-tools "gptel-transient") -(declare-function pulse-momentary-highlight-region "pulse") - -(declare-function ediff-make-cloned-buffer "ediff-util") -(declare-function ediff-regions-internal "ediff") -(declare-function hl-line-highlight "hl-line") - -(declare-function org-escape-code-in-string "org-src") -(declare-function gptel-org-set-topic "gptel-org") -(declare-function gptel-org--save-state "gptel-org") -(declare-function gptel-org--restore-state "gptel-org") -(declare-function gptel-org--annotate-links "gptel-org") -(define-obsolete-function-alias - 'gptel-set-topic 'gptel-org-set-topic "0.7.5") - -(declare-function markdown-link-at-pos "markdown-mode") - -(eval-when-compile - (require 'subr-x)) -(require 'cl-lib) -(require 'compat nil t) -(require 'url) -(require 'map) -(require 'text-property-search) -(require 'cl-generic) -(require 'gptel-request) - - -;;; User options -(defcustom gptel-pre-response-hook nil - "Hook run before inserting the LLM response into the current buffer. - -This hook is called in the buffer where the LLM response will be -inserted. - -Note: this hook only runs if the request succeeds." - :type 'hook - :group 'gptel) - -(define-obsolete-variable-alias - 'gptel-post-response-hook 'gptel-post-response-functions - "0.6.0" - "Post-response functions are now called with two arguments: the -start and end buffer positions of the response.") - -(defcustom gptel-post-response-functions nil - "Abnormal hook run after inserting the LLM response into the current buffer. - -This hook is called in the buffer to which the LLM response is -sent, and after the full response has been inserted. Each -function is called with two arguments: the response beginning and -end positions. - -Note: this hook runs even if the request fails. In this case the -response beginning and end positions are both the cursor position -at the time of the request." - :type 'hook - :group 'gptel) - -(add-hook 'gptel-post-response-functions 'pulse-momentary-highlight-region 70) - -(defcustom gptel-post-stream-hook nil - "Hook run after each insertion of the LLM's streaming response. - -This hook is called in the buffer from which the prompt was sent -to the LLM, and after a text insertion." - :type 'hook - :group 'gptel) - -(defcustom gptel-save-state-hook nil - "Hook run before gptel saves model parameters to a file. - -You can use this hook to store additional conversation state or -model parameters to the chat buffer, or to modify the buffer in -some other way." - :type 'hook - :group 'gptel) - -(defcustom gptel-default-mode (if (fboundp 'markdown-mode) - 'markdown-mode - 'text-mode) - "The default major mode for dedicated chat buffers. - -If `markdown-mode' is available, it is used. Otherwise gptel -defaults to `text-mode'." - :type 'function - :group 'gptel) - -(defcustom gptel-use-header-line t - "Whether `gptel-mode' should use header-line for status information. - -When set to nil, use the mode line for (minimal) status -information and the echo area for messages." - :type 'boolean - :group 'gptel) - -;; Set minimally to avoid display-buffer action alist conflicts (#533) -(defcustom gptel-display-buffer-action `(nil (body-function . ,#'select-window)) - "The action used to display gptel chat buffers. - -The gptel buffer is displayed in a window using - - (display-buffer BUFFER gptel-display-buffer-action) - -The value of this option has the form (FUNCTION . ALIST), -where FUNCTION is a function or a list of functions. Each such -function should accept two arguments: a buffer to display and an -alist of the same form as ALIST. See info node `(elisp)Choosing -Window' for details." - :type display-buffer--action-custom-type - :group 'gptel) - -(defcustom gptel-crowdsourced-prompts-file - (let ((cache-dir (or (eval-when-compile - (require 'xdg) - (xdg-cache-home)) - user-emacs-directory))) - (expand-file-name "gptel-crowdsourced-prompts.csv" cache-dir)) - "File used to store crowdsourced system prompts. - -These are prompts cached from an online source (see -`gptel--crowdsourced-prompts-url'), and can be set from the -transient menu interface provided by `gptel-menu'." - :type 'file - :group 'gptel) - -(defvar gptel-refresh-buffer-hook '(jit-lock-refontify) - "Hook run in gptel buffers after changing gptel's configuration. - -This hook runs in gptel chat buffers after making a change to gptel's -configuration that might require a UI update.") - -(defvar-local gptel--bounds nil) -(put 'gptel--bounds 'safe-local-variable #'always) - -(defvar-local gptel--tool-names nil - "Store to persist tool names to file across Emacs sessions. - -Note: Changing this variable does not affect gptel\\='s behavior -in any way.") -(put 'gptel--tool-names 'safe-local-variable #'always) - -(defvar-local gptel--backend-name nil - "Store to persist backend name across Emacs sessions. - -Note: Changing this variable does not affect gptel\\='s behavior -in any way.") -(put 'gptel--backend-name 'safe-local-variable #'always) - -(defvar-local gptel--old-header-line nil) - -(defvar gptel--markdown-block-map - (define-keymap - "" 'gptel-markdown-cycle-block - "TAB" 'gptel-markdown-cycle-block) - "Keymap for folding and unfolding Markdown code blocks.") - - -;;; Utility functions -(defun gptel--modify-value (original new-spec) - "Combine ORIGINAL with NEW-SPEC and return the new result. - -This function is non-destructive, ORIGINAL is not modified. - -NEW-SPEC is either a declarative action spec (plist) of the form - (:key val ...), or a simple value. Recognized spec keys are :append, -:prepend, :eval, :function and :merge. If NEW-SPEC does not have this -form it is returned as is. - -- :append and :prepend will append/prepend val (a list or string) to ORIGINAL. - Actions on strings are idempotent, they will only be appended/prepended once. -- :eval will evaluate val and return the result, and -- :function will call val with ORIGINAL as its argument, and return the result. -- :merge will treat ORIGINAL and NEW-SPEC as plists and return a merged plist, - with NEW-SPEC taking precedence." - (if (not (and (consp new-spec) (keywordp (car new-spec)))) - new-spec - (let ((current original) (tail new-spec)) - (while tail - (let ((key (pop tail)) (form (pop tail))) - (setq current - (pcase key - (:append (if (stringp form) - (if (string-suffix-p form current t) - current (concat current form)) - (append current form))) - (:prepend (if (stringp form) - (if (string-prefix-p form current t) - current (concat form current)) - (append form current))) - (:eval (eval form t)) - (:function (funcall form current)) - (:merge (gptel--merge-plists (copy-sequence current) form)) - (_ new-spec))))) - current))) - -(defun gptel-auto-scroll () - "Scroll window if LLM response continues below viewport. - -Note: This will move the cursor." - (when-let* ((win (get-buffer-window (current-buffer) 'visible)) - ((not (pos-visible-in-window-p (point) win))) - (scroll-error-top-bottom t)) - (condition-case nil - (with-selected-window win - (scroll-up-command)) - (error nil)))) - -(defun gptel-beginning-of-response (&optional beg _end arg) - "Move point to BEG, or to the beginning of the LLM response ARG times." - (interactive (list nil nil - (prefix-numeric-value current-prefix-arg))) - (gptel-end-of-response beg nil (- (or arg 1)))) - -(defun gptel-end-of-response (&optional beg end arg) - "Move point to end of LLM response. - -With BEG, start search from BEG when ARG is negative. -With END, start search from END when ARG is positive. -Otherwise move ARG times, defaulting to 1." - (interactive (list nil nil - (prefix-numeric-value current-prefix-arg))) - (unless arg (setq arg 1)) - (let* ((search (if (> arg 0) - #'text-property-search-forward - #'text-property-search-backward)) - (goto-prefix-end - (lambda () (when-let* ((prefix (gptel-prompt-prefix-string)) - ((not (string-empty-p prefix))) - ((looking-at (concat "\n\\{1,2\\}" - (regexp-quote prefix) "?")))) - (goto-char (match-end 0))))) - (goto-prefix-beg - (lambda () (when-let* ((prefix (gptel-response-prefix-string)) - ((not (string-empty-p prefix))) - ((looking-back (concat (regexp-quote prefix) "?") - (point-min)))) - (goto-char (match-beginning 0)))))) - (cond - ((and end (> arg 0)) (goto-char end) (cl-decf arg) (funcall goto-prefix-end)) - ((and beg (< arg 0)) (goto-char beg) (cl-incf arg) (funcall goto-prefix-beg))) - (dotimes (_ (abs arg)) - (funcall search 'gptel 'response t) - (if (> arg 0) - (funcall goto-prefix-end) - (funcall goto-prefix-beg))))) - -(defun gptel-markdown-cycle-block () - "Cycle code blocks in Markdown." - (interactive) - (save-excursion - (forward-line 0) - (let (start end (parity 0)) - (cond ;Find start and end of block, with possible nested blocks - ((looking-at-p "^``` *\n") ;end of block, find corresponding start - (setq parity -1 end (line-end-position)) - (while (and (not (= parity 0)) (not (bobp)) (forward-line -1)) - (cond ((looking-at-p "^``` *\n") (cl-decf parity)) - ((looking-at-p "^``` ?[a-z]") (cl-incf parity)))) - (when (= parity 0) (setq start (point)))) - - ((looking-at-p "^``` ?[a-z]") ;beginning of block, find corresponding end - (setq parity 1 start (point)) - (while (and (not (= parity 0)) (not (eobp)) (forward-line 1)) - (cond ((looking-at-p "^``` *\n") (cl-decf parity)) - ((looking-at-p "^``` ?[a-z]") (cl-incf parity)))) - (when (= parity 0) (setq end (line-end-position))))) - (when (and start end) - (goto-char start) - (end-of-line) - (pcase-let* ((`(,value . ,hide-ov) - (get-char-property-and-overlay (point) 'invisible))) - (if (and hide-ov (eq value t)) - (delete-overlay hide-ov) - (unless hide-ov (setq hide-ov (make-overlay (point) end))) - (overlay-put hide-ov 'evaporate t) - (overlay-put hide-ov 'invisible t) - (overlay-put hide-ov 'before-string - (propertize "..." 'face 'shadow)))))))) - -(defsubst gptel--annotate-link (ov link-status) - "Annotate link overlay OV according to LINK-STATUS. - -LINK-STATUS is a list of link properties relevant to gptel queries, of -the form (valid . REST). See `gptel-markdown--validate-link' for -details. Indicate the (in)validity of the link for inclusion with gptel -queries via OV." - (cl-destructuring-bind - (valid _ path resource-type user-check readablep mime-valid _mime) - link-status - (if valid - (progn - (overlay-put - ov 'before-string - (concat (propertize "SEND" 'face '(:inherit success :height 0.8)) - (if (display-graphic-p) - (propertize " " 'display '(space :width 0.5)) " "))) - (overlay-put ov 'help-echo - (format "Sending %s %s with gptel requests" resource-type path))) - (overlay-put ov 'before-string - (concat (propertize "!" 'face '(:inherit error)) - (propertize " " 'display '(space :width 0.3)))) - (overlay-put - ov 'help-echo - (concat - "Sending only link text with gptel requests, " - "this link will not be followed to its source.\n\nReason: " - (cond - ((not resource-type) "Not a supported link type\ - (Only \"file\" and \"attachment\" are supported)") - ((not user-check) - (concat - "\nNot a standalone link -- separate link from text around it. \n (OR) -Link failed to validate, see `gptel-markdown-validate-link' or `gptel-org-validate-link'.")) - ((not readablep) (format "File %s is not readable" path)) - ((not mime-valid) - (pcase resource-type - ('file (format "%s does not support binary file %s" gptel-model path)) - ('url (format "%s does not support fetching non-image URLs" gptel-model)))))))))) - -(defun gptel--annotate-link-clear (&optional beg end) - "Delete all gptel org link annotations between BEG and END." - (mapc #'delete-overlay - (cl-delete-if-not - (lambda (o) (overlay-get o 'gptel-track-media)) - (overlays-in (or beg (point-min)) (or end (point-max)))))) - -;;;; Response text recognition - -(defun gptel--get-buffer-bounds () - "Return the gptel response boundaries in the buffer as an alist." - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (let ((bounds) (prev-pt (point))) - (while (and (/= prev-pt (point-min)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min)))) - (when-let* ((prop (get-char-property (point) 'gptel))) - (let* ((prop-name (if (symbolp prop) prop (car prop))) - (val (when (consp prop) (cdr prop))) - (bound (if val - (list (point) prev-pt val) - (list (point) prev-pt)))) - (push bound (alist-get prop-name bounds)))) - (setq prev-pt (point))) - bounds)))) - -(define-obsolete-function-alias - 'gptel--get-bounds 'gptel--get-response-bounds "0.9.8") - -(defun gptel--get-response-bounds () - "Return the gptel response boundaries around point." - (let (prop) - (save-excursion - (when (text-property-search-forward - 'gptel 'response t) - (when (setq prop (text-property-search-backward - 'gptel 'response t)) - (cons (prop-match-beginning prop) - (prop-match-end prop))))))) - -(defun gptel--in-response-p (&optional pt) - "Check if position PT is inside a gptel response." - (eq (get-char-property (or pt (point)) 'gptel) 'response)) - -(defun gptel--at-response-history-p (&optional pt) - "Check if gptel response at position PT has variants." - (get-char-property (or pt (point)) 'gptel-history)) - -(defvar gptel--mode-description-alist - '((js2-mode . "Javascript") - (sh-mode . "Shell") - (enh-ruby-mode . "Ruby") - (yaml-mode . "Yaml") - (yaml-ts-mode . "Yaml") - (rustic-mode . "Rust") - (tuareg-mode . "OCaml")) - "Mapping from unconventionally named major modes to languages. - -This is used when generating system prompts for rewriting and -when including context from these major modes.") - - -;;; Saving and restoring state - -(defun gptel--restore-props (bounds-alist) - "Restore text properties from BOUNDS-ALIST. -BOUNDS-ALIST is (PROP . BOUNDS). BOUNDS is a list of BOUND. Each BOUND -is either (BEG END VAL) or (BEG END). - -For (BEG END VAL) forms, even if VAL is nil, the gptel property will be -set to (PROP . VAL). For (BEG END) forms, except when PROP is response, -the gptel property is set to just PROP. - -The legacy structure, a list of (BEG . END) is also supported and will be -applied before being re-persisted in the new structure." - (let ((modified (buffer-modified-p))) - (if (symbolp (caar bounds-alist)) - (mapc - (lambda (bounds) - (let* ((prop (pop bounds))) - (mapc - (lambda (bound) - (let ((prop-has-val (> (length bound) 2))) - (add-text-properties - (pop bound) (pop bound) - (if (eq prop 'response) - '(gptel response front-sticky (gptel)) - (list 'gptel - (if prop-has-val - (cons prop (pop bound)) - prop)))))) - bounds))) - bounds-alist) - (mapc (lambda (bound) - (add-text-properties - (car bound) (cdr bound) '(gptel response front-sticky (gptel)))) - bounds-alist)) - (set-buffer-modified-p modified))) - -(defun gptel--restore-state () - "Restore gptel state when turning on `gptel-mode'." - (when (buffer-file-name) - (if (derived-mode-p 'org-mode) - (progn - (require 'gptel-org) - (gptel-org--restore-state)) - (when gptel--bounds - (gptel--restore-props gptel--bounds) - (message "gptel chat restored.")) - (when gptel--backend-name - (if-let* ((backend (alist-get - gptel--backend-name gptel--known-backends - nil nil #'equal))) - (setq-local gptel-backend backend) - (message - (substitute-command-keys - (concat - "Could not activate gptel backend \"%s\"! " - "Switch backends with \\[universal-argument] \\[gptel-send]" - " before using gptel.")) - gptel--backend-name))) - (when gptel--tool-names - (if-let* ((tools (cl-loop - for tname in gptel--tool-names - for tool = (with-demoted-errors "gptel: %S" - (gptel-get-tool tname)) - if tool collect tool else do - (display-warning - '(gptel org tools) - (format "Tool %s not found, ignoring" tname))))) - (setq-local gptel-tools tools)))))) - -(defun gptel--save-state () - "Write the gptel state to the buffer. - -This saves chat metadata when writing the buffer to disk. To -restore a chat session, turn on `gptel-mode' after opening the -file." - (run-hooks 'gptel-save-state-hook) - (if (derived-mode-p 'org-mode) - (progn - (require 'gptel-org) - (gptel-org--save-state)) - (let ((print-escape-newlines t)) - (save-excursion - (save-restriction - (add-file-local-variable 'gptel-model gptel-model) - (add-file-local-variable 'gptel--backend-name - (gptel-backend-name gptel-backend)) - (unless (equal (default-value 'gptel--system-message) - gptel--system-message) - (add-file-local-variable - 'gptel--system-message ;TODO: Handle nil case correctly - (car-safe (gptel--parse-directive gptel--system-message)))) - (if gptel-tools - (add-file-local-variable - 'gptel--tool-names (mapcar #'gptel-tool-name gptel-tools)) - (delete-file-local-variable 'gptel--tool-names)) - (if (equal (default-value 'gptel-temperature) gptel-temperature) - (delete-file-local-variable 'gptel-temperature) - (add-file-local-variable 'gptel-temperature gptel-temperature)) - (if gptel-max-tokens - (add-file-local-variable 'gptel-max-tokens gptel-max-tokens) - (delete-file-local-variable 'gptel-max-tokens)) - (if (natnump gptel--num-messages-to-send) - (add-file-local-variable 'gptel--num-messages-to-send - gptel--num-messages-to-send) - (delete-file-local-variable 'gptel--num-messages-to-send)) - (add-file-local-variable 'gptel--bounds (gptel--get-buffer-bounds))))))) - - -;;; Minor modes and UI - -;; NOTE: It's not clear that this is the best strategy: -(cl-pushnew '(gptel . t) (default-value 'text-property-default-nonsticky) - :test #'equal) - -(defun gptel--inherit-stickiness (beg end _pre) - "Mark any change to an LLM response region as a response. - -Intended to be added to `after-change-functions' in gptel chat buffers, -which see for BEG, END and PRE." - (and (/= beg end) (< end (point-max)) - (and-let* ((val (get-text-property end 'gptel))) - (add-text-properties - beg end `(gptel ,val front-sticky (gptel)))))) - -(defun gptel-markdown--annotate-links (beg end) - "Annotate Markdown links whose sources will be sent with `gptel-send'. - -Search between BEG and END." - (when gptel-track-media - (save-excursion - (goto-char beg) (forward-line -1) - (let ((link-ovs (cl-loop for o in (overlays-in (point) end) - if (overlay-get o 'gptel-track-media) - collect o into os finally return os))) - (while (re-search-forward gptel-markdown--link-regex end t) - (unless (gptel--in-response-p (1- (point))) - (let* ((link (markdown-link-at-pos (point))) - (from (car link)) (to (cadr link)) - (link-status (gptel-markdown--validate-link link)) - (ov (cl-loop for o in (overlays-in from to) - if (overlay-get o 'gptel-track-media) - return o))) - (if ov ; Ensure overlay over each link - (progn (move-overlay ov from to) - (setq link-ovs (delq ov link-ovs))) - (setq ov (make-overlay from to nil t)) - (overlay-put ov 'gptel-track-media t) - (overlay-put ov 'evaporate t) - (overlay-put ov 'priority -80)) - ;; Check if link will be sent, and annotate accordingly - (gptel--annotate-link ov link-status)))) - (and link-ovs (mapc #'delete-overlay link-ovs)))) - `(jit-lock-bounds ,beg . ,end))) - -(defvar gptel--header-line-info - '(:eval - (let* ((model (gptel--model-name gptel-model)) - (system - (propertize - (buttonize - (format "[Prompt: %s]" - (or (car-safe (rassoc gptel--system-message gptel-directives)) - (gptel--describe-directive gptel--system-message 15))) - (lambda (&rest _) (gptel-system-prompt))) - 'mouse-face 'highlight - 'help-echo "System message for session")) - (context - (and gptel-context - (cl-loop - for entry in gptel-context - if (bufferp (or (car-safe entry) entry)) count it into bufs - else count (stringp (or (car-safe entry) entry)) into files - finally return - (propertize - (buttonize - (concat "[Context: " - (and (> bufs 0) (format "%d buf" bufs)) - (and (> bufs 1) "s") - (and (> bufs 0) (> files 0) ", ") - (and (> files 0) (format "%d file" files)) - (and (> files 1) "s") - "]") - (lambda (&rest _) - (require 'gptel-context) - (gptel-context--buffer-setup))) - 'mouse-face 'highlight - 'help-echo "Active gptel context")))) - (toggle-track-media - (lambda (&rest _) - (setq-local gptel-track-media (not gptel-track-media)) - (if gptel-track-media - (progn - (run-hooks 'gptel-refresh-buffer-hook) - (message "Sending media from included links.")) - (without-restriction (gptel--annotate-link-clear)) - (message "Ignoring links. Only link text will be sent.")) - (run-at-time 0 nil #'force-mode-line-update))) - (track-media - (and (gptel--model-capable-p 'media) - (if gptel-track-media - (propertize - (buttonize "[Sending media]" toggle-track-media) - 'mouse-face 'highlight - 'help-echo - "Sending media from links/urls when supported.\nClick to toggle") - (propertize - (buttonize "[Ignoring media]" toggle-track-media) - 'mouse-face 'highlight - 'help-echo - "Ignoring media from links/urls.\nClick to toggle")))) - (toggle-tools (lambda (&rest _) (interactive) - (run-at-time 0 nil - (lambda () (call-interactively #'gptel-tools))))) - (tools (when (and gptel-use-tools gptel-tools) - (propertize - (buttonize (pcase (length gptel-tools) - (0 "[No tools]") (1 "[1 tool]") - (len (format "[%d tools]" len))) - toggle-tools) - 'mouse-face 'highlight - 'help-echo "Select tools")))) - (concat - (propertize - " " 'display - `(space :align-to (- right - ,(+ 5 (length model) (length system) - (length track-media) (length context) (length tools))))) - tools (and track-media " ") track-media (and context " ") context " " system " " - (propertize - (buttonize (concat "[" model "]") - (lambda (&rest _) (gptel-menu))) - 'mouse-face 'highlight - 'help-echo "Model in use")))) - "Information segment for the header-line in gptel-mode.") - -(defun gptel-use-header-line () - "Set up the header-line for a gptel buffer. - -It is composed of three segments: the backend name, the -status (Ready/Waiting etc) and the info segment, showing the current -context, tools, system prompt, model and more." - (setq - header-line-format - (list '(:eval (concat (propertize " " 'display '(space :align-to 0)) - (format "%s" (gptel-backend-name gptel-backend)))) - (propertize " Ready" 'face 'success) - gptel--header-line-info))) - -;;;###autoload -(define-minor-mode gptel-mode - "Minor mode for interacting with LLMs." - :lighter " GPT" - :keymap - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c RET") #'gptel-send) - map) - (if gptel-mode - (progn - (unless (derived-mode-p 'org-mode 'markdown-mode 'text-mode) - (gptel-mode -1) - (user-error (format "`gptel-mode' is not supported in `%s'." major-mode))) - (add-hook 'before-save-hook #'gptel--save-state nil t) - (add-hook 'after-change-functions 'gptel--inherit-stickiness nil t) - (gptel--prettify-preset) - (cond - ((derived-mode-p 'org-mode) - (require 'gptel-org) - (jit-lock-register 'gptel-org--annotate-links) - ;; Work around bug in `org-fontify-extend-region'. - (add-hook 'gptel-post-response-functions #'font-lock-flush nil t)) - ((derived-mode-p 'markdown-mode) - (font-lock-add-keywords ;keymap is a font-lock-managed property in markdown-mode - nil '(("^```[ \t]*\\([[:alpha:]][^\n]*\\)?$" ;match code fences - 0 (list 'face nil 'keymap gptel--markdown-block-map)))) - (jit-lock-register 'gptel-markdown--annotate-links))) - (gptel--restore-state) - (if gptel-use-header-line - (progn (setq gptel--old-header-line header-line-format) - (gptel-use-header-line)) - (setq mode-line-process - '(:eval (concat " " (buttonize (gptel--model-name gptel-model) - (lambda (&rest _) (gptel-menu)))))))) - (remove-hook 'before-save-hook #'gptel--save-state t) - (remove-hook 'after-change-functions 'gptel--inherit-stickiness t) - (cond - ((derived-mode-p 'org-mode) - (jit-lock-unregister #'gptel-org--annotate-links) - (without-restriction (gptel--annotate-link-clear))) - ((derived-mode-p 'markdown-mode) - (jit-lock-unregister #'gptel-markdown--annotate-links) - (without-restriction (gptel--annotate-link-clear)))) - (gptel--prettify-preset) - (if gptel-use-header-line - (setq header-line-format gptel--old-header-line - gptel--old-header-line nil) - (setq mode-line-process nil)))) - -;; ;TODO(request-lib): Declaration no longer needed -(defvar gptel--fsm-last) ;Defined further below -(defun gptel--update-status (&optional msg face) - "Update status MSG in FACE." - (when gptel-mode - (if gptel-use-header-line - (and (consp header-line-format) - (setf (nth 1 header-line-format) - (thread-first - msg - (buttonize (lambda (_) (gptel--inspect-fsm))) - (propertize 'face face 'mouse-face 'highlight)))) - (if (member msg '(" Typing..." " Waiting...")) - (setq mode-line-process (propertize msg 'face face)) - (setq mode-line-process - '(:eval (concat " " - (buttonize (gptel--model-name gptel-model) - (lambda (&rest _) (gptel-menu)))))) - (message (propertize msg 'face face)))) - (force-mode-line-update))) - - -;;;; gptel-highlight-mode - -(defcustom gptel-highlight-methods '(margin) - "Types of LLM response highlighting used by `gptel-highlight-mode'. - -This must be a list of symbols denoting types of highlighting for LLM responses: -- face: highlight LLM responses using face `gptel-response-highlight'. -- fringe: highlight using a (left) fringe marker. -- margin: highlight in the (left) display margin. - -margin and fringe markings are mutually exclusive, and use the -`gptel-response-fringe-highlight' face." - :type '(set (const :tag "Fringe marker" fringe) - (const :tag "Face highlighting" face) - (const :tag "Margin indicator" margin)) - :group 'gptel) - -(defface gptel-response-highlight - '((((background light) (min-colors 88)) :background "linen" :extend t) - (((background dark) (min-colors 88)) :background "gray14" :extend t) - (t :inherit mode-line)) - "Face used to highlight LLM responses when using `gptel-highlight-mode'. - -To enable this face for responses, `gptel-highlight-methods' must be set." - :group 'gptel) - -(defface gptel-response-fringe-highlight - '((t :inherit outline-1 :height reset)) - "LLM response fringe/margin face when using `gptel-highlight-mode'. - -To enable response highlights in the fringe, `gptel-highlight-methods' -must be set." - :group 'gptel) - -(define-fringe-bitmap 'gptel-highlight-fringe - (make-vector 28 #b01100000) - nil nil 'center) - -;; Common options for margin indicator: -;; BOX DRAWINGS LIGHT VERTICAL 0x002502 -;; LEFT ONE QUARTER BLOCK 0x00258E -;; LEFT THREE EIGHTHS BLOCK 0x00258D -;; BOX DRAWINGS HEAVY VERTICAL 0x002503 -;; VERTICAL ONE EIGHTH BLOCK-2 0x01FB70 - -(defun gptel-highlight--margin-prefix (type) - "Create margin prefix string for TYPE. - -Supported TYPEs are response, ignore and tool calls." - (propertize ">" 'display - `( (margin left-margin) - ,(propertize "▎" 'face - (pcase type - ('response 'gptel-response-fringe-highlight) - ('ignore 'shadow) - (`(tool . ,_) 'shadow)))))) - -(defun gptel-highlight--fringe-prefix (type) - "Create fringe prefix string for TYPE. - -Supported TYPEs are response, ignore and tool calls." - (propertize ">" 'display - `( left-fringe gptel-highlight-fringe - ,(pcase type - ('response 'gptel-response-fringe-highlight) - ('ignore 'shadow) - (`(tool . ,_) 'shadow))))) - -(defun gptel-highlight--decorate (ov &optional val) - "Decorate gptel indicator overlay OV whose type is VAL." - (overlay-put ov 'evaporate t) - (overlay-put ov 'gptel-highlight t) - (when (memq 'face gptel-highlight-methods) - (overlay-put ov 'font-lock-face - (pcase val - ('response 'gptel-response-highlight) - ('ignore 'shadow) - (`(tool . ,_) 'shadow)))) - (when-let* ((prefix - (cond ((memq 'margin gptel-highlight-methods) - (gptel-highlight--margin-prefix (or val 'response))) - ((memq 'fringe gptel-highlight-methods) - (gptel-highlight--fringe-prefix (or val 'response)))))) - (overlay-put ov 'line-prefix prefix) - (overlay-put ov 'wrap-prefix prefix))) - -(defun gptel-highlight--update (beg end) - "JIT-lock function: mark gptel response/reasoning regions. - -BEG and END delimit the region to refresh." - (save-excursion ;Scan across region for the gptel text property - (let ((prev-pt (goto-char end))) - (while (and (goto-char (previous-single-property-change - (point) 'gptel nil beg)) - (/= (point) prev-pt)) - (pcase (get-char-property (point) 'gptel) - ((and (or 'response 'ignore `(tool . ,_)) val) - (if-let* ((ov (or (cdr-safe (get-char-property-and-overlay - (point) 'gptel-highlight)) - (cdr-safe (get-char-property-and-overlay - prev-pt 'gptel-highlight)))) - (from (overlay-start ov)) (to (overlay-end ov))) - (unless (<= from (point) prev-pt to) - (move-overlay ov (min from (point)) (max to prev-pt))) - (gptel-highlight--decorate ;Or make new overlay covering just region - (make-overlay (point) prev-pt nil t) val))) - ('nil ;If there's an overlay, we need to split it. - (when-let* ((ov (cdr-safe (get-char-property-and-overlay - (point) 'gptel-highlight))) - (from (overlay-start ov)) (to (overlay-end ov))) - (move-overlay ov from (point)) ;Move overlay to left side - (gptel-highlight--decorate ;Make a new one on the right - (make-overlay prev-pt to nil t) - (get-char-property prev-pt 'gptel))))) - (setq prev-pt (point))))) - `(jit-lock-bounds ,beg . ,end)) - -(define-minor-mode gptel-highlight-mode - "Visually highlight LLM respones regions. - -Highlighting is via fringe or margin markers, and optionally a response -face. See `gptel-highlight-methods' for highlighting methods, and -`gptel-response-highlight' and `gptel-response-fringe-highlight' for the -faces. - -This minor mode can be used anywhere in Emacs, and not just gptel chat -buffers." - :lighter nil - :global nil - (cond - (gptel-highlight-mode - (when (memq 'margin gptel-highlight-methods) - (setq left-margin-width (1+ left-margin-width)) - (if-let* ((win (get-buffer-window (current-buffer)))) - (set-window-buffer win (current-buffer)))) - (jit-lock-register #'gptel-highlight--update) - (gptel-highlight--update (point-min) (point-max))) - (t (when (memq 'margin gptel-highlight-methods) - (setq left-margin-width (max (1- left-margin-width) 0)) - (if-let* ((win (get-buffer-window (current-buffer)))) - (set-window-buffer win (current-buffer)))) - (jit-lock-unregister #'gptel-highlight--update) - (without-restriction - (remove-overlays nil nil 'gptel-highlight t))))) - - -;;; State machine additions for `gptel-send'. - -(defvar gptel-send--handlers - `((WAIT ,#'gptel--handle-wait ,#'gptel--update-wait) - (TYPE ,#'gptel--handle-pre-insert) - (ERRS ,#'gptel--handle-error ,#'gptel--fsm-last) - (TOOL ,#'gptel--update-tool-call ,#'gptel--handle-tool-use ,#'gptel--update-tool-ask) - (DONE ,#'gptel--handle-post-insert ,#'gptel--fsm-last) - (ABRT ,#'gptel--handle-abort)) - "Alist specifying handlers for `gptel-send' state transitions. - -See `gptel-request--handlers' for details.") - -(defvar-local gptel--fsm-last nil - "State machine for latest request in the buffer.") - -(defun gptel--fsm-last (fsm) - "Capture the latest request state FSM for introspection." - (let ((info (gptel-fsm-info fsm))) - (unless gptel-log-level - (let ((data (plist-get info :data))) - (dolist (key '(:messages :contents :query)) - (setf (plist-get data key) nil)))) - (setf (gptel-fsm-info fsm) - (plist-put info :end-time (current-time-string))) - (with-current-buffer (plist-get info :buffer) - (setq gptel--fsm-last fsm)))) - -(defun gptel--inspect-fsm (&optional fsm) - "Inspect gptel request state FSM. - -FSM defaults to the state of the last request in the current -buffer." - (unless fsm - (setq fsm (or (cdr-safe (cl-find-if - (lambda (proc-list) - (eq (thread-first (cadr proc-list) - (gptel-fsm-info) - (plist-get :buffer)) - (current-buffer))) - gptel--request-alist)) - gptel--fsm-last))) - (unless (cl-typep gptel--fsm-last 'gptel-fsm) - (user-error "No gptel request log in this buffer yet!")) - (require 'tabulated-list) - (with-current-buffer (get-buffer-create "*gptel-diagnostic*") - (setq tabulated-list-format [("Request attribute" 30 t) ("Value" 30)]) - (let* ((pb (lambda (s) (propertize s 'face 'font-lock-builtin-face))) - (ps (lambda (s) (propertize s 'face 'font-lock-string-face))) - (fmt (lambda (s) (cond ((memq (car-safe s) '(closure lambda)) - (format "#" (sxhash s))) - ((byte-code-function-p s) - (format "#" (sxhash s))) - ((stringp s) (string-replace "\n" "⮐ " s)) - (t (prin1-to-string s))))) - (inhibit-read-only t) - (info (gptel-fsm-info fsm)) - (entries-info - (cl-loop - for idx upfrom 3 - for (key val) on info by #'cddr - unless (memq key '(:data :history :tools - :partial_text :partial_json)) - collect - (list idx `[,(funcall pb (symbol-name key)) - ,(funcall ps (funcall fmt val))]))) - (entries-data - (cl-loop - for idx upfrom 50 - for (key val) on (plist-get info :data) by #'cddr - unless (memq key '(:messages :stream :contents :query)) - collect - (list idx `[,(funcall pb (symbol-name key)) - ,(funcall ps (funcall fmt val))])))) - (setq tabulated-list-entries - (nconc (list `(2 [,(funcall pb ":state") - ,(funcall ps - (mapconcat - fmt (reverse (cons (gptel-fsm-state fsm) - (plist-get info :history))) - " → "))])) - entries-info - entries-data)) - (tabulated-list-print) - (tabulated-list-mode) - (tabulated-list-init-header) - (hl-line-mode 1) - (display-buffer - (current-buffer) - '((display-buffer-in-side-window) - (side . bottom) - (window-height . fit-window-to-buffer) - (slot . 10) - (body-function . select-window)))))) - -;;;; State machine handlers -;; The next few functions are default state handlers for gptel-send, see -;; `gptel-send--handlers'. - -(defun gptel--handle-pre-insert (fsm) - "Tasks before inserting the LLM response for state FSM. - -Handle read-only buffers and run pre-response hooks (but only if -the request succeeded)." - (let* ((info (gptel-fsm-info fsm)) - (start-marker (plist-get info :position))) - (when (and - (memq (plist-get info :callback) - '(gptel--insert-response gptel-curl--stream-insert-response)) - (with-current-buffer (plist-get info :buffer) - (or buffer-read-only - (get-char-property start-marker 'read-only)))) - (message "Buffer is read only, displaying reply in buffer \"*LLM response*\"") - (display-buffer - (with-current-buffer (get-buffer-create "*LLM response*") - (visual-line-mode 1) - (goto-char (point-max)) - (move-marker start-marker (point) (current-buffer)) - (current-buffer)) - '((display-buffer-reuse-window - display-buffer-pop-up-window) - (reusable-frames . visible)))) - (with-current-buffer (marker-buffer start-marker) - (when (plist-get info :stream) - (gptel--update-status " Typing..." 'success)) - (save-excursion - (goto-char start-marker) - (when (and (member (plist-get info :http-status) '("200" "100")) - gptel-pre-response-hook) - (run-hooks 'gptel-pre-response-hook)))))) - -(defun gptel--handle-post-insert (fsm) - "Tasks after successfully inserting the LLM response with state FSM. - -Indicate gptel status, pulse the inserted text and run post-response hooks. - -No state transition here since that's handled by the process sentinels." - (let* ((info (gptel-fsm-info fsm)) - (start-marker (plist-get info :position)) - (tracking-marker (or (plist-get info :tracking-marker) - start-marker)) - ;; start-marker may have been moved if :buffer was read-only - (gptel-buffer (marker-buffer start-marker))) - (with-current-buffer gptel-buffer - (if (not tracking-marker) ;Empty response - (when gptel-mode (gptel--update-status " Empty response" 'success)) - (set-marker-insertion-type tracking-marker nil) ;Lock tracking-marker - (when gptel-mode - (unless (plist-get info :in-place) - (save-excursion (goto-char tracking-marker) - (insert gptel-response-separator - (gptel-prompt-prefix-string)))) - (gptel--update-status " Ready" 'success)))) - ;; Run hook in visible window to set window-point, BUG #269 - (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible))) - (with-selected-window gptel-window - (mapc (lambda (f) (funcall f info)) (plist-get info :post)) - (run-hook-with-args - 'gptel-post-response-functions - (marker-position start-marker) (marker-position tracking-marker))) - (with-current-buffer gptel-buffer - (mapc (lambda (f) (funcall f info)) (plist-get info :post)) - (run-hook-with-args - 'gptel-post-response-functions - (marker-position start-marker) (marker-position tracking-marker)))))) - -(defun gptel--handle-error (fsm) - "Check for errors in request state FSM. - -Perform UI updates and run post-response hooks." - (when-let* ((info (gptel-fsm-info fsm)) - (error-data (plist-get info :error)) - (http-msg (plist-get info :status)) - (gptel-buffer (plist-get info :buffer)) - (start-marker (plist-get info :position)) - (tracking-marker (or (plist-get info :tracking-marker) - start-marker)) - (backend-name - (gptel-backend-name - (buffer-local-value 'gptel-backend gptel-buffer)))) - (if (stringp error-data) - (message "%s error: (%s) %s" backend-name http-msg (string-trim error-data)) - (when-let* ((error-type (plist-get error-data :type))) - (setq http-msg (concat "(" http-msg ") " - (string-trim (gptel--to-string error-type))))) - (when-let* ((error-msg (plist-get error-data :message))) - (message "%s error: (%s) %s" backend-name http-msg - (string-trim (gptel--to-string error-msg))))) - (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible))) - (with-selected-window gptel-window - (mapc (lambda (f) (funcall f info)) (plist-get info :post)) - (run-hook-with-args - 'gptel-post-response-functions - (marker-position start-marker) (marker-position tracking-marker))) - (with-current-buffer gptel-buffer - (mapc (lambda (f) (funcall f info)) (plist-get info :post)) - (run-hook-with-args - 'gptel-post-response-functions - (marker-position start-marker) (marker-position tracking-marker)))) - (with-current-buffer gptel-buffer - (when gptel-mode - (gptel--update-status - (format " Error: %s" http-msg) 'error))))) - -(defun gptel--handle-abort (fsm) - "Perform UI update on `gptel-abort' for FSM." - (when-let* ((info (gptel-fsm-info fsm)) - (gptel-buffer (plist-get info :buffer)) - (start-marker (plist-get info :position)) - (tracking-marker (or (plist-get info :tracking-marker) - start-marker))) - (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible))) - (with-selected-window gptel-window - (mapc (lambda (f) (funcall f info)) (plist-get info :post)) - (run-hook-with-args - 'gptel-post-response-functions - (marker-position start-marker) (marker-position tracking-marker))) - (with-current-buffer gptel-buffer - (mapc (lambda (f) (funcall f info)) (plist-get info :post)) - (run-hook-with-args - 'gptel-post-response-functions - (marker-position start-marker) (marker-position tracking-marker)))) - (with-current-buffer gptel-buffer - (when gptel-mode (gptel--update-status " Abort" 'error))))) - -(defun gptel--update-wait (fsm) - "Update gptel's status after sending a request." - (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer) - (when gptel-mode - (gptel--update-status " Waiting..." 'warning)))) - -(defun gptel--update-tool-call (fsm) - "Update gptel's status when calling a tool." - (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer) - (setq gptel--fsm-last fsm) - (when gptel-mode - (gptel--update-status " Calling tool..." 'mode-line-emphasis)))) - -(defun gptel--update-tool-ask (fsm) - "Update gptel's status when there are pending tool calls." - (when (plist-get (gptel-fsm-info fsm) :tool-pending) - (plist-put (gptel-fsm-info fsm) :tool-pending nil) - (when gptel-mode - (gptel--update-status " Run tools?" 'mode-line-emphasis)))) - - -;;; Send queries, handle responses -;;;###autoload -(defun gptel-send (&optional arg) - "Submit this prompt to the current LLM backend. - -By default, the contents of the buffer up to the cursor position -are sent. If the region is active, its contents are sent -instead. - -The response from the LLM is inserted below the cursor position -at the time of sending. To change this behavior or model -parameters, use prefix arg ARG activate a transient menu with -more options instead. - -This command is asynchronous, you can continue to use Emacs while -waiting for the response." - (interactive "P") - (if (and arg (require 'gptel-transient nil t)) - (call-interactively #'gptel-menu) - (gptel--sanitize-model) - (let ((fsm (gptel-make-fsm :handlers gptel-send--handlers))) - (gptel-request nil - :stream gptel-stream - :transforms gptel-prompt-transform-functions - :fsm fsm) - (message "Querying %s..." - (thread-first (gptel-fsm-info fsm) - (plist-get :backend) - (or gptel-backend) - (gptel-backend-name)))) - (gptel--update-status " Waiting..." 'warning))) - -(declare-function json-pretty-print-buffer "json") -(defun gptel--inspect-query (&optional request-fsm format) - "Show the full LLM query that will be sent in a buffer. - -This functions as a dry run of `gptel-send'. The request data -may be edited and the query continued from this buffer. - -REQUEST-FSM is the state of the request, as returned by -`gptel-request'. If FORMAT is the symbol json, show the encoded -JSON query instead of the Lisp structure gptel uses." - (unless request-fsm (setq request-fsm gptel--fsm-last)) - (if (bufferp (plist-get (gptel-fsm-info request-fsm) :data)) - (letrec ((dry-run-poll - (run-with-timer - 0 1 (lambda (fsm form) - (unless (bufferp (plist-get (gptel-fsm-info fsm) :data)) - (cancel-timer dry-run-poll) - (gptel--inspect-query fsm form))) - request-fsm format)))) - (with-current-buffer (plist-get (gptel-fsm-info request-fsm) :buffer) - (gptel--update-status " Ready" 'success)) - (with-current-buffer (get-buffer-create "*gptel-query*") - (let* ((standard-output (current-buffer)) - (inhibit-read-only t) - (request-data - (plist-get (gptel-fsm-info request-fsm) :data))) - (buffer-disable-undo) - (erase-buffer) - (if (eq format 'json) - (progn (fundamental-mode) - (insert (gptel--json-encode request-data)) - (json-pretty-print-buffer)) - (lisp-data-mode) - (prin1 request-data) - (pp-buffer)) - (setq-local gptel--fsm-last request-fsm) - (goto-char (point-min)) - (view-mode 1) - (setq buffer-undo-list nil) - (use-local-map - (make-composed-keymap - (define-keymap - "C-c C-c" #'gptel--continue-query - "C-c C-w" (lambda () "Copy Curl command for query." - (interactive) (gptel--continue-query 'copy)) - "C-c C-k" #'quit-window) - (current-local-map))) - (unless header-line-format - (setq header-line-format - (substitute-command-keys - (concat - "Edit request: \\[read-only-mode]," - " Send request: \\[gptel--continue-query]," - (format " Copy Curl: %s" - (propertize "C-c C-w" 'face 'help-key-binding)) - " Quit: \\[quit-window]")))) - (display-buffer (current-buffer) gptel-display-buffer-action))))) - -(defun gptel--continue-query (&optional copy) - "Continue sending the gptel query displayed in this buffer. - -The request is continued with the same parameters as originally -specified. - -With prefix arg COPY, copy the Curl command for the request to the -kill ring instead." - (interactive "P" lisp-data-mode fundamental-mode) - (unless (equal (buffer-name) "*gptel-query*") - (user-error "This command is meant for use in a gptel dry-run buffer")) - (save-excursion - (goto-char (point-min)) - (condition-case-unless-debug nil - (when-let* ((data (if (eq major-mode 'lisp-data-mode) - (read (current-buffer)) - (gptel--json-read)))) - (cl-assert (cl-typep gptel--fsm-last 'gptel-fsm)) - (plist-put (gptel-fsm-info gptel--fsm-last) :data data) - (if copy ;Copy Curl command instead of sending request - (let ((args (gptel-curl--get-args (gptel-fsm-info gptel--fsm-last) - (md5 (format "%s" (random)))))) - (kill-new - (mapconcat #'shell-quote-argument - (cons (gptel--curl-path) args) " \\\n")) - (message "Curl command for request copied to kill-ring")) - (gptel--fsm-transition gptel--fsm-last) ;INIT -> WAIT - (quit-window))) - (error - (user-error "Can not resume request: could not read data from buffer!"))))) - -(defun gptel--insert-response (response info &optional raw) - "Insert the LLM RESPONSE into the gptel buffer. - -INFO is a plist containing information relevant to this buffer. -See `gptel--url-get-response' for details. - -Optional RAW disables text properties and transformation." - (let* ((gptel-buffer (plist-get info :buffer)) - (start-marker (plist-get info :position)) - (tracking-marker (plist-get info :tracking-marker))) - (pcase response - ((pred stringp) ;Response text - (with-current-buffer gptel-buffer - (when tracking-marker ;separate from previous response - (setq response (concat gptel-response-separator response))) - (save-excursion - (with-current-buffer (marker-buffer start-marker) - (goto-char (or tracking-marker start-marker)) - ;; (run-hooks 'gptel-pre-response-hook) - (unless (or (bobp) (plist-get info :in-place) - tracking-marker) - (insert gptel-response-separator) - (when gptel-mode - (insert (gptel-response-prefix-string))) - (move-marker start-marker (point))) - (unless raw - (when-let* ((transformer (plist-get info :transformer))) - (setq response (funcall transformer response))) - (add-text-properties - 0 (length response) '(gptel response front-sticky (gptel)) response)) - (insert response) - (plist-put info :tracking-marker (setq tracking-marker (point-marker))) - ;; for uniformity with streaming responses - (set-marker-insertion-type tracking-marker t))))) - (`(reasoning . ,text) - (when-let* ((include (plist-get info :include-reasoning))) - (if (stringp include) - (with-current-buffer (get-buffer-create - (plist-get info :include-reasoning)) - (save-excursion (goto-char (point-max)) (insert text))) - (with-current-buffer (marker-buffer start-marker) - (let ((separator ;Separate from response prefix if required - (and (not tracking-marker) gptel-mode - (not (string-suffix-p "\n" (gptel-response-prefix-string))) - "\n")) - (blocks (if (derived-mode-p 'org-mode) - `("#+begin_reasoning\n" . ,(concat "\n#+end_reasoning" - gptel-response-separator)) - ;; TODO(reasoning) remove properties and strip instead - (cons (propertize "``` reasoning\n" 'gptel 'ignore - 'keymap gptel--markdown-block-map) - (concat (propertize "\n```" 'gptel 'ignore - 'keymap gptel--markdown-block-map) - gptel-response-separator))))) - (if (eq include 'ignore) - (progn - (add-text-properties - 0 (length text) '(gptel ignore front-sticky (gptel)) text) - (gptel--insert-response - (concat (car blocks) text (cdr blocks)) info t)) - (gptel--insert-response (concat separator (car blocks)) info t) - (gptel--insert-response text info) - (gptel--insert-response (cdr blocks) info t)) - (save-excursion - (goto-char (plist-get info :tracking-marker)) - (if (derived-mode-p 'org-mode) ;fold block - (progn (search-backward "#+end_reasoning" start-marker t) - (when (looking-at "^#\\+end_reasoning") - (org-cycle))) - (when (re-search-backward "^```" start-marker t) - (gptel-markdown-cycle-block))))))))) - (`(tool-call . ,tool-calls) - (gptel--display-tool-calls tool-calls info)) - (`(tool-result . ,tool-results) - (gptel--display-tool-results tool-results info))))) - -(defun gptel-curl--stream-insert-response (response info &optional raw) - "Insert streaming RESPONSE from an LLM into the gptel buffer. - -INFO is a mutable plist containing information relevant to this buffer. -See `gptel--url-get-response' for details. - -Optional RAW disables text properties and transformation." - (pcase response - ((pred stringp) - (let ((start-marker (plist-get info :position)) - (tracking-marker (plist-get info :tracking-marker)) - (transformer (plist-get info :transformer))) - (with-current-buffer (marker-buffer start-marker) - (save-excursion - (unless tracking-marker - (goto-char start-marker) - (unless (or (bobp) (plist-get info :in-place)) - (insert gptel-response-separator) - (when gptel-mode - ;; Put prefix before AI response. - (insert (gptel-response-prefix-string))) - (move-marker start-marker (point))) - (setq tracking-marker (set-marker (make-marker) (point))) - (set-marker-insertion-type tracking-marker t) - (plist-put info :tracking-marker tracking-marker)) - (goto-char tracking-marker) - (unless raw - (when transformer - (setq response (funcall transformer response))) - (add-text-properties - 0 (length response) '(gptel response front-sticky (gptel)) - response)) - ;; (run-hooks 'gptel-pre-stream-hook) - (insert response) - (run-hooks 'gptel-post-stream-hook))))) - (`(reasoning . ,text) - (gptel--display-reasoning-stream text info)) - (`(tool-call . ,tool-calls) - (gptel--display-tool-calls tool-calls info)) - (`(tool-result . ,tool-results) - (gptel--display-tool-results tool-results info) - ;; Adjust for tool calls inside reasoning blocks - (when (eq (plist-get info :reasoning-block) 'in) - (when-let* ((rm (plist-get info :reasoning-marker)) - (tm (plist-get info :tracking-marker))) - (move-marker rm tm (marker-buffer tm))))))) - -;;;###autoload -(defun gptel (name &optional _ initial interactivep) - "Switch to or start a chat session with NAME. - -Ask for API-KEY if `gptel-api-key' is unset. - -If region is active, use it as the INITIAL prompt. Returns the -buffer created or switched to. - -INTERACTIVEP is t when gptel is called interactively." - (interactive - (let* ((backend (default-value 'gptel-backend)) - (backend-name - (format "*%s*" (gptel-backend-name backend)))) - (list (read-buffer - "Create or choose gptel buffer: " - backend-name nil ; DEFAULT and REQUIRE-MATCH - (lambda (b) ; PREDICATE - ;; NOTE: buffer check is required (#450) - (and-let* ((buf (get-buffer (or (car-safe b) b)))) - (buffer-local-value 'gptel-mode buf)))) - (condition-case nil - (gptel--get-api-key - (gptel-backend-key backend)) - ((error user-error) - (setq gptel-api-key - (read-passwd - (format "%s API key: " backend-name))))) - (and (use-region-p) - (buffer-substring (region-beginning) - (region-end))) - t))) - (with-current-buffer (get-buffer-create name) - (cond ;Set major mode - ((eq major-mode gptel-default-mode)) - ((eq gptel-default-mode 'text-mode) - (text-mode) - (visual-line-mode 1)) - (t (funcall gptel-default-mode))) - (gptel--sanitize-model :backend (default-value 'gptel-backend) - :model (default-value 'gptel-model) - :shoosh nil) - (unless gptel-mode (gptel-mode 1)) - (goto-char (point-max)) - (skip-chars-backward "\t\r\n") - (if (bobp) (insert (or initial (gptel-prompt-prefix-string)))) - (when interactivep - (display-buffer (current-buffer) gptel-display-buffer-action) - (message "Send your query with %s!" - (substitute-command-keys "\\[gptel-send]"))) - (current-buffer))) - - -;;; Reasoning content UI -(defun gptel--display-reasoning-stream (text info) - "Show reasoning TEXT in an appropriate location. - -INFO is the request INFO, see `gptel--url-get-response'. This is -for streaming responses only." - (when-let* ((include (plist-get info :include-reasoning))) - (if (stringp include) - (unless (eq text t) - (with-current-buffer (get-buffer-create include) - (save-excursion (goto-char (point-max)) - (insert text)))) - (let* ((reasoning-marker (plist-get info :reasoning-marker)) - (tracking-marker (plist-get info :tracking-marker)) - (start-marker (plist-get info :position))) - (with-current-buffer (marker-buffer start-marker) - (if (eq text t) ;end of stream - (progn - (gptel-curl--stream-insert-response - (concat (if (derived-mode-p 'org-mode) - "\n#+end_reasoning" - ;; TODO(reasoning) remove properties and strip instead - (propertize "\n```" 'gptel 'ignore - 'keymap gptel--markdown-block-map)) - gptel-response-separator) - info t) - (ignore-errors ;fold block - (save-excursion - (goto-char tracking-marker) - (if (derived-mode-p 'org-mode) - (progn (search-backward "#+end_reasoning" start-marker t) - (when (looking-at "^#\\+end_reasoning") - (org-cycle))) - (when (re-search-backward "^```" start-marker t) - (gptel-markdown-cycle-block)))))) - (unless (and reasoning-marker tracking-marker - (= reasoning-marker tracking-marker)) - (let ((separator ;Separate from response prefix if required - (and (not tracking-marker) gptel-mode - (not (string-suffix-p - "\n" (gptel-response-prefix-string))) - "\n"))) - (gptel-curl--stream-insert-response - (concat separator - (if (derived-mode-p 'org-mode) - "#+begin_reasoning\n" - ;; TODO(reasoning) remove properties and strip instead - (propertize "``` reasoning\n" 'gptel 'ignore - 'keymap gptel--markdown-block-map))) - info t))) - (if (eq include 'ignore) - (progn - (add-text-properties - 0 (length text) '(gptel ignore front-sticky (gptel)) text) - (gptel-curl--stream-insert-response text info t)) - (gptel-curl--stream-insert-response text info))) - (setq tracking-marker (plist-get info :tracking-marker)) - (if reasoning-marker - (move-marker reasoning-marker tracking-marker) - (plist-put info :reasoning-marker - (copy-marker tracking-marker nil)))))))) - -(defvar gptel--tool-preview-alist nil - "Alist mapping tool names to preview functions for tools. - -Each key is a tool name (string) and value is a list of one or two -functions, for preview-setup and (optional) preview-teardown. - -The preview-setup function is called with two arguments: a list of the -corresponding tool call arguments and the request INFO plist. It must -set up the preview for the tool call and return a handle to the preview, -which can be any object, but typically an overlay or a buffer. - -The preview-setup can integrate with gptel's default previewer by -inserting at point (and moving point), or use a different preview method -entirely. - -The preview-teardown function, if provided, is called with this handle -when the tool call is accepted or rejected, and it must clear the -preview. - -Note: This tool call preview API is currently experimental.") - - -;;; Tool use UI -(defvar-keymap gptel-tool-call-actions-map - :doc "Keymap for actions on tool calls." - "" #'gptel--dispatch-tool-calls - "C-c C-c" #'gptel--accept-tool-calls - "C-c C-k" #'gptel--reject-tool-calls - "C-c C-i" #'gptel--inspect-tool-calls) - -(defun gptel--display-tool-calls (tool-calls info &optional use-minibuffer) - "Handle tool call confirmation. - -TOOL-CALLS should be a list of tool call specifications or results, -structured as: - - ((tool args callback) ...) - -for tool call specifications to be confirmed. INFO contains the -state of the request. To prompt for tool call confirmation, use -either an overlay in the request buffer or the minibuffer (if -USE-MINIBUFFER is non-nil)." - (let* ((start-marker (plist-get info :position)) - (tracking-marker (plist-get info :tracking-marker))) - ;; pending tool calls look like ((tool callback args) ...) - (with-current-buffer (plist-get info :buffer) - (if (or use-minibuffer ;prompt for confirmation from the minibuffer - buffer-read-only ;TEMP(tool-preview) Handle read-only buffers better - (get-char-property - (max (point-min) (1- (or tracking-marker start-marker))) - 'read-only)) - (let* ((minibuffer-allow-text-properties t) - (backend-name (gptel-backend-name (plist-get info :backend))) - (prompt (format "%s wants to run " backend-name))) - (map-y-or-n-p - (lambda (tool-call-spec) - (concat prompt (propertize (gptel-tool-name (car tool-call-spec)) - 'face 'font-lock-keyword-face) - ": ")) - (lambda (tcs) (gptel--accept-tool-calls (list tcs) nil)) - tool-calls '("tool call" "tool calls" "run") - `((?i ,(lambda (_) (save-window-excursion - (with-selected-window - (gptel--inspect-fsm gptel--fsm-last) - (goto-char (point-min)) - (when (search-forward-regexp "^:tool-use" nil t) - (forward-line 0) (hl-line-highlight)) - (use-local-map - (make-composed-keymap - (define-keymap "q" (lambda () (interactive) - (quit-window) - (exit-recursive-edit))) - (current-local-map))) - (recursive-edit) nil))) - "inspect call(s)")))) - ;; Prompt for confirmation from the chat buffer - (let* ((backend-name (gptel-backend-name (plist-get info :backend))) - (actions-string - (concat (propertize "Run tools: " 'face 'font-lock-string-face) - (propertize "C-c C-c" 'face 'help-key-binding) - (propertize ", Cancel request: " 'face 'font-lock-string-face) - (propertize "C-c C-k" 'face 'help-key-binding) - (propertize ", Inspect: " 'face 'font-lock-string-face) - (propertize "C-c C-i" 'face 'help-key-binding))) - (confirm-strings) - ;; FIXME(tool) use a wrapper instead of a manual text-property search, - ;; this is fragile - (ov-start (save-excursion - (goto-char start-marker) - (text-property-search-backward 'gptel 'response) - (point))) - (preview-handlers) - (ov (or (cdr-safe (get-char-property-and-overlay - start-marker 'gptel-tool)) - (make-overlay ov-start (or tracking-marker start-marker) - nil nil nil))) - (prompt-ov)) - ;; If the cursor is at the overlay-end, it ends up outside, so move it back - (unless tracking-marker - (when (= (point) start-marker) (ignore-errors (backward-char)))) - (save-excursion - (goto-char (overlay-end ov)) - (pcase-dolist (`(,tool-spec ,arg-values _) tool-calls) - ;; Call tool-specific confirmation prompt - (if-let* ((funcs (cdr (assoc (gptel-tool-name tool-spec) - gptel--tool-preview-alist))) - ((functionp (car-safe funcs)))) - ;;preview-teardown func preview-handle overlay/buffer - (push (list (cadr funcs) (funcall (car funcs) arg-values info)) - preview-handlers) - (push (gptel--format-tool-call (gptel-tool-name tool-spec) arg-values) - confirm-strings))) - (and confirm-strings (apply #'insert (nreverse confirm-strings))) - (add-text-properties (overlay-end ov) (1- (point)) - '(read-only t font-lock-fontified t)) - (setq prompt-ov (make-overlay (overlay-end ov) (point) nil t)) - (overlay-put - prompt-ov 'before-string - (concat "\n" - (propertize " " 'display `(space :align-to (- right ,(length actions-string) 2)) - 'face '(:inherit font-lock-string-face :underline t :extend t)) - actions-string - (format (propertize "\n%s wants to run:\n\n" - 'face 'font-lock-string-face) - backend-name))) - (overlay-put - prompt-ov 'after-string - (concat (propertize "\n" 'face - '(:inherit font-lock-string-face :underline t :extend t)))) - (overlay-put prompt-ov 'evaporate t) - (overlay-put ov 'prompt prompt-ov) - (move-overlay ov ov-start (point))) - ;; Add confirmation prompt to the overlay - (when preview-handlers (overlay-put ov 'previews preview-handlers)) - (overlay-put ov 'mouse-face 'highlight) - (overlay-put ov 'gptel-tool tool-calls) - (overlay-put ov 'help-echo - (concat "Tool call(s) requested: " actions-string)) - (overlay-put ov 'keymap gptel-tool-call-actions-map) - prompt-ov))))) - -(defun gptel--display-tool-results (tool-results info) - "Insert TOOL-RESULTS into buffer. - -TOOL-RESULTS is - - ((tool args result) ...) - -for tool call results. INFO contains the state of the request." - (let* ((start-marker (plist-get info :position)) - (tool-marker (plist-get info :tool-marker)) - (tracking-marker (plist-get info :tracking-marker))) - ;; Insert tool results - (with-current-buffer (marker-buffer start-marker) - (when gptel-include-tool-results - (cl-loop - for (tool args result) in tool-results - with include-names = - (mapcar #'gptel-tool-name - (cl-remove-if-not #'gptel-tool-include (plist-get info :tools))) - if (or (eq gptel-include-tool-results t) - (member (gptel-tool-name tool) include-names)) - do (funcall - (plist-get info :callback) - (let* ((name (gptel-tool-name tool)) - (separator ;Separate from response prefix if required - (cond ((not tracking-marker) - (and gptel-mode - (not (string-suffix-p - "\n" (gptel-response-prefix-string))) - "\n")) ;start of response - ((not (and tool-marker ;not consecutive tool result blocks - (= tracking-marker tool-marker))) - gptel-response-separator))) - (tool-use - ;; TODO(tool) also check args since there may be more than - ;; one call/result for the same tool - (cl-find-if - (lambda (tu) (equal (plist-get tu :name) name)) - (plist-get info :tool-use))) - (id (plist-get tool-use :id)) - (display-call (format "(%s %s)" name - (string-trim (prin1-to-string args) "(" ")"))) - (call (prin1-to-string `(:name ,name :args ,args))) - (truncated-call - (string-replace "\n" " " - (truncate-string-to-width - display-call - (floor (* (window-width) 0.6)) 0 nil " ...)")))) - (if (derived-mode-p 'org-mode) - (concat - separator - "#+begin_tool " - truncated-call - (propertize - (org-escape-code-in-string (concat "\n" call "\n\n" result)) - 'gptel `(tool . ,id)) - "\n#+end_tool\n") - ;; TODO(tool) else branch is handling all front-ends as markdown. - ;; At least escape markdown. - (concat - separator - ;; TODO(tool) remove properties and strip instead of ignoring - (propertize (format "``` tool %s" truncated-call) - 'gptel 'ignore 'keymap gptel--markdown-block-map) - (propertize - ;; TODO(tool) escape markdown in result - (concat "\n" call "\n\n" result) - 'gptel `(tool . ,id)) - ;; TODO(tool) remove properties and strip instead of ignoring - (propertize "\n```\n" 'gptel 'ignore - 'keymap gptel--markdown-block-map)))) - info - 'raw) - ;; tool-result insertion has updated the tracking marker - (unless tracking-marker - (setq tracking-marker (plist-get info :tracking-marker))) - (if tool-marker - (move-marker tool-marker tracking-marker) - (setq tool-marker (copy-marker tracking-marker nil)) - (plist-put info :tool-marker tool-marker)) - (ignore-errors ;fold drawer - (save-excursion - (goto-char tracking-marker) - (forward-line -1) - (if (derived-mode-p 'org-mode) - (when (looking-at-p "^#\\+end_tool") (org-cycle)) - (when (looking-at-p "^```") (gptel-markdown-cycle-block)))))))))) - -(defun gptel--format-tool-call (name arg-values) - "Format a tool call for display in the buffer. - -NAME and ARG-VALUES are the name and arguments for the call." - (format "(%s %s)\n" - (propertize name 'font-lock-face 'font-lock-keyword-face) - (propertize - (mapconcat (lambda (arg) - (cond ((stringp arg) - (prin1-to-string - (replace-regexp-in-string - "\n" "⮐" (truncate-string-to-width - arg (floor (window-width) 2) - nil nil t)))) - (t (prin1-to-string arg)))) - arg-values " ") - 'font-lock-face 'font-lock-constant-face))) - -(defun gptel--inspect-tool-calls () - (interactive) - (with-selected-window - (gptel--inspect-fsm gptel--fsm-last) - (goto-char (point-min)) - (when (search-forward-regexp "^:tool-use" nil t) - (forward-line 0) - (hl-line-highlight)))) - -(defun gptel--accept-tool-calls (&optional response ov) - (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay - (point) 'gptel-tool))) - (list resp o))) - (gptel--update-status " Calling tool..." 'mode-line-emphasis) - (message "Continuing query...") - (cl-loop for (tool-spec arg-values process-tool-result) in response - do - (if (gptel-tool-async tool-spec) - (apply (gptel-tool-function tool-spec) - process-tool-result arg-values) - (let ((result - (condition-case errdata - (apply (gptel-tool-function tool-spec) arg-values) - (error (mapconcat #'gptel--to-string errdata " "))))) - (funcall process-tool-result result)))) - (when (and (overlayp ov) (overlay-buffer ov)) - (with-current-buffer (overlay-buffer ov) - (when-let* ((preview-handles (overlay-get ov 'previews))) - (dolist (func-to-handle preview-handles) - (when (car func-to-handle) (apply func-to-handle)))) - (when-let* ((prompt-ov (overlay-get ov 'prompt)) - ((overlay-buffer prompt-ov)) - (inhibit-read-only t)) - (delete-region (overlay-start prompt-ov) - (overlay-end prompt-ov)))) - (delete-overlay ov))) - -(defun gptel--reject-tool-calls (&optional _response ov) - (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay - (point) 'gptel-tool))) - (list resp o))) - (gptel--update-status " Tools cancelled" 'error) - (message (substitute-command-keys - "Tool calls canceled. \\[gptel-menu] to continue them!")) - (when (and (overlayp ov) (overlay-buffer ov)) - (with-current-buffer (overlay-buffer ov) - (when-let* ((preview-handles (overlay-get ov 'previews))) - (dolist (func-to-handle preview-handles) - (when (car func-to-handle) (apply func-to-handle)))) - (when-let* ((prompt-ov (overlay-get ov 'prompt)) - ((overlay-buffer prompt-ov)) - (inhibit-read-only t)) - (delete-region (overlay-start prompt-ov) - (overlay-end prompt-ov)))) - (delete-overlay ov))) - -(defun gptel--dispatch-tool-calls (choice) - (interactive - (list - (let ((choices '((?y "yes") (?n "do nothing") - (?k "cancel request") (?i "inspect call(s)")))) - (read-multiple-choice "Run tool calls? " choices)))) - (pcase (car choice) - (?y (call-interactively #'gptel--accept-tool-calls)) - (?k (call-interactively #'gptel--reject-tool-calls)) - (?i (gptel--inspect-fsm gptel--fsm-last)))) - - -;;; Presets -;;;; Presets implementation -(defvar gptel--known-presets nil - "Alist of presets for gptel. - -Each entry maps a preset name (a symbol) to a plist of -specifications (see `gptel-make-preset').") - -(defun gptel-make-preset (name &rest keys) - "Define a gptel preset with NAME. - -A preset is a combination of gptel options intended to be applied and -used together. Presets can make it less tedious to change gptel -settings on the fly. - -Typically this will include a model, backend, system message and perhaps -some tools, but any set of gptel options can be set this way. - -NAME must be a symbol. KEYS is a plist corresponding to the options -being set. All KEYS are optional. - -Recognized keys: - -DESCRIPTION is a description of the preset, used when selecting a -preset. - -PARENTS is a preset name (or list of preset names) to apply before this -one. - -PRE and POST are functions to run before and after the preset is -applied. They take no arguments. - -BACKEND is the `gptel-backend' to set, or its name (like \"ChatGPT\"). - -MODEL is the `gptel-model', a symbol. - -SYSTEM is the directive. It can be -- the system message (a string), -- a list of strings (a conversation template) -- or a function (dynamic system message). -- It can also be a symbol naming a directive in `gptel-directives'. - -TOOLS is a list of gptel tools or tool names, like -\\='(\"read_url\" \"read_buffer\" ...) - -Recognized keys are not limited to the above. Any other key (like -`:foo') corresponds to the value of either `gptel-foo' (preferred) or -`gptel--foo'. -- So TOOLS corresponds to option `gptel-tools', -- CONFIRM-TOOL-CALLS to `gptel-confirm-tool-calls', -- TEMPERATURE to `gptel-temperature' and so on. -See gptel's customization options for all available settings. - -Specifying the value of a key will set the corresponding gptel option to -it. For example, - - (gptel-make-preset \\='websearch - :tools \\='(\"search_web\" \"read_url\") - :system \"Use the provided tools to search the web - for up-to-date information\") - -will replace the currently active option `gptel-tools' and the system -message. - -Alternatively, - -- You can require that the value be appended or prepended to the - existing value instead of replacing it. This can be done by - specifying the value as a plist instead with the keys `:prepend' or - `:append'. - - (gptel-make-preset \\='websearch - :tools \\='(:append (\"search_web\" \"read_url\")) - :system \\='(:prepend \"Use the provided tools to search the web - for up-to-date information.\")) - -- You can dynamically compute the value for a key at the time the preset - is applied with `:eval' or `:function'. This is mostly useful when - using presets in the prompt, as @preset-name. - - An `:eval' form is evaluated when the preset is applied: - - (gptel-make-preset \\='visible-buffers - :description \"Include the full text of all buffers visible in the - frame.\" - :context \\='(:eval (mapcar #\\='window-buffer (window-list)))) - ▲ ▲ - │ ╰╴evaluated when preset is applied - ╰╴sets `gptel-context' - - `:function' should take the current value of the key as an input and - return the new value. Here we combine it with `:append' in the plist. - - (gptel-make-preset \\='github-read-only - :description \"Provide read-only GitHub tools\" - :pre (lambda () (gptel-mcp-connect \\='(\"github\") \\='sync)) - :tools - \\='( :append (\"mcp-github\") ;Adds all github MCP tools - :function (lambda (tools) - (cl-delete-if ;Remove \"write\" access to GitHub - (lambda (tool) - (string-match-p \"create_\" (gptel-tool-name tool))) - tools)))) - - NOTE: `:eval' and `:function' are evaluated in a temporary buffer, and - not the buffer from which the request is sent." - (declare (indent 1)) - (if-let* ((p (assoc name gptel--known-presets))) - (setcdr p keys) - (setq gptel--known-presets ;Add at end of presets for menu ordering - (nconc gptel--known-presets (list (cons name keys)))))) - -(defun gptel-get-preset (name) - "Get the gptel preset spec with NAME." - (alist-get name gptel--known-presets nil nil #'equal)) - -(defun gptel--save-preset (name &optional description) - "Save gptel's current settings as a preset with NAME. - -NAME must be a symbol. DESCRIPTION is added if provided. In addition -to registering the preset, elisp code to do the same is copied to the -`kill-ring'." - (interactive - (list (intern (completing-read "Save gptel settings to (existing or new) preset: " - gptel--known-presets)) - (read-string "Description (optional): "))) - (let ((preset-code - `(gptel-make-preset ',name - :description ,(when (and description - (not (string-blank-p description))) - description) - :backend ,(gptel-backend-name gptel-backend) - :model ',gptel-model - :system ,(if-let* ((directive (car-safe (rassoc gptel--system-message - gptel-directives)))) - `',directive - gptel--system-message) - :tools ',(mapcar #'gptel-tool-name gptel-tools) - :stream ,gptel-stream - :temperature ,gptel-temperature - :max-tokens ,gptel-max-tokens - :use-context ',gptel-use-context - :track-media ,gptel-track-media - :include-reasoning ,(let ((reasoning gptel-include-reasoning)) - (if (eq reasoning 'ignore) - ''ignore reasoning))))) - (kill-new (pp-to-string preset-code)) - (eval preset-code) - (message "Preset %s saved. (Lisp expression for preset saved to kill-ring)" - (propertize (symbol-name name) 'face 'highlight)))) - -(defvar gptel--rewrite-directive) -(defun gptel--apply-preset (preset &optional setter) - "Apply gptel PRESET with SETTER. - -PRESET is the name of a preset, or a spec (plist) of the form - (:KEY1 VAL1 :KEY2 VAL2 ...). - -SETTER is the function used to set the gptel options. It must accept -two arguments, the symbol being set and the value to set it to. It -defaults to `set', and can be set to a different function to (for -example) apply the preset buffer-locally." - (when (memq (type-of preset) '(string symbol)) - (let ((spec (or (gptel-get-preset preset) - (user-error "gptel preset \"%s\": Cannot find preset" - preset)))) - (setq preset spec))) - (unless setter (setq setter #'set)) - (when-let* ((func (plist-get preset :pre))) (funcall func)) - (when-let* ((parents (plist-get preset :parents))) - (mapc (lambda (parent) (gptel--apply-preset parent setter)) (ensure-list parents))) - (map-do - (lambda (key val) - (pcase key - ((or :parents :description :pre :post) nil) - ((or :system :system-message :rewrite-directive) - (let ((sym (if (eq key :rewrite-directive) - 'gptel--rewrite-directive 'gptel--system-message))) - (when (consp val) - ;; Possibly complain about trying to compose a system message string - ;; with a non-string - ;; TODO(modify-list): Catch other incompatible combinations - (and (or (plist-member val :append) (plist-member val :prepend)) - (not (stringp (symbol-value sym))) - (user-error "Composing non-string system messages is not implemented")) - (setq val (gptel--modify-value (symbol-value sym) val))) - (if (and (symbolp val) (not (functionp val))) - (if-let* ((directive (alist-get val gptel-directives))) - (funcall setter sym directive) - (user-error "gptel preset: Cannot find directive %s" val)) - (funcall setter sym val)))) - (:backend - (when (consp val) (setq val (gptel--modify-value 'gptel-backend val))) - (setq val (cl-etypecase val - (gptel-backend val) - (string (gptel-get-backend val)))) - (unless val - (user-error "gptel preset: Cannot find backend %s" val)) - (funcall setter 'gptel-backend val)) - (:tools ;TEMP Confirm this `:append' convention - (setq val (gptel--modify-value gptel-tools val)) - (let* ((tools - (flatten-list - (cl-loop for tool-name in (ensure-list val) - for tool = (cl-etypecase tool-name - (gptel-tool tool-name) - (string (ignore-errors - (gptel-get-tool tool-name)))) - do (unless tool - (user-error "gptel preset: Cannot find tool %S" - tool-name)) - collect tool)))) - (funcall setter 'gptel-tools (cl-delete-duplicates tools :test #'eq)))) - ((and (let sym (or (intern-soft - (concat "gptel-" (substring (symbol-name key) 1))) - (intern-soft - (concat "gptel--" (substring (symbol-name key) 1))))) - (guard (and sym (boundp sym)))) - (funcall setter sym (if (consp val) - (gptel--modify-value (symbol-value sym) val) - val))) - (_ (display-warning - '(gptel presets) - (format "gptel preset: setting for %s not found, ignoring." key))))) - preset) - (when-let* ((func (plist-get preset :post))) (funcall func))) - -(defun gptel--preset-syms (preset) - "Return a list of gptel variables (symbols) set by PRESET. - -PRESET is the name of a preset, or a spec (plist) of the form - (:KEY1 VAL1 :KEY2 VAL2 ...)." - (when (memq (type-of preset) '(string symbol)) - (let ((spec (or (gptel-get-preset preset) - (user-error "gptel preset \"%s\": Cannot find preset" - preset)))) - (setq preset spec))) - (let* ((index preset) - syms key val) - (while index - (setq key (pop index) val (pop index)) - (pcase key - ((or :description :pre :post)) - (:parents - (mapc (lambda (parent-preset) - (nconc syms (gptel--preset-syms parent-preset))) - (ensure-list val))) - (:system (push 'gptel--system-message syms)) - (_ (if-let* ((var (or (intern-soft - (concat "gptel-" (substring (symbol-name key) 1))) - (intern-soft - (concat "gptel--" (substring (symbol-name key) 1)))))) - (push var syms) - (display-warning - '(gptel presets) - (format "gptel preset \"%s\": setting for %s not found, ignoring." - (car preset) key)))))) - (cl-delete-duplicates syms))) - -;; This is identical to `cl-progv', only we let-bind symbols SYM from the preset -;; to their current values instead of evaluating the values explicitly. (#1005) -(defmacro gptel-with-preset (name &rest body) - "Run BODY with gptel preset NAME applied. - -This macro can be used to create `gptel-request' command with settings -from a gptel preset applied. - -NAME is the name of a preset, or a spec (plist) of the form - (:KEY1 VAL1 :KEY2 VAL2 ...). It must be quoted." - (declare (indent 1)) - (let ((syms (make-symbol "syms")) - (binds (make-symbol "binds")) - (bodyfun (make-symbol "body"))) - `(let* ((,syms (gptel--preset-syms ,name)) - (,bodyfun (lambda () (gptel--apply-preset ,name) ,@body)) - (,binds nil)) - (while ,syms (push (list (car ,syms) (pop ,syms)) ,binds)) - (eval (list 'let (nreverse ,binds) (list 'funcall (list 'quote ,bodyfun))))))) - -;;;; Presets in-buffer UI -(defun gptel--transform-apply-preset (_fsm) - "Apply a gptel preset to the buffer depending on the prompt. - -If the last user prompt includes @foo, the preset foo is applied. -Before applying the preset, \"@foo\" is removed from the prompt and -point is placed at its position." - (when gptel--known-presets - (text-property-search-backward 'gptel nil t) - (while (re-search-forward "@\\([^[:space:]]+\\)\\_>" nil t) - ;; The following convoluted check is because re-search is much faster if - ;; the search pattern begins with a non-whitespace char. - (when (or (= (match-beginning 0) (point-min)) - (memq (char-syntax (char-before (match-beginning 0))) '(32 62))) - (when-let* ((name (match-string 1)) - (preset (or (gptel-get-preset (intern-soft name)) - (gptel-get-preset name)))) - (delete-region (match-beginning 0) (match-end 0)) - ;; Point must be after @foo when the preset is applied to allow for - ;; more advanced transformations. - (gptel--apply-preset preset - (lambda (sym val) - (set (make-local-variable sym) val)))))))) - -;; ;; Alternative approach with string search -;; (search-forward "@" nil t) -;; (if (and (memq (char-syntax (char-before (1- (point)))) '(32 62)) -;; (looking-at "\\([^[:blank:]]+?\\)[[:punct:]]?\\s-+")) -;; do-stuff) - -(defun gptel--fontify-preset-keyword (end) - "Font-lock function for preset indicators in chat buffers. - -Return preset fontification info for text up to END." - (and (re-search-forward "@\\([^[:space:]]+\\)\\_>" end t) - (or (= (match-beginning 0) (point-min)) - (memq (char-syntax (char-before (match-beginning 0))) '(32 62))) - (not (plist-get (text-properties-at (match-beginning 1)) 'gptel)))) - -(defun gptel-preset-capf () - "Completion at point for gptel presets in `gptel-mode'. - -Add this to `completion-at-point-functions'." - (and gptel--known-presets - (save-excursion - (let ((num (- (skip-syntax-backward "w_")))) - (when (eql (char-before) ?@) - (list (point) (+ (point) num) - gptel--known-presets - :exclusive 'no - :annotation-function - #'(lambda (c) (thread-first - (intern-soft c) - (assq gptel--known-presets) (cdr) - (plist-get :description))))))))) - -(defun gptel--prettify-preset () - "Get visual and completion help with presets in gptel buffers. - -Intended to be added to `gptel-mode-hook'." - (let ((keyword '((gptel--fontify-preset-keyword - ;; subexp 0 here is not required, we retain it to make it - ;; easy to swtich to more complex patterns in the future - 0 (when-let* ((comps (all-completions (match-string 1) - gptel--known-presets)) - ((member (match-string 1) comps))) - '(:box -1 :inherit secondary-selection)) - prepend)))) - (cond - (gptel-mode - (font-lock-add-keywords nil keyword t) - (add-hook 'completion-at-point-functions #'gptel-preset-capf nil t)) - (t (font-lock-remove-keywords nil keyword) - (remove-hook 'completion-at-point-functions #'gptel-preset-capf t))))) - - -;;; Response tweaking commands - -(defun gptel--attach-response-history (history &optional buf) - "Attach HISTORY to the next gptel response in buffer BUF. - -HISTORY is a list of strings typically containing text replaced -by gptel. BUF is the current buffer if not specified. - -This is used to maintain variants of prompts or responses to diff -against if required." - (with-current-buffer (or buf (current-buffer)) - (letrec ((gptel--attach-after - (lambda (b e) - (when (and b e) - (add-text-properties - b e `(gptel-history - ,(append (ensure-list history) - (get-char-property (1- e) 'gptel-history)) - front-sticky (gptel gptel-history)))) - (remove-hook 'gptel-post-response-functions - gptel--attach-after 'local)))) - (add-hook 'gptel-post-response-functions gptel--attach-after - nil 'local)))) - -(defun gptel--ediff (&optional arg bounds-func) - "Ediff response at point against previous gptel responses. - -If prefix ARG is non-nil, select the previous response to ediff -against interactively. - -If specified, use BOUNDS-FUNC to compute the bounds of the -response at point. This can be used to include additional -context for the ediff session." - (interactive "P") - (when (gptel--at-response-history-p) - (pcase-let* ((`(,beg . ,end) (funcall (or bounds-func #'gptel--get-response-bounds))) - (prev-response - (if arg - (completing-read "Choose response variant to diff against: " - (get-char-property (point) 'gptel-history) - nil t) - (car-safe (get-char-property (point) 'gptel-history)))) - (buffer-mode major-mode) - (bufname (buffer-name)) - (`(,new-buf ,new-beg ,new-end) - (with-current-buffer - (get-buffer-create (concat bufname "-PREVIOUS-*")) - (let ((inhibit-read-only t)) - (erase-buffer) - (delay-mode-hooks (funcall buffer-mode)) - (visual-line-mode) - (insert prev-response) - (goto-char (point-min)) - (list (current-buffer) (point-min) (point-max)))))) - (unless prev-response (user-error "gptel response is additive: no changes to ediff")) - (require 'ediff) - (letrec ((cwc (current-window-configuration)) - (gptel--ediff-restore - (lambda () - (when (window-configuration-p cwc) - (set-window-configuration cwc)) - (kill-buffer (get-buffer (concat bufname "-PREVIOUS-*"))) - (kill-buffer (get-buffer (concat bufname "-CURRENT-*"))) - (remove-hook 'ediff-quit-hook gptel--ediff-restore)))) - (add-hook 'ediff-quit-hook gptel--ediff-restore) - (apply - #'ediff-regions-internal - (get-buffer (ediff-make-cloned-buffer (current-buffer) "-CURRENT-*")) - beg end new-buf new-beg new-end - nil - (list 'ediff-regions-wordwise 'word-wise nil) - ;; (if (transient-arg-value "-w" args) - ;; (list 'ediff-regions-wordwise 'word-wise nil) - ;; (list 'ediff-regions-linewise nil nil)) - ))))) - -(defun gptel--mark-response () - "Mark gptel response at point, if any." - (interactive) - (unless (gptel--in-response-p) (user-error "No gptel response at point")) - (pcase-let ((`(,beg . ,end) (gptel--get-response-bounds))) - (goto-char beg) (push-mark) (goto-char end) (activate-mark))) - -(defun gptel--previous-variant (&optional arg) - "Switch to ARG previous gptel-response at this point, if it exists." - (interactive "p") - (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds)) - (history (get-char-property (point) 'gptel-history)) - (alt-response (car-safe history)) - (offset)) - (unless (and history alt-response) - (user-error "No variant responses available")) - (if (> arg 0) - (setq history (append (cdr history) - (list (buffer-substring-no-properties beg end)))) - (setq - alt-response (car (last history)) - history (cons (buffer-substring-no-properties beg end) - (nbutlast history)))) - (add-text-properties - 0 (length alt-response) - `(gptel response gptel-history ,history) - alt-response) - (setq offset (min (- (point) beg) (1- (length alt-response)))) - (delete-region beg end) - (insert alt-response) - (goto-char (+ beg offset)) - (pulse-momentary-highlight-region beg (+ beg (length alt-response))))) - -(defun gptel--next-variant (&optional arg) - "Switch to ARG next gptel-response at this point, if it exists." - (interactive "p") - (gptel--previous-variant (- arg))) - -(provide 'gptel) -;;; gptel.el ends here - -;; Local Variables: -;; bug-reference-url-format: "https://github.com/karthink/gptel/issues/%s" -;; End: diff --git a/elpa/gptel-20260425.846/README-elpa b/elpa/gptel-20260425.846/README-elpa new file mode 100644 index 00000000..8b939621 --- /dev/null +++ b/elpa/gptel-20260425.846/README-elpa @@ -0,0 +1,159 @@ +gptel is a simple Large Language Model chat client, with support for multiple +models and backends. + +It works in the spirit of Emacs, available at any time and in any buffer. + +gptel supports: + +- The services ChatGPT, Azure, Gemini, Anthropic AI, Together.ai, Perplexity, + AI/ML API, Anyscale, OpenRouter, Groq, PrivateGPT, DeepSeek, Cerebras, Github Models, + GitHub Copilot chat, AWS Bedrock, Novita AI, xAI, Sambanova, Mistral Le + Chat and Kagi (FastGPT & Summarizer). +- Local models via Ollama, Llama.cpp, Llamafiles or GPT4All + +Additionally, any LLM service (local or remote) that provides an +OpenAI-compatible API is supported. + +Features: + +- Interact with LLMs from anywhere in Emacs (any buffer, shell, minibuffer, + wherever). +- LLM responses are in Markdown or Org markup. +- Supports conversations and multiple independent sessions. +- Supports tool-use to equip LLMs with agentic capabilities. +- Supports Model Context Protocol (MCP) integration using the mcp.el package. +- Supports multi-modal models (send images, documents). +- Supports "reasoning" content in LLM responses. +- Save chats as regular Markdown/Org/Text files and resume them later. +- You can go back and edit your previous prompts or LLM responses when + continuing a conversation. These will be fed back to the model. +- Redirect prompts and responses easily +- Rewrite, refactor or fill in regions in buffers. +- Write your own commands for custom tasks with a simple API. + +Requirements for ChatGPT, Azure, Gemini or Kagi: + +- You need an appropriate API key. Set the variable `gptel-api-key' to the + key or to a function of no arguments that returns the key. (It tries to + use `auth-source' by default) + +ChatGPT is configured out of the box. For the other sources: + +- For Azure: define a gptel-backend with `gptel-make-azure'. +- For Gemini: define a gptel-backend with `gptel-make-gemini'. +- For Anthropic (Claude): define a gptel-backend with `gptel-make-anthropic'. +- For AI/ML API, Together.ai, Anyscale, Groq, OpenRouter, DeepSeek, Cerebras + or Github Models: define a gptel-backend with `gptel-make-openai'. +- For PrivateGPT: define a backend with `gptel-make-privategpt'. +- For Perplexity: define a backend with `gptel-make-perplexity'. +- For Deepseek: define a backend with `gptel-make-deepseek'. +- For Kagi: define a gptel-backend with `gptel-make-kagi'. + +For local models using Ollama, Llama.cpp or GPT4All: + +- The model has to be running on an accessible address (or localhost) +- Define a gptel-backend with `gptel-make-ollama' or `gptel-make-gpt4all'. +- Llama.cpp or Llamafiles: Define a gptel-backend with `gptel-make-openai'. + +Consult the package README for examples and more help with configuring +backends. + +Usage: + +gptel can be used in any buffer or in a dedicated chat buffer. The +interaction model is simple: Type in a query and the response will be +inserted below. You can continue the conversation by typing below the +response. + +To use this in any buffer: + +- Call `gptel-send' to send the buffer's text up to the cursor. Select a + region to send only the region. + +- You can select previous prompts and responses to continue the conversation. + +- Call `gptel-send' with a prefix argument to access a menu where you can set + your backend, model and other parameters, or to redirect the + prompt/response. + +To use this in a dedicated buffer: + +- M-x gptel: Start a chat session. + +- In the chat session: Press `C-c RET' (`gptel-send') to send your prompt. + Use a prefix argument (`C-u C-c RET') to access a menu. In this menu you + can set chat parameters like the system directives, active backend or + model, or choose to redirect the input or output elsewhere (such as to the + kill ring or the echo area). + +- You can save this buffer to a file. When opening this file, turn on + `gptel-mode' before editing it to restore the conversation state and + continue chatting. + +- To include media files with your request, you can add them to the context + (described next), or include them as links in Org or Markdown mode chat + buffers. Sending media is disabled by default, you can turn it on globally + via `gptel-track-media', or locally in a chat buffer via the header line. + +Include more context with requests: + +If you want to provide the LLM with more context, you can add arbitrary +regions, buffers, files or directories to the query with `gptel-add'. To add +text or media files, call `gptel-add' in Dired or use the dedicated +`gptel-add-file'. + +You can also add context from gptel's menu instead (`gptel-send' with a +prefix arg), as well as examine or modify context. + +When context is available, gptel will include it with each LLM query. + +LLM Tool use: + +gptel supports "tool calling" behavior, where LLMs can specify arguments with +which to call provided "tools" (elisp functions). The results of running the +tools are fed back to the LLM, giving it capabilities and knowledge beyond +what is available out of the box. For example, tools can perform web +searches or API lookups, modify files and directories, and so on. + +Tools can be specified via `gptel-make-tool', or obtained from other +repositories, or from Model Context Protocol (MCP) servers using the mcp.el +package. See the README for details. + +Tools can be included with LLM queries using gptel's menu, or from +`gptel-tools'. + +Rewrite interface + +In any buffer: with a region selected, you can rewrite prose, refactor code +or fill in the region. This is accessible via `gptel-rewrite', and also from +the `gptel-send' menu. + +Presets + +Define a bundle of configuration (model, backend, system message, tools etc) +as a "preset" that can be applied together, making it easy to switch between +tasks in gptel. Presets can be saved and applied from gptel's transient +menu. You can also include a cookie of the form "@preset-name" in the prompt +to send a request with a preset applied. This feature works everywhere, but +preset cookies are also fontified in chat buffers. + +gptel in Org mode: + +gptel offers a few extra conveniences in Org mode: + +- You can limit the conversation context to an Org heading with + `gptel-org-set-topic'. + +- You can have branching conversations in Org mode, where each hierarchical + outline path through the document is a separate conversation branch. + See the variable `gptel-org-branching-context'. + +- You can declare the gptel model, backend, temperature, system message and + other parameters as Org properties with the command + `gptel-org-set-properties'. gptel queries under the corresponding heading + will always use these settings, allowing you to create mostly reproducible + LLM chat notebooks. + +Finally, gptel offers a general purpose API for writing LLM ineractions that +suit your workflow. See `gptel-request', and `gptel-fsm' for more advanced +usage. diff --git a/elpa/gptel-20260425.846/gptel-anthropic.el b/elpa/gptel-20260425.846/gptel-anthropic.el new file mode 100644 index 00000000..51afa353 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-anthropic.el @@ -0,0 +1,798 @@ +;;; gptel-anthropic.el --- Anthropic AI suppport for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur + +;; 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: + +;; This file adds support for Anthropic's Messages API to gptel + +;;; Code: +(require 'cl-generic) +(require 'cl-lib) +(require 'map) +(eval-and-compile (require 'gptel-request)) + +(defvar json-object-type) + +(declare-function prop-match-value "text-property-search") +(declare-function text-property-search-backward "text-property-search") +(declare-function json-read "json" ()) +(declare-function gptel-context--wrap "gptel-context") +(declare-function gptel-context--collect-media "gptel-context") + +;;; Anthropic (Messages API) +(cl-defstruct (gptel-anthropic (:constructor gptel--make-anthropic) + (:copier nil) + (:include gptel-backend))) + +(defun gptel--anthropic-update-tokens (usage info) + "Update token usage information from USAGE. +USAGE is part of the response, INFO is the request plist." + (when usage + (let* ((tokens (plist-get info :tokens)) + (input (+ (or (plist-get usage :input_tokens) 0) + (or (plist-get tokens :input) 0))) + (output (+ (or (plist-get usage :output_tokens) 0) + (or (plist-get tokens :output) 0))) + (cached (+ (or (plist-get usage :cache_read_input_tokens) 0) + (or (plist-get tokens :cached) 0))) + (cache (+ (or (plist-get usage :cache_creation_input_tokens) 0) + (or (plist-get tokens :cache) 0)))) + (list :input input :output output + :cache cache :cached cached)))) + +;; NOTE the crucial difference between +;; - (push val (plist-get info :key)) and +;; (plist-put (plist-get info :key) (cons val ...)) +;; +;; - (setf (plist-get info :key) val) and +;; (plist-put info :key val) +;; +;; in the following function. The first variant conses at the head of info, the +;; second one at the tail. This means only the second option is viable for +;; mutating a plist function argument that's passed by reference. +;; Do NOT change the plist-put to push or setf! + +;; NOTE: The stream parser looks complicated only because it handles streaming +;; tool calls, streaming "thinking" blocks and their interactions. Stream +;; parsing is simple: if you are studying this code, look instead at a commit +;; from before tool-use support was added to gptel. +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-anthropic) info) + "Parse an Anthropic data stream. + +Return the text response accumulated since the last call to this +function. Additionally, mutate state INFO to add tool-use +information if the stream contains it. Not my best work, I know." + (let* ((content-strs) + (pt (point))) + (condition-case nil + (while (re-search-forward "^event: " nil t) + (setq pt (match-beginning 0)) + (if (equal (line-end-position) (point-max)) + (error "Data block incomplete")) + (cond + ((looking-at "content_block_delta") ;collect incremental + (forward-line 1) (forward-char 5) ;text, tool or thinking block + (when-let* ((delta (plist-get (gptel--json-read) :delta))) + (if-let* ((content (plist-get delta :text)) + ((not (eq content :null)))) + (push content content-strs) ;collect text + (if-let* ((partial-json (plist-get delta :partial_json))) + (plist-put ;collect partial tool input + info :partial_json + (cons partial-json (plist-get info :partial_json))) + (if-let* ((thinking (plist-get delta :thinking))) + (plist-put info :reasoning + (concat (plist-get info :reasoning) thinking)) + (if-let* ((signature (plist-get delta :signature))) + (plist-put info :signature + (concat (plist-get info :signature) signature)))))))) + + ((looking-at "content_block_start") ;Is the following block text or tool-use? + (forward-line 1) (forward-char 5) + (when-let* ((cblock (plist-get (gptel--json-read) :content_block))) + (pcase (plist-get cblock :type) + ("text" (push (plist-get cblock :text) content-strs)) + ("tool_use" (plist-put info :tool-use + (cons (list :id (plist-get cblock :id) + :name (plist-get cblock :name) + :input nil) ;ensure :input key is always present + (plist-get info :tool-use)))) + ("thinking" (plist-put info :reasoning (plist-get cblock :thinking)) + (plist-put info :reasoning-block 'in))))) + + ((looking-at "content_block_stop") + (cond + ((plist-get info :partial_json) ;End of tool block + (condition-case-unless-debug nil ;Combine partial tool inputs + (let* ((args-json (apply #'concat (nreverse (plist-get info :partial_json)))) + (args-decoded ;Handle blank argument strings + (if (string-empty-p args-json) + nil (gptel--json-read-string args-json)))) + ;; Add the input to the tool-call spec + (plist-put (car (plist-get info :tool-use)) :input args-decoded)) + ;; If there was an error in reading that tool, we ignore it: + ;; TODO(tool) handle this error better + (error (pop (plist-get info :tool-use)))) ;TODO: nreverse :tool-use list + (plist-put info :partial_json nil)) + + ((eq (plist-get info :reasoning-block) 'in) ;End of reasoning block + (plist-put info :reasoning-block t)))) ;Signal end of reasoning stream to filter + + ((looking-at "message_delta") + ;; collect stop_reason, usage_tokens and prepare tools + (forward-line 1) (forward-char 5) + (when-let* ((tool-use (plist-get info :tool-use)) + (response (gptel--json-read))) + (let* ((data (plist-get info :data)) + (prompts (plist-get data :messages))) + (plist-put ; Append a COPY of response text + tool-use to the prompts list + data :messages + (vconcat + prompts + `((:role "assistant" + :content ,(vconcat ;Insert any LLM text and thinking text + (and-let* ((reasoning (plist-get info :partial_reasoning))) + `((:type "thinking" :thinking ,reasoning + :signature ,(plist-get info :signature)))) + (and-let* ((strs (plist-get info :partial_text))) + `((:type "text" :text ,(apply #'concat (nreverse strs))))) + (mapcar (lambda (tool-call) ;followed by the tool calls + (append (list :type "tool_use") + (copy-sequence tool-call))) + tool-use)))))) + (plist-put info :partial_text nil) ; Clear any captured text + ;; Then shape the tool-use block by adding args so we can call the functions + (mapc (lambda (tool-call) + (plist-put tool-call :args (plist-get tool-call :input)) + (plist-put tool-call :input nil) + (plist-put tool-call :id (plist-get tool-call :id))) + tool-use)) + ;; Capture token usage + (plist-put info :tokens (gptel--anthropic-update-tokens + (plist-get response :usage) info)) + (plist-put info :stop-reason + (map-nested-elt response '(:delta :stop_reason))))))) + (error (goto-char pt))) + (let ((response-text (apply #'concat (nreverse content-strs)))) + (unless (string-empty-p response-text) + (plist-put info :partial_text + (cons response-text (plist-get info :partial_text)))) + (when (plist-get info :tools) + (when-let* ((reasoning (plist-get info :reasoning))) + (plist-put info :partial_reasoning + (concat (plist-get info :partial_reasoning) reasoning)))) + response-text))) + +(cl-defmethod gptel--parse-response ((_backend gptel-anthropic) response info) + "Parse an Anthropic (non-streaming) RESPONSE and return response text. + +Mutate state INFO with response metadata." + (plist-put info :stop-reason (plist-get response :stop_reason)) + (plist-put info :tokens (gptel--anthropic-update-tokens + (plist-get response :usage) info)) + (cl-loop + with content = (plist-get response :content) + for cblock across content + for type = (plist-get cblock :type) + if (equal type "text") + ;; TODO(tool) can :text be :null? + collect (plist-get cblock :text) into content-strs + else if (equal type "tool_use") + collect cblock into tool-use + else if (equal type "thinking") + do + (plist-put + info :reasoning + (concat (plist-get info :reasoning) + (plist-get cblock :thinking))) + finally do + (when tool-use + ;; First, add the tool call to the prompts list + (let* ((data (plist-get info :data)) + (prompts (plist-get data :messages))) + (plist-put + data :messages + (vconcat prompts `((:role "assistant" :content ,content))))) + ;; Then capture the tool call data for running the tool + (cl-loop + for call-raw in tool-use + for call = (copy-sequence call-raw) do + (plist-put call :args (plist-get call :input)) + (plist-put call :input nil) + (plist-put call :id (plist-get call :id)) + collect call into calls + finally do (plist-put info :tool-use calls))) + finally return + (and content-strs (apply #'concat content-strs)))) + +(cl-defmethod gptel--request-data ((backend gptel-anthropic) prompts) + "JSON encode PROMPTS for sending to ChatGPT." + (let ((prompts-plist + `( :model ,(gptel--model-name gptel-model) + :stream ,(or gptel-stream :json-false) + :max_tokens ,(or gptel-max-tokens 4096) + :messages [,@prompts])) + (cachep (and (or (eq gptel-cache t) (memq 'system gptel-cache)) + (gptel--model-capable-p 'cache)))) + (when gptel--system-message + ;; gptel--system-message is a string or a list of strings + (plist-put + prompts-plist :system + (cond + ((consp gptel--system-message) ;multi-part system message + (vconcat (mapcar (lambda (part) + (nconc (list :type "text" :text part) + (and cachep + (list :cache_control + '(:type "ephemeral"))))) + gptel--system-message))) + (cachep `[(:type "text" :text ,gptel--system-message + :cache_control (:type "ephemeral"))]) + (t gptel--system-message)))) + (when gptel-temperature + (plist-put prompts-plist :temperature gptel-temperature)) + (when gptel-use-tools + (when (eq gptel-use-tools 'force) + (plist-put prompts-plist :tool_choice '(:type "any"))) + (when gptel-tools + (let ((tools-array (gptel--parse-tools backend gptel-tools))) + (plist-put prompts-plist :tools tools-array) + (when (and (or (eq gptel-cache t) (memq 'tool gptel-cache)) + (gptel--model-capable-p 'cache)) + (nconc (aref tools-array (1- (length tools-array))) + '(:cache_control (:type "ephemeral"))))))) + (when gptel--schema + (plist-put prompts-plist :tools + (vconcat + (list (gptel--parse-schema backend gptel--schema)) + (plist-get prompts-plist :tools))) + (plist-put prompts-plist :tool_choice + `(:type "tool" :name ,gptel--ersatz-json-tool))) + ;; Merge request params with model and backend params. + (gptel--merge-plists + prompts-plist + gptel--request-params + (gptel-backend-request-params gptel-backend) + (gptel--model-request-params gptel-model)))) + +(cl-defmethod gptel--parse-schema ((_backend gptel-anthropic) schema) + ;; Unlike the other backends, Anthropic generates JSON using a tool call. We + ;; write the tool here, meant to be added to :tools. + (list + :name "response_json" + :description "Record JSON output according to user prompt" + :input_schema (gptel--preprocess-schema + (gptel--dispatch-schema-type schema)))) + +(cl-defmethod gptel--parse-tools ((_backend gptel-anthropic) tools) + "Parse TOOLS to the Anthropic API tool definition spec. + +TOOLS is a list of `gptel-tool' structs, which see." + (vconcat + (mapcar + (lambda (tool) + (list :name (gptel-tool-name tool) + :description (gptel-tool-description tool) + :input_schema ;NOTE: Anthropic wants "{}" if the function takes no args, not null + (list :type "object" + ;; See the generic implementation for an explanation of this + ;; transformation. + :properties + (cl-loop + for arg in (gptel-tool-args tool) + for argspec = (copy-sequence arg) + for name = (plist-get arg :name) ;handled differently + for newname = (or (and (keywordp name) name) + (make-symbol (concat ":" name))) + do ;ARGSPEC is ARG without unrecognized keys + (cl-remf argspec :name) + (cl-remf argspec :optional) + if (equal (plist-get arg :type) "object") + do (unless (plist-member argspec :required) + (plist-put argspec :required [])) + append (list newname argspec)) + :required + (vconcat + (delq nil (mapcar + (lambda (arg) (and (not (plist-get arg :optional)) + (plist-get arg :name))) + (gptel-tool-args tool))))))) + (ensure-list tools)))) + +(cl-defmethod gptel--parse-tool-results ((_backend gptel-anthropic) tool-use) + "Return a prompt containing tool call results in TOOL-USE. + +TOOL-USE is a list of plists containing tool names, arguments and call results." + ;; (declare (side-effect-free t)) + (list + :role "user" + :content + (vconcat + (mapcar + (lambda (tool-call) + (let* ((result (plist-get tool-call :result)) + (formatted + (list :type "tool_result" + :tool_use_id (plist-get tool-call :id) + :content (if (stringp result) result + (prin1-to-string result))))) + (prog1 formatted + (when (plist-get tool-call :error) + (plist-put formatted :is_error t))))) + tool-use)))) + +;; NOTE: No `gptel--inject-prompt' method required for gptel-anthropic, since +;; this is handled by its defgeneric implementation + +(cl-defmethod gptel--inject-tool-call ((_backend gptel-anthropic) data tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +BACKEND is the `gptel-backend'. See the generic function documentation +for details. This implementation handles the Anthropic API." + ;; FIXME: We currently assume that the tool call being modified is in the last + ;; position in the messages array. + (if-let* ((messages (plist-get data :messages)) + (entry (aref messages (1- (length messages)))) + (contents (plist-get entry :content)) + (id (plist-get tool-call :id)) + (indexed-call + (cl-loop for chunk across contents + for i upfrom 0 + if (equal (plist-get chunk :id) id) + return (cons i chunk) + finally return nil)) + (index (car indexed-call)) + (call (cdr indexed-call))) + (if (null new-call) + (if (= (length contents) 1) + (plist-put data :messages (substring messages nil -1)) + (plist-put entry :content + (vconcat (substring contents 0 index) + (substring contents (1+ index))))) + (when-let* ((args (plist-get new-call :args))) + (plist-put call :input args)) + (when-let* ((name (plist-get new-call :name))) + (plist-put call :name name))) + (display-warning + '(gptel tool-call) + (format "Could not inject updated tool-call arguments for tool call %s, %s" + (plist-get tool-call :name) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))) + +;; TODO: Remove these functions (#792) +(defun gptel--anthropic-format-tool-id (tool-id) + (unless tool-id + (setq tool-id (substring + (md5 (format "%s%s" (random) (float-time))) + nil 24))) + (if (or (string-prefix-p "call_" tool-id) + (string-prefix-p "toolu_" tool-id)) + tool-id + (format "toolu_%s" tool-id))) + +(defun gptel--anthropic-unformat-tool-id (tool-id) + (or (and (string-match "toolu_\\(.+\\)" tool-id) + (match-string 1 tool-id)) + tool-id)) + +(cl-defmethod gptel--parse-list ((backend gptel-anthropic) prompt-list) + (let ((full-prompt + (if (consp (car prompt-list)) + (let ((prompts)) + (dolist (entry prompt-list) ; Advanced format, list of lists + (pcase entry + (`(prompt . ,msg) + (push (list :role "user" + :content `[(:type "text" :text ,(or (car-safe msg) msg))]) + prompts)) + (`(response . ,msg) + (push (list :role "assistant" + :content `[(:type "text" :text ,(or (car-safe msg) msg))]) + prompts)) + (`(tool . ,call) + (unless (plist-get call :id) + (plist-put call :id (gptel--anthropic-format-tool-id nil))) + (push (list :role "assistant" + :content `[( :type "tool_use" :id ,(plist-get call :id) + :name ,(plist-get call :name) + :input ,(plist-get call :args))]) + prompts) + (push (gptel--parse-tool-results backend (list (cdr entry))) prompts)))) + (nreverse prompts)) + (cl-loop for text in prompt-list ; Simple format, list of strings + for role = t then (not role) + if text + collect (list :role (if role "user" "assistant") + :content `[(:type "text" :text ,text)]))))) + ;; cache messages if required: add cache_control to the last message + (when (and (or (eq gptel-cache t) (memq 'message gptel-cache)) + (gptel--model-capable-p 'cache)) + (nconc (aref (plist-get (car (last full-prompt)) :content) 0) + '(:cache_control (:type "ephemeral")))) + full-prompt)) + +(cl-defmethod gptel--parse-buffer ((backend gptel-anthropic) &optional max-entries) + (let ((prompts) (prev-pt (point))) + (if (or gptel-mode gptel-track-response) + (while (and (or (not max-entries) (>= max-entries 0)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min))) + (not (= (point) prev-pt))) + ;; HACK Until we can find a more robust solution for editing + ;; responses, ignore prompts containing only whitespace, as the + ;; Anthropic API can't handle it. See #452, #409, #406, #351 and #321 + ;; We check for blank prompts by skipping whitespace and comparing + ;; point against the previous. + (unless (save-excursion (skip-syntax-forward " ") (>= (point) prev-pt)) + (pcase (get-char-property (point) 'gptel) + ('response + (when-let* ((content + (gptel--trim-prefixes + (buffer-substring-no-properties (point) prev-pt)))) + (when (not (string-blank-p content)) + (push (list :role "assistant" :content content) prompts)))) + (`(tool . ,id) + (save-excursion + (condition-case nil + (let* ((tool-call (read (current-buffer))) + ;; (id (gptel--anthropic-format-tool-id id)) + (name (plist-get tool-call :name)) + (arguments (plist-get tool-call :args))) + (unless id (setq id (gptel--anthropic-format-tool-id nil))) + (plist-put tool-call :id id) + (plist-put tool-call :result + (string-trim (buffer-substring-no-properties + (point) prev-pt))) + (push (gptel--parse-tool-results backend (list tool-call)) + prompts) + (push (list :role "assistant" + :content `[( :type "tool_use" :id ,id :name ,name + :input ,arguments)]) + prompts)) + ((end-of-file invalid-read-syntax) + (message (format "Could not parse tool-call %s on line %s" + id (line-number-at-pos (point)))))))) + ('ignore) + ('nil ; user role: possibly with media + (if gptel-track-media + (when-let* ((content (gptel--anthropic-parse-multipart + (gptel--parse-media-links major-mode (point) prev-pt)))) + (when (> (length content) 0) + (push (list :role "user" :content content) prompts))) + (when-let* ((content (gptel--trim-prefixes + (buffer-substring-no-properties (point) prev-pt)))) + (push (list :role "user" :content content) prompts)))))) + (setq prev-pt (point)) + (and max-entries (cl-decf max-entries))) + (when-let* ((content (string-trim (buffer-substring-no-properties + (point-min) (point-max))))) + ;; XXX fails if content is empty. The correct error behavior is left to + ;; a future discussion. + (push (list :role "user" :content content) prompts))) + ;; Cache messages if required: add cache_control to the last message + (if (and (or (eq gptel-cache t) (memq 'message gptel-cache)) + (gptel--model-capable-p 'cache)) + (let ((last-message (plist-get (car (last prompts)) :content))) + (if (stringp last-message) + (plist-put + (car (last prompts)) :content + `[(:type "text" :text ,last-message + :cache_control (:type "ephemeral"))]) + (nconc (aref (plist-get (car (last prompts)) :content) 0) + '(:cache_control (:type "ephemeral")))))) + prompts)) + +(defun gptel--anthropic-parse-multipart (parts) + "Convert a multipart prompt PARTS to the Anthropic API format. + +The input is an alist of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")). + +The output is a vector of entries in a backend-appropriate +format." + (cl-loop + for part in parts + for n upfrom 1 + with last = (length parts) + with type + for text = (plist-get part :text) + for mime = (plist-get part :mime) + for media = (plist-get part :media) + if text do + (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and + if text + collect `(:type "text" :text ,text) into parts-array end + else if media + do + (setq type (cond ;Currently supported: Images and PDFs + ((equal (substring mime 0 5) "image") "image") + ;; NOTE: Only Claude 3.5 Sonnet supports PDF documents: + ((equal mime "application/pdf") "document") + (t (error (concat "(gptel-anthropic) Request aborted: " + "trying to send unsupported MIME type %s") + mime)))) + and collect + `(:type ,type + :source (:type "base64" + :media_type ,(plist-get part :mime) + :data ,(gptel--base64-encode media))) + into parts-array + else if (plist-get part :textfile) collect + `(:type "text" + :text ,(with-temp-buffer + (gptel--insert-file-string (plist-get part :textfile)) + (buffer-string))) + into parts-array + finally return (vconcat parts-array))) + +(cl-defmethod gptel--inject-media ((_backend gptel-anthropic) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) + (cl-callf (lambda (current) + (vconcat + (gptel--anthropic-parse-multipart media-list) + (cl-typecase current + (string `((:type "text" :text ,current))) + (vector current) + (t current)))) + (plist-get (car prompts) :content)))) + +;; (if-let* ((context-string (gptel-context--string gptel-context))) +;; (cl-callf (lambda (previous) +;; (cl-typecase previous +;; (string (concat context-string previous)) +;; (vector (vconcat `((:type "text" :text ,previous)) +;; previous)) +;; (t context-string))) +;; (plist-get (car (last prompts)) :content))) + +(defconst gptel--anthropic-models + '((claude-sonnet-4-6 + :description "The best combination of speed and intelligence" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 1000 + :input-cost 3 + :output-cost 15 + :cutoff-date "2025-08") + (claude-sonnet-4-5-20250929 + :description "High-performance model with exceptional reasoning and efficiency" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 3 + :output-cost 15 + :cutoff-date "2025-07") + (claude-haiku-4-5-20251001 + :description "Near-frontier intelligence at blazing speeds with extended thinking" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 1 + :output-cost 5 + :cutoff-date "2025-02") + (claude-sonnet-4-20250514 + :description "High-performance model with exceptional reasoning and efficiency" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 3 + :output-cost 15 + :cutoff-date "2025-03") + (claude-opus-4-7 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 1000 + :input-cost 5 + :output-cost 25 + :cutoff-date "2026-01") + (claude-opus-4-6 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 5 + :output-cost 25 + :cutoff-date "2025-08") + (claude-opus-4-5-20251101 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 5 + :output-cost 25 + :cutoff-date "2025-03") + (claude-opus-4-1-20250805 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 15 + :output-cost 75 + :cutoff-date "2025-03") + (claude-opus-4-20250514 + :description "Anthropic's previous flagship model" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 15 + :output-cost 75 + :cutoff-date "2025-03") + (claude-3-7-sonnet-20250219 + :description "Hybrid model capable of standard thinking and extended thinking modes" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 3 + :output-cost 15 + :cutoff-date "2025-02") + (claude-3-5-sonnet-20241022 + :description "Highest level of intelligence and capability" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 200 + :input-cost 3 + :output-cost 15 + :cutoff-date "2024-04") + (claude-3-5-sonnet-20240620 + :description "Highest level of intelligence and capability (earlier version)" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 200 + :input-cost 3 + :output-cost 15 + :cutoff-date "2024-04") + (claude-3-5-haiku-20241022 + :description "Intelligence at blazing speeds" + :capabilities (tool-use cache) + :context-window 200 + :input-cost 1.00 + :output-cost 5.00 + :cutoff-date "2024-07") + (claude-3-opus-20240229 + :description "Top-level performance, intelligence, fluency, and understanding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 200 + :input-cost 15 + :output-cost 75 + :cutoff-date "2023-08") + (claude-3-haiku-20240307 + :description "Fast and most compact model for near-instant responsiveness" + :capabilities (tool-use cache) + :context-window 200 + :input-cost 0.25 + :output-cost 1.25 + :cutoff-date "2023-08")) + "List of available Anthropic models and associated properties. +Keys: + +- `:description': a brief description of the model. + +- `:capabilities': a list of capabilities supported by the model. + +- `:mime-types': a list of supported MIME types for media files. + +- `:context-window': the context window size, in thousands of tokens. + +- `:input-cost': the input cost, in US dollars per million tokens. + +- `:output-cost': the output cost, in US dollars per million tokens. + +- `:cutoff-date': the knowledge cutoff date. + +- `:request-params': a plist of additional request parameters to + include when using this model. + +Information about the Anthropic models was obtained from the following +comparison table: + +URL `https://docs.anthropic.com/en/docs/about-claude/models#model-comparison-table'") + +;;;###autoload +(cl-defun gptel-make-anthropic + (name &key curl-args stream key request-params + (header + (lambda (_info) (when-let* ((key (gptel--get-api-key))) + `(("x-api-key" . ,key) + ("anthropic-version" . "2023-06-01") + ("anthropic-beta" . "extended-cache-ttl-2025-04-11"))))) + (models gptel--anthropic-models) + (host "api.anthropic.com") + (protocol "https") + (endpoint "/v1/messages")) + "Register an Anthropic API-compatible backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, \"api.anthropic.com\" by default. + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--anthropic-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(claude-3-haiku-20240307 ;Simple specs + claude-3-opus-20240229 + (claude-3-5-sonnet-20240620 ;Full spec + :description \"Balance of intelligence and speed\" + :capabilities (media tool json) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/messages\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY is a variable whose value is the API key, or function that +returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for." + (declare (indent 1)) + (let ((backend (gptel--make-anthropic + :curl-args curl-args + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +(provide 'gptel-anthropic) +;;; gptel-anthropic.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-autoloads.el b/elpa/gptel-20260425.846/gptel-autoloads.el new file mode 100644 index 00000000..f7b2df4b --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-autoloads.el @@ -0,0 +1,772 @@ +;;; gptel-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from gptel.el + +(autoload 'gptel-mode "gptel" +"Minor mode for interacting with LLMs. + +This is a minor mode. If called interactively, toggle the `GPTel mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate the variable `gptel-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'gptel-send "gptel" +"Submit this prompt to the current LLM backend. + +By default, the contents of the buffer up to the cursor position +are sent. If the region is active, its contents are sent +instead. + +The response from the LLM is inserted below the cursor position +at the time of sending. To change this behavior or model +parameters, use prefix arg ARG activate a transient menu with +more options instead. + +This command is asynchronous, you can continue to use Emacs while +waiting for the response. + +(fn &optional ARG)" t) +(autoload 'gptel "gptel" +"Switch to or start a chat session with NAME. + +Ask for API-KEY if `gptel-api-key' is unset. + +If region is active, use it as the INITIAL prompt. Returns the +buffer created or switched to. + +INTERACTIVEP is t when gptel is called interactively. + +(fn NAME &optional _ INITIAL INTERACTIVEP)" t) +(register-definition-prefixes "gptel" '("gptel-")) + + +;;; Generated autoloads from gptel-anthropic.el + +(autoload 'gptel-make-anthropic "gptel-anthropic" +"Register an Anthropic API-compatible backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, \"api.anthropic.com\" by default. + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--anthropic-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(claude-3-haiku-20240307 ;Simple specs + claude-3-opus-20240229 + (claude-3-5-sonnet-20240620 ;Full spec + :description \"Balance of intelligence and speed\" + :capabilities (media tool json) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/messages\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY is a variable whose value is the API key, or function that +returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"x-api-key\" \\=\\, key) (\"anthropic-version\" . \"2023-06-01\") (\"anthropic-beta\" . \"extended-cache-ttl-2025-04-11\"))))) (MODELS gptel--anthropic-models) (HOST \"api.anthropic.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/messages\"))") +(function-put 'gptel-make-anthropic 'lisp-indent-function 1) +(register-definition-prefixes "gptel-anthropic" '("gptel--anthropic-")) + + +;;; Generated autoloads from gptel-bedrock.el + +(autoload 'gptel-make-bedrock "gptel-bedrock" +"Register an AWS Bedrock backend for gptel with NAME. + +Keyword arguments: + +REGION - AWS region name (e.g. \"us-east-1\") +MODELS - The list of models supported by this backend +MODEL-REGION - one of apac, eu, us or nil +AWS-PROFILE - the aws profile to use for aws configure export-credentials +AWS-BEARER-TOKEN - the aws bearer-token for authenticating with AWS +CURL-ARGS - additional curl args +STREAM - Whether to use streaming responses or not. +REQUEST-PARAMS - a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. + +(fn NAME &key REGION (MODELS gptel--bedrock-models) (MODEL-REGION nil) STREAM CURL-ARGS REQUEST-PARAMS AWS-PROFILE AWS-BEARER-TOKEN (PROTOCOL \"https\"))") +(function-put 'gptel-make-bedrock 'lisp-indent-function 1) +(register-definition-prefixes "gptel-bedrock" '("gptel-")) + + +;;; Generated autoloads from gptel-context.el + + (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t) + (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t) +(autoload 'gptel-context--wrap "gptel-context" +"Add request context to DATA-BUF and run CALLBACK. + +DATA-BUF is the buffer where the request prompt is constructed. + +(fn CALLBACK DATA-BUF)") +(autoload 'gptel-context--collect "gptel-context" +"Get the list of all active context sources from CONTEXT-ALIST. + +CONTEXT-ALIST defaults to the current value of `gptel-context'. + +Ignore overlays, buffers and files that are not live or readable. + +(fn &optional CONTEXT-ALIST)") +(register-definition-prefixes "gptel-context" '("gptel-context-")) + + +;;; Generated autoloads from gptel-gemini.el + +(autoload 'gptel-make-gemini "gptel-gemini" +"Register a Gemini backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, defaults to +\"generativelanguage.googleapis.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--gemini-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(gemini-2.0-flash-lite ;Simple specs + gemini-1.5-flash + (gemini-1.5-pro-latest ;Full spec + :description + \"Complex reasoning tasks, problem solving and data extraction\" + :capabilities (tool json) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\"))) + + +STREAM is a boolean to enable streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, \"https\" by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1beta/models\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +(fn NAME &key CURL-ARGS KEY REQUEST-PARAMS (STREAM nil) (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"X-goog-api-key\" \\=\\, key))))) (HOST \"generativelanguage.googleapis.com\") (PROTOCOL \"https\") (MODELS gptel--gemini-models) (ENDPOINT \"/v1beta/models\"))") +(function-put 'gptel-make-gemini 'lisp-indent-function 1) +(register-definition-prefixes "gptel-gemini" '("gptel--gemini-")) + + +;;; Generated autoloads from gptel-gh.el + +(autoload 'gptel-make-gh-copilot "gptel-gh" +"Register a Github Copilot chat backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, typically \"api.githubcopilot.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--openai-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(gpt-3.5-turbo ;Simple specs + gpt-4-turbo + (gpt-4o-mini ;Full spec + :description + \"Affordable and intelligent small model for lightweight tasks\" + :capabilities (media tool json url) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) + +Defaults to a list of models supported by GitHub Copilot. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/chat/completions\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +Defaults to headers required by GitHub Copilot. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +(fn NAME &key CURL-ARGS REQUEST-PARAMS (HEADER (lambda (info) (gptel--gh-auth) \\=`((\"openai-intent\" . \"conversation-panel\") (\"authorization\" \\=\\, (concat \"Bearer \" (plist-get (gptel--gh-token gptel-backend) :token))) (\"x-initiator\" \\=\\, (or (plist-get info :gh-initiator) (prog1 \"user\" (plist-put info :gh-initiator \"agent\")))) (\"x-request-id\" \\=\\, (gptel--gh-uuid)) (\"vscode-sessionid\" \\=\\, (or (gptel--gh-sessionid gptel-backend) \"\")) (\"vscode-machineid\" \\=\\, (or (gptel--gh-machineid gptel-backend) \"\")) ,@(when (and gptel-track-media (gptel--model-capable-p \\='media)) \\=`((\"copilot-vision-request\" . \"true\"))) (\"copilot-integration-id\" . \"vscode-chat\")))) (HOST \"api.githubcopilot.com\") (PROTOCOL \"https\") (ENDPOINT \"/chat/completions\") (STREAM t) (MODELS gptel--gh-models))") +(function-put 'gptel-make-gh-copilot 'lisp-indent-function 1) +(register-definition-prefixes "gptel-gh" '("gptel-")) + + +;;; Generated autoloads from gptel-integrations.el + +(register-definition-prefixes "gptel-integrations" '("gptel-")) + + +;;; Generated autoloads from gptel-kagi.el + +(autoload 'gptel-make-kagi "gptel-kagi" +"Register a Kagi FastGPT backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is the Kagi host (with port), defaults to \"kagi.com\". + +MODELS is a list of available Kagi models: only fastgpt is supported. + +STREAM is a boolean to toggle streaming responses, defaults to +false. Kagi does not support a streaming API yet. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/api/v0/fastgpt\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +Example: +------- + + (gptel-make-kagi \"Kagi\" :key my-kagi-key) + +(fn NAME &key CURL-ARGS STREAM KEY (HOST \"kagi.com\") (HEADER (lambda (_info) \\=`((\"Authorization\" \\=\\, (concat \"Bot \" (gptel--get-api-key)))))) (MODELS \\='((fastgpt :capabilities (nosystem)) (summarize:cecil :capabilities (nosystem)) (summarize:agnes :capabilities (nosystem)) (summarize:daphne :capabilities (nosystem)) (summarize:muriel :capabilities (nosystem)))) (PROTOCOL \"https\") (ENDPOINT \"/api/v0/\"))") +(function-put 'gptel-make-kagi 'lisp-indent-function 1) + + +;;; Generated autoloads from gptel-ollama.el + +(autoload 'gptel-make-ollama "gptel-ollama" +"Register an Ollama backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is where Ollama runs (with port), defaults to localhost:11434 + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +Currently recognized plist keys are :description, :capabilities +and :mime-types. An example of a model specification including +both kinds of specs: + +:models +\\='(mistral:latest ;Simple specs + openhermes:latest + (llava:13b ;Full spec + :description + \"Llava 1.6: Large Lanuage and Vision Assistant\" + :capabilities (media) + :mime-types (\"image/jpeg\" \"image/png\"))) + + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, http by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/api/generate\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. This is typically not required +for local models like Ollama. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + + (gptel-make-ollama + \"Ollama\" + :host \"localhost:11434\" + :models \\='(mistral:latest) + :stream t) + +(fn NAME &key CURL-ARGS HEADER KEY MODELS STREAM REQUEST-PARAMS (HOST \"localhost:11434\") (PROTOCOL \"http\") (ENDPOINT \"/api/chat\"))") +(function-put 'gptel-make-ollama 'lisp-indent-function 1) +(register-definition-prefixes "gptel-ollama" '("gptel--ollama-")) + + +;;; Generated autoloads from gptel-openai.el + +(autoload 'gptel-make-openai "gptel-openai" +"Register an OpenAI API-compatible backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, typically \"api.openai.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--openai-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(gpt-3.5-turbo ;Simple specs + gpt-4-turbo + (gpt-4o-mini ;Full spec + :description + \"Affordable and intelligent small model for lightweight tasks\" + :capabilities (media tool json url) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/chat/completions\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +(fn NAME &key CURL-ARGS (MODELS gptel--openai-models) STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.openai.com\") (PROTOCOL \"https\") ENDPOINT)") +(function-put 'gptel-make-openai 'lisp-indent-function 1) +(autoload 'gptel-make-azure "gptel-openai" +"Register an Azure backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is the API host. + +MODELS is a list of available model names, as symbols. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT is the API endpoint for completions. + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + + (gptel-make-azure + \"Azure-1\" + :protocol \"https\" + :host \"RESOURCE_NAME.openai.azure.com\" + :endpoint + \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\" + :stream t + :models \\='(gpt-3.5-turbo gpt-4)) + +(fn NAME &key CURL-ARGS HOST (PROTOCOL \"https\") (HEADER (lambda (_info) \\=`((\"api-key\" \\=\\, (gptel--get-api-key))))) (KEY \\='gptel-api-key) MODELS STREAM ENDPOINT REQUEST-PARAMS)") +(function-put 'gptel-make-azure 'lisp-indent-function 1) +(defalias 'gptel-make-gpt4all 'gptel-make-openai +"Register a GPT4All backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is where GPT4All runs (with port), typically localhost:4891 + +MODELS is a list of available model names, as symbols. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/api/v1/completions\" + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: +((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. This is typically not required for +local models like GPT4All. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + +(gptel-make-gpt4all + \"GPT4All\" + :protocol \"http\" + :host \"localhost:4891\" + :models \\='(mistral-7b-openorca.Q4_0.gguf))") +(register-definition-prefixes "gptel-openai" '("gptel--openai-")) + + +;;; Generated autoloads from gptel-openai-extras.el + +(autoload 'gptel-make-privategpt "gptel-openai-extras" +"Register an Privategpt API-compatible backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, \"api.privategpt.com\" by default. + +MODELS is a list of available model names. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/messages\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: +((\"Content-Type\" . \"application/json\")) + +KEY is a variable whose value is the API key, or function that +returns the key. + +CONTEXT and SOURCES: if true (the default), use available context +and provide sources used by the model to generate the response. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"localhost:8001\") (PROTOCOL \"http\") (MODELS \\='(private-gpt)) (ENDPOINT \"/v1/chat/completions\") (CONTEXT t) (SOURCES t))") +(function-put 'gptel-make-privategpt 'lisp-indent-function 1) +(autoload 'gptel-make-perplexity "gptel-openai-extras" +"Register a Perplexity backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, \"api.perplexity.ai\" by default. + +MODELS is a list of available model names. + +STREAM is a boolean to toggle streaming responses. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions. + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist. + +KEY is a variable whose value is the API key, or function that +returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters. + +(fn NAME &key CURL-ARGS STREAM KEY (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.perplexity.ai\") (PROTOCOL \"https\") (MODELS \\='(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research)) (ENDPOINT \"/chat/completions\") REQUEST-PARAMS)") +(function-put 'gptel-make-perplexity 'lisp-indent-function 1) +(autoload 'gptel-make-deepseek "gptel-openai-extras" +"Register a DeepSeek backend for gptel with NAME. + +For the meanings of the keyword arguments, see `gptel-make-openai'. + +(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.deepseek.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((deepseek-reasoner :capabilities (tool reasoning) :context-window 128 :input-cost 0.28 :output-cost 0.42) (deepseek-chat :capabilities (tool) :context-window 128 :input-cost 0.28 :output-cost 0.42))))") +(function-put 'gptel-make-deepseek 'lisp-indent-function 1) +(autoload 'gptel-make-xai "gptel-openai-extras" +"Register an xAI backend for gptel with NAME. + +Keyword arguments: + +KEY is a variable whose value is the API key, or function that +returns the key. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +The other keyword arguments are all optional. For their meanings +see `gptel-make-openai'. + +(fn NAME &key CURL-ARGS STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.x.ai\") (PROTOCOL \"https\") (ENDPOINT \"/v1/chat/completions\") (MODELS \\='((grok-4-1-fast-reasoning :description \"Fast tool-calling model\" :capabilities (tool-use json reasoning) :context-window 2000 :input-cost 0.2 :output-cost 0.5) (grok-4-1-fast-non-reasoning :description \"Fast tool-calling model (non-reasoning)\" :capabilities (tool-use json) :context-window 2000 :input-cost 0.2 :output-cost 0.5) (grok-code-fast-1 :description \"Fast reasoning model for agentic coding\" :capabilities (tool-use json reasoning) :context-window 256 :input-cost 0.2 :output-cost 1.5) (grok-4-fast-reasoning :description \"Fast tool-calling model\" :capabilities (tool-use json reasoning) :context-window 2000 :input-cost 0.2 :output-cost 0.5) (grok-4-fast-non-reasoning :description \"Fast tool-calling model (non-reasoning)\" :capabilities (tool-use json) :context-window 2000 :input-cost 0.2 :output-cost 0.5) (grok-4 :description \"Grok Flagship model\" :capabilities (tool-use json reasoning) :context-window 256 :input-cost 3 :output-cost 15) (grok-3-mini :description \"Mini Grok 3\" :capabilities (tool-use json reasoning) :context-window 131 :input-cost 0.3 :output-cost 0.5) (grok-3 :description \"Grok 3\" :capabilities (tool-use json reasoning) :context-window 131 :input-cost 3 :output-cost 15) (grok-2-vision-1212 :description \"Grok 2 Vision\" :capabilities (tool-use json media) :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\") :context-window 32 :input-cost 2 :output-cost 10))))") +(function-put 'gptel-make-xai 'lisp-indent-function 1) +(register-definition-prefixes "gptel-openai-extras" '("gptel--p")) + + +;;; Generated autoloads from gptel-openai-responses.el + +(autoload 'gptel-make-openai-responses "gptel-openai-responses" +"Register an OpenAI Responses API backend for gptel with NAME. + +The Responses API is OpenAI's new API for agentic applications that +provides built-in tools like web search, code interpreter, and file +search. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, typically \"api.openai.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--openai-models'. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/responses\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + + (gptel-make-openai-responses + \"OpenAI-Responses\" + :stream t + :models '((gpt-4o + :capabilities (media tool-use json url responses-api) + :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")) + (gpt-4o-mini + :capabilities (media tool-use json url responses-api) + :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")))) + +(fn NAME &key CURL-ARGS (MODELS gptel--openai-models) STREAM KEY REQUEST-PARAMS (HEADER (lambda (_info) (when-let* ((key (gptel--get-api-key))) \\=`((\"Authorization\" \\=\\, (concat \"Bearer \" key)))))) (HOST \"api.openai.com\") (PROTOCOL \"https\") (ENDPOINT \"/v1/responses\"))") +(function-put 'gptel-make-openai-responses 'lisp-indent-function 1) +(register-definition-prefixes "gptel-openai-responses" '("gptel--openai-responses-")) + + +;;; Generated autoloads from gptel-org.el + +(autoload 'gptel--convert-markdown->org "gptel-org" +"Convert string STR from markdown to org markup. + +This is a very basic converter that handles only a few markup +elements. + +(fn STR)") +(autoload 'gptel--stream-convert-markdown->org "gptel-org" +"Return a Markdown to Org converter. + +This function parses a stream of Markdown text to Org +continuously when it is called with successive chunks of the +text stream. + +START-MARKER is used to identify the corresponding process when +cleaning up after. + +(fn START-MARKER)") +(register-definition-prefixes "gptel-org" '("gptel-")) + + +;;; Generated autoloads from gptel-request.el + +(autoload 'gptel-curl-get-response "gptel-request" +"Fetch response to prompt in state FSM from the LLM using Curl. + +FSM is the state machine driving this request. + +FSM is the state machine driving this request. Its INFO slot +contains the data required for setting up the request. INFO is a +plist with the following keys, among others: +- :data (the data being sent) +- :buffer (the gptel buffer) +- :position (marker at which to insert the response). +- :callback (optional, the request callback) + +Call CALLBACK with the response and INFO afterwards. If omitted +the response is inserted into the current buffer after point. + +(fn FSM)") +(register-definition-prefixes "gptel-request" '("gptel-")) + + +;;; Generated autoloads from gptel-rewrite.el + + (autoload 'gptel-rewrite "gptel-rewrite" nil t) +(register-definition-prefixes "gptel-rewrite" '("gptel-")) + + +;;; Generated autoloads from gptel-transient.el + + (autoload 'gptel-menu "gptel-transient" nil t) + (autoload 'gptel-system-prompt "gptel-transient" nil t) +(autoload 'gptel-preset "gptel-transient" +"Load gptel PRESET with SETTER. + +Interactively, query for PRESET, allow the preset scope to be set +dynamically, and offer to save the current gptel settings as a new or +existing preset, as well. + +(fn PRESET &optional SETTER)" t) + (autoload 'gptel-tools "gptel-transient" nil t) +(register-definition-prefixes "gptel-transient" '("gptel-")) + +;;; End of scraped data + +(provide 'gptel-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; gptel-autoloads.el ends here diff --git a/elpa/gptel-20260425.846/gptel-bedrock.el b/elpa/gptel-20260425.846/gptel-bedrock.el new file mode 100644 index 00000000..5328fdd9 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-bedrock.el @@ -0,0 +1,728 @@ +;;; gptel-bedrock.el --- AWS Bedrock support for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Karthik Chikmagalur + +;; Keywords: comm, convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file adds support for AWS Bedrock to gptel. Documentation for the request data and the +;; response payloads can be found at these two links: +;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html +;; * https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ConverseStream.html + +;;; Code: +(require 'cl-lib) +(require 'map) +(require 'mail-parse) +(eval-and-compile (require 'gptel-request)) + +(declare-function gptel-context--collect-media "gptel-context") +(declare-function gptel-context--wrap "gptel-context") + +(cl-defstruct (gptel-bedrock (:constructor gptel--make-bedrock) + (:copier nil) + (:include gptel-backend)) + model-region) + +(defun gptel--bedrock-update-tokens (usage info) + "Update token usage information from USAGE. +USAGE is part of the response, INFO is the request plist. + +This function accumulates token counts across multiple turns in a +multi-turn request (e.g., during tool use where results are fed +back to the LLM)." + (when usage + (let* ((tokens (plist-get info :tokens)) + (input (+ (or (plist-get usage :inputTokens) 0) + (or (plist-get tokens :input) 0))) + (output (+ (or (plist-get usage :outputTokens) 0) + (or (plist-get tokens :output) 0))) + (cached (+ (or (plist-get usage :cacheReadInputTokens) 0) + (or (plist-get tokens :cached) 0))) + (cache (+ (or (plist-get usage :cacheWriteInputTokens) 0) + (or (plist-get tokens :cache) 0)))) + (list :input input :output output + :cache cache :cached cached)))) + +(defconst gptel-bedrock--prompt-type + ;; For documentation purposes only -- this describes the type of prompt objects that get passed + ;; around. https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Message.html + '(plist + :role (member "user" "assistant") + :content (array (or (plist :text string) + (plist :image (:format (member "png" "jpeg" "gif" "webp") + :source (plist :bytes string))) ; bytes is b64 encoded + (plist :document (:format (member "pdf" "csv" "doc" "docx" "xls" "xlsx" "html" "txt" "md") + :name string + :source (plist :bytes string))) ; bytes is b64 encoded + (plist :toolUse (plist :input any :name string :toolUseId string)) + (plist :toolResult (plist + :toolUseId string + :status (member "success" "error") + ;; AWS allows more result types in + ;; ToolResultContentBlock, but we only send text results + :content (array (plist :text string)))))))) + +(cl-defmethod gptel--request-data ((backend gptel-bedrock) prompts) + "Prepare request data for AWS Bedrock BACKEND from PROMPTS." + ;; First, build the core Bedrock request data structure. + (let ((base-request-data + (nconc + `(:messages [,@prompts] :inferenceConfig (:maxTokens ,(or gptel-max-tokens 500))) + (when gptel--system-message `(:system [(:text ,gptel--system-message)])) + (when gptel-temperature `(:temperature ,gptel-temperature)) + (when (and gptel-use-tools gptel-tools) + `(:toolConfig (:toolChoice ,(if (eq gptel-use-tools 'force) '(:any '()) '(:auto '())) + :tools ,(gptel--parse-tools backend gptel-tools))))))) + + ;; Finally, merge all potential :request-params sources. + (gptel--merge-plists + base-request-data ; The core data we just built + gptel--request-params ; Global/buffer-local gptel--request-params + (gptel-backend-request-params backend) ; From `gptel-make-bedrock` call + (gptel--model-request-params gptel-model)))) ; From the model's properties + +(cl-defmethod gptel--parse-tools ((_backend gptel-bedrock) tools) + "Parse TOOLS and return a list of ToolSpecification objects. + +TOOLS is a list of `gptel-tool' structs, which see." + ;; https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_ToolSpecification.html + (let ((default-outputs (cl-call-next-method))) ;; use openai tool-parse + (cl-map 'vector + (lambda (tool spec) + (list :toolSpec + (list + :name (gptel-tool-name tool) + :description (gptel-tool-description tool) + :inputSchema (list :json (plist-get (plist-get spec :function) :parameters))))) + (ensure-list tools) default-outputs))) + +(cl-defmethod gptel--parse-response ((_backend gptel-bedrock) response info) + "Parse a Bedrock (non-streaming) RESPONSE and return response text. + +Mutate state INFO with response metadata." + (plist-put info :stop-reason (plist-get response :stopReason)) + (plist-put info :tokens (gptel--bedrock-update-tokens + (plist-get response :usage) info)) + + (let* ((message (map-nested-elt response '(:output :message))) + (content-strs (thread-last (plist-get message :content) + (mapcar (lambda (cblock) (plist-get cblock :text))) + (delq nil)))) + (gptel-bedrock--record-tool-use message info) + (and content-strs (apply #'concat content-strs)))) + +(defun gptel-bedrock--record-tool-use (message info) + "If MESSAGE has tool use requests, save those to INFO." + (let* ((content (plist-get message :content)) + (tool-use-blocks (cl-remove-if-not + (lambda (cblock) (plist-get cblock :toolUse)) + content))) + (when tool-use-blocks + (cl-callf vconcat (plist-get (plist-get info :data) :messages) (list message)) + + (plist-put info :tool-use + (mapcar (lambda (block) + (let ((tool-use (plist-get block :toolUse))) + (list + :name (plist-get tool-use :name) + :args (plist-get tool-use :input) + :id (plist-get tool-use :toolUseId)))) + tool-use-blocks))))) + +(cl-defmethod gptel--parse-list ((_backend gptel-bedrock) prompt-strings) + "Create a list of prompt objects from PROMPT-STRINGS. + +Assumes this is a conversation with alternating roles." + (cl-loop for text in prompt-strings + for role = t then (not role) + if text collect + (list :role (if role "user" "assistant") + :content `[(:text ,text)]))) + +(cl-defmethod gptel--inject-media ((_backend gptel-bedrock) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) + (cl-callf2 vconcat (gptel-bedrock--parse-multipart media-list) + (plist-get (car prompts) :content)))) + +(defvar-local gptel-bedrock--stream-cursor nil + "Marker to indicate last point parsed.") + +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-bedrock) info) + "Parse an AWS Bedrock streaming response from the ConverseStream API. +INFO is a plist containing the request context." + (cl-block fn + (save-excursion + ;; Each streaming request uses a fresh buffer, so the cursor starts out null. We keep it unset + ;; until we have received all the headers + (when (null gptel-bedrock--stream-cursor) + (goto-char (point-min)) + (unless (search-forward "\r\n\r\n" nil t) (cl-return-from fn)) + (save-restriction + (narrow-to-region (point-min) (point)) ; Required by mail-fetch-field + (let ((content-type (mail-header-parse-content-type + (mail-fetch-field "Content-Type")))) + (cl-assert content-type nil "No Content-Type header found") + (cl-assert (string-equal (car content-type) "application/vnd.amazon.eventstream") + t "Unexpected Content-Type %S, expected %S"))) + (setq gptel-bedrock--stream-cursor (point-marker)) + + ;; :accumulated-events contains the events from an in-progress message, from the + ;; messageStart onwards. With each messageStop it gets cleared + (plist-put info :accumulated-events nil)) + + ;; Start of main routine + (let ((acc-cell (cdr (plist-member info :accumulated-events))) strings prompts) + (goto-char gptel-bedrock--stream-cursor) + (while-let ((event (gptel-bedrock--parse-stream-message))) + (let ((event-type (assoc-default ":event-type" (plist-get event :headers)))) + (when (member event-type '("messageStart" "contentBlockStart" "contentBlockDelta" + "contentBlockStop")) + (push event (car acc-cell))) + (pcase event-type + ("metadata" + (plist-put info :tokens (gptel--bedrock-update-tokens + (map-nested-elt event '(:payload :usage)) info))) + ("contentBlockDelta" + (when-let ((delta-text (map-nested-elt event '(:payload :delta :text)))) + (push delta-text strings))) + ("messageStop" + (push (gptel-bedrock--assemble-content-blocks (nreverse (car acc-cell))) prompts) + (setf (car acc-cell) nil) + (plist-put info :stop-reason (map-nested-elt event '(:payload :stopReason))) + (plist-put info :message-complete t))))) + (move-marker gptel-bedrock--stream-cursor (point)) + + (dolist (message prompts) (gptel-bedrock--record-tool-use message info)) + (apply #'concat (nreverse strings)))))) + +(defun gptel-bedrock--parse-stream-message () + "Parse AWS Bedrock event-stream message starting at current position. +Point should be at the beginning of an event in the `vnd.amazon.event-stream' +format. Returns plist with :headers and :payload keys if successful, nil if +incomplete." + ;; https://github.com/awslabs/aws-c-event-stream has documentation of this format + ;; The format consists of three main sections: Prelude, Data, and Message CRC. + ;; 1. Prelude (12 bytes) + ;; a. Total Byte Length (4 bytes): Specifies the total length of the message. + ;; b. Headers Byte Length (4 bytes): Indicates the length of the headers section. + ;; c. Prelude CRC (4 bytes): A CRC value for validating the integrity of the prelude. + ;; 2. Data (variable length) + ;; a. Headers: An array of packed headers. Each header has a specific format documented in + ;; gptel-bedrock--parse-headers + ;; b. Payload: The main message content, also of variable length. Length can be computed from + ;; the prelude fields by subtracting the prelude length, headers length, and message CRC + ;; length from the total. + ;; 3. Message CRC (4 bytes): A 4-byte CRC to validate the integrity of the entire message. + + ;; (point-max) is the position after the last character, hence the use of >= and not > below + (when (>= (- (point-max) (point)) 12) + (let* ((prelude-start (point)) + (prelude-length 12) + (prelude-end (+ prelude-start prelude-length)) + (prelude (buffer-substring-no-properties prelude-start prelude-end)) + (total-length (gptel-bedrock--bytes-to-int32 (substring prelude 0 4))) + (headers-length (gptel-bedrock--bytes-to-int32 (substring prelude 4 8))) + (headers-start prelude-end) + (headers-end (+ headers-start headers-length)) + headers payload) + ;; We don't validate either CRC because isn't that what the networking stack is for? + + (when (>= (point-max) (+ prelude-start total-length)) + (goto-char headers-start) + (setq headers (gptel-bedrock--parse-headers (buffer-substring (point) headers-end))) + (cl-assert (equal (assoc-default ":message-type" headers) "event") + t "Unknown message type %S; expected %S") + (cl-assert (equal (assoc-default ":content-type" headers) "application/json") + t "Unexpected content-type %S is not %S") + + (goto-char headers-end) + (setq payload (gptel--json-read)) + (let* ((message-crc 4) + (payload-length (- total-length headers-length prelude-length message-crc))) + (cl-assert (= (- (point) headers-end) payload-length) + t "Unexpected payload length %d; expected %d.")) + + (goto-char (+ prelude-start total-length)) + `(:headers ,headers :payload ,payload))))) + +(defun gptel-bedrock--parse-headers (headers-data) + "Parse HEADERS-DATA into alist of (NAME . VALUE). +Keys are string-valued, lower-cased names." + ;; Header wire format: + ;; 1. Header Name Byte Length (1 byte): Specifies the length of the header name. + ;; 2. Header Name (String) (Variable length): Contains the name of the header. + ;; 3. Header Value Type (1 byte): Identifies the type of the header value. + ;; 4. Value String Byte Length (2 bytes): Indicates the length of the value string. + ;; 5. Value (Variable length): Holds the actual value bytes + (let ((pos 0) (max (length headers-data)) headers) + (cl-flet ((pos++ () (prog1 pos (cl-incf pos))) + (++pos (n) (cl-incf pos n)) + (utf8 (unibyte-string) (decode-coding-string unibyte-string 'utf-8 t))) + (while (< pos max) + (let* ((name-len (aref headers-data (pos++))) + (name (substring headers-data pos (++pos name-len))) + (type (aref headers-data (pos++))) + (value-len (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2)))) + (value + (pcase type + ;; Header types from https://awslabs.github.io/aws-crt-python/api/eventstream.html + (0 t) + (1 :json-false) + (2 (let ((res (aref headers-data (pos++)))) ; int8 + (if (> res 127) (- res 256) res))) + (3 (gptel-bedrock--bytes-to-int16 (substring headers-data pos (++pos 2)))) ; int16 + (4 (gptel-bedrock--bytes-to-int32 (substring headers-data pos (++pos 4)))) ; int32 + (5 (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8)))) ; int64 + (6 (substring headers-data pos (++pos value-len))) ; raw bytes + (7 (utf8 (substring headers-data pos (++pos value-len)))) ; utf8 string + (8 (decode-time ; 64 bit int with seconds since the Unix epoch + (gptel-bedrock--bytes-to-int64 (substring headers-data pos (++pos 8))) t)) + (9 (gptel-bedrock--bytes-to-uuid ; 16 byte UUID + (substring headers-data pos (++pos 16)))) + (_ (error "Unknown header type: %d" type))))) + (push (cons (downcase (utf8 name)) value) headers))) + (cl-assert (= pos max) t "Headers did not parse cleanly. pos=%d header-len=%d") + headers))) + +(defun gptel-bedrock--bytes-to-int16 (bytes) + "Convert 2-byte string BYTES to big-endian signed integer." + (let ((b0 (logand (aref bytes 0) 255)) + (b1 (logand (aref bytes 1) 255))) + (let ((result (+ (ash b0 8) b1))) + (if (>= b0 #x80) (- result (ash 1 16)) result)))) + +(defun gptel-bedrock--bytes-to-int32 (bytes) + "Convert 4-byte string BYTES to big-endian signed integer." + (let ((b0 (logand (aref bytes 0) 255)) + (b1 (logand (aref bytes 1) 255)) + (b2 (logand (aref bytes 2) 255)) + (b3 (logand (aref bytes 3) 255))) + (let ((result (+ (ash b0 24) (ash b1 16) (ash b2 8) b3))) + (if (>= b0 #x80) (- result (ash 1 32)) result)))) + +(defun gptel-bedrock--bytes-to-int64 (bytes) + "Convert 8-byte string BYTES to big-endian signed integer." + (let ((b0 (logand (aref bytes 0) 255)) + (b1 (logand (aref bytes 1) 255)) + (b2 (logand (aref bytes 2) 255)) + (b3 (logand (aref bytes 3) 255)) + (b4 (logand (aref bytes 4) 255)) + (b5 (logand (aref bytes 5) 255)) + (b6 (logand (aref bytes 6) 255)) + (b7 (logand (aref bytes 7) 255))) + (let ((result-u63 (+ (ash (logand b0 #x7f) 56) (ash b1 48) + (ash b2 40) (ash b3 32) (ash b4 24) (ash b5 16) (ash b6 8) b7))) + (if (>= b0 #x80) + (- result-u63 (ash 1 63)) + result-u63)))) + +(defun gptel-bedrock--bytes-to-uuid (bytes) + "Convert a 16-byte unibyte BYTES to a 36 character UUID string." + (unless (and (stringp bytes) (= (length bytes) 16)) + (error "Input must be a 16-byte unibyte string")) + (let ((hex (mapconcat (lambda (i) (format "%02x" (aref bytes i))) (number-sequence 0 15) ""))) + (format "%s-%s-%s-%s-%s" + (substring hex 0 8) + (substring hex 8 12) + (substring hex 12 16) + (substring hex 16 20) + (substring hex 20 32)))) + +(defun gptel-bedrock--assemble-content-blocks (events) + "Build a completed prompt object contained from EVENTS. +EVENTS should be a list of messageStart, contentBlockStart, +contentBlockDelta, and contentBlockStop stream messages as +returned by `gptel-bedrock--parse-stream-message', in the order +received." + (let ((blocks (make-hash-table :test #'eql)) + role contents) + (dolist (event events) + (let* ((headers (plist-get event :headers)) + (payload (plist-get event :payload)) + (event-type (assoc-default ":event-type" headers))) + (pcase event-type + ("messageStart" (setq role (plist-get payload :role))) + ("contentBlockStart" + (puthash (plist-get payload :contentBlockIndex) (list event) blocks)) + ("contentBlockDelta" + (push event (gethash (plist-get payload :contentBlockIndex) blocks))) + ("contentBlockStop" + (let* ((block-index (plist-get payload :contentBlockIndex)) + (block-events (nreverse (gethash block-index blocks))) + (start (car block-events)) + (deltas (cdr block-events))) + (when-let ((tool-use (map-nested-elt start '(:payload :start :toolUse)))) + (let* ((id (plist-get tool-use :toolUseId)) + (name (plist-get tool-use :name)) + (input-str + (mapconcat (lambda (delta) (map-nested-elt + delta '(:payload :delta :toolUse :input))) + deltas)) + (input (unless (string-blank-p input-str) + (gptel--json-read-string input-str)))) + (push + (list :toolUse (list :input input :name name :toolUseId id)) + contents))) + (when-let ((texts (delq nil (mapcar (lambda (d) (map-nested-elt d '(:payload :delta :text))) + deltas)))) + (push (list :text (apply #'concat texts)) contents)) + ;; Currently we discard any reasoning content but this would be the spot to handle it + )) + (_ (error "Unexpected event-type %S" event-type))))) + (list :role role :content (vconcat (nreverse contents))))) + +(cl-defmethod gptel--parse-buffer ((_backend gptel-bedrock) &optional max-entries) + "Parse current buffer and return a list of prompt objects for Bedrock. + +MAX-ENTRIES is the maximum number of prompts to include." + (unless max-entries (setq max-entries most-positive-fixnum)) + (let ((prompts nil) (prev-pt (point)) + (include-media (and gptel-track-media (gptel--model-capable-p 'media)))) + (cl-flet ((capture-prompt (role beg end) + (let* ((content (if include-media + (gptel-bedrock--parse-multipart + (gptel--parse-media-links major-mode beg end)) + `[(:text ,(gptel--trim-prefixes + (buffer-substring-no-properties beg end)))])) + (prompt (list :role role :content content))) + (push prompt prompts)))) + + (if (or gptel-mode gptel-track-response) + (while (and (> max-entries 0) + (/= prev-pt (point-min)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min)))) + (capture-prompt (pcase (get-char-property (point) 'gptel) + ('response "assistant") + ('nil "user")) + (point) prev-pt) + (setq prev-pt (point)) + (cl-decf max-entries)) + (capture-prompt "user" (point-min) (point-max))) + prompts))) + +(defconst gptel-bedrock--image-formats + '(("image/jpg" . "jpeg") + ("image/jpeg" . "jpeg") + ("image/png" . "png") + ("image/gif" . "gif") + ("image/webp" . "webp")) + "Map of mime type to image formats as used in AWS's ImageBlock.") + +(defconst gptel-bedrock--doc-formats + '(("application/pdf" . "pdf") + ("text/csv" . "csv") + ("application/msword" . "doc") + ("application/vnd.openxmlformats-officedocument.wordprocessingml.document" . "docx") + ("application/vnd.ms-excel" . "xls") + ("application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" . "xlsx") + ("text/html" . "html") + ("text/plain" . "txt") + ("text/markdown" . "md")) + "Map of mime type to document formats as used in AWS's DocumentBlock.") + +(defun gptel-bedrock--parse-multipart (parts) + "Convert a multipart prompt PARTS to the AWS Bedrock API format. + +The input is a list of text and media plists of the form: + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")). + +The output is a vector of entries in Bedrock API format." + (thread-last parts + (cl-maplist + (lambda (tail) + (let* ((part (car tail)) + (text (plist-get part :text)) + (mime (plist-get part :mime)) + (media (plist-get part :media)) + (textfile (plist-get part :textfile)) + format) + (cond + (text (when (or (eq part (car parts)) (null (cdr tail))) + (setq text (gptel--trim-prefixes text))) + (unless (string-empty-p text) + `(:text ,text))) + (media + (cond + ((setq format (assoc mime gptel-bedrock--image-formats)) + `(:image (:format ,(cdr format) :source (:bytes ,(gptel--base64-encode media))))) + ((setq format (assoc mime gptel-bedrock--doc-formats)) + `(:document (:format ,(cdr format) + :name ,(file-name-nondirectory media) + :source (:bytes ,(gptel--base64-encode media))))) + (t (error "Unsupported MIME type %s for AWS Bedrock" mime)))) + (textfile `(:text ,(with-temp-buffer + (gptel--insert-file-string textfile) + (buffer-string)))))))) + (delq nil) + (vconcat))) + +;; gptel--inject-prompt not needed since the default implementation works here + +(cl-defmethod gptel--inject-tool-call ((_backend gptel-bedrock) data tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +BACKEND is the `gptel-backend'. See the generic function documentation +for details. This implementation handles the AWS Bedrock API." + ;; FIXME: We currently assume that the tool call being modified is in the last + ;; position in the messages array. + (if-let* ((messages (plist-get data :messages)) + (entry (aref messages (1- (length messages)))) + (contents (plist-get entry :content)) + (id (plist-get tool-call :id)) + (indexed-call + (cl-loop for chunk across contents + for i upfrom 0 + for tool-use = (plist-get chunk :toolUse) + if (and tool-use (equal (plist-get tool-use :toolUseId) id)) + return (list i chunk tool-use) + finally return nil)) + (index (nth 0 indexed-call)) + (chunk (nth 1 indexed-call)) + (call (nth 2 indexed-call))) + (if (null new-call) + (if (= (length contents) 1) + (plist-put data :messages (substring messages nil -1)) + (plist-put entry :content + (vconcat (substring contents 0 index) + (substring contents (1+ index))))) + (when-let* ((args (plist-get new-call :args))) + (setq call (plist-put call :input args))) + (when-let* ((name (plist-get new-call :name))) + (setq call (plist-put call :name name))) + (plist-put chunk :toolUse call)) + (display-warning + '(gptel tool-call) + (format "Could not inject updated tool-call arguments for tool call %s, %s" + (plist-get tool-call :name) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))) + +(cl-defmethod gptel--parse-tool-results ((_backend gptel-bedrock) tool-use-requests) + "Return a backend-appropriate prompt containing tool call results. + +TOOL-USE-REQUESTS is a list of request plists that have been +completed. Returns a single prompt object to inject into the +conversation." + (list + :role "user" + :content + (vconcat + (mapcar + (lambda (tool-call) + `(:toolResult (:toolUseId ,(plist-get tool-call :id) + :status "success" + :content [(:text ,(plist-get tool-call :result))]))) + tool-use-requests)))) + +(defvar gptel-bedrock--aws-profile-cache nil + "Cache for AWS profile credentials in the form of (PROFILE . CREDS).") + +(defvar gptel-bedrock-aws-cli-command (executable-find "aws") + "Path to the AWS CLI command. + +Can be customized to use a specific AWS CLI installation, +e.g. \"/usr/local/bin/aws\".") + +(defun gptel-bedrock--fetch-aws-profile-credentials (profile &optional clear-cache) + "Fetch & cache AWS credentials for PROFILE using aws-cli. + +If PROFILE is the keyword ':static', then it fetches IAM credentials +from the aws-cli without any profile argument. + +Non-nil CLEAR-CACHE will refresh credentials." + (let* ((creds-json + (let ((cell (or (assoc profile gptel-bedrock--aws-profile-cache #'string=) + (car (push (cons profile nil) gptel-bedrock--aws-profile-cache))))) + (or (and (not clear-cache) (cdr cell)) + (setf (cdr cell) + (with-temp-buffer + (unless (zerop (apply #'call-process gptel-bedrock-aws-cli-command + nil t nil "configure" "export-credentials" + (unless (eql profile :static) (list (format "--profile=%s" profile))))) + (user-error "Failed to get AWS credentials from profile")) + (json-parse-string (buffer-string))))))) + (expiration (if-let (exp (gethash "Expiration" creds-json)) + (date-to-time exp)))) + (cond + ((time-less-p (current-time) expiration) + (let ((access-key (gethash "AccessKeyId" creds-json)) + (secret-key (gethash "SecretAccessKey" creds-json)) + (session-token (gethash "SessionToken" creds-json))) + (cl-values access-key secret-key session-token))) + ((not clear-cache) + (gptel-bedrock--fetch-aws-profile-credentials profile t)) + (t (user-error "AWS credentials expired for profile: %s" profile))))) + +(defun gptel-bedrock--get-credentials (profile) + "Return the AWS credentials to use for the request. + +If credentials are not available based on the AWS_ACCESS_KEY_ID +AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN environment variables, +aws configure export-credentials is used to obtain credentials. +PROFILE specifies the AWS profile to use for retrieving +credentials. If PROFILE is unset, AWS_PROFILE environment +variable is used. + +Returns a list of 2-3 elements, depending on whether a session +token is needed, with this form: (AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY +AWS_SESSION_TOKEN). + +Convenient to use with `cl-multiple-value-bind'" + (let ((key-id (getenv "AWS_ACCESS_KEY_ID")) + (secret-key (getenv "AWS_SECRET_ACCESS_KEY")) + (token (getenv "AWS_SESSION_TOKEN")) + (profile (or profile (getenv "AWS_PROFILE")))) + (cond + ((and profile) (gptel-bedrock--fetch-aws-profile-credentials profile)) + ((and key-id secret-key) (cl-values key-id secret-key token)) + (t (user-error "Missing AWS credentials; provide them either via environment variables or specify PROFILE when calling gptel-make-bedrock"))))) + +(defvar gptel-bedrock--model-ids + ;; https://docs.aws.amazon.com/bedrock/latest/userguide/models-supported.html + '((claude-sonnet-4-6 . "anthropic.claude-sonnet-4-6") + (claude-opus-4-6 . "anthropic.claude-opus-4-6-v1") + (claude-sonnet-4-5-20250929 . "anthropic.claude-sonnet-4-5-20250929-v1:0") + (claude-haiku-4-5-20251001 . "anthropic.claude-haiku-4-5-20251001-v1:0") + (claude-opus-4-5-20251101 . "anthropic.claude-opus-4-5-20251101-v1:0") + (claude-opus-4-1-20250805 . "anthropic.claude-opus-4-1-20250805-v1:0") + (claude-sonnet-4-20250514 . "anthropic.claude-sonnet-4-20250514-v1:0") + (claude-opus-4-20250514 . "anthropic.claude-opus-4-20250514-v1:0") + (claude-3-7-sonnet-20250219 . "anthropic.claude-3-7-sonnet-20250219-v1:0") + (claude-3-5-sonnet-20241022 . "anthropic.claude-3-5-sonnet-20241022-v2:0") + (claude-3-5-sonnet-20240620 . "anthropic.claude-3-5-sonnet-20240620-v1:0") + (claude-3-5-haiku-20241022 . "anthropic.claude-3-5-haiku-20241022-v1:0") + (claude-3-opus-20240229 . "anthropic.claude-3-opus-20240229-v1:0") + (claude-3-haiku-20240307 . "anthropic.claude-3-haiku-20240307-v1:0") + (nova-2-lite-v1 . "amazon.nova-2-lite-v1:0") + (mistral-7b . "mistral.mistral-7b-instruct-v0:2") + (mistral-8x7b . "mistral.mixtral-8x7b-instruct-v0:1") + (mistral-large-2402 . "mistral.mistral-large-2402-v1:0") + (mistral-large-2407 . "mistral.mistral-large-2407-v1:0") + (mistral-small-2402 . "mistral.mistral-small-2402-v1:0") + (llama-3-8b . "meta.llama3-8b-instruct-v1:0") + (llama-3-70b . "meta.llama3-70b-instruct-v1:0") + (llama-3-1-8b . "meta.llama3-1-8b-instruct-v1:0") + (llama-3-1-70b . "meta.llama3-1-70b-instruct-v1:0") + (llama-3-1-405b . "meta.llama3-1-405b-instruct-v1:0") + (llama-3-2-1b . "meta.llama3-2-1b-instruct-v1:0") + (llama-3-2-3b . "meta.llama3-2-3b-instruct-v1:0") + (llama-3-2-11b . "meta.llama3-2-11b-instruct-v1:0") + (llama-3-2-90b . "meta.llama3-2-90b-instruct-v1:0") + (llama-3-3-70b . "meta.llama3-3-70b-instruct-v1:0")) + "Map of model name to bedrock id. + +IDs can be added or replaced by calling +\(push (model-name . \"model-id\") gptel-bedrock--model-ids).") + +(defvar gptel--bedrock-models + (mapcar #'car gptel-bedrock--model-ids) + "List of available AWS Bedrock models and associated properties.") + +(defun gptel-bedrock--get-model-id (model &optional region) + "Return the Bedrock model ID for MODEL. + +REGION is one of global, apac, eu or us." + (concat + (when region + (or (member region '(global apac eu us)) + (error "Unknown Bedrock region %s" region)) + (concat (symbol-name region) ".")) + (or (alist-get model gptel-bedrock--model-ids nil nil #'eq) + (error "Unknown Bedrock model: %s" model)))) + +(defun gptel-bedrock--curl-args (region profile bearer-token) + "Generate the curl arguments to get a bedrock request signed for use in REGION. + +PROFILE specifies the aws profile to use for aws configure +export-credentials. BEARER-TOKEN is the token used for authentication." + (let ((bearer-token (or bearer-token (getenv "AWS_BEARER_TOKEN_BEDROCK"))) + (output-args (unless (memq system-type '(windows-nt ms-dos)) + '("--output" "/dev/stdout")))) + (if bearer-token + (append + (list "-H" (format "Authorization: Bearer %s" bearer-token)) + output-args) + (cl-multiple-value-bind (key-id secret token) (gptel-bedrock--get-credentials profile) + (append + (list "--user" (format "%s:%s" key-id secret) + "--aws-sigv4" (format "aws:amz:%s:bedrock" region)) + output-args + (when token (list "-H" (format "x-amz-security-token: %s" token)))))))) + + +(defun gptel-bedrock--curl-version () + "Check Curl version required for gptel-bedrock." + (let* ((output (shell-command-to-string "curl --version")) + (version (and (string-match "^curl \\([0-9.]+\\)" output) + (match-string 1 output)))) + version)) + +;;;###autoload +(cl-defun gptel-make-bedrock + (name &key + region + (models gptel--bedrock-models) + (model-region nil) + stream curl-args request-params + aws-profile aws-bearer-token + (protocol "https")) + "Register an AWS Bedrock backend for gptel with NAME. + +Keyword arguments: + +REGION - AWS region name (e.g. \"us-east-1\") +MODELS - The list of models supported by this backend +MODEL-REGION - one of apac, eu, us or nil +AWS-PROFILE - the aws profile to use for aws configure export-credentials +AWS-BEARER-TOKEN - the aws bearer-token for authenticating with AWS +CURL-ARGS - additional curl args +STREAM - Whether to use streaming responses or not. +REQUEST-PARAMS - a plist of additional HTTP request +parameters (as plist keys) and values supported by the API." + (declare (indent 1)) + (unless (or aws-bearer-token (getenv "AWS_BEARER_TOKEN_BEDROCK")) + (unless (and gptel-use-curl (version<= "8.9" (gptel-bedrock--curl-version))) + (error "Bedrock-backend requires curl >= 8.9, but gptel-use-curl := %s, curl-version := %s" + gptel-use-curl (gptel-bedrock--curl-version)))) + (let ((host (format "bedrock-runtime.%s.amazonaws.com" region))) + (setf (alist-get name gptel--known-backends nil nil #'equal) + (gptel--make-bedrock + :name name + :host host + :header nil ; x-amz-security-token is set in curl-args if needed + :models (gptel--process-models models) + :model-region model-region + :protocol protocol + :endpoint "" ; Url is dynamically constructed based on other args + :stream stream + :coding-system (and stream 'binary) + :curl-args (lambda () (append curl-args (gptel-bedrock--curl-args region aws-profile aws-bearer-token))) + :request-params request-params + :url + (lambda (_info) + (concat protocol "://" host + "/model/" (gptel-bedrock--get-model-id gptel-model model-region) + "/" (if stream "converse-stream" "converse"))))))) + +(provide 'gptel-bedrock) +;;; gptel-bedrock.el ends here diff --git a/elpa/gptel-20260425.846/gptel-context.el b/elpa/gptel-20260425.846/gptel-context.el new file mode 100644 index 00000000..b89293c3 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-context.el @@ -0,0 +1,844 @@ +;;; gptel-context.el --- Context aggregator for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: daedsidog +;; Keywords: convenience, buffers + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The context allows you to conveniently create contexts which can be fed +;; to gptel. + +;;; Code: + +(eval-and-compile (require 'gptel-request)) +(require 'cl-lib) +(require 'project) + +(declare-function gptel-menu "gptel-transient") +(declare-function dired-get-marked-files "dired") +(declare-function ibuffer-get-marked-buffers "ibuffer") +(declare-function ibuffer-current-buffer "ibuffer") +(declare-function image-file-name-regexp "image-file") +(declare-function create-image "image") + +(defface gptel-context-highlight-face + '((((background dark) (min-colors 88)) :background "gray4" :extend t) + (((background light) (min-colors 88)) :background "alice blue" :extend t) + (t :inherit mode-line)) + "Face used to highlight gptel contexts in buffers." + :group 'gptel) + +(defface gptel-context-deletion-face + '((((class color) (min-colors 257) (background light)) + :background "#ffeeee" :extend t) + (((class color) (min-colors 88) (background light)) + :background "#ffdddd" :extend t) + (((class color) (min-colors 88) (background dark)) + :background "#553333" :extend t) + (((class color)) :foreground "red" :extend t)) + "Face used to highlight gptel contexts to be deleted. + +This is used in gptel context buffers." + :group 'gptel) + +(defvar gptel-context-wrap-function nil + "Function to format the context string sent with the gptel request.") +(make-obsolete-variable + 'gptel-context-wrap-function + "Custom functions for wrapping context are no longer supported by gptel.\ + See `gptel-context--wrap-in-buffer' for details." + "0.9.9") + +(defcustom gptel-context-string-function #'gptel-context--string + "Function to prepare the context string sent with the gptel request. + +This function can be synchronous or asynchronous, and receives one or +two arguments respectively. + +Synchronous: An alist of contexts with buffers or files (the context +alist). +Asynchronous: A callback to call with the result, and the context alist. + +Entries in the context alist can have one of these forms: + + (buffer1 overlay1 overlay2 ...) ;text overlays in a buffer + (buffer2) ;a buffer object + (\"/path/to/file\") ;a text file + (\"/path/to/file\" :mime \"text/markdown\") ;with explicit mime type + (\"/path/to/image\" :mime \"image/jpeg\") ;media file + +Each overlay covers a buffer region containing the +context chunk. This is accessible as, for example: + + (with-current-buffer buffer1 + (buffer-substring (overlay-start overlay1) + (overlay-end overlay1)))" + :group 'gptel + :type 'function) + +(defcustom gptel-context-restrict-to-project-files t + "Restrict files eligible to be added to the context to project files. + +When set to t, files in a VCS that are not project files (such as files +listed in `.gitignore' in a Git repository) will not be added to the +context." + :group 'gptel + :type 'boolean) + +(defvar gptel-context--project-files nil + "Cached alist of project files per project.") + +(defvar gptel-context--reset-cache nil + "Whether a project files cache-buster has been scheduled.") + +;;; Commands + +(defun gptel-context-add-current-kill (&optional arg) + "Add current kill to gptel, accumulating if ARG is non-nil." + (interactive "P") + (let ((kill (current-kill 0))) + (with-current-buffer (get-buffer-create " *gptel-kill-ring-context*") + (if (not arg) + (kill-region (point-min) (point-max)) + (goto-char (point-max)) + (unless (bobp) + (insert "\n----\n"))) + (insert kill) + (gptel-context--add-region (current-buffer) + (point-min) (point-max)) + (message "*current-kill* has been added as context.")))) + +(defun gptel-context-add (&optional arg confirm) + "Add context to gptel in a DWIM fashion. + +- If a region is selected, add the selected region to the + context. If there is already a gptel context at point, remove it + instead. + +- If in Dired, add marked files or file at point to the context. If + the selection includes directories, add all their files recursively, + prompting the user for confirmation if called interactively or + CONFIRM is non-nil. With negative prefix ARG, remove all files from + the context instead. + +- If in IBuffer, add marked buffers or buffer at point to the context. + With negative prefix ARG, remove buffers from the context instead. + +- Otherwise add the current buffer to the context. With positive + prefix ARG, prompt for a buffer name and add it to the context. + +- With negative prefix ARG, remove all gptel contexts from the current + buffer, prompting the user for confirmation if called interactively + or CONFIRM is non-nil." + (interactive "P\np") + (cond + ;; A region is selected. + ((use-region-p) + (gptel-context--add-region (current-buffer) + (region-beginning) + (region-end)) + (deactivate-mark) + (message "Current region added as context.")) + ;; If in dired + ((derived-mode-p 'dired-mode) + (let* ((files (dired-get-marked-files)) + (dirs (cl-remove-if-not #'file-directory-p files)) + (remove-p (< (prefix-numeric-value arg) 0)) + (action-fn (if remove-p + #'gptel-context-remove + #'gptel-context-add-file))) + (when (or remove-p (null dirs) (null confirm) + (y-or-n-p (format "Recursively add files from %d director%s? " + (length dirs) + (if (= (length dirs) 1) "y" "ies")))) + (mapc action-fn files)))) + ;; If in ibuffer + ((derived-mode-p 'ibuffer-mode) + (let* ((buffers (or (ibuffer-get-marked-buffers) + (list (ibuffer-current-buffer)))) + (remove-p (< (prefix-numeric-value arg) 0)) + (action-fn (if remove-p + #'gptel-context-remove + #'gptel-context--add-buffer))) + (mapc action-fn buffers))) + ;; If in an image buffer + ((and (derived-mode-p 'image-mode) + (gptel--model-capable-p 'media) + (buffer-file-name) + (not (gptel-context--skip-p (buffer-file-name)))) + (funcall (if (and arg (< (prefix-numeric-value arg) 0)) + #'gptel-context-remove + #'gptel-context-add-file) + (buffer-file-name))) + ;; No region is selected, and ARG is positive. + ((and arg (> (prefix-numeric-value arg) 0)) + (let* ((buffer-name (read-buffer "Choose buffer to add as context: " + (current-buffer) t)) + (start (with-current-buffer buffer-name (point-min))) + (end (with-current-buffer buffer-name (point-max)))) + (gptel-context--add-region + (get-buffer buffer-name) start end t) + (message "Buffer '%s' added as context." buffer-name))) + ;; No region is selected, and ARG is negative. + ((and arg (< (prefix-numeric-value arg) 0)) + (when (or (null confirm) + (y-or-n-p "Remove all contexts from this buffer? ")) + (let ((removed-contexts 0)) + (cl-loop for cov in + (gptel-context--in-region (current-buffer) (point-min) (point-max)) + do (progn + (cl-incf removed-contexts) + (gptel-context-remove cov))) + (message (format "%d context%s removed from current buffer." + removed-contexts + (if (= removed-contexts 1) "" "s")))))) + (t ; Default behavior + (if (gptel-context--at-point) + (progn + (gptel-context-remove + (car (gptel-context--in-region (current-buffer) + (max (point-min) (1- (point))) + (point)))) + (message "Context under point has been removed.")) + (gptel-context--add-buffer (current-buffer)))))) + +;;;###autoload (autoload 'gptel-add "gptel-context" "Add/remove regions or buffers from gptel's context." t) +(defalias 'gptel-add #'gptel-context-add) + +(defun gptel-context--add-buffer (buffer) + "Add BUFFER to context." + (with-current-buffer buffer + (gptel-context--add-region (current-buffer) (point-min) (point-max) t)) + (message "Buffer \"%s\" added to context." (buffer-name buffer))) + +(defun gptel-context--add-text-file (path) + "Add text file at PATH to context." + (cl-pushnew (list path) gptel-context :test #'equal) + (message "File \"%s\" added to context." path) + path) + +(defun gptel-context--add-binary-file (path) + "Add binary file at PATH to context if supported. +Return PATH if added, nil if ignored." + (if-let* (((gptel--model-capable-p 'media)) + (mime (mailcap-file-name-to-mime-type path)) + ((gptel--model-mime-capable-p mime))) + (prog1 path + (cl-pushnew (list path :mime mime) + gptel-context :test #'equal) + (message "File \"%s\" added to context." path)) + (message "Ignoring unsupported binary file \"%s\"." path) + nil)) + +(defun gptel-context--add-directory (path action) + "Process all files in directory at PATH according to ACTION. +ACTION should be either `add' or `remove'." + (dolist (file (directory-files-recursively path ".")) + (pcase-exhaustive action + ('add + (unless gptel-context--reset-cache + (setq gptel-context--reset-cache t) + (run-at-time + 0 nil + (lambda () (setq gptel-context--reset-cache nil + gptel-context--project-files nil)))) + (if (gptel-context--skip-p file) + ;; Don't message about .git, as this creates thousands of messages + (unless (string-match-p "\\.git/" file) + (gptel-context--message-skipped file)) + (gptel-context-add-file file))) + ('remove + (setf (alist-get file gptel-context nil 'remove #'equal) nil))))) + +(defun gptel-context-add-file (path) + "Add the file at PATH to the gptel context. + +If PATH is a directory, recursively add all files in it. PATH should be +readable as text." + (interactive "fChoose file to add to context: ") + (cond ((file-directory-p path) + (gptel-context--add-directory path 'add)) + ((gptel--file-binary-p path) + (gptel-context--add-binary-file path)) + (t (gptel-context--add-text-file path)))) + +;;;###autoload (autoload 'gptel-add-file "gptel-context" "Add files to gptel's context." t) +(defalias 'gptel-add-file #'gptel-context-add-file) + +;;; project-related functions +(defun gptel-context--get-project-files (dir) + "Return a list of files in the project DIR, or nil if no project is found." + (when-let* ((project (project-current nil dir))) + (with-memoization (alist-get dir gptel-context--project-files + nil nil #'equal) + (project-files project)))) + +(defun gptel-context--skip-p (file) + "Return non-nil if FILE should not be added to the context." + (when (and gptel-context-restrict-to-project-files + (not (file-remote-p file))) + (and-let* ((file-dir (or (file-name-directory file) default-directory)) + (project (project-current nil file-dir))) + (not (member (expand-file-name file) + (gptel-context--get-project-files (project-root project))))))) + +(defun gptel-context--message-skipped (file) + "Message that FILE is skipped because it is not a project file." + (let* ((type (if (file-directory-p file) "directory" "file")) + (reminder (format "To include it, unset `%S'." + 'gptel-context-restrict-to-project-files))) + (if-let* ((root (cl-some (lambda (dir) (and (file-in-directory-p file dir) dir)) + (map-keys gptel-context--project-files))) + (rel-file (file-relative-name file root))) + (message "Skipping %s \"%s\" in project \"%s\". %s" + type rel-file root reminder) + (message "Skipping %s \"%s\". %s" type file reminder)))) + +;;; Remove context +(defun gptel-context-remove (&optional context) + "Remove the CONTEXT overlay from the contexts list. + +If CONTEXT is nil, removes the context at point. +If selection is active, removes all contexts within selection. +If CONTEXT is a directory, recursively removes all files in it." + (cond + ((overlayp context) ;Overlay in buffer + (when-let* ((buf (overlay-buffer context))) + (delete-overlay context) + ;; FIXME: Quadratic cost when clearing a bunch of contexts at once + (unless + (cl-loop + for ov in + (plist-get (alist-get buf gptel-context) :overlays) + thereis (overlay-start ov)) + (setf (alist-get buf gptel-context nil 'remove) nil)))) + ((bufferp context) ;Full buffer + (setf (alist-get context gptel-context nil 'remove) nil) + (when (buffer-live-p context) + (with-current-buffer context + (without-restriction + (remove-overlays nil nil 'gptel-context t))))) + ((stringp context) ;file or directory + (if (file-directory-p context) + (gptel-context--add-directory context 'remove) + (setf (alist-get context gptel-context nil 'remove #'equal) nil) + (message "File \"%s\" removed from context." context))) + ((region-active-p) ;Overlays in region + (when-let* ((contexts (gptel-context--in-region (current-buffer) + (region-beginning) + (region-end)))) + (cl-loop for ctx in contexts do (delete-overlay ctx)))) + (t ;Anything at point + (when-let* ((ctx (gptel-context--at-point))) + (delete-overlay ctx))))) + +(defun gptel-context-remove-all (&optional verbose) + "Remove all gptel context. + +If VERBOSE is non-nil, ask for confirmation and message +afterwards." + (interactive (list t)) + (if (null gptel-context) + (when verbose (message "No gptel context sources to remove.")) + (when (or (not verbose) (y-or-n-p "Remove all context? ")) + (cl-loop + for context in gptel-context + for (source . spec) = (ensure-list context) + if (bufferp source) do ;Buffers and buffer regions + (mapc #'gptel-context-remove (plist-get spec :overlays)) + else do (gptel-context-remove source) ;files or other types + finally do (setq gptel-context nil)) + (when verbose (message "Removed all gptel context sources."))))) + +;;; Context wrap +(defun gptel-context--make-overlay (start end &optional advance) + "Highlight the region from START to END. + +ADVANCE controls the overlay boundary behavior." + (let ((overlay (make-overlay start end nil (not advance) advance)) + (buf-entry (alist-get (current-buffer) gptel-context))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'face 'gptel-context-highlight-face) + (overlay-put overlay 'gptel-context t) + (setf (alist-get (current-buffer) gptel-context) + (plist-put buf-entry :overlays + (cons overlay (plist-get buf-entry :overlays)))) + overlay)) + +;;;###autoload +(defun gptel-context--wrap (callback data-buf) + "Add request context to DATA-BUF and run CALLBACK. + +DATA-BUF is the buffer where the request prompt is constructed." + (if (= (car (func-arity gptel-context-string-function)) 2) + (funcall gptel-context-string-function + (lambda (c) (with-current-buffer data-buf + (gptel-context--wrap-in-buffer c)) + (funcall callback)) + (gptel-context--collect)) + (with-current-buffer data-buf + (thread-last (gptel-context--collect) + (funcall gptel-context-string-function) + (gptel-context--wrap-in-buffer))) + (funcall callback))) + +(defun gptel-context--wrap-in-buffer (context-string &optional method) + "Inject CONTEXT-STRING to current buffer using METHOD. + +METHOD is either system or user, and defaults to `gptel-use-context'. +This modifies the buffer." + (when (length> context-string 0) + (pcase (or method gptel-use-context) + ('system + (if (gptel--model-capable-p 'nosystem) + (gptel-context--wrap-in-buffer context-string 'user) + (if gptel--system-message + (cl-etypecase gptel--system-message + (string + (setq gptel--system-message + (concat context-string "\n\n" gptel--system-message))) + (function + (setq gptel--system-message + (gptel--parse-directive gptel--system-message 'raw)) + (gptel-context--wrap-in-buffer context-string)) + (list + (setq gptel--system-message ;cons a new list to avoid mutation + (cons (concat context-string "\n\n" (car gptel--system-message)) + (cdr gptel--system-message))))) + (setq gptel--system-message context-string)))) + ('user + (goto-char (point-max)) + (text-property-search-backward 'gptel nil t) + (and gptel-mode + (looking-at + (concat "[\n[:blank:]]*" + (and-let* ((prefix (gptel-prompt-prefix-string)) + ((not (string-empty-p prefix)))) + (concat "\\(?:" (regexp-quote prefix) "\\)?")))) + (delete-region (match-beginning 0) (match-end 0))) + (insert "\n" context-string "\n\n"))))) + +(defun gptel-context--collect-media (&optional contexts) + "Collect media CONTEXTS. + +CONTEXTS, which are typically paths to binary files, are +base64-encoded and prepended to the first user prompt." + (cl-loop for context in (or contexts gptel-context) + for (path . props) = (ensure-list context) + when (and (stringp path) (plist-get props :mime)) + collect (cons :media context))) + +(cl-defun gptel-context--add-region (buffer region-beginning region-end &optional advance) + "Add region delimited by REGION-BEGINNING, REGION-END in BUFFER as context. + +If ADVANCE is non-nil, the context overlay envelopes changes at +the beginning and end." + ;; Remove existing contexts in the same region, if any. + (mapc #'gptel-context-remove + (gptel-context--in-region buffer region-beginning region-end)) + (prog1 (with-current-buffer buffer + (gptel-context--make-overlay region-beginning region-end advance)) + (message "Region added to context buffer."))) + +(defun gptel-context--in-region (buffer start end) + "Return the list of context overlays in the given region, if any, in BUFFER. +START and END signify the region delimiters." + (with-current-buffer buffer + (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context)) + (overlays-in start end)))) + +(defun gptel-context--at-point () + "Return the context overlay at point, if any." + (cl-find-if (lambda (ov) (overlay-get ov 'gptel-context)) + (overlays-at (point)))) + +;;;###autoload +(defun gptel-context--collect (&optional context-alist) + "Get the list of all active context sources from CONTEXT-ALIST. + +CONTEXT-ALIST defaults to the current value of `gptel-context'. + +Ignore overlays, buffers and files that are not live or readable." + ;; Get only the non-degenerate overlays, collect them, and update the overlays variable. + (let ((res)) + (dolist (entry (or context-alist gptel-context)) + (pcase entry ;Context entry is: + (`(,buf . ,data) + (cond + ((buffer-live-p buf) + ;; ( :overlays ... :lines ... :bounds ...) + (when-let* ((ovs (plist-get data :overlays))) ;Clear dead overlays + (plist-put data :overlays (cl-remove-if-not #'overlay-start ovs))) + (push (cons buf data) res)) + ((and (stringp buf) (file-readable-p buf)) + ;; ("/file/path" :mime ... :bounds ... :line ...) + (push (cons buf data) res)))) + + ((and (pred stringp) (pred file-readable-p)) ;Just a file, figure out mimetype + (if (file-directory-p entry) + (progn + (unless gptel-context--reset-cache + (setq gptel-context--reset-cache t) + (run-at-time + 0 nil + (lambda () (setq gptel-context--reset-cache nil + gptel-context--project-files nil)))) + (dolist (f (directory-files-recursively entry ".")) + (unless (gptel-context--skip-p f) + (push `(,f ,@(and (gptel--file-binary-p f) + (list :mime (mailcap-file-name-to-mime-type entry)))) + res)))) + (push `(,entry ,@(and (gptel--file-binary-p entry) + (list :mime (mailcap-file-name-to-mime-type entry)))) + res))) + ((pred buffer-live-p) (push (list entry) res)))) ;Just a buffer + res)) + +(defun gptel-context--collect-regions (buffer context-data) + "Collect BUFFER regions from CONTEXT-DATA specification. + +CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds. +Returns a sorted list of (START . END) position pairs." + (let ((regions ; Collect bounds (already in position format) + (when-let* ((bounds (plist-get context-data :bounds))) + (if (consp (car bounds)) bounds (list bounds))))) + (with-current-buffer buffer + (without-restriction + ;; Collect overlays + (dolist (ov (plist-get context-data :overlays)) + (when (overlay-start ov) + (push (cons (overlay-start ov) (overlay-end ov)) + regions))) ;(start1 . end1) + ;; Collect lines (convert line numbers to positions) + (when-let* ((line-bounds (plist-get context-data :lines))) + (dolist (pair (if (consp (car line-bounds)) ;Handle single (BEG . END) + line-bounds (list line-bounds))) + (push (cons (progn (goto-char (point-min)) + (forward-line (1- (car pair))) + (point)) + (progn (goto-char (point-min)) + (forward-line (cdr pair)) + (point))) + regions))))) + ;; TODO: Update sort for Emacs 28+ calling convention + ;; Sort by start position. + ;; NOTE: This can modify `:bounds' of `context-data' by side-effect! + (sort regions #'car-less-than-car))) + +(defun gptel-context--insert-buffer-string (buffer context-data &optional header) + "Insert at point a context string from CONTEXT-DATA in BUFFER. + +CONTEXT-DATA is a plist with keys :overlays, :lines and :bounds to +include specific overlays, line ranges or position bounds instead of the +entire buffer. See `gptel-context'. + +HEADER is an optional header to insert before the contents." + (let ((is-top-snippet t) + (previous-line 1) + (regions (gptel-context--collect-regions buffer context-data))) + + ;; Insert header + (insert (or header (format "In buffer `%s`:\n\n```"(buffer-name buffer))) + (gptel--strip-mode-suffix (buffer-local-value + 'major-mode buffer)) + "\n") + (if (not regions) + (insert-buffer-substring-no-properties buffer) + (dolist (region regions) + (let ((start (car region)) (end (cdr region))) + (let (lineno column) + (with-current-buffer buffer + (without-restriction + (setq lineno (line-number-at-pos start t) + column (save-excursion (goto-char start) (current-column))))) + ;; We do not need to insert a line number indicator if we have two regions + ;; on the same line, because the previous region should have already put the + ;; indicator. + (unless (= previous-line lineno) + (unless (= lineno 1) + (unless is-top-snippet (insert "\n")) + (insert (format "... (Line %d)\n" lineno)))) + (setq previous-line lineno) + (unless (zerop column) (insert " ...")) + (if is-top-snippet + (setq is-top-snippet nil) + (unless (= previous-line lineno) (insert "\n")))) + (insert-buffer-substring-no-properties buffer start end))) + (unless (>= (cdr (car (last regions))) (point-max)) + (insert "\n..."))) + (insert "\n```"))) + +(defun gptel-context--insert-file-string (path &optional spec) + "Insert at point the contents of file at PATH as context. + +SPEC is a plist specifying :lines or position :bounds to include instead +of the entire file. See `gptel-context' for details." + (if (not (and spec (or (plist-member spec :lines) + (plist-member spec :bounds)))) + ;; Insert whole file + (gptel--insert-file-string path) + ;; Insert only regions from lines and/or bounds + (let* ((visiting-buf (find-buffer-visiting ;Reuse buffer + path (lambda (b) (not (buffer-modified-p b))))) + (file-buf (or visiting-buf ;temp buf to dump file contents + (gptel--temp-buffer " *gptel-file-context*")))) + (unless visiting-buf + (with-current-buffer file-buf (insert-file-contents path))) + (gptel-context--insert-buffer-string + file-buf spec (format "In file `%s`:\n\n```\n" + (abbreviate-file-name path))) + (unless visiting-buf (kill-buffer file-buf))))) + +(defun gptel-context--string (context-alist) + "Format the aggregated gptel context as annotated markdown fragments. + +Returns a string. CONTEXT-ALIST is a structure containing +context overlays, see `gptel-context'." + (with-temp-buffer + (cl-loop for entry in context-alist + for (source . spec) = (ensure-list entry) + if (bufferp source) + do (gptel-context--insert-buffer-string source spec) + else if (or (not (plist-get spec :mime)) + (string-match-p "^text/" (plist-get spec :mime))) + do (gptel-context--insert-file-string source spec) end + do (insert "\n\n") + finally do + (skip-chars-backward "\n\t\r ") + (delete-region (point) (point-max)) + (unless (bobp) + (goto-char (point-min)) + (insert "Request context:\n\n")) + finally return + (and (> (buffer-size) 0) + (buffer-string))))) + +;;; Major mode for context inspection buffers +(defvar-keymap gptel-context-buffer-mode-map + "C-c C-c" #'gptel-context-confirm + "C-c C-k" #'gptel-context-quit + "RET" #'gptel-context-visit + "n" #'gptel-context-next + "p" #'gptel-context-previous + "d" #'gptel-context-flag-deletion) + +(define-derived-mode gptel-context-buffer-mode special-mode "gptel-context" + "Major-mode for inspecting context used by gptel." + :group 'gptel + (add-hook 'post-command-hook #'gptel-context--post-command + nil t) + (setq-local revert-buffer-function #'gptel-context--buffer-setup)) + +;; FIXME(targeted-context): This does not handle :bounds and :lines. Reuse +;; `gptel-context--insert-buffer-string'? +(defun gptel-context--buffer-setup (&optional _ignore-auto _noconfirm context-alist) + "Set up the gptel context buffer. + +CONTEXT-ALIST is the alist of contexts to use to populate the buffer." + (with-current-buffer (get-buffer-create "*gptel-context*") + (gptel-context-buffer-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (setq header-line-format + (substitute-command-keys + (concat + "\\[gptel-context-flag-deletion]: Mark/unmark deletion, " + "\\[gptel-context-next]/\\[gptel-context-previous]: next/previous, " + "\\[gptel-context-visit]: visit, " + "\\[gptel-context-confirm]: apply, " + "\\[gptel-context-quit]: cancel, " + "\\[quit-window]: quit"))) + (save-excursion + (let ((contexts (gptel-context--collect context-alist))) + (if (length= contexts 0) + (insert "There are no active gptel contexts.") + (let (beg ov l1 l2) + (pcase-dolist (`(,buf . ,spec) contexts) + (cond + ((bufferp buf) + (if (not spec) ;BUF is a full buffer, not specific ranges + (progn + (insert (propertize (format "In buffer %s:\n\n" + (buffer-name buf)) + 'face 'bold)) + (setq beg (point)) + (insert-buffer-substring buf) + (insert "\n") + (setq ov (make-overlay beg (point)))) + (dolist (source-ov (plist-get spec :overlays)) ;BUF is a buffer with some overlay(s) + (with-current-buffer buf + (setq l1 (line-number-at-pos (overlay-start source-ov)) + l2 (line-number-at-pos (overlay-end source-ov)))) + (insert (propertize (format "In buffer %s (lines %d-%d):\n\n" + (buffer-name buf) l1 l2) + 'face 'bold)) + (setq beg (point)) + (insert-buffer-substring + buf (overlay-start source-ov) (overlay-end source-ov)) + (insert "\n") + (setq ov (make-overlay beg (point))) + (overlay-put ov 'gptel-context source-ov) + (overlay-put ov 'gptel-overlay t) + (overlay-put ov 'evaporate t))) + (insert "\n" (make-separator-line) "\n")) + (t ;BUF is a file path, not a buffer + (insert (propertize (format "In file %s:\n\n" (file-name-nondirectory buf)) + 'face 'bold)) + (setq beg (point)) + (if-let* ((mime (plist-get spec :mime)) + ((not (string-match-p "^text/" mime)))) ;BUF is a binary file + (if-let* (((string-match-p (image-file-name-regexp) buf)) + (img (create-image buf))) + (insert-image img "*") ; Can be displayed + (insert + buf " " (propertize "(No preview for binary file)" + 'face '(:inherit shadow :slant italic)))) + (insert-file-contents buf)) + (goto-char (point-max)) + (insert "\n") + (setq ov (make-overlay beg (point))) + (overlay-put ov 'gptel-context buf) + (overlay-put ov 'gptel-overlay t) + (overlay-put ov 'evaporate t) + (insert "\n" (make-separator-line) "\n")))) + (goto-char (point-min))))))) + (display-buffer (current-buffer) + `((display-buffer-reuse-window + display-buffer-reuse-mode-window + display-buffer-below-selected) + (body-function . ,#'select-window) + (window-height . ,#'fit-window-to-buffer))))) + +(defvar gptel-context--buffer-reverse nil + "Last direction of cursor movement in gptel context buffer. + +If non-nil, indicates backward movement.") + +(defalias 'gptel-context--post-command + (let ((highlight-overlay)) + (lambda () + ;; Only update if point moved outside the current region. + (unless (memq highlight-overlay (overlays-at (point))) + (let ((context-overlay + (cl-loop for ov in (overlays-at (point)) + thereis (and (overlay-get ov 'gptel-overlay) ov)))) + (when highlight-overlay + (overlay-put highlight-overlay 'face nil)) + (when context-overlay + (overlay-put context-overlay 'face 'highlight)) + (setq highlight-overlay context-overlay)))))) + +(defun gptel-context-visit () + "Display the location of this gptel context chunk in its original buffer." + (interactive) + (let ((ov-here (car (overlays-at (point))))) + (if-let* ((source (overlay-get ov-here 'gptel-context)) + (buf (if (overlayp source) + (overlay-buffer source) + (find-file-noselect source))) + (offset (- (point) (overlay-start ov-here)))) + (with-selected-window (display-buffer buf) + (goto-char (if (overlayp source) + (overlay-start source) + (point-min))) + (forward-char offset) + (recenter)) + (message "No source location for this gptel context chunk.")))) + +(defun gptel-context-next () + "Move to next gptel context chunk." + (interactive) + (let ((ov-here (car (overlays-at (point)))) + (next-start (next-overlay-change (point)))) + (when (and (/= (point-max) next-start) ov-here) + ;; We were inside the overlay, so we want the next overlay change, which + ;; would be the start of the next overlay. + (setq next-start (next-overlay-change next-start))) + (when (/= next-start (point-max)) + (setq gptel-context--buffer-reverse nil) + (goto-char next-start) + (recenter (floor (window-height) 4))))) + +(defun gptel-context-previous () + "Move to previous gptel context chunk." + (interactive) + (let ((ov-here (car (overlays-at (point))))) + (when ov-here (goto-char (overlay-start ov-here))) + (let ((previous-context-pos (previous-overlay-change + (previous-overlay-change (point))))) + ;; Prevent point from jumping to the start of the buffer. + (unless (= previous-context-pos (point-min)) + (goto-char previous-context-pos) + (recenter (floor (window-height) 4)) + (setq gptel-context--buffer-reverse t))))) + +(defun gptel-context-flag-deletion () + "Mark gptel context chunk at point for removal." + (interactive) + (let* ((overlays (if (use-region-p) + (overlays-in (region-beginning) (region-end)) + (overlays-at (point)))) + (deletion-ov) + (marked-ovs (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context-deletion-mark)) + overlays))) + (if marked-ovs + (mapc #'delete-overlay marked-ovs) + (save-excursion + (dolist (ov overlays) + (when (overlay-get ov 'gptel-context) + (goto-char (overlay-start ov)) + (setq deletion-ov (make-overlay (overlay-start ov) (overlay-end ov))) + (overlay-put deletion-ov 'gptel-context (overlay-get ov 'gptel-context)) + (overlay-put deletion-ov 'priority -80) + (overlay-put deletion-ov 'face 'gptel-context-deletion-face) + (overlay-put deletion-ov 'gptel-context-deletion-mark t))))) + (if (use-region-p) + (deactivate-mark) + (if gptel-context--buffer-reverse + (gptel-context-previous) + (gptel-context-next))))) + +(defun gptel-context-quit () + "Cancel pending operations and return to gptel's menu." + (interactive) + (quit-window) + (call-interactively #'gptel-menu)) + +(defun gptel-context-confirm () + "Confirm pending operations and return to gptel's menu." + (interactive) + ;; Delete all the context overlays that have been marked for deletion. + (when-let* ((deletion-marks + (delq nil (mapcar + (lambda (ov) + (and + (overlay-get ov 'gptel-context-deletion-mark) + (overlay-get ov 'gptel-context))) + (overlays-in (point-min) (point-max)))))) + (mapc #'gptel-context-remove deletion-marks) + (revert-buffer)) + ;; FIXME(context): This should run in the buffer from which the context + ;; inspection buffer was visited. + ;; Update contexts and revert buffer (#482) + (setq gptel-context (nreverse (gptel-context--collect))) + (gptel-context-quit)) + +(provide 'gptel-context) +;;; gptel-context.el ends here. diff --git a/elpa/gptel-20260425.846/gptel-gemini.el b/elpa/gptel-20260425.846/gptel-gemini.el new file mode 100644 index 00000000..83410523 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-gemini.el @@ -0,0 +1,724 @@ +;;; gptel-gemini.el --- Gemini suppport for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur + +;; 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: + +;; This file adds support for the Gemini API to gptel + +;;; Code: +(require 'cl-generic) +(require 'map) +(require 'cl-lib) +(eval-and-compile (require 'gptel-request)) + +(declare-function prop-match-value "text-property-search") +(declare-function text-property-search-backward "text-property-search") +(declare-function json-read "json") +(declare-function gptel-context--wrap "gptel-context") +(declare-function gptel-context--collect-media "gptel-context") + +(defvar json-object-type) + +;;; Gemini +(cl-defstruct + (gptel-gemini (:constructor gptel--make-gemini) + (:copier nil) + (:include gptel-backend))) + +(defun gptel--gemini-update-tokens (usage info) + "Update token usage information from USAGE. +USAGE is part of the response, INFO is the request plist." + (when usage + (let* ((tokens (plist-get info :tokens)) + (input (+ (plist-get usage :promptTokenCount) + (or (plist-get tokens :input) 0))) + (output (+ (- (plist-get usage :totalTokenCount) + (plist-get usage :promptTokenCount)) + (or (plist-get tokens :output) 0)))) + (list :input input :output output)))) + +;; TODO: Using alt=sse in the query url generates an OpenAI style streaming +;; response, with more immediate updates. Maybe we should switch to that and +;; rewrite the stream parser? +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-gemini) info) + "Parse a Gemini data stream. + +Return the text response accumulated since the last call to this +function. Additionally, mutate state INFO to add tool-use +information if the stream contains it." + (let* ((content-strs)) + (condition-case nil + (while (prog1 (search-forward "{" nil t) ; while-let is Emacs 29.1+ only + (backward-char 1)) + (save-match-data + (when-let* ((response (gptel--json-read)) + (text (gptel--parse-response + (plist-get info :backend) + response info 'include))) + (push text content-strs)))) + (error + (goto-char (match-beginning 0)))) + (apply #'concat (nreverse content-strs)))) + +(cl-defmethod gptel--parse-response ((_backend gptel-gemini) response info + &optional include-text) + "Parse an Gemini (non-streaming) RESPONSE and return response text. + +Mutate state INFO with response metadata. + +If INCLUDE-TEXT is non-nil, include response text in the prompts +list." + (let* ((cand0 (map-nested-elt response '(:candidates 0))) + (parts (map-nested-elt cand0 '(:content :parts))) + (stop-reason (plist-get cand0 :finishReason))) + (when stop-reason + (plist-put info :stop-reason stop-reason) + (when (string= stop-reason "STOP") + (plist-put info :tokens (gptel--gemini-update-tokens + (plist-get response :usageMetadata) info)))) + (cl-loop + for part across parts + for tx = (plist-get part :text) + if (and tx (not (eq tx :null))) + if (plist-get part :thought) + do (unless (plist-get info :reasoning-block) + (plist-put info :reasoning-block 'in)) + (plist-put info :reasoning (concat (plist-get info :reasoning) tx)) + else do + (if (eq (plist-get info :reasoning-block) 'in) + (plist-put info :reasoning-block t)) + and collect tx into content-strs end + else if (plist-get part :functionCall) + collect (copy-sequence it) into tool-use + finally do ;Add text and tool-calls to prompts list + (when (or tool-use include-text) + (let* ((data (plist-get info :data)) + (prompts (plist-get data :contents)) + (last-prompt (aref prompts (1- (length prompts))))) + (if (equal (plist-get last-prompt :role) "model") + ;; When streaming, the last prompt may already have the role + ;; "model" from prior calls to this function. Append to its parts + ;; instead of adding a new model role then. + (plist-put last-prompt :parts + (vconcat (plist-get last-prompt :parts) parts)) + (plist-put ;otherwise create a new "model" role + data :contents + (vconcat prompts `((:role "model" :parts ,parts))))))) + (when tool-use ;Capture tool call data for running tools + (plist-put info :tool-use + (nconc (plist-get info :tool-use) tool-use))) + finally return + (and content-strs (apply #'concat content-strs))))) + +(cl-defmethod gptel--request-data ((backend gptel-gemini) prompts) + "JSON encode PROMPTS for sending to Gemini." + (let ((prompts-plist + (list :contents (vconcat prompts) + :safetySettings [(:category "HARM_CATEGORY_HARASSMENT" + :threshold "BLOCK_NONE") + (:category "HARM_CATEGORY_SEXUALLY_EXPLICIT" + :threshold "BLOCK_NONE") + (:category "HARM_CATEGORY_DANGEROUS_CONTENT" + :threshold "BLOCK_NONE") + (:category "HARM_CATEGORY_HATE_SPEECH" + :threshold "BLOCK_NONE")])) + params) + (if gptel--system-message + (plist-put prompts-plist :systemInstruction + `(:parts [(:text ,gptel--system-message)]))) + (when gptel-use-tools + (when (eq gptel-use-tools 'force) + (plist-put prompts-plist :toolConfig + '(:functionCallingConfig (:mode "ANY")))) + (when gptel-tools + (plist-put prompts-plist :tools + (gptel--parse-tools backend gptel-tools)))) + (when gptel-temperature + (setq params + (plist-put params + :temperature (max 0.0 gptel-temperature)))) + (when gptel-max-tokens + (setq params + (plist-put params + :maxOutputTokens gptel-max-tokens))) + (when gptel-include-reasoning + (setq params + (plist-put params :thinkingConfig '(:includeThoughts t)))) + (when gptel--schema + (setq params (nconc params (gptel--gemini-filter-schema + (gptel--parse-schema backend gptel--schema))))) + (when params + (plist-put prompts-plist + :generationConfig params)) + ;; Merge request params with model and backend params. + (gptel--merge-plists + prompts-plist + gptel--request-params + (gptel-backend-request-params gptel-backend) + (gptel--model-request-params gptel-model)))) + +(cl-defmethod gptel--parse-schema ((_backend gptel-gemini) schema) + (list :responseMimeType "application/json" + :responseSchema (gptel--preprocess-schema + (gptel--dispatch-schema-type schema)))) + +(defun gptel--gemini-filter-schema (schema) + "Destructively filter unsupported attributes from SCHEMA. + +Gemini's API does not support `additionalProperties'." + (cl-remf schema :additionalProperties) + (when (plistp schema) + (cl-loop for (key val) on schema by #'cddr + do (cond + ;; Recursively modify schemas within vectors (anyOf/allOf) + ((memq key '(:anyOf :allOf)) + (dotimes (i (length val)) + (aset val i (gptel--gemini-filter-schema (aref val i))))) + ;; Recursively modify plist values, which may contain sub-schemas + ((plistp val) + (when (cl-remf val :additionalProperties) + (cl-remf (plist-get schema key) :additionalProperties)) + (gptel--gemini-filter-schema val)) + ;; Default: do nothing to other key-value pairs yet. + (t nil)))) + schema) + +(cl-defmethod gptel--parse-tools ((_backend gptel-gemini) tools) + "Parse TOOLS to the Gemini API tool definition spec. + +TOOLS is a list of `gptel-tool' structs, which see." + (cl-loop + for tool in (ensure-list tools) + collect + (list + :name (gptel-tool-name tool) + :description (gptel-tool-description tool) + :parameters + (if (not (gptel-tool-args tool)) + :null ;NOTE: Gemini wants :null if the function takes no args + (list :type "object" + ;; See the generic implementation for an explanation of this + ;; transformation. + :properties + (cl-loop + for arg in (gptel-tool-args tool) + for argspec = (copy-sequence arg) + for name = (plist-get arg :name) ;handled differently + for newname = (or (and (keywordp name) name) + (make-symbol (concat ":" name))) + do ;ARGSPEC is ARG without unrecognized keys + (cl-remf argspec :name) + (cl-remf argspec :optional) + if (equal (plist-get arg :type) "object") + do (unless (plist-member argspec :required) + (plist-put argspec :required [])) + if (equal (plist-get arg :type) "string") + do (cl-remf argspec :format) + append (list newname (gptel--gemini-filter-schema argspec))) + :required + (vconcat + (delq nil (mapcar + (lambda (arg) (and (not (plist-get arg :optional)) + (plist-get arg :name))) + (gptel-tool-args tool))))))) + into tool-specs + finally return `[(:functionDeclarations ,(vconcat tool-specs))])) + +(cl-defmethod gptel--parse-tool-results ((_backend gptel-gemini) tool-use) + "Return a prompt containing tool call results in TOOL-USE." + (list + :role "user" + :parts + (vconcat + (mapcar + (lambda (tool-call) + (let ((result (plist-get tool-call :result)) + (name (plist-get tool-call :name))) + `(:functionResponse + (:name ,name :response + (:name ,name :content ,result))))) + tool-use)))) + +(cl-defmethod gptel--inject-prompt ((_backend gptel-gemini) data new-prompt &optional position) + "Inject NEW-PROMPT into existing prompts in query DATA. + +See generic implementation for full documentation." + (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many? + (setq new-prompt (list new-prompt))) + (let ((prompts (plist-get data :contents))) + (pcase position + ('nil (plist-put data :contents (vconcat prompts new-prompt))) + ((pred integerp) + (when (< position 0) (setq position (+ (length prompts) position))) + (plist-put data :contents (vconcat (substring prompts 0 position) + new-prompt + (substring prompts position))))))) + +(cl-defmethod gptel--inject-tool-call ((_backend gptel-gemini) data tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +BACKEND is the `gptel-backend'. See the generic function documentation +for details. This implementation handles the Gemini API." + ;; FIXME: We currently assume that the tool call being modified is in the last + ;; position in the messages array. + (if-let* ((messages (plist-get data :contents)) + (entry (aref messages (1- (length messages)))) + (parts (plist-get entry :parts)) + (indexed-call + (cl-loop with name = (plist-get tool-call :name) + with old-args = (plist-get tool-call :args) + for chunk across parts + for i upfrom 0 + if (plist-get chunk :functionCall) + if (and (equal (plist-get it :name) name) + (equal (plist-get it :args) old-args)) + return (cons i (plist-get chunk :functionCall)) end + finally return nil)) + (index (car indexed-call)) + (call (cdr indexed-call))) + (if (null new-call) + (if (= (length parts) 1) + (plist-put data :contents (substring messages nil -1)) + (plist-put entry :parts + (vconcat (substring parts 0 index) + (substring parts (1+ index))))) + (when-let* ((args (plist-get new-call :args))) + (plist-put call :args args)) + (when-let* ((name (plist-get new-call :name))) + (plist-put call :name name))) + (display-warning + '(gptel tool-call) + (format "Could not inject updated tool-call arguments for tool call %s, %s" + (plist-get tool-call :name) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))) + +(cl-defmethod gptel--parse-list ((backend gptel-gemini) prompt-list) + (if (consp (car prompt-list)) + (let ((full-prompt)) ; Advanced format, list of lists + (dolist (entry prompt-list) + (pcase entry + (`(prompt . ,msg) + (push (list :role "user" + :parts `[(:text ,(or (car-safe msg) msg))]) + full-prompt)) + (`(response . ,msg) + (push (list :role "model" + :parts `[(:text ,(or (car-safe msg) msg))]) + full-prompt)) + (`(tool . ,call) + (push (list :role "model" + :parts (vector `(:functionCall ( :name ,(plist-get call :name) + :args ,(plist-get call :args))))) + full-prompt) + (push (gptel--parse-tool-results backend (list (cdr entry))) full-prompt)))) + (nreverse full-prompt)) + (cl-loop for text in prompt-list ; Simple format, list of strings + for role = t then (not role) + if text + if role + collect (list :role "user" :parts `[(:text ,text)]) into prompts + else collect (list :role "model" :parts `[(:text ,text)]) into prompts + finally return prompts))) + +(cl-defmethod gptel--parse-buffer ((backend gptel-gemini) &optional max-entries) + (let ((prompts) (prev-pt (point))) + (if (or gptel-mode gptel-track-response) + (while (and (or (not max-entries) (>= max-entries 0)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min))) + (not (= (point) prev-pt))) + (pcase (get-char-property (point) 'gptel) + ('response + (when-let* ((content (gptel--trim-prefixes + (buffer-substring-no-properties (point) prev-pt)))) + (push (list :role "model" :parts `[(:text ,content)]) prompts))) + (`(tool . ,_id) + (save-excursion + (condition-case nil + (let* ((tool-call (read (current-buffer))) + (name (plist-get tool-call :name)) + (arguments (plist-get tool-call :args))) + (plist-put tool-call :result + (string-trim (buffer-substring-no-properties + (point) prev-pt))) + (push (gptel--parse-tool-results backend (list tool-call)) + prompts) + (push (list :role "model" + :parts + (vector `(:functionCall ( :name ,name + :args ,arguments)))) + prompts)) + ((end-of-file invalid-read-syntax) + (message (format "Could not parse tool-call on line %s" + (line-number-at-pos (point)))))))) + ('ignore) + ('nil + (if gptel-track-media + (when-let* ((content (gptel--gemini-parse-multipart + (gptel--parse-media-links major-mode (point) prev-pt)))) + (when (> (length content) 0) + (push (list :role "user" :parts content) prompts))) + (when-let* ((content (gptel--trim-prefixes + (buffer-substring-no-properties + (point) prev-pt)))) + (push (list :role "user" :parts `[(:text ,content)]) prompts))))) + (setq prev-pt (point)) + (and max-entries (cl-decf max-entries))) + (let ((content (string-trim (buffer-substring-no-properties + (point-min) (point-max))))) + (push (list :role "user" :parts `[(:text ,content)]) prompts))) + prompts)) + +(defun gptel--gemini-parse-multipart (parts) + "Convert a multipart prompt PARTS to the Gemini API format. + +The input is an alist of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")). + +The output is a vector of entries in a backend-appropriate +format." + (cl-loop + for part in parts + for n upfrom 1 + with last = (length parts) + for text = (plist-get part :text) + for media = (plist-get part :media) + if text do + (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and + if text + collect (list :text text) into parts-array end + else if media + collect + `(:inline_data + (:mime_type ,(plist-get part :mime) + :data ,(gptel--base64-encode media))) + into parts-array + else if (plist-get part :textfile) + collect + (list :text (with-temp-buffer + (gptel--insert-file-string (plist-get part :textfile)) + (buffer-string))) + into parts-array + finally return (vconcat parts-array))) + +(cl-defmethod gptel--inject-media ((_backend gptel-gemini) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) + (cl-callf (lambda (current) + (vconcat (gptel--gemini-parse-multipart media-list) + current)) + (plist-get (car prompts) :parts)))) + +(defconst gptel--gemini-models + '((gemini-pro-latest + :description "Most powerful Gemini thinking model, always points to latest version" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 1.25 ; 2.50 for >200k tokens + :output-cost 10.00 ; 15 for >200k tokens + :cutoff-date "2025-01") + (gemini-flash-latest + :description "Best price / performance, always points to latest version" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 0.3 + :output-cost 2.50 + :cutoff-date "2025-01") + (gemini-flash-lite-latest + :description "Fastest, cheapest Gemini model, always points to latest version" + :capabilities (tool-use json media) + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain" + "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg" + "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm" + "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4" + "video/webm" "video/wmv" "video/3gpp") + :context-window 1048 ; 64000 output token limit + :input-cost 0.10 + :output-cost 0.40 + :cutoff-date "2025-01") + (gemini-3.1-pro-preview + :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 2.0 ; 4.0 for >200k tokens + :output-cost 12.00 ; 18.0 for >200k tokens + :cutoff-date "2025-01") + (gemini-3.1-flash-lite-preview + :description "Nost cost-efficient multimodal Gemini model, offering the fastest performance for high-frequency, lightweight tasks" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 + :input-cost 0.25 + :output-cost 1.50 + :cutoff-date "2025-01") + (gemini-3-pro-preview + :description "DEPRECATED: The model will be shut down on March 9, 2026. Please use gemini-3.1-pro-preview instead" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 2.0 ; 4.0 for >200k tokens + :output-cost 12.00 ; 18.0 for >200k tokens + :cutoff-date "2025-01") + (gemini-3-flash-preview + :description "Most intelligent Gemini model built for speed" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 0.50 + :output-cost 3.00 + :cutoff-date "2025-01") + (gemini-2.5-pro + :description "Most powerful Gemini thinking model with state-of-the-art performance" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 1.25 ; 2.50 for >200k tokens + :output-cost 10.00 ; 15 for >200k tokens + :cutoff-date "2025-01") + (gemini-2.5-pro-preview-06-05 + :description "Most powerful thinking model with state-of-the-art performance" + :capabilities (tool-use json media) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html") + :context-window 1048 ; 65536 output token limit + :input-cost 1.25 ; 2.50 for >200k tokens + :output-cost 10.00 ; 15 for >200k tokens + :cutoff-date "2025-01") + (gemini-2.5-flash + :description "Best in terms of price-performance, with well-rounded capabilities" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 1048 ; 65536 output token limit + :input-cost 0.3 + :output-cost 2.50 + :cutoff-date "2025-01") + (gemini-2.5-flash-preview-09-2025 + :description "DEPRECATED: Please use gemini-2.5-flash instead" + :capabilities (tool-use json media) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html") + :context-window 1048 ; 65536 output token limit + :input-cost 0.15 + :output-cost 0.60 ; 3.50 for thinking + :cutoff-date "2025-01") + (gemini-2.5-flash-lite + :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks" + :capabilities (tool-use json media) + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain" + "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg" + "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm" + "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4" + "video/webm" "video/wmv" "video/3gpp") + :context-window 1048 ; 64000 output token limit + :input-cost 0.10 + :output-cost 0.40 + :cutoff-date "2025-01") + (gemini-2.5-flash-lite-preview-09-2025 + :description "Fastest & cheapest 2.5 model, for high-volume, latency-sensitive tasks" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "application/pdf" "text/plain" + "audio/x-aac" "audio/flac" "audio/mp3" "audio/m4a" "audio/mpeg" + "audio/mpga" "audio/mp4" "audio/opus" "audio/pcm" "audio/wav" "audio/webm" + "video/x-flv" "video/quicktime" "video/mpeg" "video/mp4" + "video/webm" "video/wmv" "video/3gpp") + :context-window 1048 ; 65536 output token limit + :input-cost 0.10 + :output-cost 0.40 + :cutoff-date "2025-01") + (gemini-2.0-flash + :description "Next gen, high speed, multimodal for a diverse variety of tasks" + :capabilities (tool-use json media) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html") + :context-window 1000 + :input-cost 0.10 + :output-cost 0.40 + :cutoff-date "2024-08") + (gemini-2.0-flash-exp + :description "Next generation features, superior speed, native tool use" + :capabilities (tool-use json media) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html") + :context-window 1000 + :input-cost 0.00 + :output-cost 0.00) + (gemini-2.0-flash-thinking-exp + :description "DEPRECATED: Please use gemini-2.0-flash-thinking-exp-01-21 instead" + :capabilities (tool-use media) + :context-window 32 + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "text/plain" "text/csv" "text/html") + :input-cost 0.00 + :output-cost 0.00)) + "List of available Gemini models and associated properties. +Keys: + +- `:description': a brief description of the model. + +- `:capabilities': a list of capabilities supported by the model. + +- `:mime-types': a list of supported MIME types for media files. + +- `:context-window': the context window size, in thousands of tokens. + +- `:input-cost': the input cost, in US dollars per million tokens. + +- `:output-cost': the output cost, in US dollars per million tokens. + +- `:cutoff-date': the knowledge cutoff date. + +- `:request-params': a plist of additional request parameters to + include when using this model. + +Information about the Gemini models was obtained from the following +source: + +- +- ") + +;;;###autoload +(cl-defun gptel-make-gemini + (name &key curl-args key request-params + (stream nil) + (header + (lambda (_info) (when-let* ((key (gptel--get-api-key))) + `(("X-goog-api-key" . ,key))))) + (host "generativelanguage.googleapis.com") + (protocol "https") + (models gptel--gemini-models) + (endpoint "/v1beta/models")) + + "Register a Gemini backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, defaults to +\"generativelanguage.googleapis.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--gemini-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(gemini-2.0-flash-lite ;Simple specs + gemini-1.5-flash + (gemini-1.5-pro-latest ;Full spec + :description + \"Complex reasoning tasks, problem solving and data extraction\" + :capabilities (tool json) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/webp\" \"image/heic\"))) + + +STREAM is a boolean to enable streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, \"https\" by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1beta/models\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for." + (declare (indent 1)) + (let ((backend (gptel--make-gemini + :curl-args curl-args + :name name + :host host + :header header + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :key key + :url (lambda (_info) + (let ((method + (if (and stream gptel-use-curl gptel-stream) + "streamGenerateContent" + "generateContent"))) + (format "%s://%s%s/%s:%s" + protocol + host + endpoint + gptel-model + method)))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +(provide 'gptel-gemini) +;;; gptel-gemini.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-gh.el b/elpa/gptel-20260425.846/gptel-gh.el new file mode 100644 index 00000000..e9965f60 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-gh.el @@ -0,0 +1,579 @@ +;;; gptel-gh.el --- Github Copilot AI suppport for gptel -*- lexical-binding: t; -*- + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file adds support for Github Copilot API to gptel + +;;; Code: + +(require 'cl-lib) +(require 'map) +(eval-and-compile + (require 'gptel-request) + (require 'gptel-openai) + (require 'gptel-openai-responses)) +(require 'browse-url) + +;;; Github Copilot +(defconst gptel--gh-models + '((gpt-4.1 + :description "Flagship model for complex tasks" + :capabilities (media tool-use json url) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 111 + :input-cost 0 + :output-cost 0 + :cutoff-date "2024-04") + (gpt-4o + :description + "Advanced model for complex tasks; cheaper & faster than GPT-Turbo" + :capabilities (media tool-use json url) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 64 + :input-cost 0 + :output-cost 0 + :cutoff-date "2023-09") + (gpt-5-mini + :description "Faster, more cost-efficient version of GPT-5" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 0 + :output-cost 0 + :cutoff-date "2024-06") + (gpt-5.1 + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2024-09") + (gpt-5.1-codex + :description "Flagship model for coding, reasoning, and agentic tasks across domains" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2024-09") + (gpt-5.1-codex-max + :description "Flagship model for coding, reasoning, and agentic tasks across domains" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2024-09") + (gpt-5.1-codex-mini + :description "Flagship model for coding, reasoning, and agentic tasks across domains" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2024-09") + (gpt-5.2 + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-08") + (gpt-5.2-codex + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 272 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-08") + (gpt-5.3-codex + :description "The most capable agentic coding model to date" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-08") + (gpt-5.4 + :description "Best intelligence at scale for agentic, coding, and professional workflows" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-08") + (gpt-5.4-mini + :description "Strongest mini model yet for coding, computer use, and subagent" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 0.33 + :output-cost 0.33 + :cutoff-date "2025-08") + (claude-haiku-4.5 + :description "Near-frontier intelligence at blazing speeds with extended thinking" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 0.33 + :output-cost 0.33 + :cutoff-date "2025-02") + (claude-opus-4.5 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 3 + :output-cost 3 + :cutoff-date "2025-03") + (claude-opus-4.6 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 3 + :output-cost 3 + :cutoff-date "2025-03") + (claude-opus-4.7 + :description "Most capable model for complex reasoning and advanced coding" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 3 + :output-cost 3 + :cutoff-date "2025-03") + (claude-sonnet-4 + :description "High-performance model with exceptional reasoning and efficiency" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-03") + (claude-sonnet-4.5 + :description "High-performance model with exceptional reasoning and efficiency" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-03") + (claude-sonnet-4.6 + :description "High-performance model with exceptional reasoning and efficiency" + :capabilities (media tool-use cache) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp" "application/pdf") + :context-window 128 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-03") + (gemini-2.5-pro + :description "Next gen, high speed, multimodal for a diverse variety of tasks" + :capabilities (tool-use json media) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html") + :context-window 109 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-01") + (gemini-3-flash-preview + :description "Most intelligent Gemini model built for speed" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 109 + :input-cost 0.33 + :output-cost 0.33 + :cutoff-date "2025-01") + (gemini-3-pro-preview + :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 109 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-01") + (gemini-3.1-pro-preview + :description "Most intelligent Gemini model with SOTA reasoning and multimodal understanding" + :capabilities (tool-use json media audio video) + :mime-types ("image/png" "image/jpeg" "image/webp" "image/heic" "image/heif" + "application/pdf" "text/plain" "text/csv" "text/html" + "audio/mpeg" "audio/wav" "audio/ogg" "audio/flac" "audio/aac" "audio/mp3" + "video/mp4" "video/mpeg" "video/avi" "video/quicktime" "video/webm") + :context-window 109 + :input-cost 1 + :output-cost 1 + :cutoff-date "2025-01") + (grok-code-fast-1 + :description "Fast reasoning model for agentic coding" + :capabilities '(tool-use json reasoning) + :context-window 109 + :input-cost 0.25 + :output-cost 1.5 + :cutoff-date "2025-08"))) + +(cl-defstruct (gptel--gh (:include gptel-openai) + (:copier nil) + (:constructor gptel--make-gh)) + token github-token sessionid machineid responses-backend) + +(defcustom gptel-gh-github-token-file (expand-file-name ".cache/copilot-chat/github-token" + user-emacs-directory) + "File where the GitHub token is stored." + :type 'string + :group 'gptel) + +(defcustom gptel-gh-token-file (expand-file-name ".cache/copilot-chat/token" + user-emacs-directory) + "File where the chat token is cached." + :type 'string + :group 'gptel) + +(defconst gptel--gh-auth-common-headers + `(("editor-plugin-version" . "gptel/*") + ("editor-version" . ,(concat "emacs/" emacs-version)))) + +(defconst gptel--gh-client-id "Iv1.b507a08c87ecfe98") + +;; https://en.wikipedia.org/wiki/Universally_unique_identifier#Version_4_(random) +(defun gptel--gh-uuid () + "Generate a UUID v4-1." + (format "%04x%04x-%04x-4%03x-8%03x-%04x%04x%04x" + (random #x10000) (random #x10000) + (random #x10000) + (random #x1000) + (random #x1000) + (random #x10000) (random #x10000) (random #x10000))) + +(defun gptel--gh-machine-id () + "Generate a machine ID." + (let ((hex-chars "0123456789abcdef") + (length 65) + hex) + (dotimes (_ length) + (setq hex (nconc hex (list (aref hex-chars (random 16)))))) + (apply #'string hex))) + +(defun gptel--gh-restore (file) + "Restore saved object from FILE." + (when (file-exists-p file) + ;; We set the coding system to `utf-8-auto-dos' when reading so that + ;; files with CR EOL can still be read properly + (let ((coding-system-for-read 'utf-8-auto-dos)) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally file) + (goto-char (point-min)) + (read (current-buffer)))))) + +(defun gptel--gh-save (file obj) + "Save OBJ to FILE." + (let ((print-length nil) + (print-level nil) + (coding-system-for-write 'utf-8-unix)) + (make-directory (file-name-directory file) t) + (write-region (prin1-to-string obj) nil file nil :silent) + obj)) + +(defun gptel-gh-login () + "Login to GitHub Copilot API. + +This will prompt you to authorize in a browser and store the token. + +In SSH sessions, the URL and code will be displayed for manual entry +instead of attempting to open a browser automatically." + (interactive) + ;; Determine which GitHub backend to use + (let ((gh-backend + (cond + ;; If current backend is GitHub, use it + ((and (boundp 'gptel-backend) + gptel-backend + (gptel--gh-p gptel-backend)) + gptel-backend) + ;; Otherwise, find any GitHub backend + ((cl-find-if (lambda (b) (gptel--gh-p b)) + (mapcar #'cdr gptel--known-backends))) + ;; No GitHub backend found + (t (user-error "No GitHub Copilot backend found. \ +Please set one up with `gptel-make-gh-copilot' first")))) + ;; Detect SSH sessions + (in-ssh-session (or (getenv "SSH_CLIENT") + (getenv "SSH_CONNECTION") + (getenv "SSH_TTY")))) + (pcase-let (((map :device_code :user_code :verification_uri) + (gptel--url-retrieve + "https://github.com/login/device/code" + :method 'post + :headers gptel--gh-auth-common-headers + :data `( :client_id ,gptel--gh-client-id + :scope "read:user")))) + (gui-set-selection 'CLIPBOARD user_code) + (if in-ssh-session + ;; SSH session: display URL and code, don't auto-open browser + (progn + (message "GitHub Device Code: %s (copied to clipboard)" user_code) + (read-from-minibuffer + (format "Code %s is copied. Visit https://github.com/login/device \ +in your local browser, enter the code, and authorize. Press ENTER after authorizing. " + user_code))) + ;; Local session: auto-open browser + (read-from-minibuffer + (format "Your one-time code %s is copied. \ +Press ENTER to open GitHub in your browser. \ +If your browser does not open automatically, browse to %s." + user_code verification_uri)) + (browse-url verification_uri) + (read-from-minibuffer "Press ENTER after authorizing. ")) + ;; Use gh-backend for token storage + (thread-last + (plist-get + (gptel--url-retrieve + "https://github.com/login/oauth/access_token" + :method 'post + :headers gptel--gh-auth-common-headers + :data `( :client_id ,gptel--gh-client-id + :device_code ,device_code + :grant_type "urn:ietf:params:oauth:grant-type:device_code")) + :access_token) + (gptel--gh-save gptel-gh-github-token-file) + (setf (gptel--gh-github-token gh-backend)))) + ;; Check gh-backend for success + (if (and (gptel--gh-github-token gh-backend) + (not (string-empty-p + (gptel--gh-github-token gh-backend)))) + (message "Successfully logged in to GitHub Copilot.") + (user-error "Error: You might not have access to GitHub Copilot Chat!")))) + +(defun gptel--gh-renew-token () + "Renew session token." + (let ((token + (gptel--url-retrieve + "https://api.github.com/copilot_internal/v2/token" + :method 'get + :headers `(("authorization" + . ,(format "token %s" (gptel--gh-github-token gptel-backend))) + ,@gptel--gh-auth-common-headers)))) + (if (not (plist-get token :token)) + (progn + (setf (gptel--gh-github-token gptel-backend) nil) + (user-error "Error: You might not have access to GitHub Copilot Chat!")) + (thread-last + (gptel--gh-save gptel-gh-token-file token) + (setf (gptel--gh-token gptel-backend)))))) + +(defun gptel--gh-auth () + "Authenticate with GitHub Copilot API. + +We first need github authorization (github token). +Then we need a session token." + (unless (gptel--gh-github-token gptel-backend) + (let ((token (gptel--gh-restore gptel-gh-github-token-file))) + (if token + (setf (gptel--gh-github-token gptel-backend) token) + (gptel-gh-login)))) + + (when (null (gptel--gh-token gptel-backend)) + ;; try to load token from `gptel-gh-token-file' + (setf (gptel--gh-token gptel-backend) + (gptel--gh-restore gptel-gh-token-file))) + + (pcase-let (((map :token :expires_at) + (gptel--gh-token gptel-backend))) + (when (or (null token) + (and expires_at + (> (round (float-time (current-time))) + expires_at))) + (gptel--gh-renew-token)))) + +(cl-defmethod gptel-curl--parse-stream ((backend gptel--gh) info) + (let ((model (plist-get info :model))) + (if (gptel--model-capable-p 'responses-api model) + ;; Defer to gptel-openai-responses backend + (gptel-curl--parse-stream + (gptel--gh-responses-backend backend) info) + (cl-call-next-method)))) + +(cl-defmethod gptel--parse-response ((backend gptel--gh) response info) + (let ((model (plist-get info :model))) + (if (gptel--model-capable-p 'responses-api model) + ;; Defer to gptel-openai-responses backend + (gptel--parse-response + (gptel--gh-responses-backend backend) response info) + (cl-call-next-method)))) + +(cl-defmethod gptel--request-data ((backend gptel--gh) prompts) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--request-data (gptel--gh-responses-backend backend) prompts) + (cl-call-next-method))) + +(cl-defmethod gptel--parse-schema ((backend gptel--gh) schema) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--parse-schema (gptel--gh-responses-backend backend) schema) + (cl-call-next-method))) + +(cl-defmethod gptel--parse-tools ((backend gptel--gh) tools) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--parse-tools (gptel--gh-responses-backend backend) tools) + (cl-call-next-method))) + +(cl-defmethod gptel--inject-tool-call ((backend gptel--gh) data tool-call new-call) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--inject-tool-call (gptel--gh-responses-backend backend) data tool-call new-call) + (cl-call-next-method))) + +(cl-defmethod gptel--parse-tool-results ((backend gptel--gh) tool-use) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--parse-tool-results (gptel--gh-responses-backend backend) tool-use) + (cl-call-next-method))) + +(cl-defmethod gptel--inject-prompt ((backend gptel--gh) data new-prompt &optional position) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--inject-prompt (gptel--gh-responses-backend backend) data new-prompt position) + (cl-call-next-method))) + +(cl-defmethod gptel--parse-list ((backend gptel--gh) prompt-list) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--parse-list (gptel--gh-responses-backend backend) prompt-list) + (cl-call-next-method))) + +(cl-defmethod gptel--parse-buffer ((backend gptel--gh) &optional max-entries) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--parse-buffer (gptel--gh-responses-backend backend) max-entries) + (cl-call-next-method))) + +(cl-defmethod gptel--inject-media ((backend gptel--gh) prompts) + (if (gptel--model-capable-p 'responses-api gptel-model) + (gptel--inject-media (gptel--gh-responses-backend backend) prompts) + (cl-call-next-method))) + +;;;###autoload +(cl-defun gptel-make-gh-copilot + (name &key curl-args request-params + (header + (lambda (info) (gptel--gh-auth) + `(("openai-intent" . "conversation-panel") + ("authorization" . ,( concat "Bearer " + (plist-get (gptel--gh-token gptel-backend) :token))) + ("x-initiator" . ,(or (plist-get info :gh-initiator) ;tool call return turn + (prog1 "user" ;user turn + (plist-put info :gh-initiator "agent")))) + ("x-request-id" . ,(gptel--gh-uuid)) + ("vscode-sessionid" . ,(or (gptel--gh-sessionid gptel-backend) "")) + ("vscode-machineid" . ,(or (gptel--gh-machineid gptel-backend) "")) + ,@(when (and gptel-track-media + (gptel--model-capable-p 'media)) + `(("copilot-vision-request" . "true"))) + ("copilot-integration-id" . "vscode-chat")))) + (host "api.githubcopilot.com") + (protocol "https") + (endpoint "/chat/completions") + (stream t) + (models gptel--gh-models)) + "Register a Github Copilot chat backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, typically \"api.githubcopilot.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--openai-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(gpt-3.5-turbo ;Simple specs + gpt-4-turbo + (gpt-4o-mini ;Full spec + :description + \"Affordable and intelligent small model for lightweight tasks\" + :capabilities (media tool json url) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) + +Defaults to a list of models supported by GitHub Copilot. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/chat/completions\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +Defaults to headers required by GitHub Copilot. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for." + (declare (indent 1)) + (let* ((url (lambda (_info) + (concat protocol "://" host + (if (gptel--model-capable-p 'responses-api gptel-model) + "/v1/responses" endpoint)))) + (backend (gptel--make-gh + :name name + :host host + :header header + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :curl-args curl-args + :url url + :machineid (gptel--gh-machine-id) + :responses-backend + (gptel--make-openai-responses + :name name + :host host + :header header + :protocol protocol + :endpoint "/v1/responses" + :stream stream + :request-params request-params + :curl-args curl-args + :url url)))) + (setf (alist-get name gptel--known-backends nil nil #'equal) backend) + backend)) + +(provide 'gptel-gh) +;;; gptel-gh.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-integrations.el b/elpa/gptel-20260425.846/gptel-integrations.el new file mode 100644 index 00000000..621345d0 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-integrations.el @@ -0,0 +1,335 @@ +;;; gptel-transient.el --- Integrations for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 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: + +;; Integrations with related packages for gptel. To use these, run +;; +;; (require 'gptel-integrations) +;; +;; For MCP integration: +;; - Run M-x `gptel-mcp-connect' and M-x `gptel-mcp-disconnect', OR +;; - Use gptel's tools menu, M-x `gptel-tools', OR +;; - Access tools from `gptel-menu' + +;;; Code: +(require 'gptel) +(require 'cl-lib) +(eval-when-compile (require 'transient)) + +;;;;; Vterm integration +;; Insertion and deletion is tricky in Vterm buffers. Try to ensure that +;; gptel-send still works there. TODO: Insertion works, but insertion-in-place +;; is flaky and fails depending on how well Vterm's prompt tracking works, as +;; well as on the presence of "virtual text" in the prompt. +(declare-function vterm-copy-mode "vterm") +(declare-function vterm-delete-region "vterm") +(declare-function vterm-goto-char "vterm") +(declare-function vterm-reset-cursor-point "vterm") +(declare-function vterm-cursor-in-command-buffer-p "vterm") +(declare-function vterm-send-key "vterm") +(declare-function vterm-insert "vterm") +(defvar vterm-copy-mode) + +(defun gptel--vterm-delete () + "Try to delete the region or Vterm prompt text. + +Intended for use in Vterm buffers with the \"respond-in-place\" option +of `gptel-send'." + (if (use-region-p) + (let ((beg (region-beginning)) ; Clear region + (end (region-end))) + (vterm-copy-mode -1) + (condition-case nil + ;; Preferred solution, fails if the prompt is part of region + (vterm-delete-region beg end) + (buffer-read-only + (when (vterm-goto-char end) ;HACK Try to clear characters one by one + (let ((prev-pt (1- end))) + (while (and (>= (vterm-reset-cursor-point) beg) + (/= (point) prev-pt) + (vterm-cursor-in-command-buffer-p)) + (setq prev-pt (point)) + (vterm-send-key "" nil t nil t))))))) + (let ((prev-pt 0)) ; Clear to prompt + (while (and (/= (vterm-reset-cursor-point) prev-pt) + (vterm-cursor-in-command-buffer-p)) + (setq prev-pt (point)) + (vterm-send-key "" nil t nil t))))) + +(defun gptel--vterm-pre-insert (info) + "Set up insertion into Vterm buffers for `gptel-send'. + +INFO is the query information for the active request." + (let ((start-marker (plist-get info :position)) + (hold-buffer (gptel--temp-buffer " *gptel-vterm-redirect*"))) + (plist-put info :vterm-marker (copy-marker start-marker t)) + (with-current-buffer hold-buffer + (move-marker start-marker (point-min) hold-buffer) + ;; We collect text elsewhere and copy it into the Vterm buffer at the end + (add-hook 'gptel-post-response-functions + (lambda (beg end) + (let ((response (buffer-substring-no-properties beg end))) + (with-current-buffer (plist-get info :buffer) + (goto-char (plist-get info :vterm-marker)) + (when vterm-copy-mode (vterm-copy-mode -1)) + (vterm-insert response))) + (kill-buffer (current-buffer))) + 90 t)))) + +;;;; MCP integration - requires the mcp package +(declare-function mcp-hub-get-all-tool "mcp-hub") +(declare-function mcp-hub-get-servers "mcp-hub") +(declare-function mcp-hub-start-all-server "mcp-hub") +(declare-function mcp-stop-server "mcp") +(declare-function mcp-hub "mcp-hub") +(declare-function mcp--status "mcp-hub") +(declare-function mcp--tools "mcp-hub") +(declare-function mcp-make-text-tool "mcp-hub") +(defvar mcp-hub-servers) +(defvar mcp-server-connections) + +(defun gptel-mcp-connect (&optional servers server-callback interactive) + "Add gptel tools from MCP servers using the mcp package. + +MCP servers are started if required. SERVERS is a list of server +names (strings) to connect to. If nil, all known servers are +considered. + +If INTERACTIVE is non-nil (or called interactively), guide the user +through setting up mcp, and query for servers to retrieve tools from. + +Call SERVER-CALLBACK after starting MCP servers. If SERVER-CALLBACK is +not a function and non-nil, start SERVERS synchronously." + (interactive (list nil nil t)) + (if (locate-library "mcp-hub") + (unless (require 'mcp-hub nil t) + (user-error "Could not load `mcp-hub'! Please install\ + or configure the mcp package")) + (user-error "Could not find mcp! Please install or configure the mcp package")) + (if (null mcp-hub-servers) + (user-error "No MCP servers available! Please configure `mcp-hub-servers'") + (setq servers + (if servers + (mapcar (lambda (s) (assoc s mcp-hub-servers)) servers) + mcp-hub-servers)) + (let ((unregistered-servers ;Available servers minus servers already registered with gptel + (cl-loop for server in servers + with registered-names = + (cl-loop for (cat . _tools) in gptel--known-tools + if (string-prefix-p "mcp-" cat) + collect (substring cat 4)) + unless (member (car server) registered-names) + collect server))) + (if unregistered-servers + (let* ((servers + (if interactive + (let ((picks + (completing-read-multiple + "Add tools from MCP servers (separate with \",\"): " + (cons '("ALL") unregistered-servers) nil t))) + (if (member "ALL" picks) + unregistered-servers + (mapcar (lambda (s) (assoc s mcp-hub-servers)) picks))) + unregistered-servers)) + (server-active-p + (lambda (server) + (when-let* ((server (gethash (car server) mcp-server-connections))) + (equal (mcp--status server) 'connected)))) + (inactive-servers (cl-remove-if server-active-p servers)) + (add-all-tools + (lambda (&optional server-names) + "Register and add tools from servers. Report failures." + (let ((tools (gptel-mcp--get-tools + (or server-names (mapcar #'car servers)))) + (now-active (cl-remove-if-not server-active-p mcp-hub-servers))) + (mapc (lambda (tool) (apply #'gptel-make-tool tool)) tools) + (when tools (gptel-mcp--activate-tools tools)) + (if-let* ((failed (cl-set-difference inactive-servers now-active + :test #'equal))) + (progn + (message "Inactive-before: %S, Now-Active: %S" inactive-servers now-active) + (message (substitute-command-keys + "%d/%d server%s failed to start: %s. Run \\[mcp-hub] to investigate.") + (length failed) (length inactive-servers) + (if (= (length failed) 1) "" "s") + (mapconcat #'car failed ", "))) + (let ((added (or server-names (mapcar #'car now-active)))) + (message "Added %d tools from %d MCP server%s: %s" + (length tools) (length added) + (if (= (length added) 1) "" "s") + (mapconcat #'identity added ", ")))) + (when (functionp server-callback) (funcall server-callback)))))) + + (if inactive-servers ;start servers + (let ((syncp (and server-callback (not (functionp server-callback)) t))) + (mcp-hub-start-all-server + add-all-tools (mapcar #'car inactive-servers) syncp)) + (funcall add-all-tools (mapcar #'car servers)))) + (when interactive (message "All MCP tools are already available to gptel!")) + (when (functionp server-callback) (funcall server-callback)))))) + +(defun gptel-mcp-disconnect (&optional servers interactive) + "Unregister gptel tools provided by MCP servers using the mcp package. + +SERVERS is a list of server names (strings) to disconnect from. + +If INTERACTIVE is non-nil, query the user about which tools to remove." + (interactive (list nil t)) + (if-let* ((names-alist + (cl-loop + for (category . _tools) in gptel--known-tools + if (and (string-match "^mcp-\\(.*\\)" category) + (or (null servers) ;Consider all if nil + (member (match-string 1 category) servers))) + collect (cons (match-string 1 category) category)))) + (let ((remove-fn (lambda (cat-names) + (setq gptel-tools ;Remove from gptel-tools + (cl-delete-if (lambda (tool) (member (gptel-tool-category tool) + cat-names)) + gptel-tools)) + (mapc (lambda (category) ;Remove from registry + (setf (alist-get category gptel--known-tools + nil t #'equal) + nil)) + cat-names)))) + (if interactive + (when-let* ((server-names + (completing-read-multiple + "Remove MCP server tools for (separate with \",\"): " + (cons '("ALL" . nil) names-alist) + nil t))) + (when (member "ALL" server-names) + (setq server-names (mapcar #'car names-alist))) + (funcall remove-fn ;remove selected tool categories + (mapcar (lambda (s) (cdr (assoc s names-alist))) server-names)) + (if (y-or-n-p + (format "Removed MCP tools from %d server%s. Also shut down MCP servers?" + (length server-names) + (if (= (length server-names) 1) "" "s"))) + (progn (mapc #'mcp-stop-server server-names) + (message "Shut down MCP servers: %S" server-names)) + (message "Removed MCP tools for: %S" server-names))) + (funcall remove-fn (mapcar #'cdr names-alist)))) + ;; No MCP tools, ask to shut down servers + (if (cl-loop + for v being the hash-values of mcp-server-connections + never v) + (when interactive (message "No MCP servers active!")) + (when (or (not interactive) + (y-or-n-p "No MCP tools in gptel! Shut down all MCP servers? ")) + (dolist (server mcp-hub-servers) + (when (gethash (car server) mcp-server-connections) + (mcp-stop-server (car server)))))))) + +(defun gptel-mcp--get-tools (&optional server-names) + "Return tools from running MCP servers. + +SERVER-NAMES is a list of server names to add tools from. Add tools +from all connected servers if it is nil." + (unless server-names + (setq server-names (hash-table-keys mcp-server-connections))) + (let ((servers (mapcar (lambda (n) (gethash n mcp-server-connections)) + server-names))) + (cl-mapcan + (lambda (name server) + (when (and server (equal (mcp--status server) 'connected)) + (when-let* ((tools (mcp--tools server)) + (tool-names (mapcar #'(lambda (tool) (plist-get tool :name)) tools))) + (mapcar (lambda (tool-name) + (plist-put (mcp-make-text-tool name tool-name t) + :category (format "mcp-%s" name))) + tool-names)))) + server-names servers))) + +(defun gptel-mcp--activate-tools (&optional tools) + "Activate TOOLS or all MCP tools in current gptel session." + (unless tools (setq tools (gptel-mcp--get-tools))) + (dolist (tool tools) + (cl-pushnew (gptel-get-tool (list (plist-get tool :category) + (plist-get tool :name))) + gptel-tools))) + +(with-eval-after-load 'gptel-transient + (transient-define-suffix gptel--suffix-mcp-connect () + "Register tools provided by MCP servers." + :key "M+" + :description "Add MCP server tools" + :transient t + (interactive) + ;; gptel-tools stores its state in its scope slot. Retain the scope but + ;; update it with the newly selected tools. Then set up gptel-tools. + (condition-case err + (gptel-mcp-connect + nil (lambda () (when-let* ((transient--prefix) + ((eq (oref transient--prefix command) + 'gptel-tools))) + (let ((state (transient-scope 'gptel-tools))) + (plist-put state :tools + (delete-dups + (nconc (mapcar (lambda (tool) + (list (gptel-tool-category tool) + (gptel-tool-name tool))) + gptel-tools) + (plist-get state :tools)))) + (transient-setup 'gptel-tools nil nil :scope state)))) + t) + (user-error (message "%s" (cadr err))))) + + (transient-define-suffix gptel--suffix-mcp-disconnect () + "Remove tools provided by MCP servers from gptel." + :key "M-" + :description (lambda () (if (cl-some (lambda (cat) (string-match-p "^mcp-" cat)) + (map-keys gptel--known-tools)) + "Remove MCP server tools" + "Shut down MCP servers")) + :transient t + :inapt-if + (lambda () (or (not (boundp 'mcp-hub-servers)) + (null mcp-hub-servers) + (cl-loop + for v being the hash-values of mcp-server-connections + never v))) + (interactive) + (call-interactively #'gptel-mcp-disconnect) + ;; gptel-tools stores its state in its scope slot. Retain the scope but + ;; remove tools from it that no longer exist, then set up gptel-tools + (cl-loop with state = (transient-scope 'gptel-tools) + with tools = (plist-get state :tools) + for tool-spec in tools + if (map-nested-elt gptel--known-tools tool-spec) + collect tool-spec into valid-tools + finally do (plist-put state :tools valid-tools) + (transient-setup 'gptel-tools nil nil :scope state))) + + (transient-remove-suffix 'gptel-tools '(0 2)) + (transient-append-suffix 'gptel-tools '(0 -1) + ["" + (gptel--suffix-mcp-connect) + (gptel--suffix-mcp-disconnect)])) + +(provide 'gptel-integrations) +;;; gptel-integrations.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not noruntime) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-kagi.el b/elpa/gptel-20260425.846/gptel-kagi.el new file mode 100644 index 00000000..d27188d4 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-kagi.el @@ -0,0 +1,191 @@ +;;; gptel-kagi.el --- Kagi support for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur +;; Keywords: hypermedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file adds support for the Kagi FastGPT LLM API to gptel + +;;; Code: +(require 'cl-generic) +(eval-when-compile (require 'cl-lib)) +(eval-and-compile (require 'gptel-request)) + +(declare-function gptel-context--wrap "gptel-context") + +;;; Kagi +(cl-defstruct (gptel-kagi (:constructor gptel--make-kagi) + (:copier nil) + (:include gptel-backend))) + +(cl-defmethod gptel--parse-response ((_backend gptel-kagi) response info) + (let* ((data (plist-get response :data)) + (output (plist-get data :output)) + (references (plist-get data :references)) + (tokens (plist-get data :tokens))) + (when tokens + (plist-put info :tokens (list :input tokens :output tokens))) + (if (eq references :null) (setq references nil)) + (if (eq output :null) (setq output nil)) + (when references + (setq references + (cl-loop with linker = + (pcase (buffer-local-value 'major-mode + (plist-get info :buffer)) + ('org-mode + (lambda (text url) + (format "[[%s][%s]]" url text))) + ('markdown-mode + (lambda (text url) + (format "[%s](%s)" text url))) + (_ (lambda (text url) + (buttonize + text (lambda (data) (browse-url data)) + url)))) + for ref across references + for title = (plist-get ref :title) + for snippet = (plist-get ref :snippet) + for url = (plist-get ref :url) + for n upfrom 1 + collect + (concat (format "[%d] " n) + (funcall linker title url) ": " + (replace-regexp-in-string + "" "*" snippet)) + into ref-strings + finally return + (concat "\n\n" (mapconcat #'identity ref-strings "\n"))))) + (concat output references))) + +;; TODO: Add support for model/backend-specific request-params and +;; gptel--request-params +(cl-defmethod gptel--request-data ((_backend gptel-kagi) prompts) + "JSON encode PROMPTS for Kagi." + (pcase-exhaustive (gptel--model-name gptel-model) + ("fastgpt" + `(,@prompts :web_search t :cache t)) + ((and model (guard (string-prefix-p "summarize" model))) + `(,@prompts :engine ,(substring model 10))))) + +(cl-defmethod gptel--parse-buffer ((_backend gptel-kagi) &optional _max-entries) + (let ((url (or (thing-at-point 'url) + (get-text-property (point) 'shr-url) + (get-text-property (point) 'image-url))) + ;; (filename (thing-at-point 'existing-filename)) ;no file upload support yet + (prop (text-property-search-backward + 'gptel 'response + (when (get-char-property (max (point-min) (1- (point))) + 'gptel) + t)))) + (if (and url (string-prefix-p "summarize" (gptel--model-name gptel-model))) + (list :url url) + (if (and (or gptel-mode gptel-track-response) + (prop-match-p prop) + (prop-match-value prop)) + (user-error "No user prompt found!") + (let ((prompts + (if (or gptel-mode gptel-track-response) + (or (gptel--trim-prefixes + (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop))) + "") + (string-trim (buffer-substring-no-properties (point-min) (point-max)))))) + (pcase-exhaustive (gptel--model-name gptel-model) + ("fastgpt" (setq prompts (list :query (if (prop-match-p prop) prompts "")))) + ((and model (guard (string-prefix-p "summarize" model))) + ;; If the entire contents of the prompt looks like a url, send the url + ;; Else send the text of the region + (setq prompts + (if-let* (((prop-match-p prop)) + (engine (substring model 10))) + ;; It's a region of text + (list :text prompts) + "")))) + prompts))))) + +;;;###autoload +(cl-defun gptel-make-kagi + (name &key curl-args stream key + (host "kagi.com") + (header (lambda (_info) + `(("Authorization" . ,(concat "Bot " (gptel--get-api-key)))))) + (models '((fastgpt :capabilities (nosystem)) + (summarize:cecil :capabilities (nosystem)) + (summarize:agnes :capabilities (nosystem)) + (summarize:daphne :capabilities (nosystem)) + (summarize:muriel :capabilities (nosystem)))) + (protocol "https") + (endpoint "/api/v0/")) + "Register a Kagi FastGPT backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is the Kagi host (with port), defaults to \"kagi.com\". + +MODELS is a list of available Kagi models: only fastgpt is supported. + +STREAM is a boolean to toggle streaming responses, defaults to +false. Kagi does not support a streaming API yet. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/api/v0/fastgpt\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +Example: +------- + + (gptel-make-kagi \"Kagi\" :key my-kagi-key)" + (declare (indent 1)) + stream ;Silence byte-compiler + (let ((backend (gptel--make-kagi + :curl-args curl-args + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :url + (lambda (_info) + (concat protocol "://" host endpoint + (if (equal gptel-model 'fastgpt) + "fastgpt" "summarize")))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +(provide 'gptel-kagi) +;;; gptel-kagi.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-ollama.el b/elpa/gptel-20260425.846/gptel-ollama.el new file mode 100644 index 00000000..63d5a9cc --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-ollama.el @@ -0,0 +1,408 @@ +;;; gptel-ollama.el --- Ollama support for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur +;; Keywords: hypermedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file adds support for the Ollama LLM API to gptel + +;;; Code: +(require 'cl-generic) +(eval-and-compile (require 'gptel-request)) + +(declare-function json-read "json" ()) +(declare-function gptel-context--wrap "gptel-context") +(declare-function gptel-context--collect-media "gptel-context") + +(defvar json-object-type) + +;;; Ollama +(cl-defstruct (gptel-ollama (:constructor gptel--make-ollama) + (:copier nil) + (:include gptel-backend))) + +(defun gptel--ollama-update-tokens (usage info) + "Update token usage information from USAGE. +USAGE is part of the response, INFO is the request plist. + +This function accumulates token counts across multiple turns in a +multi-turn request (e.g., during tool use where results are fed +back to the LLM)." + (when usage + (let* ((tokens (plist-get info :tokens)) + (input (+ (or (plist-get usage :prompt_eval_count) 0) + (or (plist-get tokens :input) 0))) + (output (+ (or (plist-get usage :eval_count) 0) + (or (plist-get tokens :output) 0)))) + (list :input input :output output)))) + +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-ollama) info) + "Parse response stream for the Ollama API." + (when (and (bobp) (re-search-forward "^{" nil t)) + (forward-line 0)) + (let* ((content-strs) (content) (pt (point))) + (condition-case nil + (while (setq content (gptel--json-read)) + (setq pt (point)) + (let ((done (map-elt content :done)) + (reasoning (map-nested-elt content '(:message :thinking))) + (response (map-nested-elt content '(:message :content))) + (tool-calls (map-nested-elt content '(:message :tool_calls)))) + (when (and response (not (eq response :null))) + (push response content-strs)) + (when (and tool-calls (not (eq tool-calls :null))) + (gptel--inject-prompt + (plist-get info :backend) (plist-get info :data) + `(:role "assistant" :content :null :tool_calls ,(vconcat tool-calls))) + (cl-loop + for tool-call across tool-calls ;replace ":arguments" with ":args" + for call-spec = (copy-sequence (plist-get tool-call :function)) + do (plist-put call-spec :args + (plist-get call-spec :arguments)) + (plist-put call-spec :arguments nil) + collect call-spec into tool-use + finally (plist-put info :tool-use tool-use))) + (if (and reasoning (not (eq reasoning :null))) + (plist-put info :reasoning + (concat (plist-get info :reasoning) reasoning)) + (if (eq 'in (plist-get info :reasoning-block)) + (plist-put info :reasoning-block t) + (plist-put info :reasoning-block nil))) + (unless (eq done :json-false) + (plist-put info :tokens (gptel--ollama-update-tokens content info)) + (goto-char (point-max))))) + (error (goto-char pt))) + (apply #'concat (nreverse content-strs)))) + +(cl-defmethod gptel--parse-response ((_backend gptel-ollama) response info) + "Parse a one-shot RESPONSE from the Ollama API and return text. + +Store response metadata in state INFO." + (plist-put info :stop-reason (plist-get response :done_reason)) + (plist-put info :tokens (gptel--ollama-update-tokens response info)) + (let* ((message (plist-get response :message)) + (reasoning (plist-get message :thinking)) + (content (plist-get message :content))) + (when reasoning + (plist-put info :reasoning reasoning)) + (when-let* ((tool-calls (plist-get message :tool_calls))) + ;; First add the tool call to the prompts list + (let* ((data (plist-get info :data)) + (prompts (plist-get data :messages))) + (plist-put data :messages (vconcat prompts `(,message)))) + ;; Then capture the tool call data for running the tool + (cl-loop + for tool-call across tool-calls ;replace ":arguments" with ":args" + for call-spec = (copy-sequence (plist-get tool-call :function)) + do (plist-put call-spec :args + (plist-get call-spec :arguments)) + (plist-put call-spec :arguments nil) + collect call-spec into tool-use + finally (plist-put info :tool-use tool-use))) + (when (and content (not (or (eq content :null) (string-empty-p content)))) + content))) + +(cl-defmethod gptel--request-data ((backend gptel-ollama) prompts) + "JSON encode PROMPTS for sending to Ollama." + (when gptel--system-message + (push (list :role "system" + :content gptel--system-message) + prompts)) + (let* ((prompts-plist + (gptel--merge-plists + `(:model ,(gptel--model-name gptel-model) + :messages [,@prompts] + :stream ,(or gptel-stream :json-false) + ,@(and gptel--schema + `(:format ,(gptel--preprocess-schema + (gptel--dispatch-schema-type gptel--schema))))) + gptel--request-params + (gptel-backend-request-params gptel-backend) + (gptel--model-request-params gptel-model))) + ;; the initial options (if any) from request params + (options-plist (plist-get prompts-plist :options))) + + (when (and gptel-use-tools gptel-tools) + ;; TODO(tool): Find out how to force tool use for Ollama + (plist-put prompts-plist :tools + (gptel--parse-tools backend gptel-tools))) + ;; if the temperature and max-tokens aren't set as + ;; backend/model-specific, use the global settings + (when (and gptel-temperature (not (plist-get options-plist :temperature))) + (setq options-plist + (plist-put options-plist :temperature gptel-temperature))) + (when (and gptel-max-tokens (not (plist-get options-plist :num_predict))) + (setq options-plist + (plist-put options-plist :num_predict gptel-max-tokens))) + (plist-put prompts-plist :options options-plist))) + +;; NOTE: No `gptel--parse-tools' method required for gptel-ollama, since this is +;; handled by its defgeneric implementation + +(cl-defmethod gptel--parse-tool-results ((_backend gptel-ollama) tool-use) + "Return a prompt containing tool call results in TOOL-USE." + (mapcar (lambda (tool-call) + (list :role "tool" :content (plist-get tool-call :result))) + tool-use)) + +;; NOTE: No `gptel--inject-prompt' method required for gptel-ollama, since this is +;; handled by its defgeneric implementation + +(cl-defmethod gptel--inject-tool-call ((_backend gptel-ollama) data tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +BACKEND is the `gptel-backend'. See the generic function documentation +for details. This implementation handles the Ollama API." + ;; FIXME: We currently assume that the tool call being modified is in the last + ;; position in the messages array. + (if-let* ((messages (plist-get data :messages)) + (entry (aref messages (1- (length messages)))) + (calls (plist-get entry :tool_calls)) + (indexed-call + (cl-loop with name = (plist-get tool-call :name) + with old-args = (plist-get tool-call :args) + for chunk across calls + for i upfrom 0 + for function = (plist-get chunk :function) + if (and (equal (plist-get function :name) name) + (equal (plist-get function :arguments) old-args)) + return (cons i function) end + finally return nil)) + (index (car indexed-call)) + (call (cdr indexed-call))) + (if (null new-call) + (if (= (length calls) 1) + (plist-put data :messages (substring messages nil -1)) + (plist-put entry :tool_calls + (vconcat (substring calls 0 index) + (substring calls (1+ index))))) + (when-let* ((args (plist-get new-call :args))) + (plist-put call :arguments args)) + (when-let* ((name (plist-get new-call :name))) + (plist-put call :name name))) + (display-warning + '(gptel tool-call) + (format "Could not inject updated tool-call arguments for tool call %s, %s" + (plist-get tool-call :name) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))) + +(cl-defmethod gptel--parse-list ((backend gptel-ollama) prompt-list) + (if (consp (car prompt-list)) + (let ((full-prompt)) ; Advanced format, list of lists + (dolist (entry prompt-list) + (pcase entry + (`(prompt . ,msg) + (push (list :role "user" :content (or (car-safe msg) msg)) + full-prompt)) + (`(response . ,msg) + (push (list :role "assistant" :content (or (car-safe msg) msg)) + full-prompt)) + (`(tool . ,call) + (push (list :role "assistant" + :content "" + :tool_calls `[(:function (:name ,(plist-get call :name) + :arguments ,(plist-get call :args)))]) + full-prompt) + (push (car (gptel--parse-tool-results backend (list (cdr entry)))) + full-prompt)))) + (nreverse full-prompt)) + (cl-loop for text in prompt-list ; Simple format, list of strings + for role = t then (not role) + if text collect + (list :role (if role "user" "assistant") :content text)))) + +(cl-defmethod gptel--parse-buffer ((backend gptel-ollama) &optional max-entries) + (let ((prompts) (prev-pt (point))) + (if (or gptel-mode gptel-track-response) + (while (and (or (not max-entries) (>= max-entries 0)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min))) + (not (= (point) prev-pt))) + (pcase (get-char-property (point) 'gptel) + ('response + (when-let* ((content (gptel--trim-prefixes + (buffer-substring-no-properties (point) prev-pt)))) + (push (list :role "assistant" :content content) prompts))) + (`(tool . ,_id) + (save-excursion + (condition-case nil + (let* ((tool-call (read (current-buffer))) + (name (plist-get tool-call :name)) + (arguments (plist-get tool-call :args))) + (plist-put tool-call :result + (string-trim (buffer-substring-no-properties + (point) prev-pt))) + (push (car (gptel--parse-tool-results backend (list tool-call))) + prompts) + (push (list :role "assistant" + :content "" + :tool_calls `[(:function (:name ,name :arguments ,arguments))]) + prompts)) + ((end-of-file invalid-read-syntax) + (message (format "Could not parse tool-call on line %s" + (line-number-at-pos (point)))))))) + ('ignore) + ('nil + (if gptel-track-media + (when-let* ((content (gptel--ollama-parse-multipart + (gptel--parse-media-links major-mode (point) prev-pt)))) + (when (> (length content) 0) + (push (append '(:role "user") content) prompts))) + (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties + (point) prev-pt)))) + (push (list :role "user" :content content) prompts))))) + (setq prev-pt (point)) + (and max-entries (cl-decf max-entries))) + (let ((content (string-trim (buffer-substring-no-properties + (point-min) (point-max))))) + (push (list :role "user" :content content) prompts))) + prompts)) + +(defun gptel--ollama-parse-multipart (parts) + "Convert a multipart prompt PARTS to the Ollama API format. + +The input is an alist of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")). + +The output is a vector of entries in a backend-appropriate +format." + (cl-loop + for part in parts + for n upfrom 1 + with last = (length parts) + for text = (plist-get part :text) + for media = (plist-get part :media) + if text do + (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) and + if text + collect text into text-array end + else if media + collect (gptel--base64-encode media) into media-array + else if (plist-get part :textfile) + collect + (with-temp-buffer + (gptel--insert-file-string (plist-get part :textfile)) + (buffer-string)) + into text-array + finally return + `(,@(and text-array (list :content (mapconcat #'identity text-array " "))) + ,@(and media-array (list :images (vconcat media-array)))))) + +(cl-defmethod gptel--inject-media ((_backend gptel-ollama) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media)) + (media-processed (gptel--ollama-parse-multipart media-list))) + (cl-callf (lambda (images) + (vconcat (plist-get media-processed :images) + images)) + (plist-get (car prompts) :images)))) + +;;;###autoload +(cl-defun gptel-make-ollama + (name &key curl-args header key models stream request-params + (host "localhost:11434") + (protocol "http") + (endpoint "/api/chat")) + "Register an Ollama backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is where Ollama runs (with port), defaults to localhost:11434 + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +Currently recognized plist keys are :description, :capabilities +and :mime-types. An example of a model specification including +both kinds of specs: + +:models +\\='(mistral:latest ;Simple specs + openhermes:latest + (llava:13b ;Full spec + :description + \"Llava 1.6: Large Lanuage and Vision Assistant\" + :capabilities (media) + :mime-types (\"image/jpeg\" \"image/png\"))) + + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, http by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/api/generate\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. This is typically not required +for local models like Ollama. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + + (gptel-make-ollama + \"Ollama\" + :host \"localhost:11434\" + :models \\='(mistral:latest) + :stream t)" + (declare (indent 1)) + (let ((backend (gptel--make-ollama + :curl-args curl-args + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +(provide 'gptel-ollama) +;;; gptel-ollama.el ends here + + diff --git a/elpa/gptel-20260425.846/gptel-openai-extras.el b/elpa/gptel-20260425.846/gptel-openai-extras.el new file mode 100644 index 00000000..b5fad51f --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-openai-extras.el @@ -0,0 +1,452 @@ +;;; gptel-openai-extras.el --- Extensions to the OpenAI API -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Authors: Karthik Chikmagalur and pirminj + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file adds support for Privategpt's Messages API and +;; Perplexity's Citations feature to gptel + +;;; Code: +(require 'cl-generic) +(eval-when-compile (require 'cl-lib)) +(require 'map) +(eval-and-compile + (require 'gptel-request) + (require 'gptel-openai)) + +(defvar json-object-type) + +(declare-function prop-match-value "text-property-search") +(declare-function text-property-search-backward "text-property-search") +(declare-function json-read "json" ()) + + + +;;; Privategpt (Messages API) +(cl-defstruct (gptel-privategpt (:constructor gptel--make-privategpt) + (:copier nil) + (:include gptel-openai)) + context sources) + +(defun gptel--privategpt-parse-sources (response) + (cl-loop with source-alist + for source across (map-nested-elt response '(:choices 0 :sources)) + for name = (map-nested-elt source '(:document :doc_metadata :file_name)) + for page = (map-nested-elt source '(:document :doc_metadata :page_label)) + do (push page (alist-get name source-alist nil nil #'equal)) + finally return + (cl-loop for (file-name . file-pages) in source-alist + for pages = (delete-dups (delq nil file-pages)) + if pages + collect (format "- %s (page %s)" file-name (mapconcat #'identity pages ", ")) + into source-items + else collect (format "- %s" file-name) into source-items + finally return (mapconcat #'identity (cons "\n\nSources:" source-items) "\n")))) + +;; FIXME(tool) add tool use +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-privategpt) info) + (let* ((content-strs)) + (condition-case nil + (while (re-search-forward "^data:" nil t) + (save-match-data + (if (looking-at " *\\[DONE\\]") + (when-let* ((sources-string (plist-get info :sources))) + (push sources-string content-strs)) + (let ((response (gptel--json-read))) + (unless (or (plist-get info :sources) + (not (gptel-privategpt-sources (plist-get info :backend)))) + (plist-put info :sources (gptel--privategpt-parse-sources response))) + (let* ((delta (map-nested-elt response '(:choices 0 :delta))) + (content (plist-get delta :content))) + (push content content-strs)))))) + (error + (goto-char (match-beginning 0)))) + (apply #'concat (nreverse content-strs)))) + +;; FIXME(tool) add tool use +(cl-defmethod gptel--parse-response ((_backend gptel-privategpt) response info) + (let ((response-string (map-nested-elt response '(:choices 0 :message :content))) + (sources-string (and (gptel-privategpt-sources (plist-get info :backend)) + (gptel--privategpt-parse-sources response)))) + (concat response-string sources-string))) + +(cl-defmethod gptel--request-data ((_backend gptel-privategpt) prompts) + "JSON encode PROMPTS for sending to ChatGPT." + (let ((prompts-plist + `(:model ,(gptel--model-name gptel-model) + :messages [,@prompts] + :use_context ,(or (gptel-privategpt-context gptel-backend) :json-false) + :include_sources ,(or (gptel-privategpt-sources gptel-backend) :json-false) + :stream ,(or gptel-stream :json-false)))) + (when (and gptel--system-message + (not (gptel--model-capable-p 'nosystem))) + (plist-put prompts-plist :system gptel--system-message)) + (when gptel-temperature + (plist-put prompts-plist :temperature gptel-temperature)) + (when gptel-max-tokens + (plist-put prompts-plist :max_tokens gptel-max-tokens)) + ;; Merge request params with model and backend params. + (gptel--merge-plists + prompts-plist + (gptel-backend-request-params gptel-backend) + (gptel--model-request-params gptel-model)))) + + +;;;###autoload +(cl-defun gptel-make-privategpt + (name &key curl-args stream key request-params + (header + (lambda (_info) + (when-let* ((key (gptel--get-api-key))) + `(("Authorization" . ,(concat "Bearer " key)))))) + (host "localhost:8001") + (protocol "http") + (models '(private-gpt)) + (endpoint "/v1/chat/completions") + (context t) (sources t)) + "Register an Privategpt API-compatible backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, \"api.privategpt.com\" by default. + +MODELS is a list of available model names. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/messages\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: +((\"Content-Type\" . \"application/json\")) + +KEY is a variable whose value is the API key, or function that +returns the key. + +CONTEXT and SOURCES: if true (the default), use available context +and provide sources used by the model to generate the response. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for." + (declare (indent 1)) + (let ((backend (gptel--make-privategpt + :curl-args curl-args + :name name + :host host + :header header + :key key + :models models + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint)) + :context context + :sources sources))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + + +;;; Perplexity +(cl-defstruct (gptel-perplexity (:constructor gptel--make-perplexity) + (:copier nil) + (:include gptel-openai))) + +(defsubst gptel--perplexity-parse-citations (citations) + (let ((counter 0)) + (concat "\n\nCitations:\n" + (mapconcat (lambda (url) + (setq counter (1+ counter)) + (format "[%d] %s" counter url)) + citations "\n")))) + +(cl-defmethod gptel--parse-response ((_backend gptel-perplexity) response _info) + "Parse Perplexity response RESPONSE." + (let ((response-string (cl-call-next-method)) + (citations-string (when-let* ((citations (map-elt response :citations))) + (gptel--perplexity-parse-citations citations)))) + (concat response-string citations-string))) + +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-perplexity) info) + "Parse a Perplexity API data stream with INFO. + +If available, collect citations at the end and include them with +the response." + (let ((resp (cl-call-next-method))) + (unless (plist-get info :citations) + (save-excursion + (goto-char (point-max)) + (when (search-backward (plist-get info :uuid) + (line-beginning-position) t) + (forward-line 0) + (when (re-search-backward "^data: " nil t) + (goto-char (match-end 0)) + (ignore-errors + (when-let* ((chunk (gptel--json-read)) + (citations (map-elt chunk :citations))) + (plist-put info :citations t) + (setq resp (concat resp (gptel--perplexity-parse-citations + citations))))))))) + resp)) + +;;;###autoload +(cl-defun gptel-make-perplexity + (name &key curl-args stream key + (header + (lambda (_info) + (when-let* ((key (gptel--get-api-key))) + `(("Authorization" . ,(concat "Bearer " key)))))) + (host "api.perplexity.ai") + (protocol "https") + ;; https://docs.perplexity.ai/guides/model-cards + (models '(sonar sonar-pro sonar-reasoning sonar-reasoning-pro sonar-deep-research)) + (endpoint "/chat/completions") + request-params) + "Register a Perplexity backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, \"api.perplexity.ai\" by default. + +MODELS is a list of available model names. + +STREAM is a boolean to toggle streaming responses. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions. + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist. + +KEY is a variable whose value is the API key, or function that +returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters." + (declare (indent 1)) + (let ((backend (gptel--make-perplexity + :curl-args curl-args + :name name + :host host + :header header + :key key + :models models + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +;;; Deepseek +(cl-defstruct (gptel-deepseek (:include gptel-openai) + (:copier nil) + (:constructor gptel--make-deepseek))) + +(cl-defmethod gptel--parse-buffer :around ((_backend gptel-deepseek) _max-entries) + "Merge successive prompts in the prompts list that have the same role. + +The Deepseek API requires strictly alternating roles (user/assistant) in messages." + (let* ((prompts (cl-call-next-method)) + (index prompts)) + (prog1 prompts + (while index + (let ((p1 (car index)) + (p2 (cadr index)) + (rest (cdr index))) + (when (and p2 (equal (plist-get p1 :role) + (plist-get p2 :role))) + ;; Blocks to be merged must both be text blocks + ;; and not tool calls + (when-let* ((content1 (plist-get p1 :content)) + (content2 (plist-get p2 :content))) + (plist-put p1 :content + (concat content1 "\n" content2)) + (setcdr index (cdr rest)))) + (setq index (cdr index))))))) + +;;;###autoload +(cl-defun gptel-make-deepseek + (name &key curl-args stream key request-params + (header (lambda (_info) + (when-let* ((key (gptel--get-api-key))) + `(("Authorization" . ,(concat "Bearer " key)))))) + (host "api.deepseek.com") + (protocol "https") + (endpoint "/v1/chat/completions") + (models '((deepseek-reasoner + :capabilities (tool reasoning) + :context-window 128 + :input-cost 0.28 + :output-cost 0.42) + (deepseek-chat + :capabilities (tool) + :context-window 128 + :input-cost 0.28 + :output-cost 0.42)))) + "Register a DeepSeek backend for gptel with NAME. + +For the meanings of the keyword arguments, see `gptel-make-openai'." + (declare (indent 1)) + (let ((backend (gptel--make-deepseek + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :curl-args curl-args + :url (concat protocol "://" host endpoint)))) + (setf (alist-get name gptel--known-backends nil nil #'equal) backend) + backend)) + +;;; xAI +;;;###autoload +(cl-defun gptel-make-xai + (name &key curl-args stream key request-params + (header (lambda (_info) + (when-let* ((key (gptel--get-api-key))) + `(("Authorization" . ,(concat "Bearer " key)))))) + (host "api.x.ai") + (protocol "https") + (endpoint "/v1/chat/completions") + (models + '((grok-4-1-fast-reasoning + :description "Fast tool-calling model" + :capabilities (tool-use json reasoning) + :context-window 2000 + :input-cost 0.2 + :output-cost 0.5) + + (grok-4-1-fast-non-reasoning + :description "Fast tool-calling model (non-reasoning)" + :capabilities (tool-use json) + :context-window 2000 + :input-cost 0.2 + :output-cost 0.5) + + (grok-code-fast-1 + :description "Fast reasoning model for agentic coding" + :capabilities (tool-use json reasoning) + :context-window 256 + :input-cost 0.2 + :output-cost 1.5) + + (grok-4-fast-reasoning + :description "Fast tool-calling model" + :capabilities (tool-use json reasoning) + :context-window 2000 + :input-cost 0.2 + :output-cost 0.5) + + (grok-4-fast-non-reasoning + :description "Fast tool-calling model (non-reasoning)" + :capabilities (tool-use json) + :context-window 2000 + :input-cost 0.2 + :output-cost 0.5) + + (grok-4 + :description "Grok Flagship model" + :capabilities (tool-use json reasoning) + :context-window 256 + :input-cost 3 + :output-cost 15) + + (grok-3-mini + :description "Mini Grok 3" + :capabilities (tool-use json reasoning) + :context-window 131 + :input-cost 0.3 + :output-cost 0.5) + + (grok-3 + :description "Grok 3" + :capabilities (tool-use json reasoning) + :context-window 131 + :input-cost 3 + :output-cost 15) + + (grok-2-vision-1212 + :description "Grok 2 Vision" + :capabilities (tool-use json media) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 32 + :input-cost 2 + :output-cost 10)))) + "Register an xAI backend for gptel with NAME. + +Keyword arguments: + +KEY is a variable whose value is the API key, or function that +returns the key. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +The other keyword arguments are all optional. For their meanings +see `gptel-make-openai'." + (declare (indent 1)) + (let ((backend (gptel--make-deepseek + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :curl-args curl-args + :url (concat protocol "://" host endpoint)))) + (setf (alist-get name gptel--known-backends nil nil #'equal) backend) + backend)) + + +(provide 'gptel-openai-extras) +;;; gptel-openai-extras.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-openai-responses.el b/elpa/gptel-20260425.846/gptel-openai-responses.el new file mode 100644 index 00000000..e2f73aa4 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-openai-responses.el @@ -0,0 +1,602 @@ +;;; gptel-openai-responses.el --- Responses API support for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur +;; Keywords: comm + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: +(require 'cl-generic) +(require 'cl-lib) +(require 'map) +(require 'gptel-request) +(require 'gptel-openai) + +(defvar gptel-mode) +(declare-function gptel-context--collect-media "gptel-context") + +;;; OpenAI Responses +(defun gptel--openai-responses-update-tokens (usage info) + "Update token usage information from USAGE. +USAGE is part of the response, INFO is the request plist." + (when usage + (let* ((tokens (plist-get info :tokens)) + (input (+ (or (plist-get usage :input_tokens) 0) + (or (plist-get tokens :input) 0))) + (output (+ (or (plist-get usage :output_tokens) 0) + (or (plist-get tokens :output) 0))) + (cached (+ (or (map-nested-elt + usage '(:input_tokens_details :cached_tokens)) + 0) + (or (plist-get tokens :cached) 0)))) + (list :input input :output output :cached cached)))) + +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-openai-responses) info) + "Parse an OpenAI Responses API data stream. + +Return the text response accumulated since the last call to this +function. Additionally, mutate state INFO to add tool-use +information if the stream contains it." + (let ((content-strs) wait) + (condition-case nil + (while (and (not wait) (re-search-forward "^event: *\\(.+\\)" nil t)) + (let ((event-type (match-string 1)) data) + (forward-line 1) + (if (not (looking-at "data:" t)) + (progn (goto-char (match-beginning 0)) ;not enough data, reset + (setq wait t)) + (forward-char 5) + (setq data (gptel--json-read)) + (pcase event-type + ;; Text content delta + ("response.output_text.delta" + (when-let* ((delta (plist-get data :delta)) + ((not (string-empty-p delta)))) + (push delta content-strs))) + ;; Function call arguments delta + ("response.function_call_arguments.delta" + (when-let* ((delta (plist-get data :delta))) + (plist-put info :partial_json + (cons delta (plist-get info :partial_json))))) + ;; Function call completed (user-defined tools) + ("response.output_item.done" + (when-let* ((item (plist-get data :item)) + ((equal (plist-get item :type) "function_call")) + (tool-call + (list :id (plist-get item :call_id) + :name (plist-get item :name) + :args (ignore-errors + (gptel--json-read-string + (plist-get item :arguments)))))) + (plist-put info :tool-use + (cons tool-call (plist-get info :tool-use))) + (plist-put info :partial_json nil))) + ;; Reasoning content + ((or "response.reasoning_summary_text.delta" + "response.reasoning.delta") + (when-let* ((delta (plist-get data :delta))) + (plist-put info :reasoning + (concat (plist-get info :reasoning) delta)))) + ((or "response.reasoning_summary_text.done" + "response.reasoning.done") + (plist-put info :reasoning-block t)) + ;; NOTE: backend tools are not supported in gptel yet, this + ;; parsing is for the future + ;; Web search completed (server-side tool) + ("response.web_search_call.completed" + (push "\n[Web search completed]" content-strs)) + ;; Code interpreter output (server-side tool) + ("response.code_interpreter_call.completed" + (when-let* ((item (plist-get data :item)) + (results (plist-get item :results))) + (cl-loop + for result across results + if (equal (plist-get result :type) "logs") + do (push (format "\n```\n%s\n```" (plist-get result :logs)) + content-strs)))) + ;; Response completed + ("response.completed" + (when-let* ((tool-use (plist-get info :tool-use))) + ;; Inject tool calls into prompt data for continuation + ;; TODO(responses-api) Avoid re-encoding these tool calls, + ;; especially :arguments + (gptel--inject-prompt + (plist-get info :backend) (plist-get info :data) + (mapcar (lambda (tc) + (list :type "function_call" + :call_id (plist-get tc :id) + :name (plist-get tc :name) + :arguments + (gptel--json-encode (plist-get tc :args)))) + tool-use))) + (when-let* ((resp (plist-get data :response))) + (plist-put info :stop-reason (plist-get resp :status)) + (plist-put info :tokens (gptel--openai-responses-update-tokens + (plist-get resp :usage) info)))))))) + (error (goto-char (match-beginning 0)))) + (apply #'concat (nreverse content-strs)))) + +(cl-defmethod gptel--parse-response ((_backend gptel-openai-responses) response info) + "Parse an OpenAI Responses API RESPONSE and return response text. +Mutate state INFO with response metadata." + (let ((output-items (plist-get response :output)) + (content-strs) (tool-use) (tool-calls)) + ;; Store usage info + (plist-put info :stop-reason (plist-get response :status)) + (plist-put info :tokens (gptel--openai-responses-update-tokens + (plist-get response :usage) info)) + ;; Process output items + (cl-loop + for item across output-items + for item-type = (plist-get item :type) + do + (pcase item-type + ;; Text message output + ("message" + (when-let* ((content (plist-get item :content))) + (cl-loop + for part across content + for part-type = (plist-get part :type) + if (equal part-type "output_text") + do (push (plist-get part :text) content-strs) + else if (equal part-type "refusal") + do (push (format "[Refused: %s]" (plist-get part :refusal)) + content-strs)))) + ;; Function call from model (user-defined tools) + ("function_call" + (push item tool-calls) + (push (list :id (plist-get item :call_id) + :name (plist-get item :name) + :args (ignore-errors + (gptel--json-read-string + (plist-get item :arguments)))) + tool-use)) + ;; Reasoning summary + ("reasoning" + (cl-loop with summary = (plist-get item :summary) + with content = (plist-get item :content) + for s across + (if (length= content 0) summary content) + collect (plist-get s :text) into reasoning + finally do + (plist-put info :reasoning (apply #'concat reasoning)))) + ;; Web search results (server-side tool) + ("web_search_call" + (when-let* ((status (plist-get item :status)) + ((equal status "completed"))) + ;; Results are inline, just note that search was done + (push "\n[Web search completed]" content-strs))) + ;; Code interpreter output (server-side tool) + ("code_interpreter_call" + (when-let* ((status (plist-get item :status)) + ((equal status "completed")) + (results (plist-get item :results))) + (cl-loop + for result across results + for result-type = (plist-get result :type) + if (equal result-type "logs") + do (push (format "\n```\n%s\n```" (plist-get result :logs)) + content-strs)))) + ;; File search results (server-side tool) + ("file_search_call" + (when-let* ((status (plist-get item :status)) + ((equal status "completed")) + (results (plist-get item :results))) + (push (format "\n[File search: %d results]" (length results)) + content-strs))))) + ;; Store tool calls for user-defined function tools + (when tool-use + (plist-put info :tool-use (nreverse tool-use)) + ;; Inject into prompts for conversation continuity + (gptel--inject-prompt + (plist-get info :backend) (plist-get info :data) + (nreverse tool-calls))) + ;; Return concatenated content + (when content-strs + (apply #'concat (nreverse content-strs))))) + +(cl-defmethod gptel--request-data ((backend gptel-openai-responses) prompts) + "JSON encode PROMPTS for sending to OpenAI Responses API." + (let ((prompts-plist + `( :model ,(gptel--model-name gptel-model) + :input ,(vconcat prompts) + ;; Stateless: don't store responses server-side, don't use + ;; previous_response_id. Each request contains full context. + :store :json-false + :stream ,(or gptel-stream :json-false))) + (o-model-p (memq gptel-model '(o1 o1-preview o1-mini o3-mini o3 o4-mini)))) + ;; System message becomes instructions + (when gptel--system-message + (plist-put prompts-plist :instructions gptel--system-message)) + ;; Temperature + (when (and gptel-temperature (not o-model-p)) + (plist-put prompts-plist :temperature gptel-temperature)) + ;; Max tokens + (when gptel-max-tokens + (plist-put prompts-plist :max_output_tokens gptel-max-tokens)) + (when gptel-use-tools + (let ((tools-array + (vconcat + (when gptel-tools + (gptel--parse-tools backend gptel-tools))))) + (when (> (length tools-array) 0) + (plist-put prompts-plist :tools tools-array)) + (when (eq gptel-use-tools 'force) + (plist-put prompts-plist :tool_choice "required")))) + ;; Structured output via text format + (when gptel--schema + (plist-put prompts-plist :text + (list :format + (list :type "json_schema" + :name (md5 (format "%s" (random))) + :schema (gptel--preprocess-schema + (gptel--dispatch-schema-type gptel--schema)) + :strict t)))) + ;; Merge request params + (gptel--merge-plists + prompts-plist + gptel--request-params + (gptel-backend-request-params gptel-backend) + (gptel--model-request-params gptel-model)))) + +;; Helper functions for Responses API format conversion + +(cl-defmethod gptel--parse-schema ((_backend gptel-openai-responses) schema) + "Parse SCHEMA for Responses API structured output. +In Responses API, the schema format uses text.format instead of response_format." + (list :type "json_schema" + :name (md5 (format "%s" (random))) + :schema (gptel--preprocess-schema + (gptel--dispatch-schema-type schema)) + :strict t)) + +(cl-defmethod gptel--parse-tools ((_backend gptel-openai-responses) tools) + "Parse TOOLS and return a list of prompts. + +TOOLS is a list of `gptel-tool' structs, which see. + +_BACKEND is the LLM backend in use. This is the default +implementation, used by OpenAI-compatible APIs and Ollama." + (vconcat + (mapcar + (lambda (tool) + (nconc + (list + :type "function" + :name (gptel-tool-name tool) + :description (gptel-tool-description tool)) + (if (gptel-tool-args tool) + (list + :parameters + (list :type "object" + ;; gptel's tool args spec is close to the JSON schema, except + ;; that we use (:name "argname" ...) + ;; instead of (:argname (...)), and + ;; (:optional t) for each arg instead of (:required [...]) + ;; for all args at once. Handle this difference by + ;; modifying a copy of the gptel tool arg spec. + :properties + (cl-loop + for arg in (gptel-tool-args tool) + for argspec = (copy-sequence arg) + for name = (plist-get arg :name) ;handled differently + for newname = (or (and (keywordp name) name) + (make-symbol (concat ":" name))) + do ;ARGSPEC is ARG without unrecognized keys + (cl-remf argspec :name) + (cl-remf argspec :optional) + if (equal (plist-get arg :type) "object") + do (unless (plist-member argspec :required) + (plist-put argspec :required [])) + (plist-put argspec :additionalProperties :json-false) + append (list newname argspec)) + :required + (vconcat + (delq nil (mapcar + (lambda (arg) (and (not (plist-get arg :optional)) + (plist-get arg :name))) + (gptel-tool-args tool)))) + :additionalProperties :json-false)) + (list :parameters (list :type "object" :properties nil))))) + (ensure-list tools)))) + +(cl-defmethod gptel--inject-tool-call ((_backend gptel-openai-responses) data tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +BACKEND is the `gptel-backend'. See the generic function documentation +for details. This implementation handles the OpenAI Responses API." + (if-let* ((input (plist-get data :input)) + (indexed-call + (cl-loop for item across input + for i upfrom 0 + if (and (equal (plist-get item :type) "function_call") + (equal (plist-get item :call_id) (plist-get tool-call :id))) + return (cons i item))) + (index (car indexed-call)) + (call (cdr indexed-call))) + (if (null new-call) ;delete tool call if new-call is nil + (plist-put data :input (vconcat (substring input 0 index) + (substring input (1+ index)))) + (progn + (when-let* ((args (plist-get new-call :args))) + (plist-put call :arguments (gptel--json-encode args))) + (when-let* ((name (plist-get new-call :name))) + (plist-put call :name name)))) + (display-warning + '(gptel tool-call) + (format "Could not inject updated tool-call arguments for tool call %s, %s" + (plist-get tool-call :name) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))) + +(cl-defmethod gptel--parse-tool-results ((_backend gptel-openai-responses) tool-use) + "Format TOOL-USE results for Responses API. +Returns prompts in Responses API format with function_call_output items." + (mapcar + (lambda (tool-call) + (list + :type "function_call_output" + :call_id (plist-get tool-call :id) + :output (plist-get tool-call :result))) + tool-use)) + +(cl-defmethod gptel--inject-prompt + ((_backend gptel-openai-responses) data new-prompt &optional position) + "Inject NEW-PROMPT into existing prompts in query DATA. + +NEW-PROMPT can be a single message or a list of messages. + +If POSITION is +- nil, append NEW-PROMPT at the end of DATA +- a non-negative integer, insert it at that position in DATA. +- a negative integer, insert it there counting from the end." + (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many? + (setq new-prompt (list new-prompt))) + (let ((prompts (plist-get data :input))) + (pcase position + ('nil (plist-put data :input (vconcat prompts new-prompt))) + ((pred integerp) + (when (< position 0) (setq position (+ (length prompts) position))) + (plist-put data :input (vconcat (substring prompts 0 position) + new-prompt + (substring prompts position))))))) + +(cl-defmethod gptel--parse-list ((backend gptel-openai-responses) prompt-list) + (if (consp (car prompt-list)) + (let ((full-prompt)) ; Advanced format, list of lists + (dolist (entry prompt-list) + (pcase entry + (`(prompt . ,msg) + (push (list :role "user" :content (or (car-safe msg) msg)) full-prompt)) + (`(response . ,msg) + (push (list :role "assistant" :content (or (car-safe msg) msg)) full-prompt)) + (`(tool . ,call) + (unless (plist-get call :id) + (plist-put call :id (gptel--openai-format-tool-id nil))) + (push + (list :type "function_call" + :call_id (plist-get call :id) + :name (plist-get call :name) + :arguments (decode-coding-string + (gptel--json-encode (plist-get call :args)) + 'utf-8 t)) + full-prompt) + (push (car (gptel--parse-tool-results backend (list (cdr entry)))) full-prompt)))) + (nreverse full-prompt)) + (cl-loop for text in prompt-list ; Simple format, list of strings + for role = t then (not role) + if text collect + (list :role (if role "user" "assistant") :content text)))) + +(cl-defmethod gptel--parse-buffer ((backend gptel-openai-responses) &optional max-entries) + (let ((prompts) (prev-pt (point))) + (if (or gptel-mode gptel-track-response) + (while (and (or (not max-entries) (>= max-entries 0)) + (/= prev-pt (point-min)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min)))) + (pcase (get-char-property (point) 'gptel) + ('response + (when-let* ((content (gptel--trim-prefixes + (buffer-substring-no-properties (point) prev-pt)))) + (push (list :role "assistant" :content content) prompts))) + (`(tool . ,id) + (save-excursion + (condition-case nil + (let* ((tool-call (read (current-buffer))) + (name (plist-get tool-call :name)) + (arguments (decode-coding-string + (gptel--json-encode (plist-get tool-call :args)) + 'utf-8 t))) + (setq id (gptel--openai-format-tool-id id)) + (plist-put tool-call :id id) + (plist-put tool-call :result + (string-trim (buffer-substring-no-properties + (point) prev-pt))) + (push (car (gptel--parse-tool-results backend (list tool-call))) + prompts) + (push (list :type "function_call" + :call_id id + :name name + :arguments arguments) + prompts)) + ((end-of-file invalid-read-syntax) + (message (format "Could not parse tool-call %s on line %s" + id (line-number-at-pos (point)))))))) + ('ignore) + ('nil + (and max-entries (cl-decf max-entries)) + (if gptel-track-media + (when-let* ((content (gptel--openai-responses-parse-multipart + (gptel--parse-media-links major-mode + (point) prev-pt)))) + (when (> (length content) 0) + (push (list :role "user" :content content) prompts))) + (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties + (point) prev-pt)))) + (push (list :role "user" :content content) prompts))))) + (setq prev-pt (point))) + (let ((content (string-trim (buffer-substring-no-properties + (point-min) (point-max))))) + (push (list :role "user" :content content) prompts))) + prompts)) + +(defun gptel--openai-responses-parse-multipart (parts) + "Convert a multipart prompt PARTS to the OpenAI API format. + +The input is an alist of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")). + +The output is a vector of entries in a backend-appropriate +format." + (cl-loop + for part in parts + for n upfrom 1 + with last = (length parts) + for text = (plist-get part :text) + for media = (plist-get part :media) + if text do + (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) + and if text + collect `(:type "input_text" :text ,text) into parts-array end + else if media collect + `(:type "input_image" + :image_url ,(concat "data:" (plist-get part :mime) + ";base64," (gptel--base64-encode media))) + into parts-array + else if (plist-get part :textfile) collect + `(:type "input_text" + :text ,(with-temp-buffer + (gptel--insert-file-string (plist-get part :textfile)) + (buffer-string))) + into parts-array end and + if (plist-get part :url) + collect + `(:type "input_image" + :image_url ,(plist-get part :url)) + into parts-array + finally return (vconcat parts-array))) + +(cl-defmethod gptel--inject-media ((_backend gptel-openai-responses) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) + (cl-callf (lambda (current) + (vconcat + (gptel--openai-responses-parse-multipart media-list) + (cl-typecase current + (string `((:type "input_text" :text ,current))) + (vector current) + (t current)))) + (plist-get (car prompts) :content)))) + +;;;###autoload +(cl-defun gptel-make-openai-responses + (name &key curl-args (models gptel--openai-models) + stream key request-params + (header + (lambda (_info) (when-let* ((key (gptel--get-api-key))) + `(("Authorization" . ,(concat "Bearer " key)))))) + (host "api.openai.com") + (protocol "https") + (endpoint "/v1/responses")) + "Register an OpenAI Responses API backend for gptel with NAME. + +The Responses API is OpenAI's new API for agentic applications that +provides built-in tools like web search, code interpreter, and file +search. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, typically \"api.openai.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--openai-models'. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/responses\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + + (gptel-make-openai-responses + \"OpenAI-Responses\" + :stream t + :models '((gpt-4o + :capabilities (media tool-use json url responses-api) + :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\")) + (gpt-4o-mini + :capabilities (media tool-use json url responses-api) + :mime-types (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))))" + (declare (indent 1)) + (let ((backend (gptel--make-openai-responses + :curl-args curl-args + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +(provide 'gptel-openai-responses) +;;; gptel-openai-responses.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-openai.el b/elpa/gptel-20260425.846/gptel-openai.el new file mode 100644 index 00000000..86151d67 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-openai.el @@ -0,0 +1,917 @@ +;;; gptel-openai.el --- ChatGPT suppport for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur + +;; 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: + +;; This file adds support for the ChatGPT API to gptel + +;;; Code: +(require 'cl-generic) +(eval-when-compile (require 'cl-lib)) +(require 'map) +(eval-and-compile (require 'gptel-request)) + +(defvar json-object-type) +(defvar gptel-mode) +(declare-function gptel-context--collect-media "gptel-context") +(declare-function json-read "json") +(declare-function gptel-context--wrap "gptel-context") + +;; OpenAI Completions Backend +(cl-defstruct (gptel-openai (:constructor gptel--make-openai) + (:copier nil) + (:include gptel-backend))) + +;; OpenAI Responses Backend +(cl-defstruct (gptel-openai-responses (:constructor gptel--make-openai-responses) + (:copier nil) + (:include gptel-backend))) + + +(defun gptel--openai-update-tokens (usage info) + "Update token usage information from USAGE. +USAGE is part of the response, INFO is the request plist. + +This function accumulates token counts across multiple turns in a +multi-turn request (e.g., during tool use where results are fed +back to the LLM)." + (when usage + (let* ((tokens (plist-get info :tokens)) + (input (+ (or (plist-get usage :prompt_tokens) 0) + (or (plist-get tokens :input) 0))) + (output (+ (or (plist-get usage :completion_tokens) 0) + (or (plist-get tokens :output) 0))) + (cached (+ (or (map-nested-elt + usage '(:prompt_tokens_details :cached_tokens)) + 0) + (or (plist-get tokens :cached) 0))) + (cache (+ (or (plist-get usage :prompt_cache_hit_tokens) 0) + (or (plist-get tokens :cache) 0)))) + (list :input input :output output + :cache cache :cached cached)))) + +;; How the following function works: +;; +;; The OpenAI API returns a stream of data chunks. Each data chunk has a +;; component that can be parsed as JSON. Besides metadata, each chunk has +;; either some text or part of a tool call. +;; +;; If we find text, we collect it in a list, concat them at the end and return +;; it. +;; +;; If we find part of a tool call, we begin collecting the pieces in +;; INFO -> :tool-use. +;; +;; Tool call arguments are themselves JSON encoded strings can be spread across +;; chunks. We collect them in INFO -> :partial_json. The end of a tool call +;; chunk is marked by the beginning of another, or by the end of the stream. In +;; either case we flaten the :partial_json we have thus far, add it to the tool +;; call spec in :tool-use and reset it. +;; +;; If we find reasoning text, collect it in INFO -> :reasoning, to be consumed +;; by the stream filter (and eventually the callback). We also collect it in +;; INFO -> :reasoning-chunks, in case we need to send it back along with tool +;; call results. +;; +;; Finally we append any tool calls and accumulated reasoning text (from +;; :reasoning-chunks) to the (INFO -> :data -> :messages) list of prompts. + +(cl-defmethod gptel-curl--parse-stream ((_backend gptel-openai) info) + "Parse an OpenAI API data stream. + +Return the text response accumulated since the last call to this +function. Additionally, mutate state INFO to add tool-use +information if the stream contains it." + (let* ((content-strs)) + (condition-case nil + (while (re-search-forward "^data:" nil t) + (save-match-data + (if (looking-at " *\\[DONE\\]") + ;; The stream has ended, so we do the following thing (if we found tool calls) + ;; - pack tool calls into the messages prompts list to send (INFO -> :data -> :messages) + ;; - collect tool calls (formatted differently) into (INFO -> :tool-use) + ;; - Clear any reasoning content chunks we've captured + (progn + (when-let* ((tool-use (plist-get info :tool-use)) + (args (apply #'concat (nreverse (plist-get info :partial_json)))) + (func (plist-get (car tool-use) :function))) + (plist-put func :arguments args) ;Update arguments for last recorded tool + (gptel--inject-prompt + (plist-get info :backend) (plist-get info :data) + `( :role "assistant" :content :null :tool_calls ,(vconcat tool-use) ; :refusal :null + ;; Return reasoning if available + ,@(and-let* ((chunks (nreverse (plist-get info :reasoning-chunks))) + (reasoning-field (pop chunks))) ;chunks is (:reasoning.* "chunk1" "chunk2" ...) + (list reasoning-field (apply #'concat chunks))))) + (cl-loop + for tool-call in tool-use ; Construct the call specs for running the function calls + for spec = (plist-get tool-call :function) + collect (list :id (plist-get tool-call :id) + :name (plist-get spec :name) + :args (ignore-errors (gptel--json-read-string + (plist-get spec :arguments)))) + into call-specs + finally (plist-put info :tool-use call-specs))) + ;; Update token usage if present + (when-let* ((last-resp (save-excursion + (forward-line -1) + (and (re-search-backward "^data:" nil t) + (goto-char (match-end 0)) + (ignore-errors (gptel--json-read))))) + (usage (plist-get last-resp :usage))) + (plist-put info :tokens (gptel--openai-update-tokens usage info))) + (when (plist-member info :reasoning-chunks) (plist-put info :reasoning-chunks nil))) + (when-let* ((response (gptel--json-read)) + (delta (map-nested-elt response '(:choices 0 :delta)))) + (if-let* ((content (plist-get delta :content)) + ((not (or (eq content :null) (string-empty-p content))))) + (push content content-strs) + ;; No text content, so look for tool calls + (when-let* ((tool-call (map-nested-elt delta '(:tool_calls 0))) + (func (plist-get tool-call :function))) + (if (and-let* ((func-name (plist-get func :name)) ((not (eq func-name :null)))) + ;; TEMP: This check is for litellm compatibility, should be removed + (not (equal func-name "null"))) ; new tool block begins + (progn + (when-let* ((partial (plist-get info :partial_json))) + (let* ((prev-tool-call (car (plist-get info :tool-use))) + (prev-func (plist-get prev-tool-call :function))) + (plist-put prev-func :arguments ;update args for old tool block + (apply #'concat (nreverse (plist-get info :partial_json))))) + (plist-put info :partial_json nil)) ;clear out finished chain of partial args + ;; Start new chain of partial argument strings + (plist-put info :partial_json (list (plist-get func :arguments))) + ;; NOTE: Do NOT use `push' for this, it prepends and we lose the reference + (plist-put info :tool-use (cons tool-call (plist-get info :tool-use)))) + ;; old tool block continues, so continue collecting arguments in :partial_json + (push (plist-get func :arguments) (plist-get info :partial_json))))) + ;; Check for reasoning blocks, currently only used by Openrouter + (unless (eq (plist-get info :reasoning-block) 'done) + (if-let* ((reasoning-plist ;reasoning-plist is (:reasoning.* "chunk" ...) or nil + (or (plist-member delta :reasoning) ;for Openrouter and co + (plist-member delta :reasoning_content))) ;for Deepseek, Llama.cpp + (reasoning-chunk (cadr reasoning-plist)) + ((not (or (eq reasoning-chunk :null) (string-empty-p reasoning-chunk))))) + (progn (plist-put info :reasoning ;For stream filter consumption + (concat (plist-get info :reasoning) reasoning-chunk)) + (plist-put info :reasoning-chunks ;To include with tool call results, if any + (cons reasoning-chunk (or (plist-get info :reasoning-chunks) + (list (car reasoning-plist)))))) + ;; Done with reasoning if we get non-empty content + (if-let* (((plist-member info :reasoning)) ;Is this a reasoning model? + (c (plist-get delta :content)) ;Started receiving text content? + ((not (or (eq c :null) (string-blank-p c))))) + (plist-put info :reasoning-block t)))))))) ;Signal end of reasoning block + (error (goto-char (match-beginning 0)))) + (apply #'concat (nreverse content-strs)))) + +(cl-defmethod gptel--parse-response ((_backend gptel-openai) response info) + "Parse an OpenAI (non-streaming) RESPONSE and return response text. + +Mutate state INFO with response metadata." + (let* ((choice0 (map-nested-elt response '(:choices 0))) + (message (plist-get choice0 :message)) + (content (plist-get message :content))) + (plist-put info :stop-reason + (plist-get choice0 :finish_reason)) + (plist-put info :tokens (gptel--openai-update-tokens + (map-nested-elt response '(:usage)) info)) + ;; OpenAI returns either non-blank text content or a tool call, not both. + ;; However OpenAI-compatible APIs like llama.cpp can include both (#819), so + ;; we check for both tool calls and responses independently. + (when-let* ((tool-calls (plist-get message :tool_calls)) + ((not (eq tool-calls :null)))) + (gptel--inject-prompt ; First add the tool call to the prompts list + (plist-get info :backend) (plist-get info :data) message) + (cl-loop ;Then capture the tool call data for running the tool + for tool-call across tool-calls ;replace ":arguments" with ":args" + for call-spec = (copy-sequence (plist-get tool-call :function)) + do (ignore-errors (plist-put call-spec :args + (gptel--json-read-string + (plist-get call-spec :arguments)))) + (plist-put call-spec :arguments nil) + (plist-put call-spec :id (plist-get tool-call :id)) + collect call-spec into tool-use + finally (plist-put info :tool-use tool-use))) + (when-let* ((reasoning (or (plist-get message :reasoning) ;for Openrouter and co + (plist-get message :reasoning_content))) ;for Deepseek, Llama.cpp + ((and (stringp reasoning) (not (string-empty-p reasoning))))) + (plist-put info :reasoning reasoning)) + (when (and content (not (or (eq content :null) (string-empty-p content)))) + content))) + +(cl-defmethod gptel--request-data ((backend gptel-openai) prompts) + "JSON encode PROMPTS for sending to ChatGPT." + (when gptel--system-message + (push (list :role "system" + :content gptel--system-message) + prompts)) + (let ((prompts-plist + (list :model (gptel--model-name gptel-model) + :messages (vconcat prompts) + :stream (or gptel-stream :json-false)))) + (when gptel-stream + (plist-put prompts-plist :stream_options '(:include_usage t))) + (when gptel-temperature + (plist-put prompts-plist :temperature gptel-temperature)) + (when gptel-use-tools + (when (eq gptel-use-tools 'force) + (plist-put prompts-plist :tool_choice "required")) + (when gptel-tools + (plist-put prompts-plist :tools + (gptel--parse-tools backend gptel-tools)) + (plist-put prompts-plist :parallel_tool_calls t))) + (when gptel-max-tokens + ;; HACK: The OpenAI API has deprecated max_tokens, but we still need it + ;; for OpenAI-compatible APIs like GPT4All (#485) + (plist-put prompts-plist :max_tokens gptel-max-tokens)) + (when gptel--schema + (plist-put prompts-plist + :response_format (gptel--parse-schema backend gptel--schema))) + ;; Merge request params with model and backend params. + (gptel--merge-plists + prompts-plist + gptel--request-params + (gptel-backend-request-params gptel-backend) + (gptel--model-request-params gptel-model)))) + +(cl-defmethod gptel--parse-schema ((_backend gptel-openai) schema) + (list :type "json_schema" + :json_schema + (list :name (md5 (format "%s" (random))) + :schema (gptel--preprocess-schema + (gptel--dispatch-schema-type schema)) + :strict t))) + +;; NOTE: No `gptel--parse-tools' method required for gptel-openai, since this is +;; handled by its defgeneric implementation + +(cl-defmethod gptel--inject-tool-call ((_backend gptel-openai) data tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +BACKEND is the `gptel-backend'. See the generic function documentation +for details. This implementation handles the OpenAI-compatible +Completions API." + ;; FIXME: We currently assume that the tool call being modified is in the last + ;; position in the messages array. + (if-let* ((messages (plist-get data :messages)) + (entry (aref messages (1- (length messages)))) + (calls (plist-get entry :tool_calls)) + (id (plist-get tool-call :id)) + (indexed-call + (cl-loop for chunk across calls + for i upfrom 0 + if (equal (plist-get chunk :id) id) + return (cons i (plist-get chunk :function)) + finally return nil)) + (index (car indexed-call)) + (call (cdr indexed-call))) + (if (null new-call) ;delete tool call if new-call is nil + (if (= (length calls) 1) ;only tool call, delete message entirely + (plist-put data :messages (substring messages nil -1)) + ;; delete new-call selectively from parallel tool calls + (plist-put entry :tool_calls + (vconcat (substring calls 0 index) + (substring calls (1+ index))))) + (when-let* ((args (plist-get new-call :args))) + (plist-put call :arguments (gptel--json-encode args))) + (when-let* ((name (plist-get new-call :name))) + (plist-put call :name name))) + (display-warning + '(gptel tool-call) + (format "Could not inject updated tool-call arguments for tool call %s, %s" + (plist-get tool-call :name) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t))))) + +(cl-defmethod gptel--parse-tool-results ((_backend gptel-openai) tool-use) + "Return a prompt containing tool call results in TOOL-USE." + ;; (declare (side-effect-free t)) + (mapcar + (lambda (tool-call) + (list + :role "tool" + :tool_call_id (plist-get tool-call :id) + :content (plist-get tool-call :result))) + tool-use)) + +;; TODO: Remove these functions (#792) +(defun gptel--openai-format-tool-id (tool-id) + "Format TOOL-ID for OpenAI. + +If the ID has the format used by a different backend, use as-is." + (unless tool-id + (setq tool-id (substring + (md5 (format "%s%s" (random) (float-time))) + nil 24))) + (if (or (string-prefix-p "toolu_" tool-id) ;#747 + (string-prefix-p "call_" tool-id)) + tool-id + (format "call_%s" tool-id))) + +(defun gptel--openai-unformat-tool-id (tool-id) + "Return the raw tool ID for TOOL-ID." + (or (and (string-match "call_\\(.+\\)" tool-id) + (match-string 1 tool-id)) + tool-id)) + +;; NOTE: No `gptel--inject-prompt' method required for gptel-openai, since this +;; is handled by its defgeneric implementation + +(cl-defmethod gptel--parse-list ((backend gptel-openai) prompt-list) + (if (consp (car prompt-list)) + (let ((full-prompt)) ; Advanced format, list of lists + (dolist (entry prompt-list) + (pcase entry + (`(prompt . ,msg) + (push (list :role "user" :content (or (car-safe msg) msg)) full-prompt)) + (`(response . ,msg) + (push (list :role "assistant" :content (or (car-safe msg) msg)) full-prompt)) + (`(tool . ,call) + (unless (plist-get call :id) + (plist-put call :id (gptel--openai-format-tool-id nil))) + (push + (list + :role "assistant" + :tool_calls + (vector + (list :type "function" + :id (plist-get call :id) + :function `( :name ,(plist-get call :name) + :arguments ,(decode-coding-string + (gptel--json-encode (plist-get call :args)) + 'utf-8 t))))) + full-prompt) + (push (car (gptel--parse-tool-results backend (list (cdr entry)))) full-prompt)))) + (nreverse full-prompt)) + (cl-loop for text in prompt-list ; Simple format, list of strings + for role = t then (not role) + if text collect + (list :role (if role "user" "assistant") :content text)))) + +(cl-defmethod gptel--parse-buffer ((backend gptel-openai) &optional max-entries) + (let ((prompts) (prev-pt (point))) + (if (or gptel-mode gptel-track-response) + (while (and (or (not max-entries) (>= max-entries 0)) + (/= prev-pt (point-min)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min)))) + (pcase (get-char-property (point) 'gptel) + ('response + (when-let* ((content (gptel--trim-prefixes + (buffer-substring-no-properties (point) prev-pt)))) + (push (list :role "assistant" :content content) prompts))) + (`(tool . ,id) + (save-excursion + (condition-case nil + (let* ((tool-call (read (current-buffer))) + (name (plist-get tool-call :name)) + (arguments (decode-coding-string + (gptel--json-encode (plist-get tool-call :args)) + 'utf-8 t))) + (setq id (gptel--openai-format-tool-id id)) + (plist-put tool-call :id id) + (plist-put tool-call :result + (string-trim (buffer-substring-no-properties + (point) prev-pt))) + (push (car (gptel--parse-tool-results backend (list tool-call))) + prompts) + (push (list :role "assistant" + :tool_calls + (vector (list :type "function" + :id id + :function `( :name ,name + :arguments ,arguments)))) + prompts)) + ((end-of-file invalid-read-syntax) + (message (format "Could not parse tool-call %s on line %s" + id (line-number-at-pos (point)))))))) + ('ignore) + ('nil + (and max-entries (cl-decf max-entries)) + (if gptel-track-media + (when-let* ((content (gptel--openai-parse-multipart + (gptel--parse-media-links major-mode + (point) prev-pt)))) + (when (> (length content) 0) + (push (list :role "user" :content content) prompts))) + (when-let* ((content (gptel--trim-prefixes (buffer-substring-no-properties + (point) prev-pt)))) + (push (list :role "user" :content content) prompts))))) + (setq prev-pt (point))) + (let ((content (string-trim (buffer-substring-no-properties + (point-min) (point-max))))) + (push (list :role "user" :content content) prompts))) + prompts)) + +;; TODO This could be a generic function +(defun gptel--openai-parse-multipart (parts) + "Convert a multipart prompt PARTS to the OpenAI API format. + +The input is an alist of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")). + +The output is a vector of entries in a backend-appropriate +format." + (cl-loop + for part in parts + for n upfrom 1 + with last = (length parts) + for text = (plist-get part :text) + for media = (plist-get part :media) + if text do + (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text))) + and if text + collect `(:type "text" :text ,text) into parts-array end + else if media collect + `(:type "image_url" + :image_url (:url ,(concat "data:" (plist-get part :mime) + ";base64," (gptel--base64-encode media)))) + into parts-array + else if (plist-get part :textfile) collect + `(:type "text" + :text ,(with-temp-buffer + (gptel--insert-file-string (plist-get part :textfile)) + (buffer-string))) + into parts-array end and + if (plist-get part :url) + collect + `(:type "image_url" + :image_url (:url ,(plist-get part :url))) + into parts-array + finally return (vconcat parts-array))) + +(cl-defmethod gptel--inject-media ((_backend gptel-openai) prompts) + "Wrap the first user prompt in PROMPTS with included media files. + +Media files, if present, are placed in `gptel-context'." + (when-let* ((media-list (gptel-context--collect-media))) + (cl-callf (lambda (current) + (vconcat + (gptel--openai-parse-multipart media-list) + (cl-typecase current + (string `((:type "text" :text ,current))) + (vector current) + (t current)))) + (plist-get (car prompts) :content)))) + +(defconst gptel--openai-models + '((gpt-5.4-mini + :description "Faster, more cost-efficient version of GPT-5.4" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 0.75 + :output-cost 4.50 + :cutoff-date "2025-08") + (gpt-5.4-nano + :description "Fastest, cheapest version of GPT-5.4" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 0.20 + :output-cost 1.25 + :cutoff-date "2025-08") + (gpt-5.4 + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1050 + :input-cost 2.50 + :output-cost 15 + :cutoff-date "2025-08") + (gpt-5.4-pro + :description "Maximum performance model for reasoning tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1050 + :input-cost 30 + :output-cost 180 + :cutoff-date "2025-08") + (gpt-5.5 + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1050 + :input-cost 5 + :output-cost 30 + :cutoff-date "2025-12") + (gpt-5.5-pro + :description "Maximum performance model for reasoning tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1050 + :input-cost 30 + :output-cost 180 + :cutoff-date "2025-12") + (gpt-5.3-chat-latest + :description "Answers right away" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 1.75 + :output-cost 14 + :cutoff-date "2025-08") + (gpt-5.2 + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 1.75 + :output-cost 14 + :cutoff-date "2025-08") + (gpt-5.1 + :description "The best model for coding and agentic tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 1.25 + :output-cost 10 + :cutoff-date "2024-09") + (gpt-5-mini + :description "Faster, more cost-efficient version of GPT-5" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 0.25 + :output-cost 2.0 + :cutoff-date "2024-09") + (gpt-5-nano + :description "Fastest, cheapest version of GPT-5" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 0.05 + :output-cost 0.40 + :cutoff-date "2024-09") + (gpt-5 + :description "Flagship model for coding, reasoning, and agentic tasks across domains" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 400 + :input-cost 1.25 + :output-cost 10 + :cutoff-date "2024-09") + (gpt-4.1-mini + :description "Balance between intelligence, speed and cost" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1024 + :input-cost 0.4 + :output-cost 1.6) + (gpt-4.1-nano + :description "Fastest, most cost-effective GPT-4.1 model" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1024 + :input-cost 0.10 + :output-cost 0.40 + :cutoff-date "2024-05") + (gpt-4.1 + :description "Flagship model for complex tasks" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 1024 + :input-cost 2.0 + :output-cost 8.0 + :cutoff-date "2024-05") + (gpt-4o-mini + :description "Cheap model for fast tasks; cheaper & more capable than GPT-3.5 Turbo" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 0.15 + :output-cost 0.60 + :cutoff-date "2023-10") + (gpt-4o + :description "Advanced model for complex tasks; cheaper & faster than GPT-Turbo" + :capabilities (media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 2.50 + :output-cost 10 + :cutoff-date "2023-10") + (gpt-4.5-preview + :description "DEPRECATED: Use gpt-4.1 instead" + :capabilities (media tool-use url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 75 + :output-cost 150 + :cutoff-date "2023-10") + (gpt-4-turbo + :description "Previous high-intelligence model" + :capabilities (media tool-use url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 128 + :input-cost 10 + :output-cost 30 + :cutoff-date "2023-11") + (gpt-4 + :description "GPT-4 snapshot from June 2023 with improved function calling support" + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :capabilities (media url responses-api) + :context-window 8.192 + :input-cost 30 + :output-cost 60 + :cutoff-date "2023-11") + (o4-mini + :description "Fast, effective reasoning with efficient performance in coding and visual tasks" + :capabilities (reasoning media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 200 + :input-cost 1.10 + :output-cost 4.40 + :cutoff-date "2024-05") + (o3-mini + :description "High intelligence at the same cost and latency targets of o1-mini" + :context-window 200 + :input-cost 1.10 + :output-cost 4.40 + :cutoff-date "2023-10" + :capabilities (reasoning tool-use json responses-api)) + (o3 + :description "Well-rounded and powerful model across domains" + :capabilities (reasoning media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 200 + :input-cost 2 + :output-cost 8 + :cutoff-date "2024-05") + (o3-pro + :description "Maximum performance model for reasoning tasks" + :capabilities (reasoning media tool-use json url responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 200 + :input-cost 20 + :output-cost 80 + :cutoff-date "2024-05") + (o1-mini + :description "Faster and cheaper reasoning model good at coding, math, and science" + :context-window 128 + :input-cost 1.10 + :output-cost 4.40 + :cutoff-date "2023-10" + :capabilities (nosystem reasoning responses-api)) + (o1 + :description "Reasoning model designed to solve hard problems across domains" + :capabilities (media reasoning responses-api) + :mime-types ("image/jpeg" "image/png" "image/gif" "image/webp") + :context-window 200 + :input-cost 15 + :output-cost 60 + :cutoff-date "2023-10")) + "List of available OpenAI models and associated properties. + +Each model symbol is associated with the following keys, all optional: + +- `:description': a brief description of the model. + +- `:capabilities': a list of capabilities supporte responses-apid by the model. + +- `:mime-types': a list of supported MIME types for media files. + +- `:context-window': the context window size, in thousands of tokens. + +- `:input-cost': the input cost, in US dollars per million tokens. + +- `:output-cost': the output cost, in US dollars per million tokens. + +- `:cutoff-date': the knowledge cutoff date. + +- `:request-params': a plist of additional request parameters to + include when using this model. + +Information about the OpenAI models was obtained from the following +sources: + +- +- ") + +;;;###autoload +(cl-defun gptel-make-openai + (name &key curl-args (models gptel--openai-models) + stream key request-params + (header + (lambda (_info) + (when-let* ((key (gptel--get-api-key))) + `(("Authorization" . ,(concat "Bearer " key)))))) + (host "api.openai.com") + (protocol "https") + endpoint) + "Register an OpenAI API-compatible backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST (optional) is the API host, typically \"api.openai.com\". + +MODELS is a list of available model names, as symbols. +Additionally, you can specify supported LLM capabilities like +vision or tool-use by appending a plist to the model with more +information, in the form + + (model-name . plist) + +For a list of currently recognized plist keys, see +`gptel--openai-models'. An example of a model specification +including both kinds of specs: + +:models +\\='(gpt-3.5-turbo ;Simple specs + gpt-4-turbo + (gpt-4o-mini ;Full spec + :description + \"Affordable and intelligent small model for lightweight tasks\" + :capabilities (media tool json url) + :mime-types + (\"image/jpeg\" \"image/png\" \"image/gif\" \"image/webp\"))) + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/v1/chat/completions\". + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that returns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for." + (declare (indent 1)) + (let* ((responses-api (string-match-p "api\\.openai\\.com" host)) + ;; Use the OpenAI Responses API if required + ;; TODO: Find a more reliable way to dispatch. Checking the host isn't + ;; reliable. For example, it won't work when using the Responses API + ;; via a proxy. + (constructor (if (not responses-api) + #'gptel--make-openai + (require 'gptel-openai-responses) + #'gptel--make-openai-responses)) + (endpoint (or endpoint + (if responses-api "/v1/responses" "/v1/chat/completions"))) + (backend (funcall constructor + :curl-args curl-args + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +;;; Azure +;;;###autoload +(cl-defun gptel-make-azure + (name &key curl-args host + (protocol "https") + (header (lambda (_info) `(("api-key" . ,(gptel--get-api-key))))) + (key 'gptel-api-key) + models stream endpoint request-params) + "Register an Azure backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is the API host. + +MODELS is a list of available model names, as symbols. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL (optional) specifies the protocol, https by default. + +ENDPOINT is the API endpoint for completions. + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: + ((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + + (gptel-make-azure + \"Azure-1\" + :protocol \"https\" + :host \"RESOURCE_NAME.openai.azure.com\" + :endpoint + \"/openai/deployments/DEPLOYMENT_NAME/completions?api-version=2023-05-15\" + :stream t + :models \\='(gpt-3.5-turbo gpt-4))" + (declare (indent 1)) + (let ((backend (gptel--make-openai + :curl-args curl-args + :name name + :host host + :header header + :key key + :models (gptel--process-models models) + :protocol protocol + :endpoint endpoint + :stream stream + :request-params request-params + :url (if protocol + (concat protocol "://" host endpoint) + (concat host endpoint))))) + (prog1 backend + (setf (alist-get name gptel--known-backends + nil nil #'equal) + backend)))) + +;; GPT4All +;;;###autoload +(defalias 'gptel-make-gpt4all 'gptel-make-openai + "Register a GPT4All backend for gptel with NAME. + +Keyword arguments: + +CURL-ARGS (optional) is a list of additional Curl arguments. + +HOST is where GPT4All runs (with port), typically localhost:4891 + +MODELS is a list of available model names, as symbols. + +STREAM is a boolean to toggle streaming responses, defaults to +false. + +PROTOCOL specifies the protocol, https by default. + +ENDPOINT (optional) is the API endpoint for completions, defaults to +\"/api/v1/completions\" + +HEADER (optional) is for additional headers to send with each +request. It should be an alist or a function that retuns an +alist, like: +((\"Content-Type\" . \"application/json\")) + +KEY (optional) is a variable whose value is the API key, or +function that returns the key. This is typically not required for +local models like GPT4All. + +REQUEST-PARAMS (optional) is a plist of additional HTTP request +parameters (as plist keys) and values supported by the API. Use +these to set parameters that gptel does not provide user options +for. + +Example: +------- + +(gptel-make-gpt4all + \"GPT4All\" + :protocol \"http\" + :host \"localhost:4891\" + :models \\='(mistral-7b-openorca.Q4_0.gguf))") + +(provide 'gptel-openai) +;;; gptel-openai.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not docstrings) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-org.el b/elpa/gptel-20260425.846/gptel-org.el new file mode 100644 index 00000000..32bafd09 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-org.el @@ -0,0 +1,879 @@ +;;; gptel-org.el --- Org functions for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: +(require 'cl-lib) +(require 'org-element) +(require 'outline) +(require 'mailcap) ;FIXME Avoid this somehow +(eval-when-compile (require 'gptel-request)) + +;; Functions used for saving/restoring gptel state in Org buffers +(defvar gptel--num-messages-to-send) +(defvar org-entry-property-inherited-from) +(defvar gptel-backend) +(defvar gptel--known-backends) +(defvar gptel--system-message) +(defvar gptel-model) +(defvar gptel-temperature) +(defvar gptel-max-tokens) +(defvar gptel--link-type-cache) +(defvar gptel--preset) + +(defvar org-link-angle-re) +(defvar org-link-bracket-re) +(declare-function mailcap-file-name-to-mime-type "mailcap") +(declare-function gptel--model-capable-p "gptel-request") +(declare-function gptel--model-mime-capable-p "gptel-request") +(declare-function gptel--model-name "gptel-request") +(declare-function gptel--to-string "gptel-request") +(declare-function gptel--to-number "gptel-request") +(declare-function gptel--intern "gptel-request") +(declare-function gptel-backend-name "gptel-request") +(declare-function gptel--parse-buffer "gptel-request") +(declare-function gptel--parse-directive "gptel-request") +(declare-function gptel--with-buffer-copy "gptel-request") +(declare-function gptel--file-binary-p "gptel-request") +(declare-function gptel--get-buffer-bounds "gptel") +(declare-function gptel--restore-props "gptel") +(declare-function org-entry-get "org") +(declare-function org-entry-put "org") +(declare-function org-with-wide-buffer "org-macs") +(declare-function org-set-property "org") +(declare-function org-property-values "org") +(declare-function org-open-line "org") +(declare-function org-at-heading-p "org") +(declare-function org-get-heading "org") +(declare-function org-at-heading-p "org") + +;; Bundle `org-element-lineage-map' if it's not available (for Org 9.67 or older) +(eval-and-compile + (if (fboundp 'org-element-lineage-map) + (progn (declare-function org-element-lineage-map "org-element-ast") + (defalias 'gptel-org--element-lineage-map 'org-element-lineage-map)) + (defun gptel-org--element-lineage-map (datum fun &optional types with-self first-match) + "Map FUN across ancestors of DATUM, from closest to furthest. + +DATUM is an object or element. For TYPES, WITH-SELF and +FIRST-MATCH see `org-element-lineage-map'. + +This function is provided for compatibility with older versions +of Org." + (declare (indent 2)) + (setq fun (if (functionp fun) fun `(lambda (node) ,fun))) + (let ((up (if with-self datum (org-element-parent datum))) + acc rtn) + (catch :--first-match + (while up + (when (or (not types) (org-element-type-p up types)) + (setq rtn (funcall fun up)) + (if (and first-match rtn) + (throw :--first-match rtn) + (when rtn (push rtn acc)))) + (setq up (org-element-parent up))) + (nreverse acc))))) + (if (fboundp 'org-element-begin) + (progn (declare-function org-element-begin "org-element") + (declare-function org-element-end "org-element") + (declare-function org-element-parent "org-element") + (defalias 'gptel-org--element-begin 'org-element-begin) + (defalias 'gptel-org--element-end 'org-element-end) + (defalias 'gptel-org--element-parent 'org-element-parent)) + (defsubst gptel-org--element-begin (node) + "Get `:begin' property of NODE." + (org-element-property :begin node)) + (defsubst gptel-org--element-end (node) + "Get `:end' property of NODE." + (org-element-property :end node)) + (defsubst gptel-org--element-parent (node) + "Return `:parent' property of NODE." + (org-element-property :parent node)))) + + +;;; User options +(defcustom gptel-org-branching-context nil + "Use the lineage of the current heading as the context for gptel in Org buffers. + +This makes each same level heading a separate conversation +branch. + +By default, gptel uses a linear context: all the text up to the +cursor is sent to the LLM. Enabling this option makes the +context the hierarchical lineage of the current Org heading. In +this example: + +----- +Top level text + +* Heading 1 +heading 1 text + +* Heading 2 +heading 2 text + +** Heading 2.1 +heading 2.1 text +** Heading 2.2 +heading 2.2 text +----- + +With the cursor at the end of the buffer, the text sent to the +LLM will be limited to + +----- +Top level text + +* Heading 2 +heading 2 text + +** Heading 2.2 +heading 2.2 text +----- + +This makes it feasible to have multiple conversation branches." + :type 'boolean + :group 'gptel) + +(defcustom gptel-org-ignore-elements '(property-drawer) + "Types of Org elements to be stripped from the prompt before sending. + +By default gptel will remove Org property drawers from the +prompt. For the full list of available elements, please see +`org-element-all-elements'. + +Please note: Removing property-drawer elements is fast, but +adding elements to this list can significantly slow down +`gptel-send'." + :group 'gptel + :type '(repeat symbol)) + +(defcustom gptel-org-validate-link #'always + "Validate links to be sent as context with gptel queries. + +When `gptel-track-media' is enabled, this option determines if a +supported link will be followed and its source included with gptel +queries from Org buffers. Currently only \"file\" and \"attachment\" +link types are supported (along with web URLs if the model supports +them). + +It should be a function that accepts an Org link object and return +non-nil if the link should be followed. + +By default, all links are considered valid. + +Set this to `gptel-org--link-standalone-p' to only follow links placed +on a line by themselves, separated from surrounding text." + :group 'gptel + :type '(choice + (const :tag "All links" always) + (const :tag "Standalone links" gptel-org--link-standalone-p) + (function :tag "Function"))) + +(defconst gptel-org--link-regex + (concat "\\(?:" org-link-bracket-re "\\|" org-link-angle-re "\\)") + "Link regex for `gptel-mode' in Org mode.") + + +;;; Setting context and creating queries +(defun gptel-org--get-topic-start () + "If a conversation topic is set, return it." + (when (org-entry-get (point) "GPTEL_TOPIC" 'inherit) + (marker-position org-entry-property-inherited-from))) + +(defun gptel-org-set-topic (topic) + "Set a TOPIC and limit this conversation to the current heading. + +This limits the context sent to the LLM to the text between the current +heading (i.e. the heading with the topic set) and the cursor position." + (interactive + (list + (progn + (or (derived-mode-p 'org-mode) + (user-error "Support for multiple topics per buffer is only implemented for `org-mode'")) + (completing-read "Set topic as: " + (org-property-values "GPTEL_TOPIC") + nil nil (downcase + (truncate-string-to-width + (substring-no-properties + (replace-regexp-in-string + "\\s-+" "-" + (org-entry-get nil "ITEM"))) + 50)))))) + (when (stringp topic) (org-set-property "GPTEL_TOPIC" topic))) + +;; NOTE: This can be converted to a cl-defmethod for +;; `gptel--create-prompt-buffer' (conceptually cleaner), but will cause +;; load-order issues in gptel.el and might be harder to debug. +(defun gptel-org--create-prompt-buffer (&optional prompt-end) + "Return a buffer with the conversation prompt to be sent. + +If the region is active limit the prompt text to the region contents. +Otherwise the prompt text is constructed from the contents of the +current buffer up to point, or PROMPT-END if provided. Its contents +depend on the value of `gptel-org-branching-context', which see." + (when (use-region-p) + (narrow-to-region (region-beginning) (region-end)) + (setq prompt-end (point-max))) + (goto-char (or prompt-end (setq prompt-end (point)))) + (let ((topic-start (gptel-org--get-topic-start))) + (when topic-start + ;; narrow to GPTEL_TOPIC property scope + (narrow-to-region topic-start prompt-end)) + (if (and gptel-org-branching-context + (or (fboundp 'org-element-lineage-map) + (prog1 nil + (display-warning + '(gptel org) + "Using `gptel-org-branching-context' requires Org version 9.7 or higher, it will be ignored.")))) + ;; Create prompt from direct ancestors of point + (save-excursion + (let* ((org-buf (current-buffer)) + ;; Collect all heading start positions in the lineage + (full-bounds (gptel-org--element-lineage-map + (org-element-at-point) #'gptel-org--element-begin + '(headline) 'with-self) ) + ;; lineage-map returns the full lineage in the unnarrowed + ;; buffer. Remove heading start positions before (point-min) + ;; that are invalid due to narrowing, and add (point-min) if + ;; it's not already included in the lineage + (start-bounds + (nconc (cl-delete-if (lambda (p) (< p (point-min))) + full-bounds) + (unless (save-excursion (goto-char (point-min)) + (looking-at-p outline-regexp)) + (list (point-min))))) + (end-bounds + (cl-loop + ;; (car start-bounds) is the begining of the current element, + ;; not relevant + for pos in (cdr start-bounds) + do (goto-char pos) (outline-next-heading) + collect (point) into ends + finally return (cons prompt-end ends)))) + (gptel--with-buffer-copy org-buf nil nil + (cl-loop for start in start-bounds + for end in end-bounds + do (insert-buffer-substring org-buf start end) + (goto-char (point-min))) + (goto-char (point-max)) + (gptel-org--unescape-tool-results) + (gptel-org--strip-block-headers) + (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy + (buffer-local-value 'gptel-org-ignore-elements + org-buf))) + (gptel-org--strip-elements)) + (setq org-complex-heading-regexp ;For org-element-context to run + (buffer-local-value 'org-complex-heading-regexp org-buf)) + (current-buffer)))) + ;; Create prompt the usual way + (let ((org-buf (current-buffer)) + (beg (point-min))) + (gptel--with-buffer-copy org-buf beg prompt-end + (gptel-org--unescape-tool-results) + (gptel-org--strip-block-headers) + (when-let* ((gptel-org-ignore-elements ;not copied by -with-buffer-copy + (buffer-local-value 'gptel-org-ignore-elements + org-buf))) + (gptel-org--strip-elements)) + (setq org-complex-heading-regexp ;For org-element-context to run + (buffer-local-value 'org-complex-heading-regexp org-buf)) + (current-buffer)))))) + +(defun gptel-org--strip-elements () + "Remove all elements in `gptel-org-ignore-elements' from the prompt." + (let ((major-mode 'org-mode) element-markers) + (if (equal '(property-drawer) gptel-org-ignore-elements) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-property-drawer-re nil t) + ;; ;; Slower but accurate + ;; (let ((drawer (org-element-at-point))) + ;; (when (org-element-type-p drawer 'property-drawer) + ;; (delete-region (org-element-begin drawer) (org-element-end drawer)))) + + ;; Fast but inexact, can have false positives + (delete-region (match-beginning 0) (match-end 0)))) + ;; NOTE: Parsing the buffer is extremely slow. Avoid this path unless + ;; required. + ;; NOTE: `org-element-map' takes a third KEEP-DEFERRED argument in newer + ;; Org versions + (org-element-map (org-element-parse-buffer 'element nil) + gptel-org-ignore-elements + (lambda (node) + (push (list (gptel-org--element-begin node) + (gptel-org--element-end node)) + element-markers))) + (dolist (bounds element-markers) + (apply #'delete-region bounds))))) + +(defun gptel-org--strip-block-headers () + "Remove all gptel-specific block headers and footers. +Every line that matches will be removed entirely. + +This removal is necessary to avoid auto-mimicry by LLMs." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + (rx line-start (literal "#+") + (or (literal "begin") (literal "end")) + (or (literal "_tool") (literal "_reasoning"))) + nil t) + (delete-region (match-beginning 0) + (min (point-max) (1+ (line-end-position))))))) + +(defun gptel-org--unescape-tool-results () + "Undo escapes done to keep results from escaping blocks. +Scans backward for gptel tool text property, then unescapes the block +contents." + (save-excursion + (goto-char (point-max)) + (let ((prev-pt (point))) + (while (> prev-pt (point-min)) + (goto-char + (previous-single-char-property-change (point) 'gptel)) + (let ((prop (get-text-property (point) 'gptel)) + (backward-progress (point))) + (when (eq (car-safe prop) 'tool) + ;; User edits to clean up can potentially insert a tool-call header + ;; that is propertized. Tool call headers should not be + ;; propertized. + (when (looking-at-p "[[:space:]]*#\\+begin_tool") + (goto-char (match-end 0))) + ;; TODO this code is able to put the point behind prev-pt, which + ;; makes the region inverted. The `max' catches this, but really + ;; `read' and `looking-at' are the culprits. Badly formed tool + ;; blocks can lead to this being necessary. + (org-unescape-code-in-region + (min prev-pt (point)) prev-pt)) + (goto-char (setq prev-pt backward-progress))))))) + +(defun gptel-org--link-standalone-p (object) + "Check if link OBJECT is on a line by itself." + (when-let* ((par (gptel-org--element-parent object)) + ((eq (org-element-type par) 'paragraph))) + (and (= (gptel-org--element-begin object) + (save-excursion + (goto-char (org-element-property :contents-begin par)) + (skip-chars-forward "\t ") + (point))) ;account for leading space before object + (<= (- (org-element-property :contents-end par) + (org-element-property :end object)) + 1)))) + +(defsubst gptel-org--validate-link (link) + "Validate an Org LINK as sendable under the current gptel settings. + +Return a form (validp link-type path . REST), where REST is a list +explaining why sending the link is not supported by gptel. Only the +first nil value in REST is guaranteed to be correct." + (let ((mime)) + (if-let* ((link-type (org-element-property :type link)) + (resource-type + (or (and (member link-type '("attachment" "file")) 'file) + (and (gptel--model-capable-p 'url) + (member link-type '("http" "https" "ftp")) 'url))) + (path (org-element-property :path link)) + (user-check (funcall gptel-org-validate-link link)) + (readablep (or (eq resource-type 'url) (file-remote-p path) + (file-readable-p path))) + (mime-valid + (or (eq resource-type 'url) + (and (with-memoization + (alist-get (expand-file-name path) + gptel--link-type-cache + nil nil #'string=) + (if (gptel--file-binary-p path) t)) + (setq mime (mailcap-file-name-to-mime-type path)) + (gptel--model-mime-capable-p mime)) + t))) + (list t link-type path resource-type user-check readablep mime-valid mime) + (list nil link-type path resource-type user-check readablep mime-valid mime)))) + +(cl-defmethod gptel--parse-media-links ((_mode (eql 'org-mode)) beg end) + "Parse text and actionable links between BEG and END. + +Return a list of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")) +for inclusion into the user prompt for the gptel request." + (let ((parts) (from-pt)) + (save-excursion + (setq from-pt (goto-char beg)) + (while (re-search-forward gptel-org--link-regex end t) + (let* ((link (org-element-context)) + (link-status (gptel-org--validate-link link))) + (cl-destructuring-bind + (valid type path resource-type user-check readablep mime-valid mime) + link-status + (cond + ((and valid (member type '("file" "attachment"))) + ;; Text file or supported binary file: collect text up to link + (when-let* ((text (buffer-substring-no-properties + from-pt (gptel-org--element-begin link)))) + (unless (string-blank-p text) (push (list :text text) parts))) + ;; collect link + (push (if mime (list :media path :mime mime) (list :textfile path)) + parts) + (setq from-pt (point))) + ((and valid (member type '("http" "https" "ftp"))) + ;; Collect text up to this image, and collect this image url + (when-let* ((text (buffer-substring-no-properties + from-pt (gptel-org--element-begin link)))) + (unless (string-blank-p text) (push (list :text text) parts))) + (push (list :url (org-element-property :raw-link link) :mime mime) parts) + (setq from-pt (point))) + ((not resource-type) + (message "Link source not followed for unsupported link type \"%s\"." type)) + ((not user-check) + (message (if (eq gptel-org-validate-link 'gptel--link-standalone-p) + "Ignoring non-standalone link \"%s\"." + "Link %s failed to validate, see `gptel-org-validate-link'.") + path)) + ((not readablep) + (message "Ignoring inaccessible file \"%s\"." path)) + ((and (not mime-valid) (eq resource-type 'file)) + (message "Ignoring unsupported binary file \"%s\"." path)))))) + (unless (= from-pt end) + (push (list :text (buffer-substring-no-properties from-pt end)) parts))) + (nreverse parts))) + +(defun gptel-org--annotate-links (beg end) + "Annotate Org links whose sources will be sent with `gptel-send'. + +Search between BEG and END." + (when gptel-track-media + (save-excursion + (goto-char beg) (forward-line -1) + (let ((link-ovs (cl-loop for o in (overlays-in (point) end) + if (overlay-get o 'gptel-track-media) + collect o into os finally return os))) + (while (re-search-forward gptel-org--link-regex end t) + (unless (gptel--in-response-p (1- (point))) + (let* ((link (org-element-context)) + (from (org-element-begin link)) + (to (org-element-end link)) + (link-status (gptel-org--validate-link link)) + (ov (cl-loop for o in (overlays-in from to) + if (overlay-get o 'gptel-track-media) + return o))) + (if ov ; Ensure overlay over each link + (progn (move-overlay ov from to) + (setq link-ovs (delq ov link-ovs))) + (setq ov (make-overlay from to nil t)) + (overlay-put ov 'gptel-track-media t) + (overlay-put ov 'evaporate t) + (overlay-put ov 'priority -80)) + ;; Check if link will be sent, and annotate accordingly + (gptel--annotate-link ov link-status)))) + (and link-ovs (mapc #'delete-overlay link-ovs)))) + `(jit-lock-bounds ,beg . ,end))) + +(defun gptel-org--send-with-props (send-fun &rest args) + "Conditionally modify SEND-FUN's calling environment. + +If in an Org buffer under a heading containing a stored gptel +configuration, use that for requests instead. This includes the +system message, model and provider (backend), among other +parameters. + +ARGS are the original function call arguments." + (if (derived-mode-p 'org-mode) + (pcase-let ((`( ,gptel--preset ,gptel--system-message ,gptel-backend + ,gptel-model ,gptel-temperature ,gptel-max-tokens + ,gptel--num-messages-to-send ,gptel-tools) + (seq-mapn (lambda (a b) (or a b)) + (gptel-org--entry-properties) + (list gptel--preset gptel--system-message gptel-backend + gptel-model gptel-temperature gptel-max-tokens + gptel--num-messages-to-send gptel-tools)))) + (apply send-fun args)) + (apply send-fun args))) + +(advice-add 'gptel-send :around #'gptel-org--send-with-props) +(advice-add 'gptel--suffix-send :around #'gptel-org--send-with-props) + +;; ;; NOTE: Basic uses in org-mode are covered by advising gptel-send and +;; ;; gptel--suffix-send. For custom commands it might be necessary to advise +;; ;; gptel-request instead. +;; (advice-add 'gptel-request :around #'gptel-org--send-with-props) + + +;;; Saving and restoring state +(defun gptel-org--entry-properties (&optional pt) + "Find gptel configuration properties stored at PT." + (pcase-let + ((`(,preset ,system ,backend ,model ,temperature ,tokens ,num ,tools) + (mapcar + (lambda (prop) (org-entry-get (or pt (point)) prop 'selective)) + '("GPTEL_PRESET" "GPTEL_SYSTEM" "GPTEL_BACKEND" + "GPTEL_MODEL" "GPTEL_TEMPERATURE" "GPTEL_MAX_TOKENS" + "GPTEL_NUM_MESSAGES_TO_SEND" "GPTEL_TOOLS")))) + (when preset (setq preset (gptel--intern preset))) + (when system + (setq system (string-replace "\\n" "\n" system))) + (when backend + (setq backend (alist-get backend gptel--known-backends + nil nil #'equal))) + (when model (setq model (gptel--intern model))) + (when temperature + (setq temperature (gptel--to-number temperature))) + (when tokens (setq tokens (gptel--to-number tokens))) + (when num (setq num (gptel--to-number num))) + (when tools + (setq tools (cl-loop + for tname in (split-string tools) + for tool = (with-demoted-errors "gptel: %S" + (gptel-get-tool tname)) + if tool collect tool else do + (display-warning + '(gptel org tools) + (format "Tool %s not found, ignoring" tname))))) + (list preset system backend model temperature tokens num tools))) + +(defun gptel-org--restore-state () + "Restore gptel state for Org buffers when turning on `gptel-mode'." + (save-restriction + (widen) + (condition-case status + (progn + (when-let* ((bounds (org-entry-get (point-min) "GPTEL_BOUNDS"))) + (gptel--restore-props (read bounds))) + (pcase-let ((`(,preset ,system ,backend ,model ,temperature ,tokens ,num ,tools) + (gptel-org--entry-properties (point-min)))) + (when preset + (if (gptel-get-preset preset) + (progn (gptel--apply-preset + preset (lambda (sym val) (set (make-local-variable sym) val))) + (setq gptel--preset preset)) + (display-warning + '(gptel presets) + (format "Could not activate gptel preset `%s' in buffer \"%s\"" + preset (buffer-name))))) + (when system (setq-local gptel--system-message system)) + (if backend (setq-local gptel-backend backend) + (message + (substitute-command-keys + (concat + "Could not activate gptel backend \"%s\"! " + "Switch backends with \\[universal-argument] \\[gptel-send]" + " before using gptel.")) + backend)) + (when model (setq-local gptel-model model)) + (when temperature (setq-local gptel-temperature temperature)) + (when tokens (setq-local gptel-max-tokens tokens)) + (when num (setq-local gptel--num-messages-to-send num)) + (when tools (setq-local gptel-tools tools)))) + (:success (message "gptel chat restored.")) + (error (message "Could not restore gptel state, sorry! Error: %s" status))))) + +(defun gptel-org-set-properties (pt &optional msg) + "Store the active gptel configuration under the current heading. + +PT is the cursor position by default. If MSG is non-nil (default), +display a message afterwards. + +If a gptel preset has been applied in this buffer, a reference to it is +saved. + +Additional metadata is stored only if no preset was applied or if it +differs from the preset specification. This is limited to the active +gptel model and backend names, the system message, active tools, the +response temperature, max tokens and number of conversation turns to +send in queries. (See `gptel--num-messages-to-send' for the last one.)" + (interactive (list (point) t)) + (let ((preset-spec (and gptel--preset (gptel-get-preset gptel--preset)))) + (if preset-spec + (org-entry-put pt "GPTEL_PRESET" (gptel--to-string gptel--preset)) + (org-entry-delete pt "GPTEL_PRESET")) + + ;; FIXME: nil can mean "no value was explicitly set by the user" as well as + ;; "this setting has been set to nil". We are not yet distinguishing + ;; between the two when saving Org properties. This is particularly + ;; relevant for the system message, whose explicit nil value will not be + ;; captured when saving Org buffers. + + ;; Model and backend + (if (gptel--preset-mismatch-value preset-spec :model gptel-model) + (org-entry-put pt "GPTEL_MODEL" (gptel--model-name gptel-model))) + (if (gptel--preset-mismatch-value preset-spec :backend gptel-backend) + (org-entry-put pt "GPTEL_BACKEND" (gptel-backend-name gptel-backend))) + ;; System message + (let ((parsed (car-safe (gptel--parse-directive gptel--system-message)))) + (if (gptel--preset-mismatch-value preset-spec :system parsed) + (when parsed + (org-entry-put pt "GPTEL_SYSTEM" (string-replace "\n" "\\n" parsed))) + (org-entry-delete pt "GPTEL_SYSTEM"))) + ;; Tools + (let ((tool-names (mapcar #'gptel-tool-name gptel-tools))) + (if (gptel--preset-mismatch-value preset-spec :tools tool-names) + (org-entry-put pt "GPTEL_TOOLS" (string-join tool-names " ")) + (org-entry-delete pt "GPTEL_TOOLS"))) + ;; Temperature, max tokens and cutoff + (if (and (gptel--preset-mismatch-value preset-spec :temperature gptel-temperature) + (not (equal (default-value 'gptel-temperature) gptel-temperature))) + (org-entry-put pt "GPTEL_TEMPERATURE" (number-to-string gptel-temperature)) + (org-entry-delete pt "GPTEL_TEMPERATURE")) + (if (and (gptel--preset-mismatch-value preset-spec :max-tokens gptel-max-tokens) + gptel-max-tokens) + (org-entry-put pt "GPTEL_MAX_TOKENS" (number-to-string gptel-max-tokens)) + (org-entry-delete pt "GPTEL_MAX_TOKENS")) + (if (and (gptel--preset-mismatch-value + preset-spec :num-messages-to-send gptel--num-messages-to-send) + (natnump gptel--num-messages-to-send)) + (org-entry-put pt "GPTEL_NUM_MESSAGES_TO_SEND" + (number-to-string gptel--num-messages-to-send)) + (org-entry-delete pt "GPTEL_NUM_MESSAGES_TO_SEND"))) + (when msg + (message "Added gptel configuration to current headline."))) + +(defun gptel-org--save-state () + "Write the gptel state to the Org buffer as Org properties." + (org-with-wide-buffer + (goto-char (point-min)) + (when (org-at-heading-p) + (org-open-line 1)) + (gptel-org-set-properties (point-min)) + ;; Save response boundaries + (letrec ((write-bounds + (lambda (attempts) + (when-let* ((bounds (gptel--get-buffer-bounds)) + ;; first value of ((prop . ((beg end val)...))...) + (offset (caadar bounds)) + (offset-marker (set-marker (make-marker) offset))) + (org-entry-put (point-min) "GPTEL_BOUNDS" + (prin1-to-string (gptel--get-buffer-bounds))) + (when (and (not (= (marker-position offset-marker) offset)) + (> attempts 0)) + (funcall write-bounds (1- attempts))))))) + (funcall write-bounds 6)))) + + +;;; Transforming responses +;;;###autoload +(defun gptel--convert-markdown->org (str) + "Convert string STR from markdown to org markup. + +This is a very basic converter that handles only a few markup +elements." + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (re-search-forward "`+\\|\\*\\{1,2\\}\\|_\\|^#+" nil t) + (pcase (match-string 0) + ;; Handle backticks + ((and (guard (eq (char-before) ?`)) ticks) + (gptel--replace-source-marker (length ticks)) + (save-match-data + (catch 'block-end + (while (search-forward ticks nil t) + (unless (or (eq (char-before (match-beginning 0)) ?`) + (eq (char-after) ?`)) + (gptel--replace-source-marker (length ticks) 'end) + (throw 'block-end nil)))))) + ;; Handle headings + ((and (guard (eq (char-before) ?#)) heading) + (cond + ((looking-at "[[:space:]]") ;Handle headings + (delete-region (line-beginning-position) (point)) + (insert (make-string (length heading) ?*))) + ((looking-at "\\+begin_src") ;Overeager LLM switched to using Org src blocks + (save-match-data (re-search-forward "^#\\+end_src" nil t))))) + ;; Handle emphasis + ("**" (cond + ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)") + ;; (delete-char 1)) + ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}" + (max (- (point) 3) (point-min))) + (delete-char -1)))) + ("*" + (cond + ((save-match-data + (and (or (= (point) 2) + (looking-back "\\(?:[[:space:]]\\|\s\\)\\(?:_\\|\\*\\)" + (max (- (point) 2) (point-min)))) + (not (looking-at "[[:space:]]\\|\s")))) + ;; Possible beginning of emphasis + (and + (save-excursion + (when (and (re-search-forward (regexp-quote (match-string 0)) + (line-end-position) t) + (looking-at "[[:space:][:punct:]]\\|\s") + (not (looking-back "\\(?:[[:space]]\\|\s\\)\\(?:_\\|\\*\\)" + (max (- (point) 2) (point-min))))) + (delete-char -1) (insert "/") t)) + (progn (delete-char -1) (insert "/")))) + ((save-excursion + (ignore-errors (backward-char 2)) + (or (and (bobp) (looking-at "\\*[[:space:]]")) + (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]"))) + ;; Bullet point, replace with hyphen + (delete-char -1) (insert "-")))))) + (buffer-string))) + +(defun gptel--replace-source-marker (num-ticks &optional end) + "Replace markdown style backticks with Org equivalents. + +NUM-TICKS is the number of backticks being replaced. If END is +true these are \"ending\" backticks. + +This is intended for use in the markdown to org stream converter." + (let ((from (match-beginning 0))) + (delete-region from (point)) + (if (and (= num-ticks 3) + (save-excursion (beginning-of-line) + (skip-chars-forward " \t") + (eq (point) from))) + (insert (if end "#+end_src" "#+begin_src ")) + (insert "=")))) + +;;;###autoload +(defun gptel--stream-convert-markdown->org (start-marker) + "Return a Markdown to Org converter. + +This function parses a stream of Markdown text to Org +continuously when it is called with successive chunks of the +text stream. + +START-MARKER is used to identify the corresponding process when +cleaning up after." + (letrec ((in-src-block nil) ;explicit nil to address BUG #183 + (in-org-src-block nil) + (temp-buf ; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 + (gptel--temp-buffer " *gptel-temp*")) + (start-pt (make-marker)) + (ticks-total 0) ;MAYBE should we let-bind case-fold-search here? + (cleanup-fn + (lambda (beg _) + (when (and (equal beg (marker-position start-marker)) + (eq (current-buffer) (marker-buffer start-marker))) + (when (buffer-live-p (get-buffer temp-buf)) + (set-marker start-pt nil) + (kill-buffer temp-buf)) + (remove-hook 'gptel-post-response-functions cleanup-fn))))) + (add-hook 'gptel-post-response-functions cleanup-fn) + (lambda (str) + (let ((noop-p) (ticks 0)) + (with-current-buffer (get-buffer temp-buf) + (save-excursion (goto-char (point-max)) (insert str)) + (when (marker-position start-pt) (goto-char start-pt)) + (when in-src-block (setq ticks ticks-total)) + (save-excursion + (while (re-search-forward "`\\|\\*\\{1,2\\}\\|_\\|^#+" nil t) + (pcase (match-string 0) + ("`" + ;; Count number of consecutive backticks + (backward-char) + (while (and (char-after) (eq (char-after) ?`)) + (forward-char) + (if in-src-block (cl-decf ticks) (cl-incf ticks))) + ;; Set the verbatim state of the parser + (if (and (eobp) + ;; Special case heuristic: If the response ends with + ;; ^``` we don't wait for more input. + ;; FIXME: This can have false positives. + (not (save-excursion (beginning-of-line) + (looking-at "^```$")))) + ;; End of input => there could be more backticks coming, + ;; so we wait for more input + (progn (setq noop-p t) (set-marker start-pt (match-beginning 0))) + ;; We reached a character other than a backtick + (cond + ;; Ticks balanced, end src block + ((= ticks 0) + (progn (setq in-src-block nil) + (gptel--replace-source-marker ticks-total 'end))) + ;; Positive number of ticks, start an src block + ((and (> ticks 0) (not in-src-block)) + (setq ticks-total ticks + in-src-block t) + (gptel--replace-source-marker ticks-total)) + ;; Negative number of ticks or in a src block already, + ;; reset ticks + (t (setq ticks ticks-total))))) + ;; Handle headings and misguided #+begin_src text + ((and (guard (and (eq (char-before) ?#) (or (not in-src-block) in-org-src-block))) + heading) + (if in-org-src-block + ;; If we are inside an Org-style src block, look for #+end_src + (cond + ((< (- (point-max) (point)) 8) ;not enough information to close Org src block + (setq noop-p t) (set-marker start-pt (match-beginning 0))) + ((looking-at "\\+end_src") ;Close Org src block + (setq in-src-block nil in-org-src-block nil))) + ;; Otherwise check for Markdown headings, or for #+begin_src + (cond + ((eobp) ; Not enough information about the heading yet + (setq noop-p t) (set-marker start-pt (match-beginning 0))) + ((looking-at "[[:space:]]") ; Convert markdown heading to Org heading + (delete-region (line-beginning-position) (point)) + (insert (make-string (length heading) ?*))) + ((< (- (point-max) (point)) 11) ;Not enough information to check if Org src block + (setq noop-p t) (set-marker start-pt (match-beginning 0))) + ((looking-at "\\+begin_src ") ;Overeager LLM switched to using Org src blocks + (setq in-src-block t in-org-src-block t))))) + ;; Handle other chars: emphasis, bold and bullet items + ((and "**" (guard (not in-src-block))) + (cond + ;; TODO Not sure why this branch was needed + ;; ((looking-at "\\*\\(?:[[:word:]]\\|\s\\)") (delete-char 1)) + + ;; Looking back at "w**" or " **" + ((looking-back "\\(?:[[:word:][:punct:]\n]\\|\s\\)\\*\\{2\\}" + (max (- (point) 3) (point-min))) + (delete-char -1)))) + ((and "*" (guard (not in-src-block))) + (if (eobp) + ;; Not enough information about the "*" yet + (progn (setq noop-p t) (set-marker start-pt (match-beginning 0))) + ;; "*" is either emphasis or a bullet point + (save-match-data + (save-excursion + (ignore-errors (backward-char 2)) + (cond + ((and ; At bob, underscore/asterisk followed by word + (or (and (bobp) (looking-at "\\(?:_\\|\\*\\)\\([^[:space:][:punct:]]\\|$\\)")) + (looking-at ; word followed by underscore/asterisk + "[^[:space:]\n]\\(?:_\\|\\*\\)\\(?:[[:space:][:punct:]]\\|$\\)") + (looking-at ; underscore/asterisk followed by word + "\\(?:[[:space:]]\\)\\(?:_\\|\\*\\)\\([^[:space:]]\\|$\\)")) + (not (looking-at "[[:punct:]]\\(?:_\\|\\*\\)[[:punct:]]"))) + ;; Emphasis, replace with slashes + (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "/")) + ((or (and (bobp) (looking-at "\\*[[:space:]]")) + (looking-at "\\(?:$\\|\\`\\)\n\\*[[:space:]]")) + ;; Bullet point, replace with hyphen + (forward-char (if (bobp) 1 2)) (delete-char -1) (insert "-")))))))))) + (if noop-p + (buffer-substring (point) start-pt) + (prog1 (buffer-substring (point) (point-max)) + (set-marker start-pt (point-max))))))))) + +(provide 'gptel-org) +;;; gptel-org.el ends here + +;; Silence warnings about `org-element-type-p' and `org-element-parent', see #294. +;; Local Variables: +;; byte-compile-warnings: (not unresolved) +;; End: diff --git a/elpa/gptel-20260425.846/gptel-pkg.el b/elpa/gptel-20260425.846/gptel-pkg.el new file mode 100644 index 00000000..61c61cc3 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-pkg.el @@ -0,0 +1,12 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "gptel" "20260425.846" + "Interact with ChatGPT or other LLMs." + '((emacs "27.1") + (transient "0.7.4") + (compat "30.1.0.0")) + :url "https://github.com/karthink/gptel" + :commit "101904a1a8568fe42df49f0f1acd4ddab39ae1f8" + :revdesc "101904a1a856" + :keywords '("convenience" "tools") + :authors '(("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) + :maintainers '(("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com"))) diff --git a/elpa/gptel-20260425.846/gptel-request.el b/elpa/gptel-20260425.846/gptel-request.el new file mode 100644 index 00000000..f50173a0 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-request.el @@ -0,0 +1,3084 @@ +;;; gptel-request.el --- LLM request library for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 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 exceeds this +threshold, the data is written to a temporary file and passed to Curl using the +`--data-binary' option with a file reference. Otherwise, the data is passed +directly as a command-line argument. + +The value is an integer representing the number of bytes. + +Adjusting this value may be necessary depending on the environment +and the typical size of the data being sent in gptel queries. +A larger value may improve performance by avoiding the overhead of creating +temporary files for small data payloads, while a smaller value may be needed +if the command-line argument size is limited by the operating system. + +The default of #x8000 for windows comes from Microsoft documentation +located here: +https://learn.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-createprocessa + +It is set to (#x8000 - #x1000 - 2) to account for other (non-data) Curl +command line arguments." + :type 'natnum) + +(define-obsolete-variable-alias 'gptel-prompt-filter-hook + 'gptel-prompt-transform-functions "0.9.9") + +(defcustom gptel-prompt-transform-functions + '(gptel--transform-apply-preset gptel--transform-add-context) + "Handlers to augment or transform a query before sending it. + +This hook is called in a temporary buffer containing the text to +be sent, with the cursor at the end of the prompt. You can use +it to modify the buffer or buffer-local variables as required. + +Since these functions modify the prompt construction buffer, the order +in which they run is significant! In particular, you may want to add +your function before (the default) or after +`gptel--transform-add-context', which adds gptel's context (other +buffers, files etc) to this buffer. + +Example: A typical use case might be to search for occurrences of $(cmd) +and replace it with the output of the shell command cmd, making it easy +to send the output of shell commands to the LLM. + +Transform functions can be synchronous or asynchronous. + +Synchronous hook functions must accept zero or one argument: the INFO +plist for the current request. + +Asynchronous hook functions must accept two arguments: a callback to +call after the transformation is complete, and the INFO plist for the +current request. + +Note that while this set of handlers can certainly be set with a global +value to be applied to all queries in all buffers, it meant to be set +locally for a specific buffer, or chat topic, or only the context of a +certain task." + :type 'hook) + +(defcustom gptel-post-request-hook nil + "Hook run after sending a gptel request. + +This runs (possibly) before any response is received." + :type 'hook) + +;; TODO(v1.0): Remove this. +(defvar gptel-response-filter-functions nil) +(make-obsolete-variable + 'gptel-response-filter-functions + "Response filtering is no longer supported in gptel. To toggle +markdown to Org conversion, see `gptel-org-convert-response'. To +filter LLM response text, either use `gptel-request' with a +custom callback, or use `gptel-post-response-functions'." + "0.9.7") + +;; TODO: Handle `prog-mode' using the `comment-start' variable +(defcustom gptel-prompt-prefix-alist + '((markdown-mode . "### ") + (org-mode . "*** ") + (text-mode . "### ")) + "String used as a prefix to the query being sent to the LLM. + +This is meant for the user to distinguish between queries and +responses, and is removed from the query before it is sent. + +This is an alist mapping major modes to the prefix strings. This +is only inserted in dedicated gptel buffers." + :type '(alist :key-type symbol :value-type string)) + +(defcustom gptel-response-prefix-alist + '((markdown-mode . "") + (org-mode . "") + (text-mode . "")) + "String inserted before the response from the LLM. + +This is meant for the user to distinguish between queries and +responses. + +This is an alist mapping major modes to the reply prefix strings. This +is only inserted in dedicated gptel buffers before the AI's response." + :type '(alist :key-type symbol :value-type string)) + +(defcustom gptel-response-separator "\n\n" + "String inserted before responses. + +Also inserted before and after non-consecutive tool calls." + :type 'string) + +;; Model and interaction parameters +(defcustom gptel-directives + '((default . "You are a large language model living in Emacs and a helpful assistant. Respond concisely.") + (programming . "You are a large language model and a careful programmer. Provide code and only code as output without any additional text, prompt or note.") + (writing . "You are a large language model and a writing assistant. Respond concisely.") + (chat . "You are a large language model and a conversation partner. Respond concisely.")) + "System prompts or directives for the LLM. + +Each entry in this alist maps a symbol naming the directive to +the directive itself. By default, gptel uses the directive with +the key \\+`default'. + +To set the directive for a chat session interactively call +`gptel-send' with a prefix argument, or call `gptel-menu'. + +A \"directive\" is typically the system message (also called +system prompt or system instruction) sent at the beginning of +each request to the LLM. It is used to set general instructions, +expectations and the overall tone. + +gptel's idea of the directive is more general. A directive in +`gptel-directives' can be + +- A string, interpreted as the system message. + +- A list of strings, whose first (possibly nil) element is + interpreted as the system message, and the remaining elements + as (possibly nil) alternating user prompts and LLM responses. + This can be used to template the initial part of a conversation. + +- A function that returns a string or a list of strings, + interpreted as the above. This can be used to dynamically + generate a system message and/or conversation template based on + the current context. See the definition of + `gptel--rewrite-directive-default' for an example." + :safe #'always + :type '(alist :key-type symbol :value-type string)) + +(defcustom gptel-max-tokens nil + "Max tokens per response. + +This is roughly the number of words in the response. 100-300 is a +reasonable range for short answers, 400 or more for longer +responses. + +To set the target token count for a chat session interactively +call `gptel-send' with a prefix argument." + :safe #'always + :type '(choice (natnum :tag "Specify Token count") + (const :tag "Default" nil))) + +(defcustom gptel-temperature 1.0 + "\"Temperature\" of the LLM response. + +This is a number between 0.0 and 2.0 that controls the randomness +of the response, with 2.0 being the most random. + +To set the temperature for a chat session interactively call +`gptel-send' with a prefix argument." + :safe (lambda (v) (or (null v) (numberp v))) + :type '(choice (number :tag "Temperature value") + (const :tag "Use default" nil))) + +(defcustom gptel-cache nil + "Whether the LLM should cache request content. + +Some LLM backends can cache content sent to it by gptel, so that +only the newly included part of the text needs to be processed on +subsequent conversation turns. This results in faster and +significantly cheaper processing. + +NOTE: Manual or client-configurable caching is currently +supported only by the Anthropic API and thus the +`gptel-anthropic' backend. This variable has no effect on the +behavior of other backends. + +This variable controls which parts of the query will be cached, +and can be the symbols t or nil to cache everything or nothing +respectively. It can also be a list of symbols: + +- message: Cache conversation messages +- system: Cache the system message +- tool: Cache tool definitions + +Examples: + +Setting it to (message system) will cache the system message and +the conversation text. + +Setting it to (message system tool) will cache everything and is +the same as t." + :type '(choice + (const :tag "Cache everything" t) + (const :tag "Do not cache" nil) + (repeat symbol)) + :group 'gptel) + +(defvar gptel--known-backends nil + "Alist of LLM backends known to gptel. + +This is an alist mapping user-provided names to backend structs, +see `gptel-backend'. + +You can have more than one backend pointing to the same resource +with differing settings.") + +(defvar gptel--openai nil) +(make-obsolete-variable 'gptel--openai "No longer used" "v0.9.9.5") + +(defcustom gptel-backend nil + "LLM backend to use. + +This is the default \"backend\" used by gptel, an object specifying +connection, authentication and model information required to send LLM +requests. + +There are two ways to set `gptel-backend': + +1. with `setopt' or the Customize interface, +2. and via constructors (such as `gptel-make-openai') in Elisp code. + +When using `setopt' or the customize interface, a backend may be +specified in a list such as + + (BACKEND-TYPE NAME . PLIST) + +where: + +BACKEND-TYPE is one of `gptel-openai' (all OpenAI-compatible +services), `gptel-anthropic', `gptel-gemini', `gptel-ollama', +`gptel-kagi', `gptel--gh' (GitHub Copilot), `gptel-bedrock' (AWS +Bedrock), `gptel-perplexity', `gptel-deepseek' or `gptel-privategpt'. + +NAME is a string, any backend name of your choosing. + +PLIST is an optional plist specifying connection and authentication +information, with keys + +:protocol - \"http\" or \"https\" +:host - Host, such as \"api.openai.com\" or \"localhost:1616\" +:endpoint - connection endpoint, such as \"/v1/chat/completions\" +:header - HTTP header to inclue with the request, a string + or function +:key - API key, if required for authentication + String, symbol or function, see `gptel-api-key' +:models - List of supported models (symbols, see + `gptel--openai-models' for an example) +:stream - Whether to stream responses, boolean +:request-params - Additional parameters to send with backend queries, as + a plist. This plist is converted to JSON when sending. + This is meant for request parameters that gptel does not + provide user options for. +:curl-args - list of strings representing additional Curl arguments (if + `gptel-use-curl' is set) + +When using the OpenAI, Anthropic, Gemini, Kagi, Github Copilot, +Perplexity or Deepseek backends, all plist keys are optional. For other +services, specifying some fields may be required. Examples: + + (setopt gptel-backend \\='(gptel-openai \"OpenAI\" + :key gptel-api-key-from-auth-source + :stream t)) + + (setopt gptel-backend \\='(gptel-anthropic \"Claude\" :key \"sk-...\")) + + (setopt gptel-backend \\='(gptel-ollama \"Ollama\" + :host \"localhost:11434\" + :models (qwen3:4b llama3.1:8b) + :stream t)) + +This list of keys is non-exhaustive. Some backends (such as +`gptel-bedrock') recognize or require additional keys. To see what +other keys are available, check the corresponding constructor (such as +`gptel-make-bedrock'). + +When not using `setopt', backends for LLM providers (local or remote) +may be constructed and registered using one of the available backend +constructor functions: + +- `gptel-make-openai' +- `gptel-make-anthropic' +- `gptel-make-gemini' +- `gptel-make-ollama' +- `gptel-make-azure' +- `gptel-make-gpt4all' +- `gptel-make-kagi' +- `gptel-make-privategpt' +- `gptel-make-perplexity' +- `gptel-make-deepseek' +- `gptel-make-xai' +- `gptel-make-gh-copilot' +- `gptel-make-bedrock' + +In addition, `gptel-backend' can be assigned to them. Examples: + + (setq gptel-backend (gptel-make-openai \"llamacpp\" + :host \"localhost:8080\" + :protocol \"http\" + :models \\='(gpt-oss-120b glm-4.7-flash))) + + (setq gptel-backend (gptel-make-gemini \"Gemini\" + :key gptel-api-key :stream t)) + + (setq gptel-backend (gptel-make-anthropic \"Claude-think\" + :key gptel-api-key + :request-params + \\='(:thinking (:type \"enabled\" :budget_tokens 1024) + :max_tokens 2048))) + +See their documentation for more information and the package README for +examples. Once registered, backends may be retrieved using +`gptel-get-backend' or switched to interactively from gptel's menu (see +`gptel-menu')." + :safe #'always + :type + (let ((types '( choice :tag "Type" + (const :tag "OpenAI compatible" gptel-openai) + (const gptel-anthropic) + (const gptel-gemini) + (const gptel-ollama) + (const gptel-kagi) + (const :tag "GitHub Copilot" gptel-gh) + (const gptel-bedrock) + (const gptel-perplexity) + (const gptel-deepseek) + (const gptel-privategpt)))) + `(choice + (restricted-sexp :match-alternatives (gptel-backend-p 'nil) + :tag "No backend") + (cons :tag "(BACKEND-TYPE NAME . PLIST)" ;accommodate (gptel-openai "chatgpt" . plist) + ,types (cons string + (plist :value-type (choice string symbol function + (repeat symbol))))) + (cons :tag "(BACKEND-TYPE . PLIST)" ;accommodate (gptel-openai :name "chatgpt" . plist) + ,types (plist :value-type (choice string symbol function + (repeat symbol)))))) + :get + (lambda (sym) + (when-let* ((backend (default-toplevel-value sym)) + (type (type-of backend)) + (plist (list :protocol (gptel-backend-protocol backend) + :host (gptel-backend-host backend) + :endpoint (gptel-backend-endpoint backend) + :header (gptel-backend-header backend) + :key (gptel-backend-key backend) + :models (gptel-backend-models backend) + :stream (gptel-backend-stream backend) + :curl-args (gptel-backend-curl-args backend) + :request-params (gptel-backend-request-params backend)))) + (apply #'list type (gptel-backend-name backend) + (cl-loop for (k v) on plist by #'cddr + if (and (readablep v) (not (null v))) + collect k and collect v)))) + :set + (lambda (sym val) + (cond + ((null val) (set-default-toplevel-value sym val)) + ((listp val) + (let* ((name (if (stringp (cadr val)) ;explicit and implicit :name specification + (cadr val) (plist-get (cdr val) :name))) + (args (if name (cddr val) (cdr val))) + type) + (cl-remf args :name) + (if (memq (car val) '(gptel-gh gptel--gh)) + (setq type 'gptel-gh-copilot) + (setq type (car val))) + (set-default-toplevel-value + sym (apply (intern (concat "gptel-make-" + (substring (symbol-name type) 6))) + name args)))) + ((gptel-backend-p val) (set-default-toplevel-value sym val))))) + +(defcustom gptel-model nil + (concat + "Model for gptel queries. + +The name of the model, as a symbol. This is the name as expected +by the LLM provider's API. + +To set the model for a chat session interactively call +`gptel-send' with a prefix argument.") + :safe #'always + :type `(choice + (symbol :tag "Specify model name") + ,@(cl-loop + for (_name . backend) in gptel--known-backends + append (mapcar + (lambda (model) (list 'const :tag (symbol-name model) + model)) + (gptel-backend-models backend))))) + +(defvar gptel-expert-commands nil + "Whether experimental gptel options should be enabled. + +This opens up advanced options in `gptel-menu'.") + +(defvar gptel--num-messages-to-send nil) +(put 'gptel--num-messages-to-send 'safe-local-variable #'integer-or-null-p) + +(defcustom gptel-log-level nil + "Logging level for gptel. + +This is one of nil or the symbols info and debug: + +nil: Don't log responses +info: Log request and response bodies +debug: Log request/response bodies, headers and all other + connection settings. + +When non-nil, information is logged to `gptel--log-buffer-name', +which see." + :type '(choice + (const :tag "No logging" nil) + (const :tag "Limited" info) + (const :tag "Full" debug))) + +(defcustom gptel-track-response t + "Distinguish between user messages and LLM responses. + +When creating a prompt to send to the LLM, gptel distinguishes +between text entered by the user and past LLM responses. This +distinction is necessary for back-and-forth conversation with an +LLM. + +In regular Emacs buffers you can turn this behavior off by +setting `gptel-track-response' to nil. All text, including +past LLM responses, is then treated as user input when sending +queries. + +This variable has no effect in dedicated chat buffers (buffers +with `gptel-mode' enabled), where user prompts and responses are +always handled separately." + :type 'boolean) + +(defcustom gptel-track-media nil + "Whether links to supported media types should be followed. + +When this is non-nil, gptel will send text, images or other media from +links in Org and Markdown buffers to the LLM. + +Sending images or other binary media from links requires the +active `gptel-model' to support it. See `gptel-make-openai', +`gptel-make-anthropic', `gptel-make-ollama' or `gptel-make-gemini' for +details on how to specify media support for models. + +To include media (including binary formats like images) more generally, +you can also use `gptel-add' or `gptel-add-file' instead." + :type 'boolean) + +(defcustom gptel-use-context 'system + "Where in the request to inject gptel's additional context. + +gptel always includes the active region or the buffer up to the +cursor in the request to the LLM. Additionally, you can add +other buffers or their regions to the context with +`gptel-add-context', or from gptel's menu. This data will be +sent with every request. + +This option controls whether and where this additional context is +included in the request. + +Currently supported options are: + + nil - Do not use the context. + system - Include the context with the system message. + user - Include the context with the user prompt." + :group 'gptel + :type '(choice + (const :tag "Don't include context" nil) + (const :tag "With system message" system) + (const :tag "With user prompt" user))) + +(defcustom gptel-include-reasoning 'ignore + "How to handle LLM reasoning or \"thinking\" text blocks. + +Some LLMs include in their response a \"thinking\" section. This +text improves the quality of the LLM's final output, but may not +be interesting to you by itself. + +Supported options are the symbols + + ignore - Include in the response but ignore on subsequent + conversation turns (default) + t - Include in the response + nil - Do not include + +It can also be a string naming a buffer, in which case the +reasoning text will be inserted at the end of that buffer." + :group 'gptel + :type '(choice + (const :tag "Include with response" t) + (const :tag "Don't include" nil) + (const :tag "Include but ignore" ignore) + (string :tag "Include in buffer"))) + +(define-obsolete-variable-alias 'gptel-context--alist 'gptel-context + "0.9.9.3") + +(defcustom gptel-context nil + "List of gptel's context sources. + +The items in this list (file names or buffers) are included with gptel +queries as additional context. + +Each entry can be a file path (string) or a buffer (object, not buffer +name): + + \\='(\"~/path/to/file1\" + \"./file2\" + # + ...) + +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" ()) + `(let ((json-object-type 'plist)) + (json-read-from-string ,str)))) + +(defmacro gptel--json-encode (object) + "Serialize OBJECT as JSON." + (if (fboundp 'json-serialize) + `(json-serialize ,object + :null-object :null + :false-object :json-false) + (require 'json) + (defvar json-false) + (defvar json-null) + (declare-function json-encode "json" (object)) + `(let ((json-false :json-false) + (json-null :null)) + (json-encode ,object)))) + +(defmacro gptel--maybe-funcall (func-or-sym &rest args) + "If FUNC-OR-SYM is a function, call it with ARGS. + +Otherwise, evaluate it as a variable." + `(if (functionp ,func-or-sym) + ;; TODO(v1.0) Remove this condition-case. This arity check is for + ;; benefit of users who have personal customizations touching gptel's + ;; internal API re: backend header and url functions. + (condition-case nil + (apply ,func-or-sym (list ,@args)) + (wrong-number-of-arguments + (message "Displaying warning") + (display-warning + 'gptel (format "%s calling convention has changed: \ +Called with %d arguments but accept %d. \ +Please update them, and see NEWS (0.9.9.5) for details." + (if (symbolp ,func-or-sym) (format "Function %s" ,func-or-sym) + "gptel-backend-header/gptel-backend-url function") + (length ',args) (car (func-arity ,func-or-sym)))) + (funcall ,func-or-sym))) + ,func-or-sym)) + +(defun gptel--process-models (models) + "Convert items in MODELS to symbols with appropriate properties." + (let ((models-processed)) + (dolist (model models) + (cl-etypecase model + (string (push (intern model) models-processed)) + (symbol (push model models-processed)) + (cons + (cl-destructuring-bind (name . props) model + (setf (symbol-plist name) + ;; MAYBE: Merging existing symbol plists is safer, but makes it + ;; difficult to reset a symbol plist, since removing keys from + ;; it (as opposed to setting them to nil) is more work. + ;; + ;; (map-merge 'plist (symbol-plist name) props) + props) + (push name models-processed))))) + (nreverse models-processed))) + +;;;; Backend interface +(defun gptel-get-backend (name) + "Return gptel backend with NAME. + +Throw an error if there is no match." + (or (alist-get name gptel--known-backends nil nil #'equal) + (user-error "Backend %s is not known to be defined" + name))) + +(gv-define-setter gptel-get-backend (val name) + `(setf (alist-get ,name gptel--known-backends + nil t #'equal) + ,val)) + +(cl-defstruct + (gptel-backend (:constructor gptel--make-backend) + (:copier gptel--copy-backend)) + name host header protocol stream + endpoint key models url request-params + curl-args + (coding-system + nil :documentation "Can be set to `binary' if the backend expects non UTF-8 output.")) + +;;;; Misc utilities +(defun gptel-api-key-from-auth-source (&optional host user) + "Lookup api key in the auth source. +By default, the LLM host for the active backend is used as HOST, +and \"apikey\" as USER." + (if-let* ((secret + (plist-get + (car (auth-source-search + :host (or host (gptel-backend-host gptel-backend)) + :user (or user "apikey") + :require '(:secret))) + :secret))) + (if (functionp secret) + (encode-coding-string (funcall secret) 'utf-8) + secret) + (user-error "No `gptel-api-key' found in the auth source"))) + +;; FIXME Should we utf-8 encode the api-key here? +(defun gptel--get-api-key (&optional key) + "Get api key from KEY, or from `gptel-api-key'." + (when-let* ((key-sym (or key (gptel-backend-key gptel-backend)))) + (cl-typecase key-sym + (function (string-trim-right (funcall key-sym) "[\n\r]+")) + (string (string-trim-right key-sym "[\n\r]+")) + (symbol (if-let* ((val (symbol-value key-sym))) + (gptel--get-api-key val) + (error "`gptel-api-key' is not valid"))) + (t (error "`gptel-api-key' is not valid"))))) + +(defsubst gptel--to-number (val) + "Ensure VAL is a number." + (cond + ((numberp val) val) + ((stringp val) (string-to-number val)) + ((error "%S cannot be converted to a number" val)))) + +(defsubst gptel--to-string (s) + "Convert S to a string, if possible." + (cl-typecase s + (symbol (symbol-name s)) + (string s) + (otherwise (prin1-to-string s)))) + +(defsubst gptel--intern (s) + "Intern S, if possible." + (cl-etypecase s + (symbol s) + (string (intern s)))) + +(defun gptel--merge-plists (&rest plists) + "Merge PLISTS, altering the first one. + +Later plists in the sequence take precedence over earlier ones." + (let (;; (rtn (copy-sequence (pop plists))) + (rtn (pop plists)) + p v ls) + (while plists + (setq ls (pop plists)) + (while ls + (setq p (pop ls) v (pop ls)) + (setq rtn (plist-put rtn p v)))) + rtn)) + +(defun gptel--file-binary-p (path) + "Check if file at PATH is readable and binary." + ;; HACK Image files with ICC color profiles are characterized as ASCII + ;; (#1223), so until we find a better solution we just match these files by + ;; extension. + (or (string-match-p "\\.\\(jpe?g\\|png\\|gif\\|webp\\)\\'" path) + (condition-case nil + (with-temp-buffer + (insert-file-contents path nil 1 512 'replace) + (memq buffer-file-coding-system + '(no-conversion no-conversion-multibyte))) + (file-missing (message "File \"%s\" is not readable." path) + nil)))) + +(defun gptel--insert-file-string (path) + "Insert at point the contents of the file at PATH as context." + (insert (format "In file `%s`:" (abbreviate-file-name path)) + "\n\n```\n") + (let ((pm (point-marker))) + (set-marker-insertion-type pm t) + (insert-file-contents path) + (goto-char pm)) + (insert "\n```\n")) + +(defun gptel--strip-mode-suffix (mode-sym) + "Remove the -mode suffix from MODE-SYM. + +MODE-SYM is typically a major-mode symbol." + (or (alist-get mode-sym gptel--mode-description-alist) + (let ((mode-name (thread-last + (symbol-name mode-sym) + (string-remove-suffix "-mode") + (string-remove-suffix "-ts")))) + ;; NOTE: The advertised calling convention of provided-mode-derived-p + ;; has changed in Emacs 30, this needs to be updated eventually + (if (provided-mode-derived-p + mode-sym 'prog-mode 'text-mode 'tex-mode) + mode-name "")))) + +(defvar url-http-end-of-headers) +(defvar url-http-response-status) +(cl-defun gptel--url-retrieve (url &key method data headers) + "Retrieve URL synchronously with METHOD, DATA and HEADERS." + (declare (indent 1)) + (let ((url-request-method (if (eq method 'post) "POST" "GET")) + (url-request-data (when (eq method 'post) (encode-coding-string (gptel--json-encode data) 'utf-8))) + (url-mime-accept-string "application/json") + (url-request-extra-headers + `(("content-type" . "application/json") + ,@headers))) + (with-current-buffer (url-retrieve-synchronously url 'silent) + (goto-char url-http-end-of-headers) + (gptel--json-read)))) + +(defsubst gptel-prompt-prefix-string () + "Prefix before user prompts in `gptel-mode'." + (declare (side-effect-free t)) + (or (alist-get major-mode gptel-prompt-prefix-alist) "")) + +(defsubst gptel-response-prefix-string () + "Prefix before LLM responses in `gptel-mode'." + (declare (side-effect-free t)) + (or (alist-get major-mode gptel-response-prefix-alist) "")) + +(defmacro gptel--at-word-end (&rest body) + "Execute BODY at end of the current word or punctuation." + `(save-excursion + (skip-syntax-forward "w.") + ,(macroexp-progn body))) + +;; NOTE: Remove after we drop Emacs 27.1 (#724) +(defmacro gptel--temp-buffer (buf) + "Generate a temp buffer BUF. + +Compatibility macro for Emacs 27.1." + (if (< emacs-major-version 28) + `(generate-new-buffer ,buf) + `(generate-new-buffer ,buf t))) + +;; This is defined in gptel, but we define it here as well as it's required by +;; `gptel--with-buffer-copy'. +(defvar gptel-mode nil) + +(defmacro gptel--with-buffer-copy (buf start end &rest body) + "Copy gptel's local variables from BUF to a temp buffer and run BODY. + +If positions START and END are provided, insert that part of BUF first." + (declare (indent 3)) + `(gptel--with-buffer-copy-internal ,buf ,start ,end (lambda () ,@body))) + +(defun gptel--with-buffer-copy-internal (buf start end body-thunk) + "Prepare a temp buffer for a gptel request. + +For BUF, START, END and BODY-THUNK see `gptel--with-buffer-copy'." + (let ((temp-buffer (gptel--temp-buffer " *gptel-prompt*"))) + (with-current-buffer temp-buffer + (dolist (sym '( gptel-backend gptel--system-message gptel-model + gptel-mode gptel-track-response gptel-track-media + gptel-use-tools gptel-tools gptel-use-curl gptel--schema + gptel-use-context gptel-context gptel--num-messages-to-send + gptel-stream gptel-include-reasoning gptel--request-params + gptel-temperature gptel-max-tokens gptel-cache)) + (set (make-local-variable sym) (buffer-local-value sym buf))) + (when (and start end) (insert-buffer-substring buf start end)) + (setq major-mode (buffer-local-value 'major-mode buf)) + (funcall body-thunk)))) + +(defsubst gptel--trim-prefixes (s) + "Remove prompt/response prefixes from string S. + +Return nil if string collapses to empty string." + (let* ((trimmed (string-trim-left + s (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*" + (regexp-quote + (gptel-prompt-prefix-string))))) + (trimmed (string-trim-right + trimmed (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*" + (regexp-quote + (gptel-response-prefix-string)))))) + (unless (string-empty-p trimmed) + trimmed))) + +(defun gptel--link-standalone-p (link) + "Return non-nil if Markdown LINK is isolated. + +This means the extent from the link beginning to end is the only +non-whitespace content on its line." + (let ((beg (car link)) (end (cadr link))) + (save-excursion + (and (= beg (progn (goto-char beg) (beginning-of-line) + (skip-chars-forward "\t ") + (point))) + (= end (progn (goto-char end) (end-of-line) + (skip-chars-backward "\t ") + (point))))))) + +(defsubst gptel--curl-path () + "Curl executable to use." + (if (stringp gptel-use-curl) gptel-use-curl "curl")) + +(defun gptel--transform-add-context (callback fsm) + (if (and gptel-use-context gptel-context) + (gptel-context--wrap callback (plist-get (gptel-fsm-info fsm) :data)) + (funcall callback))) + +;;;; Model interface +;; NOTE: This interface would be simpler to implement as a defstruct. But then +;; users cannot set `gptel-model' to a symbol/string directly, or we'd need +;; another map from these symbols to the actual model structs. + +(defsubst gptel--model-name (model) + "Get name of gptel MODEL." + (gptel--to-string model)) + +(defsubst gptel--model-capabilities (model) + "Get MODEL capabilities." + (get model :capabilities)) + +(defsubst gptel--model-mimes (model) + "Get supported mime-types for MODEL." + (get model :mime-types)) + +(defsubst gptel--model-capable-p (cap &optional model) + "Return non-nil if MODEL supports capability CAP." + (memq cap (gptel--model-capabilities + (or model gptel-model)))) + +;; TODO Handle model mime specifications like "image/*" +(defsubst gptel--model-mime-capable-p (mime &optional model) + "Return non nil if MODEL can understand MIME type." + (car-safe (member mime (gptel--model-mimes + (or model gptel-model))))) + +(defsubst gptel--model-request-params (model) + "Get model-specific request parameters for MODEL." + (get model :request-params)) + +;;;; File handling +(defun gptel--base64-encode (file) + "Encode FILE as a base64 string. + +FILE is assumed to exist and be a regular file." + (with-temp-buffer + (insert-file-contents-literally file) + (base64-encode-region (point-min) (point-max) + :no-line-break) + (buffer-string))) + +;;;; Directive handling + +(defvar gptel--system-message + (or (alist-get 'default gptel-directives) + "You are a large language model living in Emacs and a helpful assistant. Respond concisely.") + "The system message used by gptel.") +(put 'gptel--system-message 'safe-local-variable + #'(lambda (v) (or (string-or-null-p v) + (and (listp v) + (cl-every #'string-or-null-p v))))) + +(defun gptel--describe-directive (directive width &optional replacement) + "Find description for DIRECTIVE, truncated to WIDTH. + +DIRECTIVE is a gptel directive, and can be a string, a function +or a list of strings. See `gptel-directives'. + +The result is a string intended for display. Newlines are +replaced with REPLACEMENT." + (cl-typecase directive + (string + (string-replace + "\n" (or replacement " ") + (substring directive 0 (min width (length directive))))) + (function + (concat + "λ: " + (string-replace + "\n" (or replacement " ") + (truncate-string-to-width + (or (and-let* ((doc (documentation directive))) + (substring doc nil (string-match-p "\n" doc))) + "[Dynamically generated; no preview available]") + width nil nil t)))) + (list (and-let* ((from-template (car directive))) + (gptel--describe-directive + from-template width))) + (t ""))) + +(defun gptel--parse-directive (directive &optional raw) + "Parse DIRECTIVE into a backend-appropriate form. + +DIRECTIVE is a gptel directive: it can be a string, a list or a +function that returns either, see `gptel-directives'. + +Return a cons cell consisting of the system message (a string) +and a template consisting of alternating user/LLM +records (a list of strings or nil). + +If RAW is non-nil, the user/LLM records are not processed and are +returned as a list of strings." + (and directive + (cl-etypecase directive + (string (list directive)) + (function (gptel--parse-directive (funcall directive) raw)) + (cons (if raw directive + (cons (car directive) + ;; FIXME(augment) do this elsewhere + (gptel--parse-list + gptel-backend (cdr directive)))))))) + + +;;; 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 or nil, results of tool calls are always or never +included in the LLM response, respectively. + +If set to the symbol auto (the default), a tool call result is +included only when the corresponding tool spec has a non-nil +:include slot. See `gptel-make-tool'." + :type '(choice + (const :tag "Tool decides" auto) + (const :tag "Always" t) + (const :tag "Never" nil))) + +(defcustom gptel-tools nil + "A list of tools to include with gptel requests. + +Each tool should be a `gptel-tool' struct, which see. To specify +a tool, use `gptel-make-tool', which see." + :group 'gptel + :type '(repeat gptel-tool)) + +(cl-defstruct (gptel-tool (:constructor nil) + (:constructor gptel--make-tool-internal + (&key function name description args + async category confirm include + &allow-other-keys)) + (:copier gptel--copy-tool)) + "Struct to specify tools for LLMs to run. + +A tool is a function specification sent to the LLM along with +a (plain language) task. If the LLM decides to use the tool to +accomplish the task, gptel will run the tool and (optionally) +feed the LLM the results. You can add tools via +`gptel-make-tool', which see." + (function nil :type function :documentation "Function that runs the tool") + (name nil :type string :documentation "Tool name, snake_case recommended") + (description nil :type string :documentation "What the tool does, intended for the LLM") + (args nil :type list :documentation "List of plists specifying function arguments") + (async nil :type boolean :documentation "Whether the function runs asynchronously") + (category nil :type string :documentation "Use to group tools by purpose") + (confirm nil :type boolean :documentation "Seek confirmation before running tool?") + (include t :type boolean :documentation "Include tool results in buffer?")) + +(defun gptel--preprocess-tool-args (spec) + "Convert symbol :type values in tool SPEC to strings destructively." + ;; NOTE: Do not use `sequencep' here, as that covers strings too and breaks + ;; things. + (when (or (listp spec) (vectorp spec)) + (cond + ((vectorp spec) + (cl-loop for element across spec + for idx upfrom 0 + do (aset spec idx (gptel--preprocess-tool-args element)))) + ((keywordp (car spec)) + (let ((tail spec)) + (while tail + (when (and (eq (car tail) :type) (symbolp (cadr tail))) + (setcar (cdr tail) (symbol-name (cadr tail)))) + ;; TODO: Handle :enum ("provided" "as" "list") here, convert to + ;; :enum ["provided" "as" "array"] + (when (or (listp (cadr tail)) (vectorp (cadr tail))) + (gptel--preprocess-tool-args (cadr tail))) + (setq tail (cddr tail))))) + ((listp spec) (dolist (element spec) + (when (listp element) + (gptel--preprocess-tool-args element)))))) + spec) + +(defun gptel--make-tool (&rest spec) + "Construct a gptel-tool according to SPEC." + (gptel--preprocess-tool-args (plist-get spec :args)) + (apply #'gptel--make-tool-internal spec)) + +(defvar gptel--known-tools nil + "Alist of gptel tools arranged by category. + +A \"tool\" is a function spec (definition and description) +provided by gptel to an LLM. See `gptel-tool'. Each tool is +assigned a category when it is created, with a category of +\"misc\" if none is specified. + +This is a two-level alist mapping categories and tool names to +the tool itself. It is used as a global register of available +tools and in gptel's UI, see variable `gptel-tools'. + +In this example structure, cat-tool and the rest are cl-structs +of type `gptel-tool': + + CATEGORY TOOL NAME TOOL + ((\"filesystem\" . ((\"read_file\" . cat-tool) + (\"list_directory\" . ls-tool))) + (\"emacs\" . ((\"read_buffer\" . buffer-substring-tool) + (\"send_message\" . message-tool)))) + +This variable is for internal use only, to define a tool use +`gptel-make-tool'.") + +(defun gptel-get-tool (path) + "Find tool in gptel's tool registry at PATH. + +PATH can be specified +- as a string representing the tool name, like \"search_db\", +- or as a list representing a category and tool name, + like \\='(\"emacs\" \"read_buffer\"). +In both cases, the first matching gptel-tool is returned. + +- as a string representing a category, like \"filesystem\". +In this case a list of all gptel-tools with this category is +returned." + (or (cl-etypecase path + (cons (let ((tc (map-nested-elt gptel--known-tools path))) + (if (consp tc) (map-values tc) tc))) + (string (if-let* ((category (assoc path gptel--known-tools))) + (map-values (cdr category)) + (cl-loop for (_ . tools) in gptel--known-tools + if (assoc path tools) + return (cdr it))))) + (error "No tool matches for %S" path))) + +(defun gptel-make-tool (&rest slots) + "Make a gptel tool for LLM use. + +The following keyword arguments are available, of which the first +four SLOTS are required. + +NAME: The name of the tool, recommended to be in Javascript style snake_case. + +FUNCTION: The function itself (lambda or symbol) that runs the tool. + +DESCRIPTION: A verbose description of what the tool does, how to +call it and what it returns. + +ARGS: A list of plists specifying the arguments, or nil for a function that +takes no arguments. Each plist in ARGS requires the following keys: +- argument :name and :description, as strings. +- argument :type, as a symbol. Allowed types are those understood by the JSON + schema: string, number, integer, boolean, array, object or null + +The following plist keys are conditional/optional: +- :optional, boolean indicating if argument is optional +- :enum for enumerated types, whose value is a vector of strings representing + allowed values. Note that :type is still required for enums. +- :items, if the :type is array. Its value must be a plist including at least + the item's :type. +- :properties, if the type is object. Its value must be a plist that can be + serialized into a JSON object specification by `json-serialize'. + +ASYNC: boolean indicating if the elisp function is asynchronous. +If ASYNC is t, the function should take a callback as its first +argument, along with the arguments specified in ARGS, and run the +callback with the tool call result when it's ready. The callback +itself is an implementation detail and must not be included in +ARGS. + +The following keys are optional + +CATEGORY: A string indicating a category for the tool. This is +used only for grouping in gptel's UI. Defaults to \"misc\". + +CONFIRM: Whether the tool call should wait for the user to run it. If +true, the user will be prompted with the proposed tool call, which can +be examined, accepted, deferred or canceled. It can also be a function +that receives the same arguments as FUNCTION and returns true if the +user should be prompted. + +INCLUDE: Whether the tool results should be included as part of +the LLM output. This is useful for logging and as context for +subsequent requests in the same buffer. This is primarily useful +in chat buffers. + +Here is an example definition: + + (gptel-make-tool + :function (lambda (location unit) + (url-retrieve-synchronously \"api.weather.com/...\" + location unit)) + :name \"get_weather\" + :description \"Get the current weather in a given location\" + :args (list \\='(:name \"location\" + :type string + :description \"The city and state, e.g. San Francisco, CA\") + \\='(:name \"unit\" + :type string + :enum [\"celsius\" \"farenheit\"] + :description + \"The unit of temperature, either \\='celsius\\=' or \\='fahrenheit\\='\" + :optional t))) + +If the tool is asynchronous, the function is modified to take a +callback as its first argument, which it runs with the result: + + (lambda (callback location unit) + (url-retrieve \"api.weather.com/...\" + (lambda (_) + (let ((result (parse-this-buffer))) + (funcall callback result)))))" + (let* ((tool (apply #'gptel--make-tool slots)) + (category (or (gptel-tool-category tool) "misc"))) + (setf (alist-get + (gptel-tool-name tool) + (alist-get category gptel--known-tools nil nil #'equal) + nil nil #'equal) + tool))) + +(cl-defgeneric gptel--parse-tools (_backend tools) + "Parse TOOLS and return a list of prompts. + +TOOLS is a list of `gptel-tool' structs, which see. + +_BACKEND is the LLM backend in use. This is the default +implementation, used by OpenAI-compatible APIs and Ollama." + (vconcat + (mapcar + (lambda (tool) + (list + :type "function" + :function + (append + (list + :name (gptel-tool-name tool) + :description (gptel-tool-description tool)) + (if (gptel-tool-args tool) + (list + :parameters + (list :type "object" + ;; gptel's tool args spec is close to the JSON schema, except + ;; that we use (:name "argname" ...) + ;; instead of (:argname (...)), and + ;; (:optional t) for each arg instead of (:required [...]) + ;; for all args at once. Handle this difference by + ;; modifying a copy of the gptel tool arg spec. + :properties + (cl-loop + for arg in (gptel-tool-args tool) + for argspec = (copy-sequence arg) + for name = (plist-get arg :name) ;handled differently + for newname = (or (and (keywordp name) name) + (make-symbol (concat ":" name))) + do ;ARGSPEC is ARG without unrecognized keys + (cl-remf argspec :name) + (cl-remf argspec :optional) + if (equal (plist-get arg :type) "object") + do (unless (plist-member argspec :required) + (plist-put argspec :required [])) + (plist-put argspec :additionalProperties :json-false) + append (list newname argspec)) + :required + (vconcat + (delq nil (mapcar + (lambda (arg) (and (not (plist-get arg :optional)) + (plist-get arg :name))) + (gptel-tool-args tool)))) + :additionalProperties :json-false)) + (list :parameters (list :type "object" :properties nil)))))) + (ensure-list tools)))) + +(cl-defgeneric gptel--parse-tool-results (backend results) + "Return a BACKEND appropriate prompt containing tool call RESULTS. + +This will be injected into the messages list in the prompt to +send to the LLM.") + +;; FIXME(fsm) unify this with `gptel--inject-media', which is a mess +(cl-defgeneric gptel--inject-prompt + (_backend data new-prompt &optional position) + "Inject NEW-PROMPT into existing prompts in query DATA. + +NEW-PROMPT can be a single message or a list of messages. + +If POSITION is +- nil, append NEW-PROMPT at the end of DATA +- a non-negative integer, insert it at that position in DATA. +- a negative integer, insert it there counting from the end. + +- Not implemented: a list of accessors, inject it at that position. + +This generic implementation handles the Anthropic, +OpenAI-compatible and Ollama message formats." + (when (keywordp (car-safe new-prompt)) ;Is new-prompt one or many? + (setq new-prompt (list new-prompt))) + (let ((prompts (plist-get data :messages))) + (pcase position + ('nil (plist-put data :messages (vconcat prompts new-prompt))) + ((pred integerp) + (when (< position 0) (setq position (+ (length prompts) position))) + (plist-put data :messages (vconcat (substring prompts 0 position) + new-prompt + (substring prompts position))))))) + +(cl-defgeneric gptel--inject-tool-call (backend _data _tool-call new-call) + "Replace TOOL-CALL in query DATA with NEW-CALL. + +DATA is the request payload containing the array of user and assistant +messages, typically available as (plist-get INFO :data). TOOL-CALL is +the call plist as recorded by gptel's response parser(s). NEW-CALL is +the replacement plist containing the new tool name and arguments, in the +form + + (:name \"newName\" :args (:arg1 \"newArg\" :arg2 ...)) + +:name and :args are both optional. + +If NEW-CALL is nil, the tool call is removed from DATA and thus the turn +history. + +BACKEND is the `gptel-backend'." + (display-warning + '(gptel tool-call) + (format "Editing tool call arguments is not implemented for %s.\ + Ignoring new arguments %s" + (type-of backend) + (truncate-string-to-width (prin1-to-string new-call) 50 nil nil t)))) + + +;;; State machine for driving requests +(defvar gptel-request--transitions + `((INIT . ((t . WAIT))) + (WAIT . ((t . TYPE))) + (TYPE . ((,#'gptel--error-p . ERRS) + (,#'gptel--tool-use-p . TOOL) + (t . DONE))) + (TOOL . ((t . TRET))) + (TRET . ((,#'gptel--error-p . ERRS) + (,#'gptel--tool-result-p . WAIT) + (t . DONE)))) + "Alist specifying gptel's default state transition table for requests. + +Each entry is a list whose car is a request state (any symbol) +and whose cdr is an alist listing possible next states. Each key +is either a predicate function or t. When `gptel--fsm-next' is +called, the predicates are called in the order they appear here +to find the next state. Each predicate is called with the state +machine's INFO, see `gptel-fsm'. A predicate of t is +considered a success and acts as a default.") + +(defvar gptel-request--handlers + `((WAIT ,#'gptel--handle-wait) + (TOOL ,#'gptel--handle-tool-use) + (TRET ,#'gptel--handle-tool-result) + (DONE ,#'gptel--handle-post) + (ERRS ,#'gptel--handle-post) + (ABRT ,#'gptel--handle-post)) + "Alist specifying handlers for gptel's default state transitions. + +Each entry is a list whose car is a request state (a symbol) and +whose cdr is a list of handler functions called when +transitioning to that state. The handlers are called in the +sequence that they appear in the list, and each function receives +the state machine as its only argument. Information about the +request state can be retrieved via the machine's INFO slot, see +`gptel-fsm'. + +Handlers are responsible for doing state-related tasks (like +logging errors or inserting responses) and transitioning to the +next state by calling `gptel--fsm-transition'. + +Handlers can be asynchronous, in which case the transition call +should typically be placed in its callback.") + +(cl-defstruct (gptel-fsm (:constructor gptel-make-fsm) + (:copier gptel-copy-fsm)) + "State machine for gptel requests. + +STATE: The current state of the machine, can be any symbol. + +TABLE: Alist mapping states to possible next states +along with predicates to determine the next state. See +`gptel-request--transitions' for an example. + +HANDLERS: Alist mapping states to state handler functions. +Handlers are called when entering each state. See +`gptel-request--handlers' for an example + +INFO: The state machine's current context. This is a plist +holding all the information required for the ongoing request, and +can be used to tweak and resume a paused request. This should be +called \"context\", but context means too many things already in +gptel's code! + +Each gptel request is passed an instance of this +state machine and driven by it." + (state 'INIT) + (table gptel-request--transitions) + (handlers gptel-request--handlers) info) + +(defun gptel--fsm-transition (machine &optional new-state) + "Move MACHINE to its next state. + +MACHINE is an instance of `gptel-fsm'. + +The next state is NEW-STATE if given. Otherwise it is determined +automatically from MACHINE's transition table." + (unless new-state (setq new-state (gptel--fsm-next machine))) + (push (gptel-fsm-state machine) + (plist-get (gptel-fsm-info machine) :history)) + (setf (gptel-fsm-state machine) new-state) + (when-let* ((handlers (alist-get new-state (gptel-fsm-handlers machine)))) + (mapc (lambda (h) (funcall h machine)) handlers))) + +(defun gptel--fsm-next (machine) + "Determine MACHINE's next state according to its transition table. + +MACHINE is an instance of `gptel-fsm'" + (let* ((current (gptel-fsm-state machine)) + (transitions (alist-get current (gptel-fsm-table machine)))) + (cl-loop + with info = (gptel-fsm-info machine) + for (pred . next) in transitions + when (or (eq pred t) (funcall pred info)) + return next))) + +;;;; State machine handlers +;; The next few functions are default state handlers for gptel's state machine, +;; see `gptel-request--handlers'. + +(defun gptel--handle-wait (fsm) + "Fire the request contained in state machine FSM's info." + ;; Reset some flags in info. This is necessary when reusing fsm's context for + ;; a second network request: gptel tests for the presence of these flags to + ;; handle state transitions. (NOTE: Don't add :uuid to this.) + (let ((info (gptel-fsm-info fsm))) + (dolist (key '(:tool-result :tool-use :error :http-status :reasoning)) + (when (plist-get info key) + (plist-put info key nil)))) + (funcall + (if gptel-use-curl + #'gptel-curl-get-response + #'gptel--url-get-response) + fsm) + (run-hooks 'gptel-post-request-hook)) + +(defun gptel--process-tool-call (fsm tool-spec tool-call result) + "Add tool RESULT to a TOOL-CALL and transition FSM if required. + +TOOL-CALL is a plist with the tool :name, :args and other metadata. +TOOL-SPEC is the `gptel-tool' object, and FSM is the request state. + +If all pending tool calls in the current request have finished, it +injects the results into the prompt data and transitions the FSM." + (let* ((info (gptel-fsm-info fsm)) + (tool-result-alist (plist-get info :tool-result)) + ;; MAYBE(tool-hooks): Use plist-member for valid nil :result? + (remaining (cl-loop for call in (plist-get info :tool-use) + count (not (plist-get call :result))))) + (let ((result (gptel--to-string result))) + ;; FIXME(tool-hooks): If a hook has changed the tool that was called + ;; tool-spec needs to be updated. + (push (list tool-spec (plist-get tool-call :args) result) + tool-result-alist) + (plist-put info :tool-result tool-result-alist) ;for the callback + ;; NOTE: tool-call is a member of (plist-get info :tool-use), so :tool-use + ;; is modified by side effect. + ;; FIXME: Make the implicit addition to :tool-use explicit + (plist-put tool-call :result result)) ;for the LLM + ;; All tools have run + (when (<= (cl-decf remaining) 0) (gptel--fsm-transition fsm)))) + +(defun gptel--handle-tool-use (fsm) + "Run tool calls captured in FSM, and advance the state machine with the results." + (when-let* ((info (gptel-fsm-info fsm)) + (backend (plist-get info :backend)) + ;; This function might run many times, so only act on the remaining tool calls. + (tool-use (cl-remove-if (lambda (tc) (plist-get tc :result)) + (plist-get info :tool-use)))) + (with-current-buffer (plist-get info :buffer) + (let ((pending-calls)) + (mapc ; Construct function calls + (lambda (tool-call) + (letrec ((args (plist-get tool-call :args)) + (name (plist-get tool-call :name)) + (tool-spec (cl-find-if (lambda (ts) (equal (gptel-tool-name ts) name)) + (plist-get info :tools))) + (process-tool-result (apply-partially #'gptel--process-tool-call + fsm tool-spec tool-call))) + (if (null tool-spec) + (if (equal name gptel--ersatz-json-tool) ;Could be a JSON response + ;; Handle structured JSON output supplied as tool call + (funcall (plist-get info :callback) + (gptel--json-encode (plist-get tool-call :args)) + info) + (message "Unknown tool called by model: %s" name)) + (let ((confirm)) ;Check if tool requires confirmation + (cond ;:confirm in tool-call (from hooks) takes precedence + ((and-let* ((call-confirm (plist-member tool-call :confirm))) + (setq confirm (cadr call-confirm)))) + ((and gptel-confirm-tool-calls ;global and tool-specific setting + (or (eq gptel-confirm-tool-calls t) ;always confirm, or + (and-let* ((confirm (gptel-tool-confirm tool-spec))) + (or (not (functionp confirm)) + (apply confirm (gptel--map-tool-args tool-spec args)))))) + (setq confirm t))) + (if confirm ;To send to callback for confirmation + (push (list tool-spec args process-tool-result) pending-calls) + (let ((arg-values (gptel--map-tool-args tool-spec args))) + (if (gptel-tool-async tool-spec) ;If not, run the tool + (apply (gptel-tool-function tool-spec) + process-tool-result arg-values) + (let ((result (condition-case errdata + (apply (gptel-tool-function tool-spec) arg-values) + (error (mapconcat #'gptel--to-string errdata " "))))) + (funcall process-tool-result result))))))))) + tool-use) + (when pending-calls + (plist-put info :tool-pending t) + (funcall (plist-get info :callback) + (cons 'tool-call pending-calls) info)))))) + +(defun gptel--map-tool-args (tool-spec args) + "Create a tool call argument list from TOOL-SPEC and ARGS. + +TOOL-SPEC is a `gptel-tool' and ARGS is a plist of arguments for a tool +call. The argument list is suitable for supplying to the tool function." + (mapcar + (lambda (arg) + (let ((key (intern (concat ":" (plist-get arg :name))))) + (plist-get args key))) + (gptel-tool-args tool-spec))) + +(defun gptel--handle-tool-result (fsm) + "Handle the results of tool execution in FSM. + +Inject tool results into into the prompt data (for the LLM), run the +callback (for the user), and transition the request state." + (let ((info (gptel-fsm-info fsm))) + (gptel--inject-prompt + (plist-get info :backend) (plist-get info :data) + (gptel--parse-tool-results (plist-get info :backend) + (plist-get info :tool-use))) + (funcall (plist-get info :callback) + (cons 'tool-result (plist-get info :tool-result)) info)) + (gptel--fsm-transition fsm)) + +(defun gptel--handle-post (fsm) + "Run cleanup for `gptel-request' with FSM." + (when-let* ((info (gptel-fsm-info fsm)) + (post (plist-get info :post))) + (mapc (lambda (f) (funcall f info)) post))) + +;;;; State machine predicates +;; Predicates used to find the next state to transition to, see +;; `gptel-request--transitions'. + +(defun gptel--error-p (info) (plist-get info :error)) + +(defun gptel--tool-use-p (info) (plist-get info :tool-use)) + +(defun gptel--tool-result-p (info) (plist-get info :tool-result)) + + +;;; Send gptel requests +(cl-defun gptel-request + (&optional prompt &key callback + (buffer (current-buffer)) + position context dry-run + (stream nil) (in-place nil) + (system gptel--system-message) + schema transforms (fsm (gptel-make-fsm))) + "Request a response from the `gptel-backend' for PROMPT. + +The request is asynchronous, this function returns immediately. + +If PROMPT is +- a string, it is used to create a full prompt suitable for + sending to the LLM. +- A list of strings, it is interpreted as a conversation, i.e. a + series of alternating user prompts and LLM responses. + (\"user msg 1\" \"llm msg 1\" \"user msg 2\" \"llm msg 2\" ...) +- nil but region is active, the region contents are used. +- nil, the current buffer's contents up to (point) are used. + Previous responses from the LLM are identified as responses. + +Keyword arguments: + +CALLBACK, if supplied, is a function of two arguments, called +with the RESPONSE (usually a string) and INFO (a plist): + + (funcall CALLBACK RESPONSE INFO) + +RESPONSE is + +- A string if the request was successful +- nil if there was no response or an error. + +These are the only two cases you typically need to consider, +unless you need to clean up after aborted requests, use LLM +tools, handle \"reasoning\" content specially or stream +responses (see STREAM). In these cases, RESPONSE can be + +- The symbol `abort' if the request is aborted, see `gptel-abort'. + +- A cons cell of the form + + (tool-call . ((TOOL ARGS CB) ...)) + + where TOOL is a gptel-tool struct, ARGS is a plist of + arguments, and CB is a function for handling the results. You + can call CB with the result of calling the tool to continue the + request. + +- A cons cell of the form + + (tool-result . ((TOOL ARGS RESULT) ...)) + + where TOOL is a gptel-tool struct, ARGS is a plist of + arguments, and RESULT was returned from calling the tool + function. + +- A cons cell of the form + + (reasoning . text) + + where text is the contents of the reasoning block. (Also see + STREAM if you are using streaming.) + +See `gptel--insert-response' for an example callback handling all +cases. + +The INFO plist has (at least) the following keys: +:data - The request data included with the query +:position - marker where the response will (nominally) be inserted. + Of course, the insertion is left to the CALLBACK. +:buffer - The buffer current when the request was sent, + unless BUFFER is specified. +:status - Short string describing the result of the request, + including possible HTTP errors. + +Example of a callback that messages the user with the response +and info: + + (lambda (response info) + (if (stringp response) + (let ((posn (marker-position (plist-get info :position))) + (buf (buffer-name (plist-get info :buffer)))) + (message \"Response for request from %S at %d: %s\" + buf posn response)) + (message \"gptel-request failed with message: %s\" + (plist-get info :status)))) + +Or, for just the response: + + (lambda (response _) + ;; Do something with response + (message (rot13-string response))) + +If CALLBACK is omitted, the response is inserted at the point the +request was sent. + +STREAM is a boolean that determines if the response should be +streamed, as in `gptel-stream'. If the model or the backend does +not support streaming, this will be ignored. + +When streaming responses + +- CALLBACK will be called repeatedly with each RESPONSE text + chunk (a string) as it is received. +- When the HTTP request ends successfully, CALLBACK will be + called with a RESPONSE argument of t to indicate success. +- Similarly, CALLBACK will be called with + (reasoning . text-chunk) for each reasoning chunk, and + (reasoning . t) to indicate the end of the reasoning block. + +BUFFER and POSITION are the buffer and position (integer or +marker) at which the response is inserted. If a CALLBACK is +specified, no response is inserted and these arguments are +ignored, but they are still available in the INFO plist passed +to CALLBACK for you to use. + +BUFFER defaults to the current buffer, and POSITION to the value +of (point) or (region-end), depending on whether the region is +active. + +CONTEXT is any additional data needed for the callback to run. It +is included in the INFO argument to the callback. +Note: This is intended for storing Emacs state to be used by +CALLBACK, and unrelated to the context supplied to the LLM. + +SYSTEM is the system message or extended chat directive sent to +the LLM. This can be a string, a list of strings or a function +that returns either; see `gptel-directives' for more +information. If SYSTEM is omitted, the value of +`gptel--system-message' for the current buffer is used. + +The following keywords are mainly for internal use: + +IN-PLACE is a boolean used by the default callback when inserting +the response to determine if delimiters are needed between the +prompt and the response. + +If DRY-RUN is non-nil, do not send the request. Construct and +return a state machine object that can be introspected and +resumed. + +TRANSFORMS is a list of functions used to transform the prompt or query +parameters dynamically. Each function is called in a temporary buffer +containing the prompt to be sent, and can conditionally modify this +buffer. This can include changing the (buffer-local) values of the +model, backend or system prompt, or augmenting the prompt with +additional information (such as from a RAG engine). + +- Synchronous transformers are called with zero or one argument, the + state machine for the request. + +- Asynchronous transformers are called with two arguments, a callback + and the state machine. It should run the callback after finishing its + transformation. + +See `gptel-prompt-transform-functions' for more. + +If provided, SCHEMA forces the LLM to generate JSON output. Its value +is a JSON schema, which can be provided as +- an elisp object, a nested plist structure. +- A JSON schema serialized to a string +- A shorthand object/array description, see `gptel--dispatch-schema-type'. +See the manual or the wiki for examples. + +Note: SCHEMA is presently experimental and subject to change, and not +all providers support structured output. + +FSM is the state machine driving the request. This can be used +to define a custom request control flow, see `gptel-fsm' for +details. You can safely ignore this -- FSM is an unstable +feature and subject to change. + +Note: + +1. This function is not fully self-contained. Consider +let-binding the parameters `gptel-backend', `gptel-model', +`gptel-use-tools' and `gptel-use-context' around calls to it as +required. + +2. The return value of this function is a state machine that may +be used to rerun or continue the request at a later time." + (declare (indent 1)) + ;; TODO Remove this check in version 1.0 + (gptel--sanitize-model) + (let* ((start-marker + (cond + ((null position) + (if (use-region-p) + (set-marker (make-marker) (region-end)) + (gptel--at-word-end (point-marker)))) + ((markerp position) position) + ((integerp position) + (set-marker (make-marker) position buffer)))) + (gptel--schema schema) + (prompt-buffer + (cond ;prompt from buffer or explicitly supplied + ((null prompt) ;Send text up to end of word (for evil-mode users) + (gptel--create-prompt-buffer (gptel--at-word-end (point)))) + ((stringp prompt) + (gptel--with-buffer-copy buffer nil nil + (insert prompt) + (setq major-mode 'fundamental-mode) ;Avoid mode-specific behavior + (current-buffer))) + ((consp prompt) + ;; (gptel--parse-list gptel-backend prompt) + (gptel--with-buffer-copy buffer nil nil + ;; TEMP Decide on the annoated prompt-list format + (gptel--parse-list-and-insert prompt) + (setq major-mode 'fundamental-mode) ;Avoid mode-specific behavior + (current-buffer))))) + (system-list (gptel--parse-directive system 'raw)) ;eval function-valued system prompts + (info (list :data prompt-buffer + :buffer buffer + :position start-marker))) + (when transforms (plist-put info :transforms transforms)) + (with-current-buffer prompt-buffer + (setq gptel--system-message ;guaranteed to be buffer-local + ;; Retain single-part system messages as strings to avoid surprises + ;; when applying presets + (if (cdr system-list) system-list (car system-list)))) + (when stream (plist-put info :stream stream)) + ;; This context should not be confused with the context aggregation context! + (when callback (plist-put info :callback callback)) + (when context (plist-put info :context context)) + (when in-place (plist-put info :in-place in-place)) + ;; Add info to state machine context + (when dry-run (plist-put info :dry-run dry-run)) + (setf (gptel-fsm-info fsm) info)) + + ;; TEMP: Augment in separate let block for now. Are we overcapturing? + ;; FIXME(augment): Call augmentors with INFO, not FSM + (let ((info (gptel-fsm-info fsm))) + (with-current-buffer (plist-get info :data) + (setq-local gptel-prompt-transform-functions (plist-get info :transforms)) + ;; Preset has highest priority because it can change prompt-transform-functions + (when (memq 'gptel--transform-apply-preset gptel-prompt-transform-functions) + (gptel--transform-apply-preset fsm) + (setq gptel-prompt-transform-functions ;avoid mutation, copy transforms + (remq 'gptel--transform-apply-preset gptel-prompt-transform-functions))) + (let ((augment-total ;act like a hook, count total + (if (memq t gptel-prompt-transform-functions) + (length + (setq gptel-prompt-transform-functions + (nconc (remq t gptel-prompt-transform-functions) + (default-value 'gptel-prompt-transform-functions)))) + (length gptel-prompt-transform-functions))) + (augment-idx 0)) + (if (null gptel-prompt-transform-functions) + (gptel--realize-query fsm) + ;; FIXME(request-lib): Cannot use gptel--update-status from this file + ;; (with-current-buffer (plist-get info :buffer) ;Apply prompt transformations + ;; (gptel--update-status " Augmenting..." 'mode-line-emphasis)) + + ;; FIXME(augment): This needs to be converted into a linear callback + ;; chain to avoid race conditions with multiple async augmentors. + (run-hook-wrapped + 'gptel-prompt-transform-functions + (lambda (func fsm-arg) + (with-current-buffer (plist-get info :data) + (goto-char (point-max)) + (if (= (car (func-arity func)) 2) ;async augmentor + (funcall func (lambda () + (cl-incf augment-idx) + (when (>= augment-idx augment-total) ;All augmentors have run + (gptel--realize-query fsm-arg))) + fsm-arg) + (if (= (car (func-arity func)) 0) + (funcall func) + (funcall func fsm-arg)) ;sync augmentor + (cl-incf augment-idx) + (when (>= augment-idx augment-total) ;All augmentors have run + (gptel--realize-query fsm-arg)))) + nil) ;always return nil so run-hook-wrapped doesn't abort + fsm))))) + fsm) + +(defun gptel--realize-query (fsm) + "Realize the query payload for FSM from its prompt buffer. + +Initiate the request when done." + (let ((info (gptel-fsm-info fsm))) + (with-current-buffer (plist-get info :data) + (let* ((directive (gptel--parse-directive gptel--system-message 'raw)) + ;; DIRECTIVE contains both the system message and the template prompts + (gptel--system-message + (unless (gptel--model-capable-p 'nosystem) (car directive))) + ;; TODO(tool) Limit tool use to capable models after documenting :capabilities + ;; (gptel-use-tools (and (gptel--model-capable-p 'tool-use) gptel-use-tools)) + (stream (and (plist-get info :stream) gptel-use-curl gptel-stream + ;; Check model-specific request-params for streaming preference + (let* ((model-params (gptel--model-request-params gptel-model)) + (stream-spec (plist-get model-params :stream))) + ;; If not present, there is no model-specific preference + (or (not (memq :stream model-params)) + ;; If present, it must not be :json-false or nil + (and stream-spec (not (eq stream-spec :json-false))))) + ;; Check backend-specific streaming settings + (gptel-backend-stream gptel-backend))) + (gptel-stream stream) + (full-prompt)) + (when (cdr directive) ; prompt constructed from directive/template + (save-excursion (goto-char (point-min)) + (gptel--parse-list-and-insert (cdr directive)))) + (goto-char (point-max)) + (setq full-prompt (gptel--parse-buffer ;prompt from buffer or explicitly supplied + gptel-backend (and gptel--num-messages-to-send + (* 2 gptel--num-messages-to-send)))) + ;; Inject media chunks into the first user prompt if required. Media + ;; chunks are always included with the first user message, + ;; irrespective of the preference in `gptel-use-context'. This is + ;; because media cannot be included (in general) with system messages. + ;; TODO(augment): Find a way to do this in the prompt-buffer? + (when (and gptel-context gptel-use-context (gptel--model-capable-p 'media)) + (gptel--inject-media gptel-backend full-prompt)) + (unless stream (cl-remf info :stream)) + (plist-put info :backend gptel-backend) + (plist-put info :model gptel-model) + (when gptel-include-reasoning ;Required for next-request-only scope + (plist-put info :include-reasoning gptel-include-reasoning)) + (when (and gptel-use-tools gptel-tools) + (plist-put info :tools gptel-tools)) + (plist-put info :data + (gptel--request-data gptel-backend full-prompt))) + (kill-buffer (current-buffer))) + ;; INIT -> WAIT + (unless (plist-get info :dry-run) (gptel--fsm-transition fsm)) + fsm)) + +(defun gptel-abort (buf) + "Stop any active gptel process associated with buffer BUF. + +BUF defaults to the current buffer." + (interactive (list (current-buffer))) + (when-let* ((proc-attrs + (cl-find-if + (lambda (entry) + ;; each entry has the form (PROC . (FSM ABORT-FN)) + (eq (thread-first (cadr entry) ; FSM + (gptel-fsm-info) + (plist-get :buffer)) + buf)) + gptel--request-alist)) + (proc (car proc-attrs)) + (fsm (cadr proc-attrs)) + (info (gptel-fsm-info fsm)) + (abort-fn (cddr proc-attrs))) + ;; Run :callback with abort signal + (with-demoted-errors "Callback error: %S" + (and-let* ((cb (plist-get info :callback)) + ((functionp cb))) + (funcall cb 'abort info))) + (funcall abort-fn) + (setf (alist-get proc gptel--request-alist nil 'remove) nil) + (gptel--fsm-transition fsm 'ABRT) + (message "Stopped gptel request in buffer %S" (buffer-name buf)))) + + +;;; Prompt creation +(defun gptel--create-prompt-buffer (&optional prompt-end) + "Return a buffer with the conversation prompt to be sent. + +If the region is active limit the prompt text to the region contents. +Otherwise the prompt text is constructed from the contents of the +current buffer up to point, or PROMPT-END if provided." + (save-excursion + (save-restriction + (let ((buf (current-buffer))) + (cond + ((derived-mode-p 'org-mode) + (require 'gptel-org) + ;; Also handles regions in Org mode + (gptel-org--create-prompt-buffer prompt-end)) + ((use-region-p) + (let ((rb (region-beginning)) (re (region-end))) + (gptel--with-buffer-copy buf rb re + (current-buffer)))) + (t (unless prompt-end (setq prompt-end (point))) + (gptel--with-buffer-copy buf (point-min) prompt-end + (current-buffer)))))))) + +(defun gptel--create-prompt (&optional prompt-end) + "Return a full conversation prompt from the contents of this buffer. + +If `gptel--num-messages-to-send' is set, limit to that many +recent exchanges. + +If PROMPT-END (a marker) is provided, end the prompt contents +there. This defaults to (point)." + (with-current-buffer (gptel--create-prompt-buffer prompt-end) + (unwind-protect + (gptel--parse-buffer + gptel-backend (and gptel--num-messages-to-send + (* 2 gptel--num-messages-to-send))) + (kill-buffer (current-buffer))))) + +(make-obsolete 'gptel--create-prompt 'gptel--create-prompt-buffer + "0.9.9") + +(cl-defgeneric gptel--parse-buffer (backend max-entries) + "Parse current buffer backwards from point and return a list of prompts. + +BACKEND is the LLM backend in use. + +MAX-ENTRIES is the number of queries/responses to include for +contexbt.") + +(defun gptel--parse-list-and-insert (prompts) + "Insert PROMPTS, a list of messages into the current buffer. + +Propertize the insertions in a format gptel can parse into a +conversation. + +PROMPTS is typically the input to `gptel-request', either a list of strings +representing a conversation with alternate prompt/response turns, or a list of +lists with explicit roles (prompt/response/tool). See the documentation of +`gptel-request' for the latter." + (if (stringp (car prompts)) ; Simple format, list of strings + (cl-loop for text in prompts + for response = nil then (not response) + when text + if response + do (insert gptel-response-separator + (propertize text 'gptel 'response) + gptel-response-separator) + else do (insert text)) + (dolist (entry prompts) ; Advanced format, list of lists + (pcase entry + (`(prompt . ,msg) (insert (or (car-safe msg) msg))) + (`(response . ,msg) + (insert gptel-response-separator + (propertize (or (car-safe msg) msg) 'gptel 'response))) + (`(tool . ,call) + (insert gptel-response-separator + (propertize + (concat + "(:name " (plist-get call :name) " :args " + (prin1-to-string (plist-get call :args)) ")\n\n" + (plist-get call :result)) + 'gptel `(tool . ,(plist-get call :id))))))))) + +(cl-defgeneric gptel--parse-list (backend prompt-list) + "Parse PROMPT-LIST and return a list of prompts for BACKEND. + +PROMPT-LIST is interpreted as a conversation, i.e. an alternating +series of user prompts and LLM responses. The returned structure +is suitable for including in the request payload. + +BACKEND is the LLM backend in use.") + +(cl-defgeneric gptel--parse-media-links (mode beg end) + "Find media links between BEG and END. + +MODE is the major-mode of the buffer. + +Returns a plist where each entry is of the form + (:text \"some text\") +or + (:media \"media uri or file path\")." + (ignore mode) ;byte-compiler + (list `(:text ,(buffer-substring-no-properties + beg end)))) + +(declare-function markdown-link-at-pos "markdown-mode") +(declare-function mailcap-file-name-to-mime-type "mailcap") + +(defsubst gptel-markdown--validate-link (link) + "Validate a Markdown LINK as sendable under the current gptel settings. + +Return a form (validp link-type path . REST), where REST is a list +explaining why sending the link is not supported by gptel. Only the +first nil value in REST is guaranteed to be correct." + (let ((mime)) + (if-let* ((path (nth 3 link)) + (prefix (or (string-search "://" path) 0)) + (link-type (if (= prefix 0) "file" (substring path 0 prefix))) + (path (if (and (equal link-type "file") (> prefix 0)) + (substring path (+ prefix 3)) path)) + (resource-type + (or (and (equal link-type "file") 'file) + (and (gptel--model-capable-p 'url) + (member link-type '("http" "https" "ftp")) 'url))) + (user-check (funcall gptel-markdown-validate-link link)) + (readablep (or (member link-type '("http" "https" "ftp")) + (file-remote-p path) + (file-readable-p path))) + (mime-valid + (or (eq resource-type 'url) + (and (with-memoization + (alist-get (expand-file-name path) + gptel--link-type-cache + nil nil #'string=) + (if (gptel--file-binary-p path) t)) + (setq mime (mailcap-file-name-to-mime-type path)) + (gptel--model-mime-capable-p mime)) + t))) + (list t link-type path resource-type user-check readablep mime-valid mime) + (list nil link-type path resource-type user-check readablep mime-valid mime)))) + +(cl-defmethod gptel--parse-media-links ((_mode (eql 'markdown-mode)) beg end) + "Parse text and actionable links between BEG and END. + +Return a list of the form + ((:text \"some text\") + (:media \"/path/to/media.png\" :mime \"image/png\") + (:text \"More text\")) +for inclusion into the user prompt for the gptel request." + (let ((parts) (from-pt)) + (save-excursion + (setq from-pt (goto-char beg)) + (while (re-search-forward gptel-markdown--link-regex end t) + (let* ((link-at-pt (markdown-link-at-pos (point))) + (link-status (gptel-markdown--validate-link link-at-pt))) + (cl-destructuring-bind + (valid type path resource-type user-check readablep mime-valid mime) + link-status + (cond + ((and valid (member type '("http" "https" "ftp"))) + ;; Collect text up to this image, and collect this image url + (let ((text (buffer-substring-no-properties from-pt (car link-at-pt)))) + (unless (string-blank-p text) (push (list :text text) parts)) + (push (list :url path :mime mime) parts) + (setq from-pt (cadr link-at-pt)))) + (valid ; Collect text up to this link, and collect this link data + (let ((text (buffer-substring-no-properties from-pt (car link-at-pt)))) + (unless (string-blank-p text) (push (list :text text) parts)) + (push (if mime (list :media path :mime mime) (list :textfile path)) parts) + (setq from-pt (cadr link-at-pt)))) + ((not resource-type) + (message "Link source not followed for unsupported link type \"%s\"." type)) + ((not user-check) + (message + (if (eq gptel-markdown-validate-link 'gptel--link-standalone-p) + "Ignoring non-standalone link \"%s\"." + "Link %s failed to validate, see `gptel-markdown-validate-link'.") + path)) + ((not readablep) (message "Ignoring inaccessible file \"%s\"." path)) + ((and (not mime-valid) (eq resource-type 'file)) + (message "Ignoring unsupported binary file \"%s\"." path))))))) + (unless (= from-pt end) + (push (list :text (buffer-substring-no-properties from-pt end)) parts)) + (nreverse parts))) + +(cl-defgeneric gptel--inject-media (backend _prompts) + "Wrap the last prompt in PROMPTS with gptel's context. + +PROMPTS is a structure as returned by `gptel--parse-buffer'. +Typically this is a list of plists. + +BACKEND is the gptel backend in use." + (display-warning + '(gptel context) + (format "Context support not implemented for backend %s, ignoring context" + (gptel-backend-name backend)))) + +(cl-defgeneric gptel--request-data (backend prompts) + "Generate a plist of all data for an LLM query. + +BACKEND is the LLM backend in use. + +PROMPTS is the plist of previous user queries and LLM responses.") + +(cl-defun gptel--sanitize-model (&key (backend gptel-backend) + (model gptel-model) + (shoosh t)) + "Check if MODEL is available in BACKEND, adjust accordingly. + +If SHOOSH is true, don't issue a warning." + (unless backend + (unless shoosh + (display-warning + 'gptel "No gptel-backend defined: defaulting to ChatGPT")) + (setq gptel-backend + (gptel-make-openai "ChatGPT" :key 'gptel-api-key :stream t) + backend gptel-backend)) + (let ((available (gptel-backend-models backend))) + (when (stringp model) + (unless shoosh + (display-warning + 'gptel + (format "`gptel-model' expects a symbol, found string \"%s\" + Resetting `gptel-model' to %s" + model model))) + (setq gptel-model (gptel--intern model) + model gptel-model)) + (unless (member model available) + (let ((fallback (car available))) + (unless shoosh + (display-warning + 'gptel + (format (concat "Preferred `gptel-model' \"%s\" not" + "supported in \"%s\", using \"%s\" instead") + model (gptel-backend-name backend) fallback))) + (setq-local gptel-model fallback))))) + + +;;; 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 + (cond ((plistp response) (plist-get response :error)) + ((arrayp response) + (cl-some (lambda (el) (plist-get el :error)) response))))) + (list nil http-status http-msg error-data))) + ((eq response 'json-read-error) + (list nil http-status (concat "(" http-msg ") Malformed JSON in response.") "json-read-error")) + (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.") + "Could not parse HTTP response."))) + (list nil (concat "(" http-msg ") Could not parse HTTP response.") + "Could not parse HTTP response."))) + + +;;; Curl request response handling + +(defun gptel-curl--get-args (info uuid include-headers) + "Produce list of arguments for calling Curl. + +INFO contains the request data, UUID is a unique identifier. + +If INCLUDE-HEADERS is non-nil, include headers with the -H option." + (let* ((data (plist-get info :data)) + ;; We have to let-bind the following three since their dynamic + ;; values are used for key lookup and url resolution + (gptel-backend (plist-get info :backend)) + (gptel-model (plist-get info :model)) + (gptel-stream (plist-get info :stream)) + (url (let ((backend-url (gptel-backend-url gptel-backend))) + (gptel--maybe-funcall backend-url info))) + (data-json (decode-coding-string (gptel--json-encode data) 'utf-8 t))) + (when gptel-log-level (gptel--log data-json "request body")) + (append + gptel-curl--common-args + gptel-curl-extra-args + (if include-headers + (cl-loop + for (key . val) in + (append '(("Content-Type" . "application/json")) + (when-let* ((header (gptel-backend-header gptel-backend))) + (gptel--maybe-funcall header info))) + collect (format "-H%s: %s" key val)) + (list "-H@-")) + (and-let* ((curl-args (gptel-backend-curl-args gptel-backend))) + (gptel--maybe-funcall curl-args)) + (list (format "-w(%s . %%{size_header})" uuid)) + (if (< (string-bytes data-json) gptel-curl-file-size-threshold) + (list (format "-d%s" data-json)) + (let* ((write-region-inhibit-fsync t) + (file-name-handler-alist nil) + (inhibit-message t) + (temp-filename (make-temp-file "gptel-curl-data" nil ".json" data-json)) + (cleanup-fn (lambda (&rest _) (when (file-exists-p temp-filename) + (delete-file temp-filename))))) + (plist-put info :post (cons cleanup-fn (plist-get info :post))) + (list "--data-binary" (format "@%s" temp-filename)))) + (when (not (string-empty-p gptel-proxy)) + (list "--proxy" gptel-proxy + "--proxy-negotiate" + "--proxy-user" ":")) + (list url)))) + +;;;###autoload +(defun gptel-curl-get-response (fsm) + "Fetch response to prompt in state FSM from the LLM using Curl. + +FSM is the state machine driving this request. + +FSM is the state machine driving this request. Its INFO slot +contains the data required for setting up the request. INFO is a +plist with the following keys, among others: +- :data (the data being sent) +- :buffer (the gptel buffer) +- :position (marker at which to insert the response). +- :callback (optional, the request callback) + +Call CALLBACK with the response and INFO afterwards. If omitted +the response is inserted into the current buffer after point." + (let* ((uuid (md5 (format "%s%s%s%s" + (random) (emacs-pid) (user-full-name) + (recent-keys)))) + (info (gptel-fsm-info fsm)) + (backend (plist-get info :backend)) + (args (gptel-curl--get-args info uuid nil)) + (stream (plist-get info :stream)) + (process (make-process + :name "gptel-curl" + :buffer (gptel--temp-buffer " *gptel-curl*") + :command (cons (gptel--curl-path) args) + :connection-type 'pipe))) + (with-current-buffer (process-buffer process) + (cond + ((eq (gptel-backend-coding-system backend) 'binary) + ;; set-buffer-file-coding-system is not needed since we don't save this buffer + (set-buffer-multibyte nil) + (set-process-coding-system process 'binary 'binary)) + (t + ;; Don't try to convert cr-lf to cr on Windows so that curl's "header size + ;; in bytes" stays correct. Explicitly set utf-8 for non-win systems too, + ;; for cases when buffer coding system is not set to utf-8. + (set-process-coding-system process 'utf-8-unix 'utf-8-unix))) + (set-process-query-on-exit-flag process nil) + (let* ((gptel-backend backend) ;Required for header function's environment + (gptel-model (plist-get info :model)) + (headers + (append '(("Content-Type" . "application/json")) + (when-let* ((header (gptel-backend-header backend))) + (gptel--maybe-funcall header info))))) + (when (eq gptel-log-level 'debug) + (gptel--log (gptel--json-encode + (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair))) + headers)) + "request headers") + (gptel--log (mapconcat #'shell-quote-argument + (cons (gptel--curl-path) args) " \\\n") + "request Curl command" 'no-json)) + (dolist (header headers) + (process-send-string process (concat (car header) ": " (cdr header) "\n")))) + (process-send-eof process) + (if (plist-get info :uuid) ;not the first run, set only the uuid + (plist-put info :uuid uuid) + (setf (gptel-fsm-info fsm) ;fist run, set all process parameters + (nconc (list :uuid uuid + :transformer + (when (with-current-buffer (plist-get info :buffer) + (and (derived-mode-p 'org-mode) + gptel-org-convert-response)) + (gptel--stream-convert-markdown->org + (plist-get info :position)))) + (unless (plist-get info :callback) + (list :callback (if stream + #'gptel-curl--stream-insert-response + #'gptel--insert-response))) + info))) + (if stream + (progn (set-process-sentinel process #'gptel-curl--stream-cleanup) + (set-process-filter process #'gptel-curl--stream-filter)) + (set-process-sentinel process #'gptel-curl--sentinel)) + (setf (alist-get process gptel--request-alist) + (cons fsm + #'(lambda () + ;; Clean up Curl process + (set-process-sentinel process #'ignore) + (delete-process process) + (kill-buffer (process-buffer process)))))))) + +;; ;; Ahead-Of-Time dispatch code for the parsers +;; :parser ; FIXME `cl--generic-*' are internal functions +;; (cl--generic-method-function +;; (if stream +;; (cl-loop +;; for type in +;; (cl--class-allparents (get (type-of backend) 'cl--class)) +;; with methods = (cl--generic-method-table +;; (cl--generic 'gptel-curl--parse-stream)) +;; when (cl--generic-member-method `(,type t) nil methods) +;; return (car it)) +;; (cl-loop +;; for type in +;; (cl--class-allparents (get (type-of backend) 'cl--class)) +;; with methods = (cl--generic-method-table +;; (cl--generic 'gptel--parse-response)) +;; when (cl--generic-member-method `(,type t t) nil methods) +;; return (car it)))) + +(defun gptel-curl--log-response (proc-buf proc-info) + "Parse response buffer PROC-BUF and log response. + +PROC-INFO is the plist containing process metadata." + (with-current-buffer proc-buf + (save-excursion + (goto-char (point-min)) + (when (re-search-forward " ?\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)) + ;; MAYBE: This transition should happen in the process filter, but it's + ;; not clear how to reliably detect Curl failure there. + (gptel--fsm-transition fsm) ;Curl failed, WAIT -> TYPE + (plist-put info :error + (format "Curl failed with exit code %d. See Curl manpage for details." + exit-status)) + (plist-put info :status "Curl failure") + (with-demoted-errors "gptel callback error: %S" + (funcall (plist-get info :callback) nil info))) + ;; Finish handling a successful streaming response + ((member http-status '("200" "100")) + (with-demoted-errors "gptel callback error: %S" + (funcall (plist-get info :callback) t info))) + ;; Capture error message from HTTP error response + (t + (with-current-buffer proc-buf + (goto-char (point-max)) + (if (not (search-backward (plist-get info :uuid) nil t)) + (plist-put info :error "Could not parse Curl response") + (backward-char) + (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))) + (response (progn (goto-char header-size) + (condition-case nil (gptel--json-read) + (error 'json-read-error)))) + (error-data + (cond ((plistp response) (plist-get response :error)) + ((arrayp response) + (cl-some (lambda (el) (plist-get el :error)) response))))) + (cond + (error-data + (plist-put info :error error-data)) + ((eq response 'json-read-error) + (plist-put info :error "Malformed JSON in response.")) + (t (plist-put info :error "Could not parse HTTP response.")))))) + (with-demoted-errors "gptel callback error: %S" + (funcall (plist-get info :callback) nil info)))) + (gptel--fsm-transition fsm)) ; Move to next state + (setf (alist-get process gptel--request-alist nil 'remove) nil) + (kill-buffer proc-buf))) + +(defun gptel-curl--stream-filter (process output) + (let* ((fsm (car (alist-get process gptel--request-alist))) + (proc-info (gptel-fsm-info fsm)) + (callback (or (plist-get proc-info :callback) + #'gptel-curl--stream-insert-response))) + (with-current-buffer (process-buffer process) + ;; Insert output + (save-excursion + (goto-char (process-mark process)) + (insert output) + (set-marker (process-mark process) (point))) + + ;; Find HTTP status + (unless (plist-get proc-info :http-status) + (save-excursion + (goto-char (point-min)) + (when-let* (((not (= (line-end-position) (point-max)))) + (http-msg (buffer-substring (line-beginning-position) + (line-end-position))) + (http-status + (save-match-data + (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) + (match-string 1 http-msg))))) + (plist-put proc-info :http-status http-status) + (plist-put proc-info :status (string-trim http-msg)) + (gptel--fsm-transition fsm)))) ;Response started, WAIT -> TYPE + + (when-let* ((http-msg (plist-get proc-info :status)) + (http-status (plist-get proc-info :http-status))) + ;; Find data chunk(s) and run callback + ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 + (when (member http-status '("200" "100")) + (let ((response (gptel-curl--parse-stream + (plist-get proc-info :backend) proc-info)) + (reasoning-block (plist-get proc-info :reasoning-block))) + ;; Depending on the API, there are two modes that reasoning or + ;; chain-of-thought content appears: as part of the main response + ;; but surrounded by ... 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 + (cond ((plistp response) (plist-get response :error)) + ((arrayp response) + (cl-some (lambda (el) (plist-get el :error)) response))))) + (list nil http-status http-msg error-data))) + ((eq response 'json-read-error) + (list nil http-status (concat "(" http-msg ") Malformed JSON in response.") + "Malformed JSON in response")) + (t (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.") + "Could not parse HTTP response."))) + (list nil http-status (concat "(" http-msg ") Could not parse HTTP response.") + "Could not parse HTTP response.")))))) + +(provide 'gptel-request) +;;; gptel-request.el ends here diff --git a/elpa/gptel-20260425.846/gptel-rewrite.el b/elpa/gptel-20260425.846/gptel-rewrite.el new file mode 100644 index 00000000..4b388e42 --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-rewrite.el @@ -0,0 +1,855 @@ +;;; gptel-rewrite.el --- Refactoring functions for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur +;; Keywords: hypermedia, convenience, tools + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: +(require 'gptel-transient) +(require 'cl-lib) + +(defvar eldoc-documentation-functions) +(defvar diff-entire-buffers) +(defvar ediff-window-setup-function) +(defvar ediff-split-window-function) + +(declare-function diff-no-select "diff") +(declare-function rmc--add-key-description "rmc") +(declare-function ediff-setup-windows-plain "ediff-wind") + +;; * User options + +(defcustom gptel-rewrite-directives-hook nil + "Hook run to generate gptel's default rewrite directives. + +Each function in this hook is called with no arguments until one +returns a non-nil value, the base string to use as the +rewrite instruction. + +Use this hook to tailor context-specific rewrite directives. +For example, you can specialize the default rewrite directive +for a particular major-mode or project." + :group 'gptel + :type 'hook) + +(defcustom gptel-post-rewrite-functions nil + "Abnormal hook run after a `gptel-rewrite' action. + +This hook is called after the LLM response for the rewrite action +has been fully received in a temporary buffer. Each function is +called with two arguments: the response beginning and end +positions. + +Note: this hook only runs if the rewrite request succeeds." + :type 'hook + :group 'gptel) + +(defcustom gptel-rewrite-default-action nil + "Action to take when rewriting a text region using gptel. + +When the LLM response with the rewritten text is received, you can +- merge it with the current region, possibly creating a merge conflict, +- diff or ediff against the original region, +- or accept it in place, replacing the original region. +- display a dispatch menu with the above choices. + +If this option is nil (the default), gptel waits for an explicit +command. Set it to the symbol `merge', `diff', `ediff', `accept' +or `dispatch' to automatically do one of these things instead. + +You can also set it to a function of your choosing for a custom +action. This function receives one argument, the rewrite +overlay." + :group 'gptel + :type '(choice + (const :tag "Wait" nil) + (const :tag "Merge with current region" merge) + (const :tag "Diff against current region" diff) + (const :tag "Ediff against current region" ediff) + (const :tag "Accept rewrite" accept) + (const :tag "Dispatch" dispatch) + (function :tag "Custom action"))) + +(defface gptel-rewrite-highlight-face + '((((class color) (min-colors 88) (background dark)) + :background "#041714" :extend t :inherit default) + (((class color) (min-colors 88) (background light)) + :background "light goldenrod yellow" :extend t :inherit default) + (t :inherit secondary-selection)) + "Face for highlighting regions with pending rewrites." + :group 'gptel) + +;; * Variables + +(defvar-keymap gptel-rewrite-actions-map + :doc "Keymap for gptel rewrite actions at point." + "RET" #'gptel--rewrite-dispatch + "" #'gptel--rewrite-dispatch + "C-c C-a" #'gptel--rewrite-accept + "C-c C-r" #'gptel--rewrite-iterate + "C-c C-k" #'gptel--rewrite-reject + "C-c C-d" #'gptel--rewrite-diff + "C-c C-e" #'gptel--rewrite-ediff + "C-c C-n" #'gptel--rewrite-next + "C-c C-p" #'gptel--rewrite-previous + "C-c C-m" #'gptel--rewrite-merge) + +(defvar-local gptel--rewrite-overlays nil + "List of active rewrite overlays in the buffer.") + +(defvar-local gptel--rewrite-message nil + "Request-specific instructions for a `gptel-rewrite' action.") + +;; Add the rewrite directive to `gptel-directives' +(unless (alist-get 'rewrite gptel-directives) + (add-to-list 'gptel-directives `(rewrite . ,#'gptel--rewrite-directive-default))) + +(defvar gptel--rewrite-directive + (or (alist-get 'rewrite gptel-directives) + #'gptel--rewrite-directive-default) + "Active system message for rewrite actions. + +This variable is for internal use only. To customize the rewrite +system message, set a system message (or function that generates +the system message) as the value of the `rewrite' key in +`gptel-directives': + + (setf (alist-get \\='rewrite gptel-directives) + #\\='my-rewrite-message-generator) + +You can also customize `gptel-rewrite-directives-hook' to +dynamically inject a rewrite-specific system message.") + +(defun gptel--rewrite-directive-default () + "Generic directive for rewriting or refactoring. + +These are instructions not specific to any particular required +change. + +The returned string is interpreted as the system message for the +rewrite request. To use your own, add a different directive to +`gptel-directives', or add to `gptel-rewrite-directives-hook', +which see." + (or (save-mark-and-excursion + (run-hook-with-args-until-success + 'gptel-rewrite-directives-hook)) + (let* ((lang (downcase (gptel--strip-mode-suffix major-mode))) + (article (if (and lang (not (string-empty-p lang)) + (memq (aref lang 0) '(?a ?e ?i ?o ?u))) + "an" "a"))) + (if (derived-mode-p 'prog-mode) + (format (concat "You are %s %s programmer. " + "Follow my instructions and refactor %s code I provide.\n" + "- Generate ONLY %s code as output, without " + "any explanation or markdown code fences.\n" + "- Generate code in full, do not abbreviate or omit code.\n" + "- Do not produce intermediate text or report on your progress.\n" + "- Do not ask for further clarification, and make " + "any assumptions you need to follow instructions.") + article lang lang lang) + (concat + (if (string-empty-p lang) + "You are an editor." + (format "You are %s %s editor." article lang)) + " Follow my instructions and improve or rewrite the text I provide." + " Do not produce intermediate text or report on your progress." + " Generate ONLY the replacement text," + " without any explanation or markdown code fences."))))) + +;; MAYBE: Save FSM to `gptel--fsm-last' on request end? +(defvar gptel--rewrite-handlers + `((WAIT ,#'gptel--handle-wait ,#'gptel--rewrite-update-wait) + (TPRE ,#'gptel--handle-pre-tool ,#'gptel--fsm-transition) + (TOOL ,#'gptel--rewrite-update-tool-call ,#'gptel--handle-tool-use) + (TRET ,#'gptel--handle-post-tool ,#'gptel--rewrite-update-tool-call + ,#'gptel--handle-tool-result)) + "Alist specifying FSM handlers for `gptel-rewrite' state transitions.") + +;; * Helper functions + +;; ** UI Indicators +(defun gptel--rewrite-update-tool-call (fsm) + "Update the rewrite overlay to indicate tool call progress for FSM." + (when-let* ((info (gptel-fsm-info fsm)) + (ov (car-safe (plist-get info :context))) + (names (cl-loop for call in (plist-get info :tool-use) + collect (plist-get call :name)))) + (with-current-buffer (plist-get info :buffer) + (setq gptel--fsm-last fsm) + (gptel--rewrite-update-status + ov (concat + (propertize + (if (length> names 1) " Calling tools (" " Calling tool (") + 'face '(mode-line-emphasis default)) + (mapconcat (lambda (name) (propertize name 'face '(font-lock-keyword-face default))) + names (propertize ", " 'face '(mode-line-emphasis default))) + (propertize ")" 'face '(mode-line-emphasis default))))))) + +(defun gptel--rewrite-update-wait (fsm) + "Update the rewrite overlay status for FSM to indicate a waiting state." + (when-let* ((info (gptel-fsm-info fsm)) + (ov (car-safe (plist-get info :context))) + (model (gptel--model-name + (or (plist-get info :model) gptel-model))) + (hint-str (concat "[" model "]\n"))) + (overlay-put + ov 'status + (list (propertize "REWRITE" 'face '(warning default)) ;status element 0 + (propertize " Waiting..." 'face '(warning default)) ;status element 1 + (propertize ;status element 2 + " " 'display + (if (fboundp 'string-pixel-width) + `(space :align-to (- right (,(string-pixel-width hint-str)))) + `(space :align-to (- right ,(+ 1 (string-width hint-str)))))) + (propertize hint-str 'face '(warning default)))) ;status element 3 + (overlay-put ov 'before-string (apply #'concat (overlay-get ov 'status))))) + +(defun gptel--rewrite-update-status (ov msg &optional face) + "Update overlay OV's status with MSG and refresh its before-string. +If FACE is non-nil, apply that face to MSG when storing the status." + (setq msg (or msg "")) + (setf (cadr (overlay-get ov 'status)) + (if face (propertize msg 'face face) msg)) + (overlay-put ov 'before-string (apply #'concat (overlay-get ov 'status)))) + +(defun gptel--rewrite-key-help (callback) + "Eldoc documentation function for gptel rewrite actions. + +CALLBACK is supplied by Eldoc, see +`eldoc-documentation-functions'." + (when (and gptel--rewrite-overlays + (get-char-property (point) 'gptel-rewrite)) + (funcall callback + (format (substitute-command-keys "%s rewrite available: accept \\[gptel--rewrite-accept], iterate \\[gptel--rewrite-iterate], clear \\[gptel--rewrite-reject], merge \\[gptel--rewrite-merge], diff \\[gptel--rewrite-diff] or ediff \\[gptel--rewrite-ediff]") + (propertize (gptel--model-name gptel-model) 'face 'mode-line-emphasis))))) + +;; ** Navigation across rewrite regions + +(defun gptel--rewrite-move (search-func) + "Move directionally to a gptel rewrite location using SEARCH-FUNC." + (let* ((ov (cdr (get-char-property-and-overlay (point) 'gptel-rewrite))) + (pt (save-excursion + (if ov + (goto-char + (funcall search-func (overlay-start ov) 'gptel-rewrite)) + (goto-char + (max (1- (funcall search-func (point) 'gptel-rewrite)) + (point-min)))) + (funcall search-func (point) 'gptel-rewrite)))) + (if (get-char-property pt 'gptel-rewrite) + (goto-char pt) + (user-error "No further rewrite regions!")))) + +(defun gptel--rewrite-next () + "Go to next pending LLM rewrite in buffer, if one exists." + (interactive) + (gptel--rewrite-move #'next-single-char-property-change)) + +(defun gptel--rewrite-previous () + "Go to previous pending LLM rewrite in buffer, if one exists." + (interactive) + (gptel--rewrite-move #'previous-single-char-property-change)) + +;; ** Rewrite actions helpers + +(defun gptel--rewrite-overlay-at (&optional pt) + "Check for a gptel rewrite overlay at PT and return it. + +If no suitable overlay is found, raise an error." + (pcase-let ((`(,response . ,ov) + (get-char-property-and-overlay (or pt (point)) 'gptel-rewrite)) + (diff-entire-buffers nil)) + (unless ov (user-error "Could not find region being rewritten")) + (unless response (user-error "No LLM output available for this rewrite")) + ov)) + +(defun gptel--rewrite-prepare-buffer (ovs &optional buf) + "Prepare new buffer with LLM changes applied and return it. + +This is used for (e)diff purposes. + +RESPONSE is the LLM response. OVS are the overlays specifying +the changed regions. BUF is the (current) buffer." + (setq buf (or buf (overlay-buffer (or (car-safe ovs) ovs)))) + (with-current-buffer buf + (let ((pmin (point-min)) + (pmax (point-max)) + (pt (point)) + ;; (mode major-mode) + (newbuf (get-buffer-create "*gptel-diff*")) + (inhibit-read-only t) + (inhibit-message t)) + (save-restriction + (widen) + (with-current-buffer newbuf + (erase-buffer) + (insert-buffer-substring buf))) + (with-current-buffer newbuf + (narrow-to-region pmin pmax) + (goto-char pt) + ;; We mostly just want font-locking + ;; (delay-mode-hooks (funcall mode)) + ;; Apply the changes to the new buffer + (save-excursion + (gptel--rewrite-accept ovs newbuf))) + newbuf))) + +(defun gptel--rewrite-read-message (prompt &optional _ history) + "Read a rewrite message from the minibuffer. + +Provide custom keybindings for cycling, editing, and submitting the +`gptel-rewrite' action directly from this prompt. + +PROMPT is the prompt string to display. HISTORY, if provided, is the +input history list." + (let* ((rewrite-directive + (car-safe (gptel--parse-directive gptel--rewrite-directive 'raw))) + (cb (current-buffer)) + (cycle-prefix (lambda () (interactive) + (gptel--read-with-prefix rewrite-directive) + (push-mark) (goto-char (point-max)) + (activate-mark))) + (set-rewrite-message + (lambda () + (let ((message (buffer-substring-no-properties + (minibuffer-prompt-end) (point-max)))) + (with-current-buffer cb (setq gptel--rewrite-message message)) + (setf (alist-get 'gptel--infix-rewrite-extra transient-history) + (delete-dups (cons message transient--history)))))) + (start-rewrite-maybe + (lambda () (interactive) + (when (minibufferp) (funcall set-rewrite-message)) + (if transient--prefix ;Called from transient? Don't start rewrite + (run-at-time 0 nil #'transient-setup 'gptel-rewrite) + (with-current-buffer cb + (gptel--suffix-rewrite gptel--rewrite-message))) + (when (minibufferp) (exit-minibuffer)))) + (start-transient + (lambda () (interactive) + (run-at-time 0 nil #'transient-setup 'gptel-rewrite) + (when (minibufferp) + (funcall set-rewrite-message) + (exit-minibuffer)))) + (edit-in-buffer + (lambda () (interactive) + (let ((offset (- (point) (minibuffer-prompt-end)))) + (gptel--edit-directive 'gptel--rewrite-message + :prompt rewrite-directive :initial (minibuffer-contents) + :buffer cb :setup (lambda () (ignore-errors (forward-char offset))) + :callback + (lambda (msg) + (when msg + (push (buffer-local-value 'gptel--rewrite-message cb) + (alist-get 'gptel--infix-rewrite-extra transient-history)) + (with-current-buffer cb (gptel--suffix-rewrite))) + (when (minibufferp) (exit-minibuffer))))))) + (minibuffer-local-map + (make-composed-keymap (define-keymap + "TAB" cycle-prefix "" cycle-prefix + "C-c C-e" edit-in-buffer + " " start-rewrite-maybe + "M-RET" start-transient) + minibuffer-local-map))) + (minibuffer-with-setup-hook cycle-prefix + (read-string + prompt (or gptel--rewrite-message "Rewrite: ") + history)))) + +;; * Rewrite action functions + +(defun gptel--rewrite-reject (&optional ovs) + "Clear pending LLM responses in OVS or at point." + (interactive (list (gptel--rewrite-overlay-at))) + (dolist (ov (ensure-list ovs)) + (setq gptel--rewrite-overlays (delq ov gptel--rewrite-overlays)) + (delete-overlay ov)) + (unless gptel--rewrite-overlays + (remove-hook 'eldoc-documentation-functions 'gptel--rewrite-key-help 'local)) + (message "Cleared pending LLM response(s).")) + +(defun gptel--rewrite-accept (&optional ovs buf) + "Apply pending LLM responses in OVS or at point. + +BUF is the buffer to modify, defaults to the overlay buffer." + (interactive (list (gptel--rewrite-overlay-at))) + (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) + (buf (or buf ov-buf)) + ((buffer-live-p buf))) + (with-current-buffer ov-buf + (cl-loop for ov in (ensure-list ovs) + for ov-beg = (overlay-start ov) + for ov-end = (overlay-end ov) + for response = (overlay-get ov 'gptel-rewrite) + do (with-current-buffer buf + (goto-char ov-beg) + (delete-region ov-beg ov-end) + (insert response)))) + (message "Replaced region(s) with LLM output in buffer: %s." + (buffer-name ov-buf)))) + +(defalias 'gptel--rewrite-iterate 'gptel-rewrite + "Iterate on pending LLM response at point.") + +(defun gptel--rewrite-diff (&optional ovs switches) + "Diff pending LLM responses in OVS or at point. + +SWITCHES are diff arguments." + (interactive (list (gptel--rewrite-overlay-at))) + (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) + ((buffer-live-p ov-buf))) + (require 'diff) + (let* ((newbuf (gptel--rewrite-prepare-buffer ovs)) + (diff-buf (diff-no-select ov-buf newbuf switches))) + (with-current-buffer diff-buf + (setq-local diff-jump-to-old-file t)) + (display-buffer diff-buf)))) + +(defun gptel--rewrite-ediff (&optional ovs) + "Ediff pending LLM responses in OVS or at point." + (interactive (list (gptel--rewrite-overlay-at))) + (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) + ((buffer-live-p ov-buf))) + (letrec ((newbuf (gptel--rewrite-prepare-buffer ovs)) + (cwc (current-window-configuration)) + (hideshow + (lambda (&optional restore) + (dolist (ov (ensure-list ovs)) + (when-let* ((overlay-buffer ov)) + (let ((disp (overlay-get ov 'display)) + (stored (overlay-get ov 'gptel--ediff))) + (overlay-put ov 'face (and restore 'gptel-rewrite-highlight-face)) + (overlay-put ov 'display (and restore stored)) + (overlay-put ov 'gptel--ediff (unless restore disp))))))) + (gptel--ediff-restore + (lambda () + (when (window-configuration-p cwc) + (set-window-configuration cwc)) + (funcall hideshow 'restore) + (remove-hook 'ediff-quit-hook gptel--ediff-restore)))) + (funcall hideshow) + (add-hook 'ediff-quit-hook gptel--ediff-restore 50) + (let ((ediff-window-setup-function #'ediff-setup-windows-plain) + (ediff-split-window-function #'split-window-horizontally)) + (ediff-buffers ov-buf newbuf))))) + +(defun gptel--rewrite-merge-git (beg end new-str) + "Produce a merge conflict region between BEG and END. + +Merge the region with NEW-STR using git merge-file." + (let ((original-temp-file (make-temp-file "gptel-merge-")) + (empty-temp-file (make-temp-file "gptel-merge-")) ; use /dev/null? (windows?) + (new-temp-file (make-temp-file "gptel-merge-"))) + (unwind-protect + (progn (write-region beg end original-temp-file) + (with-temp-file empty-temp-file (insert "")) + (with-temp-file new-temp-file (insert new-str)) + (goto-char beg) + (delete-region beg end) + (call-process + "git" nil (list (current-buffer) nil) nil + "merge-file" "--no-diff3" "-L" "original" "-L" "Empty" "-L" + (gptel-backend-name gptel-backend) "-p" + original-temp-file empty-temp-file new-temp-file) + ;; Make merge marker active if required + (goto-char beg) (unless (bolp) (insert "\n"))) + (delete-file original-temp-file) + (delete-file empty-temp-file) + (delete-file new-temp-file)))) + +(defun gptel--rewrite-merge-simple (beg end new-str) + "Produce a merge conflict region between BEG and END. + +NEW-STR is the new string intended to replace the region." + (goto-char end) ;End first to preserve ordering + (unless (bolp) (insert "\n")) + (insert "=======\n" new-str "\n>>>>>>> " + (gptel-backend-name gptel-backend) "\n") + (goto-char beg) + (unless (bolp) (insert "\n")) + (insert-before-markers "<<<<<<< original\n")) + +(defun gptel--rewrite-merge (&optional ovs) + "Insert pending LLM responses in OVS as merge conflicts." + (interactive (list (gptel--rewrite-overlay-at))) + (when-let* ((ov-buf (overlay-buffer (or (car-safe ovs) ovs))) + ((buffer-live-p ov-buf))) + (with-current-buffer ov-buf + (let ((changed)) + (dolist (ov (ensure-list ovs)) + (save-excursion + (when-let* ((new-str (overlay-get ov 'gptel-rewrite))) + (if (executable-find "git") ;Replace overlay content with merge result + (gptel--rewrite-merge-git (overlay-start ov) (overlay-end ov) new-str) + (gptel--rewrite-merge-simple (overlay-start ov) (overlay-end ov) new-str)) + (setq changed t)))) + (when changed (smerge-mode 1))) + (gptel--rewrite-reject ovs)))) + +(defun gptel--rewrite-dispatch (&optional ov ci) + "Dispatch actions for gptel rewrites. + +OV is the rewrite overlay, CI is true for interactive calls." + (interactive (list (gptel--rewrite-overlay-at) t)) + (let ((choice) + (orig-status (copy-sequence (overlay-get ov 'status)))) + (unwind-protect + (pcase-let ((choices '((?a "accept") (?k "reject") (?r "iterate") + (?m "merge") (?d "diff") (?e "ediff")))) + (gptel--rewrite-update-status + ov (when (fboundp #'rmc--add-key-description) ; introduced in Emacs 29 + (concat " " (mapconcat (lambda (e) (cdr e)) + (mapcar #'rmc--add-key-description choices) ", ")))) + (setq choice (read-multiple-choice "Action: " choices))) + (overlay-put ov 'status orig-status) + (overlay-put ov 'before-string (apply #'concat orig-status))) + (if ci + (call-interactively (intern (concat "gptel--rewrite-" (cadr choice)))) + (funcall (intern (concat "gptel--rewrite-" (cadr choice))) ov)))) + +(defun gptel--rewrite-callback (response info) + "Callback for gptel rewrite actions. + +Show the rewrite result in an overlay over the original text, and +set up dispatch actions. + +RESPONSE is the response received. It may also be t (to indicate +success) nil (to indicate failure), or the symbol `abort'. + +INFO is the async communication channel for the rewrite request." + (when-let* ((ov-and-buf (plist-get info :context)) + (ov (car ov-and-buf)) + (proc-buf (cdr ov-and-buf)) + (buf (overlay-buffer ov))) + (cond + ((stringp response) ;partial or fully successful result + (with-current-buffer proc-buf ;auxiliary buffer, insert text here and copy to overlay + (let ((inhibit-modification-hooks nil) + (inhibit-read-only t)) + (when (= (buffer-size) 0) + (buffer-disable-undo) + (overlay-put ov 'gptel-rewrite nil) + (gptel--rewrite-update-status ov " Typing..." '(success default)) + (insert-buffer-substring buf (overlay-start ov) (overlay-end ov)) + (when (eq (char-before (point-max)) ?\n) + (plist-put info :newline t)) + (setq major-mode (buffer-local-value 'major-mode buf)) ;Don't turn on major-mode (#730, #722) + (add-text-properties (point-min) (point-max) '(face shadow font-lock-face shadow)) + (goto-char (point-min))) + (insert response) + (unless (eobp) (ignore-errors (delete-char (length response)))) + (font-lock-ensure) + (overlay-put ov 'display (propertize (buffer-string) 'face 'default)))) + (unless (plist-get info :stream) (gptel--rewrite-callback t info))) + + ((eq response 'abort) ;request aborted + (when-let* ((proc-buf (cdr-safe (plist-get info :context)))) + (kill-buffer proc-buf)) + (delete-overlay ov)) + + ((eq (car-safe response) 'tool-call) ;tool call confirmation + (gptel--rewrite-update-status ov " Run tools?" '(mode-line-emphasis default)) + (gptel--display-tool-calls ;use minibuffer + (cdr response) info ;; (buffer-local-value 'buffer-read-only buf) + t)) + + ((null response) ;finished with error + (message (concat "LLM response error: %s. Rewrite in buffer %s canceled.") + (plist-get info :status) (plist-get info :buffer)) + (gptel--rewrite-callback 'abort info)) + + ((consp response)) ;reasoning or tool call result -- don't care + + (t + (if (plist-get info :tool-use) ;stopped to use tools + ;; Clear text inserted so far + (with-current-buffer proc-buf (delete-region (point-min) (point))) + (let ((mkb (propertize "" 'face 'help-key-binding))) ;or finished successfully + (with-current-buffer proc-buf + (let ((inhibit-read-only t)) + (delete-region (point) (point-max)) + ;; Run post-rewrite-functions on rewritten text in its buffer + (setq-local gptel-post-rewrite-functions + (buffer-local-value 'gptel-post-rewrite-functions buf)) + (with-demoted-errors "gptel-post-rewrite-functions: %S" + (run-hook-with-args 'gptel-post-rewrite-functions (point-min) (point-max))) + (when (and (plist-get info :newline) + (not (eq (char-before (point-max)) ?\n))) + (insert "\n")) + (font-lock-ensure)) + (overlay-put ov 'display (buffer-string)) + (overlay-put ov 'gptel-rewrite (buffer-string)) + (kill-buffer proc-buf)) + (when (buffer-live-p buf) + (with-current-buffer buf + (pulse-momentary-highlight-region (overlay-start ov) (overlay-end ov)) + (add-hook 'eldoc-documentation-functions #'gptel--rewrite-key-help nil 'local) + ;; (overlay-put ov 'gptel-rewrite response) + (overlay-put ov 'face 'gptel-rewrite-highlight-face) + (overlay-put ov 'priority 2000) + (overlay-put ov 'keymap gptel-rewrite-actions-map) + (overlay-put ov 'mouse-face 'highlight) + (let ((status (overlay-get ov 'status))) + (dolist (idx '(0 1 3)) + (setf (nth idx status) + (propertize (nth idx status) 'face '(success default)))) + (gptel--rewrite-update-status ov " Ready" '(success default))) + (overlay-put + ov 'help-echo + (format (concat "%s rewrite available: %s or \\[gptel--rewrite-dispatch] for options") + (concat (gptel-backend-name gptel-backend) ":" (gptel--model-name gptel-model)) + mkb)) + (push ov gptel--rewrite-overlays)) + (if-let* ((sym gptel-rewrite-default-action)) + (if-let* ((action (intern (concat "gptel--rewrite-" (symbol-name sym)))) + ((functionp action))) + (funcall action ov) (funcall sym ov)) + (message (concat + "LLM rewrite output" + (unless (eq (current-buffer) buf) + (format " in buffer %s " (buffer-name buf))) + (concat " ready: " mkb ", " (propertize "RET" 'face 'help-key-binding) + " or " (substitute-command-keys "\\[gptel-rewrite] to continue.")))))))))))) + +;; * Transient Prefixes for rewriting + +(transient-define-prefix gptel--rewrite-directive-menu () + "Set the directive (system message) for rewrite actions. + +By default, gptel uses the directive associated with the `rewrite' + key in `gptel-directives'. You can add more rewrite-specific + directives to `gptel-directives' and pick one from here." + [:description gptel-system-prompt--format + [(gptel--suffix-rewrite-directive)] + [(gptel--infix-variable-scope)]] + [:class transient-column + :setup-children + (lambda (_) (transient-parse-suffixes + 'gptel--rewrite-directive-menu + (gptel--setup-directive-menu + 'gptel--rewrite-directive "Rewrite directive"))) + :pad-keys t]) + +;;;###autoload (autoload 'gptel-rewrite "gptel-rewrite" nil t) +(transient-define-prefix gptel-rewrite () + "Rewrite or refactor text region using an LLM." + [:description + (lambda () + (gptel--describe-directive + gptel--rewrite-directive (max (- (window-width) 14) 20) " ")) + ["" + (gptel-preset + :transient t + :if (lambda () (or (get-char-property (point) 'gptel-rewrite) + (use-region-p))) + :key "@" :format "%d" + :description + (lambda () + (concat (propertize "Instructions" 'face 'transient-heading) + (gptel--format-preset-string)))) + ("s" "Set full directive" gptel--rewrite-directive-menu) + (gptel--infix-rewrite-extra)]] + ;; FIXME: We are requiring `gptel-transient' because of this suffix, perhaps + ;; we can get find some way around that? + [:description "Context for rewrite" + :if use-region-p + (gptel--infix-context-remove-all :key "-d") + (gptel--suffix-context-buffer :key "C" :format " %k %d")] + [[:description "Diff Options" + :if (lambda () gptel--rewrite-overlays) + ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) + ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) + ("-i" "Ignore case" ("-i" "--ignore-case")) + (gptel--infix-rewrite-diff:-U)] + [:description "Accept all" + :if (lambda () gptel--rewrite-overlays) + (gptel--suffix-rewrite-merge) + (gptel--suffix-rewrite-accept) + "Reject all" + (gptel--suffix-rewrite-reject)]] + [[:description "Diff rewrite regions" + :if (lambda () gptel--rewrite-overlays) + (gptel--suffix-rewrite-diff) + (gptel--suffix-rewrite-ediff)]] + [[:description "Rewrite" + :if (lambda () (or (get-char-property (point) 'gptel-rewrite) + (use-region-p))) + (gptel--suffix-rewrite)] + ["Dry Run" + :if (lambda () (and (or gptel-log-level gptel-expert-commands) + (or (get-char-property (point) 'gptel-rewrite) + (use-region-p)))) + ("I" "Inspect query (Lisp)" + (lambda () + "Inspect the query that will be sent as a lisp object." + (interactive) + (gptel--sanitize-model) + (gptel--inspect-query + (gptel--suffix-rewrite gptel--rewrite-message t)))) + ("J" "Inspect query (JSON)" + (lambda () + "Inspect the query that will be sent as a JSON object." + (interactive) + (gptel--sanitize-model) + (gptel--inspect-query + (gptel--suffix-rewrite gptel--rewrite-message t) + 'json)))]] + (interactive) + (gptel--rewrite-sanitize-overlays) + (cond + ((use-region-p) ;Start a/another rewrite + (let ((transient--history ;No transient reader, so We manage history ourselves + (alist-get 'gptel--infix-rewrite-extra transient-history))) + (gptel--rewrite-read-message + (concat "Instructions (" gptel--read-with-prefix-help + (format " %s%s) " + (propertize "M-RET" 'face 'help-key-binding) + (propertize ": More options" 'face 'default))) + nil (cons 'transient--history 1)))) + (gptel--rewrite-overlays ;Rewrite actions pending, show options + (transient-setup 'gptel-rewrite)) + (t (user-error + "`gptel-rewrite' requires an active region or rewrite in progress")))) + +;; * Transient infixes for rewriting + +(transient-define-infix gptel--infix-rewrite-extra () + "Chat directive (system message) to use for rewriting or refactoring." + :description "Rewrite instruction" + :class 'gptel-lisp-variable + :variable 'gptel--rewrite-message + :set-value #'gptel--set-with-scope + :display-nil "(None)" + :key "d" + :format " %k %d %v" + :prompt (concat "Instructions (" gptel--read-with-prefix-help ") ") + :reader #'gptel--rewrite-read-message) + +(transient-define-argument gptel--infix-rewrite-diff:-U () + :description "Context lines" + :class 'transient-option + :argument "-U" + :reader #'transient-read-number-N0) + +;; * Transient suffixes for rewriting + +(transient-define-suffix gptel--suffix-rewrite-directive (&optional cancel) + "Edit Rewrite directive. + +CANCEL is used to avoid touching dynamic rewrite directives, +generated from functions." + :transient 'transient--do-exit + :description "Edit full rewrite directive" + :key "s" + (interactive + (list (and + (functionp gptel--rewrite-directive) + (not (y-or-n-p + "Rewrite directive is dynamically generated: Edit its current value instead?"))))) + (if cancel (progn (message "Edit canceled") + (call-interactively #'gptel-rewrite)) + (gptel--edit-directive 'gptel--rewrite-directive + :callback (lambda (_) (call-interactively #'gptel-rewrite)) + :setup #'activate-mark))) + +(transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message dry-run) + "Rewrite or refactor region contents." + :key "r" + :description (lambda () (if (get-char-property (point) 'gptel-rewrite) "Iterate" "Rewrite")) + (interactive (list gptel--rewrite-message)) + (let* ((nosystem (gptel--model-capable-p 'nosystem)) + ;; Try to send context with system message + (gptel-use-context + (and gptel-use-context (if nosystem 'user 'system))) + (prompt (list (or (get-char-property (point) 'gptel-rewrite) + (buffer-substring-no-properties (region-beginning) (region-end))) + "What is the required change? I will generate only the final replacement." + (or rewrite-message gptel--rewrite-message)))) + (when nosystem + (setcar prompt (concat (car-safe (gptel--parse-directive + gptel--rewrite-directive 'raw)) + "\n\n" (car prompt)))) + (prog1 (gptel-request prompt + :dry-run dry-run + :system gptel--rewrite-directive + :stream gptel-stream + :context + (let ((ov (or (cdr-safe (get-char-property-and-overlay (point) 'gptel-rewrite)) + (make-overlay (region-beginning) (region-end) nil t)))) + (overlay-put ov 'evaporate t) + ;; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 (#724) + (cons ov (gptel--temp-buffer " *gptel-rewrite*"))) + :transforms gptel-prompt-transform-functions + :fsm (gptel-make-fsm :handlers gptel--rewrite-handlers) + :callback #'gptel--rewrite-callback) + ;; Move back so that the cursor is on the overlay when done. + (unless (get-char-property (point) 'gptel-rewrite) + (when (= (point) (region-end)) (run-at-time 0 nil #'backward-char 1))) + (setq deactivate-mark t)))) + +;; Allow this to be called non-interactively for dry runs +(put 'gptel--suffix-rewrite 'interactive-only nil) + +(transient-define-suffix gptel--suffix-rewrite-diff (&optional switches) + "Diff LLM output against buffer." + :if (lambda () gptel--rewrite-overlays) + :key "D" + :description "Diff LLM rewrites" + (interactive (list (transient-args transient-current-command))) + (gptel--rewrite-diff gptel--rewrite-overlays switches)) + +(transient-define-suffix gptel--suffix-rewrite-ediff () + "Ediff LLM output against buffer." + :if (lambda () gptel--rewrite-overlays) + :key "E" + :description "Ediff LLM rewrites" + (interactive) + (gptel--rewrite-ediff gptel--rewrite-overlays)) + +(transient-define-suffix gptel--suffix-rewrite-merge () + "Insert LLM output as merge conflicts." + :if (lambda () gptel--rewrite-overlays) + :key "M" + :description "Merge with conflicts" + (interactive) + (gptel--rewrite-merge gptel--rewrite-overlays)) + +(transient-define-suffix gptel--suffix-rewrite-accept () + "Accept pending LLM rewrites." + :if (lambda () gptel--rewrite-overlays) + :key "A" + :description "Accept and replace" + (interactive) + (gptel--rewrite-accept gptel--rewrite-overlays)) + +(transient-define-suffix gptel--suffix-rewrite-reject () + "Clear pending LLM rewrites." + :if (lambda () gptel--rewrite-overlays) + :key "K" + :description "Clear pending rewrites" + (interactive) + (gptel--rewrite-reject gptel--rewrite-overlays)) + +(provide 'gptel-rewrite) +;;; gptel-rewrite.el ends here + +;; Local Variables: +;; outline-regexp: "^;; \\*+" +;; End: diff --git a/elpa/gptel-20260425.846/gptel-transient.el b/elpa/gptel-20260425.846/gptel-transient.el new file mode 100644 index 00000000..66ba3a1d --- /dev/null +++ b/elpa/gptel-20260425.846/gptel-transient.el @@ -0,0 +1,1997 @@ +;;; gptel-transient.el --- Transient menu for gptel -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 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: + +;; + +;;; Code: +(require 'cl-lib) +(require 'gptel) +(require 'transient) + +(declare-function ediff-regions-internal "ediff") +(declare-function ediff-make-cloned-buffer "ediff-utils") +(declare-function org-escape-code-in-string "org-src") +(declare-function gptel--vterm-delete "gptel-integrations") + + +;; * Helper functions and vars + +(defvar-local gptel--rewrite-overlays nil + "List of active rewrite overlays in the buffer.") + +(defun gptel--rewrite-sanitize-overlays () + "Ensure gptel's rewrite overlays in buffer are consistent." + (setq gptel--rewrite-overlays + (cl-delete-if-not #'overlay-buffer + gptel--rewrite-overlays))) + +(defvar gptel--set-buffer-locally nil + "Set model parameters from `gptel-menu' buffer-locally. + +Affects the system message too.") + +(defun gptel--set-with-scope (sym value &optional scope) + "Set SYM's symbol value to VALUE with SCOPE. + +If SCOPE is t, set it buffer-locally. +If SCOPE is 1, reset it after the next gptel request. (oneshot) +Otherwise, clear any buffer-local value and set its default +global value." + (pcase scope + (1 (unless (get sym 'gptel-history) + (put sym 'gptel-history (symbol-value sym)) + (letrec ((restore-value + (lambda () + (remove-hook 'gptel-post-request-hook restore-value) + (run-at-time ; Required to work around let bindings + 0 nil (lambda (s) ; otherwise this change is overwritten! + (set s (get s 'gptel-history)) + (put s 'gptel-history nil)) + sym)))) + (add-hook 'gptel-post-request-hook restore-value))) + (set sym value)) + ('t (set (make-local-variable sym) value)) + (_ (kill-local-variable sym) + (set sym value)))) + +(defun gptel--preset-mismatch-p (name) + "Check if gptel preset with NAME is in effect. + +This is intended to be fast but imperfect. See +`gptel--preset-mismatch-value' for more granular checking." + (let ((elm (or (gptel-get-preset name) + (gptel-get-preset (intern-soft name)))) + key val) + (catch 'mismatch + (while elm + (setq key (pop elm) val (pop elm)) + (cond + ((memq key '(:description :parents)) 'nil) + ((eq key :system) + (or (equal gptel--system-message val) + (functionp val) ; Ignore functions, modify-specs for speed here + (and (consp val) (keywordp (car val))) + (and-let* (((symbolp val)) + (p (assq val gptel-directives))) + (equal gptel--system-message (cdr p))) + (throw 'mismatch t))) + ((eq key :backend) + (or (if (stringp val) + (equal (gptel-backend-name gptel-backend) val) + (eq gptel-backend val)) + (throw 'mismatch t))) + ((eq key :tools) + (setq val (cl-loop ; Check against tool names, not tools (faster with sorting) + for tool in (ensure-list (gptel--modify-value gptel-tools val)) + for tool-name = (or (and (stringp tool) tool) + (ignore-errors (gptel-tool-name tool))) + if (not (member tool-name uniq-tool-names)) + collect tool-name into uniq-tool-names + finally return uniq-tool-names)) + (or (equal (sort val #'string-lessp) ;preset tools same as gptel-tools? + (sort (mapcar #'gptel-tool-name gptel-tools) + #'string-lessp)) + (throw 'mismatch t))) + (t (let* ((suffix (substring + (if (symbolp key) (symbol-name key) key) 1)) + (sym (or (intern-soft (concat "gptel-" suffix)) + (intern-soft (concat "gptel--" suffix))))) + ;; FIXME(modify-list): Fix for values specified with a spec, like :eval + (or (null sym) + (and (boundp sym) (equal (eval sym) val)) + (throw 'mismatch t))))))))) + +(defun gptel--get-directive (args) + "Find the additional directive in the transient ARGS. + +Meant to be called when `gptel-menu' is active." + (cl-some (lambda (s) (and (stringp s) (string-prefix-p ":" s) + (substring s 1))) + args)) + +(defun gptel--instructions-make-overlay (text &optional ov) + "Make or move overlay OV with TEXT." + (save-excursion + ;; Move point to overlay position + (cond + ((use-region-p) + (if (pos-visible-in-window-p (region-beginning)) + (goto-char (region-beginning)))) + ((gptel--in-response-p) + (gptel-beginning-of-response) + (skip-chars-forward "\n \t")) + (t (text-property-search-backward 'gptel 'response) + (skip-chars-forward "\n \t"))) + ;; Make overlay + (if (and ov (overlayp ov)) + (move-overlay ov (point) (point) (current-buffer)) + (setq ov (make-overlay (point) (point) nil t))) + (overlay-put ov 'before-string nil) + ;; (unless (or (bobp) (eq (char-before) "\n")) + ;; (overlay-put ov 'before-string (propertize "\n" 'font-lock-face 'shadow))) + (overlay-put ov 'category 'gptel) + (overlay-put + ov 'after-string + (concat (propertize (concat "DIRECTIVE: " text) + 'font-lock-face '(:inherit shadow :weight bold :box t)) + "\n")) + ov)) + +(defconst gptel--read-with-prefix-help + (concat + (propertize "TAB" 'face 'help-key-binding) + (propertize ": expand, " 'face 'default) + (propertize "M-n" 'face 'help-key-binding) + (propertize "/" 'face 'default) + (propertize "M-p" 'face 'help-key-binding) + (propertize ": next/previous" 'face 'default)) + "Help string (TODO).") + +(defun gptel--read-with-prefix (prefix) + "Show string PREFIX in the minibuffer after the minibuffer prompt. + +PREFIX is shown in an overlay. Repeated calls to this function +will toggle its visibility state." + (unless (minibufferp) + (user-error "This command is intended to be used in the minibuffer")) + (let* ((update + (lambda (ov s) + (overlay-put + ov 'after-string + (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow) + (make-separator-line)))))) + (max-width (- (window-width) (minibuffer-prompt-end))) + (max (or max-mini-window-height 0.4)) + (max-height (- (or (and (natnump max) max) + (floor (* max (frame-height)))) + 5))) + (if (and prefix (not (string-empty-p prefix)) (> max-height 1)) + (progn + (unless visual-line-mode (visual-line-mode 1)) + (goto-char (minibuffer-prompt-end)) + (pcase-let ((`(,prop . ,ov) + (get-char-property-and-overlay + (point-min) 'gptel))) + (unless ov + (setq ov (make-overlay + (point-min) (minibuffer-prompt-end) nil t))) + (pcase prop + ('partial + (if (> (length prefix) max-width) + (progn + (overlay-put ov 'gptel 'prefix) + (let ((disp-size + (cl-loop for char across prefix + for idx upfrom 0 + with n = 0 with max-length = (* max-height max-width) + if (eq char ?\n) do (cl-incf n) + if (> n max-height) return idx + if (> idx max-length) + return idx + finally return nil))) + (funcall update ov + (if disp-size + (truncate-string-to-width + prefix disp-size nil nil 'ellipsis) + prefix)))) + (overlay-put ov 'gptel 'hide) + (funcall update ov nil))) + ('prefix (overlay-put ov 'gptel 'hide) + (funcall update ov nil)) + (_ (overlay-put ov 'gptel 'partial) + (funcall update ov (truncate-string-to-width + prefix max-width nil nil + 'ellipsis)))))) + (when-let* ((prop-ov (get-char-property-and-overlay (point-min) 'gptel))) + (when (overlayp (cdr prop-ov)) (delete-overlay (cdr prop-ov))))))) + +(defvar gptel--minibuffer-prompt-history nil + "History of prompts read from the minibuffer by gptel.") + +(defun gptel--read-minibuffer-prompt (&optional read-prompt) + "Read a user prompt from the minibuffer. + +Prompt with READ-PROMPT if supplied. Return a cons cell of the buffer +region (if included) and the provided instructions." + (let* ((include-region (use-region-p)) + (cb (current-buffer)) + (get-region (lambda () (with-current-buffer cb + (and include-region + (buffer-substring-no-properties + (region-beginning) (region-end)))))) + (cycle-prefix (lambda () (interactive) + (let ((p (point))) + (gptel--read-with-prefix (funcall get-region)) + (goto-char p)))) + (toggle-region (lambda () (interactive) + (if include-region + (progn (setq include-region nil) + (gptel--read-with-prefix nil)) + (setq include-region t) + (funcall cycle-prefix)))) + (edit-in-buffer + (lambda () (interactive) + (gptel--edit-directive nil + :initial (minibuffer-contents) + :prompt (if include-region + (with-current-buffer cb (buffer-substring-no-properties + (region-beginning) (region-end))) + "# Edit prompt below") + :setup (lambda () (goto-char (point-max)) (run-at-time 0 nil #'recenter)) + :callback (lambda (msg) + (if (not msg) + (minibuffer-quit-recursive-edit) + (delete-region (minibuffer-prompt-end) (point-max)) + (insert msg) (exit-minibuffer)))))) + (minibuffer-local-map + (make-composed-keymap (define-keymap + "M-RET" toggle-region "C-c C-e" edit-in-buffer) + minibuffer-local-map))) + (let ((user-prompt + (minibuffer-with-setup-hook + (lambda () (add-hook 'completion-at-point-functions + #'gptel-preset-capf nil t) + (funcall cycle-prefix) + ;; HACK for lucid Emacs, where `make-separator-line' is wonky. The + ;; minibuffer prompt gets cut off -- force redisplay to fix: + (insert " ") (redisplay) (delete-char -1)) + (read-string + (or read-prompt + (concat (format "Ask %s" (gptel-backend-name gptel-backend)) + (if (use-region-p) ;NOTE: not "include-region" as this is only read once + (concat " (" (propertize "M-RET" 'face 'help-key-binding) + (propertize ": Include/Ignore selection" 'face 'default) + "): ") + ": "))) + nil 'gptel--minibuffer-prompt-history)))) + (cons (funcall get-region) user-prompt)))) + +(defun gptel--transient-read-number (prompt _initial-input history) + "Read a numeric value from the minibuffer. + +PROMPT, _INITIAL-INPUT and HISTORY are as in the transient reader +documention. Return nil if user does not provide a number, for default." + ;; Workaround for buggy transient behaviour when dealing with + ;; non-string values. See: https://github.com/magit/transient/issues/172 + (when-let* ((history-symbol (or (car-safe history) history)) + (val (and (symbolp history-symbol) (symbol-value history-symbol)))) + (unless (stringp (car val)) + (setcar val (number-to-string (car val))))) + (let* ((minibuffer-default-prompt-format "") + (num (read-number prompt -1 history))) + (if (= num -1) nil num))) + +(defun gptel-system-prompt--format () + "Format the system prompt for display in gptel's transient menus. + +Handle formatting for system messages when the active `gptel-model' does +not support system messages." + (if (gptel--model-capable-p 'nosystem) + (concat (propertize "[No system message support for model " + 'face 'transient-heading) + (propertize (gptel--model-name gptel-model) + 'face 'warning) + (propertize "]" 'face 'transient-heading)) + (if gptel--system-message + (gptel--describe-directive + gptel--system-message (max (- (window-width) 12) 14) "⮐ ") + "[No system message set]"))) + +(defun gptel--tools-init-value (obj) + "Set the initial state of a tool OBJ in variable `gptel-tools'. + +OBJ is a tool-infix of type `gptel--switch'." + (when-let* ((name (car (member (oref obj argument) + (mapcar #'cadr + (plist-get (transient-scope) :tools)))))) + (oset obj value (list (oref obj category) name)))) + +(defvar gptel--crowdsourced-prompts-url + "https://raw.githubusercontent.com/f/prompts.chat/main/prompts.csv" + "URL for crowdsourced LLM system prompts.") + +(defvar gptel--crowdsourced-prompts + (make-hash-table :test #'equal) + "Crowdsourced LLM system prompts.") + +(defun gptel--read-csv-column () + "Read the next CSV column in the current buffer. + +Supports RFC 4180 quoted and unquoted fields, including embedded +newlines and escaped quotes in quoted fields." + (cond + ((eobp) nil) + ((eq (char-after) ?,) + (forward-char 1) + "") + ((eq (char-after) ?\") + (forward-char 1) + (let ((parts nil) + (start (point)) + done) + (while (not done) + (if (search-forward "\"" nil t) + (if (eq (char-after) ?\") + (progn + (push (buffer-substring-no-properties start (1- (point))) parts) + (push "\"" parts) + (forward-char 1) + (setq start (point))) + (push (buffer-substring-no-properties start (1- (point))) parts) + (setq done t)) + (push (buffer-substring-no-properties start (point-max)) parts) + (goto-char (point-max)) + (setq done t))) + (when (eq (char-after) ?,) + (forward-char 1)) + (apply #'concat (nreverse parts)))) + (t + (let ((start (point))) + (while (and (not (eobp)) + (not (memq (char-after) '(?, ?\n ?\r)))) + (forward-char 1)) + (prog1 (buffer-substring-no-properties start (point)) + (when (eq (char-after) ?,) + (forward-char 1))))))) + +(defun gptel--crowdsourced-prompts () + "Acquire and read crowdsourced LLM system prompts. + +These are stored in the variable `gptel--crowdsourced-prompts', +which see." + (when (hash-table-p gptel--crowdsourced-prompts) + (when (hash-table-empty-p gptel--crowdsourced-prompts) + (unless gptel-crowdsourced-prompts-file + (run-at-time 0 nil #'gptel-system-prompt) + (user-error "No crowdsourced prompts available")) + (unless (and (file-exists-p gptel-crowdsourced-prompts-file) + (time-less-p + (time-subtract (current-time) (days-to-time 14)) + (file-attribute-modification-time + (file-attributes gptel-crowdsourced-prompts-file)))) + (when (y-or-n-p + (concat + "Fetch crowdsourced system prompts from " + (propertize gptel--crowdsourced-prompts-url 'face 'link) + "?")) + ;; Fetch file + (message "Fetching prompts...") + (let ((dir (file-name-directory gptel-crowdsourced-prompts-file))) + (unless (file-exists-p dir) (mkdir dir 'create-parents)) + (if (url-copy-file gptel--crowdsourced-prompts-url + gptel-crowdsourced-prompts-file + 'ok-if-already-exists) + (message "Fetching prompts... done.") + (message "Could not retrieve new prompts."))))) + (if (not (file-readable-p gptel-crowdsourced-prompts-file)) + (progn (message "No crowdsourced prompts available") + (call-interactively #'gptel-system-prompt)) + (with-temp-buffer + (insert-file-contents gptel-crowdsourced-prompts-file) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (when-let* ((act (gptel--read-csv-column)) + (prompt (gptel--read-csv-column))) + (puthash act prompt gptel--crowdsourced-prompts)) + (forward-line 1))))) + gptel--crowdsourced-prompts)) + +;; FIXME(targeted-context): This does not handle :bounds and :lines. +(defun gptel--describe-infix-context () + "Return a count of the number of context chunks." + (if (null gptel-context) "Context" + (pcase-let* + ((buffer-count (length gptel-context)) + (`(,file-count ,ov-count) + (if (> buffer-count 0) + (cl-loop for entry in gptel-context + for (buf-file . spec) = (ensure-list entry) + if (bufferp buf-file) + sum (max (length (plist-get spec :overlays)) 1) + into ov-count + else count (stringp buf-file) into file-count + finally return (list file-count ov-count)) + (list 0 0)))) + (concat "Context (" + (propertize + (concat + (and (> ov-count 0) + (format "%d region%s in %d buffer%s" + ov-count (if (> ov-count 1) "s" "") + (- buffer-count file-count) + (if (> ( - buffer-count file-count) 1) "s" ""))) + (and (> file-count 0) + (format "%s%d file%s" + (if (> ov-count 0) ", " "") file-count + (if (> file-count 1) "s" "")))) + 'face 'warning) + ")")))) + +(defun gptel--describe-suffix-send () + "Describe the action of `gptel--suffix-send'." + (cl-flet ((ptv (s) (propertize s 'face 'warning)) + (pth (s) (propertize s 'face 'transient-heading))) + (let* ((args (or (and transient-current-command + (transient-args transient-current-command)) + ;; Not yet exported, simulate. HACK: We are accessing + ;; Transient's internal variables here for live updates. + (let* ((transient-current-command (oref transient--prefix command)) + (transient-current-suffixes transient--suffixes)) + (transient-args transient-current-command)))) + (lbeg (line-number-at-pos (if (use-region-p) (region-beginning) + (point-min)))) + (lend (line-number-at-pos (if (use-region-p) (region-end) + (point)))) + (ltext (ptv (if (> lend lbeg) + (format " (lines %d-%d)" lbeg lend) + (format " (line %d)" lbeg)))) + (dest) (context)) + (setq dest (cond + ((member "e" args) (ptv "echo area")) + ((member "k" args) (ptv "kill-ring")) + ((cl-some (lambda (s) + (and (stringp s) (memq (aref s 0) '(?g ?b)) + (not (equal (substring s 1) (buffer-name))) + (concat (pth "buffer ") (ptv (substring s 1))))) + args)))) + (setq context + (and gptel-context + (let ((lc (length gptel-context))) + (concat (pth " along with ") (ptv (format "%d" lc)) + (pth (concat " context source" (and (/= lc 1) "s"))))))) + (cond ((member "m" args) + (concat (pth "Read prompt from ") (ptv "minibuffer") + context + (if dest (concat (pth ", response to ") dest) + (concat (pth ", insert response at point"))))) + ((member "y" args) + (concat (pth "Send prompt from ") + (concat (ptv "kill-ring (") + (if-let* ((val (current-kill 0)) + (val (substring-no-properties val)) + (len (length val))) + (ptv (concat + "\"" (string-replace + "\n" "⮐" + (truncate-string-to-width + val 20 nil nil t)) + "\"" (when (> len 20) + (concat + ", " + (file-size-human-readable len 'si " ") + " chars")))) + (propertize "empty" 'face 'error)) + (ptv ")")) + context + (if dest (concat (pth ", response to ") dest) + (concat (pth ", insert response at point"))))) + ((member "i" args) + (let* ((reg (use-region-p)) + (src (ptv (if reg "selection" (buffer-name))))) + (if dest (concat (pth "Send ") src ltext context (pth ", with response to ") + (ptv dest) (pth "; kill") ltext + (and (not reg) (concat (pth " in ") src))) + (concat (pth "Replace ") src ltext (pth " with response") + (and context + (concat (pth " ( with") (substring context 11) " )")))))) + ((use-region-p) + (concat (pth "Send ") (ptv "selection") ltext + context (if dest (concat (pth ", with response to ") dest) + (concat (pth ", insert response at region end"))))) + (t (concat (pth "Send ") (ptv (buffer-name)) ltext + context (if dest (concat (pth ", with response to ") dest) + (concat (pth ", insert response at point"))))))))) + +(defun gptel--format-preset-string () + "Format the preset indicator display for `gptel-menu'." + (if (and gptel--known-presets gptel--preset) + (apply + #'format " (%s%s)" + (let ((mismatch (gptel--preset-mismatch-p gptel--preset))) + (list (propertize "@" 'face (if mismatch 'transient-key + '( :inherit transient-key + :inherit secondary-selection + :box -1 :weight bold))) + (propertize (format "%s" gptel--preset) 'face + (if mismatch + '(:inherit warning :strike-through t) + '(:inherit secondary-selection :box -1)))))) + (format " (%s%s)" + (propertize "@" 'face 'transient-key) + (propertize "preset" 'face 'transient-inactive-value)))) + + +;; * Transient classes and methods for gptel + +;; ** Class for generic gptel elisp variables + +(defclass gptel-lisp-variable (transient-lisp-variable) + ((display-nil :initarg :display-nil) ;String to display if value if nil + (display-map :initarg :display-map :initform nil)) ;Display string from alist display-map + "Lisp variables that show :display-nil instead of nil.") + +(cl-defmethod transient-format-value ((obj gptel-lisp-variable)) + (let ((display-value + (with-slots (value display-nil display-map) obj + (cond ((null value) display-nil) + (display-map (or (cdr (assoc value display-map)) value)) + (t value))))) + (propertize + (if (stringp display-value) display-value (prin1-to-string display-value)) + 'face 'transient-value))) + +(cl-defmethod transient-infix-set ((obj gptel-lisp-variable) value) + (funcall (oref obj set-value) + (oref obj variable) + (oset obj value value) + gptel--set-buffer-locally)) + +;; ** Class for managing gptel tools + +(defclass gptel--switch (transient-switch) + ((category :initarg :category)) + "Class used for arguments that share a category.") + +(cl-defmethod transient-infix-set ((obj gptel--switch) value) + "Set VALUE of a `gptel--switch' OBJ. + +It is a list of the category and argument, e.g. + (\"filesystem\" \"read_file\")." + (let ((state (transient-scope)) + (category (oref obj category))) + (if value + (progn + (cl-pushnew (list category value) + (plist-get state :tools) :test #'equal) + (oset obj value (list category value))) + (plist-put state :tools + (delete (list category (oref obj argument)) + (plist-get state :tools))) + (oset obj value nil)) + (oset transient--prefix scope state))) + +;; ** Class for managing gptel tool categories + +(defclass gptel--switch-category (transient-switch) + ((category :initarg :category)) + "Class used for arguments that switch a group of other arguments. + +Their own value is ignored") + +(cl-defmethod transient-format-value ((obj gptel--switch-category)) + (let* ((category (oref obj category)) + (active-count + (cl-count-if (lambda (tl) (equal (car tl) category)) + (plist-get (transient-scope) :tools))) + (total-count (length (cdr (assoc category gptel--known-tools))))) + (if (> active-count 0) + (propertize (format "(%d/%d)" active-count total-count) 'face 'transient-value) + (propertize (format "(0/%d)" total-count) 'face 'transient-inactive-value)))) + +;; Pressing a tool category key should have different behaviors in different +;; contexts: +;; - If the tools for the category are not shown, show them, do nothing else +;; - If the tools are showing and any of them are selected, deselect all +;; - If the tools are showing and none of them are selected, select all + +;; To do this we independently track whether the category tools are visible +;; ("active"), and whether any category tools have been "selected": +(cl-defmethod transient-infix-read ((obj gptel--switch-category)) + "Determine OBJ value according to category toggle settings." + (let* ((category (oref obj category)) + (active (equal category (plist-get (transient-scope) :category))) + (selected (cl-some (lambda (tool-spec) (equal category (car tool-spec))) + (plist-get (transient-scope) :tools)))) + (if (not active) + (oref obj value) + (if selected nil (oref obj argument))))) + +(cl-defmethod transient-infix-set ((obj gptel--switch-category) value) + "When setting VALUE, set all options in the category of OBJ." + (dolist (suffix-obj transient--suffixes) + ;; Find all suffixes that have this category + (when-let* (((cl-typep suffix-obj 'gptel--switch)) + ((equal (oref suffix-obj category) + (oref obj category))) + (arg (if (slot-boundp suffix-obj 'argument) + (oref suffix-obj argument) + (oref obj argument-format)))) + (if value ; Turn on/off all members in category + (transient-infix-set suffix-obj arg) + (transient-infix-set suffix-obj nil)))) + ;; Update the active menu category and key in the prefix scope + (plist-put (transient-scope) :category (oref obj category)) + (plist-put (transient-scope) :key (oref obj key)) + ;; Finally set the "value" of the category itself + (oset obj value value)) + +;; ** Class for gptel options that are three-way switches + +(defclass gptel--switches (gptel-lisp-variable) + ((display-if-true :initarg :display-if-true :initform "True") + (display-if-false :initarg :display-if-false :initform "False")) + "Boolean Lisp variable class for gptel-transient.") + +(cl-defmethod transient-infix-read ((obj gptel--switches)) + "Cycle through the mutually exclusive switches for OBJ." + (not (oref obj value))) + +(cl-defmethod transient-format-value ((obj gptel--switches)) + (with-slots (value display-if-true display-if-false) obj + (format + (propertize "(%s)" 'face 'transient-delimiter) + (concat + (propertize display-if-false + 'face (if value 'transient-inactive-value 'transient-value)) + (propertize "|" 'face 'transient-delimiter) + (propertize display-if-true + 'face (if value 'transient-value 'transient-inactive-value)))))) + +;; ** Class for gptel's scope management, singleton + +(defclass gptel--scope (gptel--switches) + ((display-if-true :initarg :display-if-true :initform "buffer") + (display-if-false :initarg :display-if-false :initform "global")) + "Singleton Lisp variable class for `gptel--set-buffer-locally'. + +This is used only for setting this variable via `gptel-menu'.") + +(cl-defmethod transient-infix-read ((obj gptel--scope)) + "Cycle through the mutually exclusive switches for OBJ." + (with-slots (value) obj + (pcase value + ('t (message "Parameters will be set for the next request only")) + ('nil (message "Parameters will be set buffer-locally")) + (1 (message "Parameters will be set globally"))) + (pcase value ('t 1) ('nil t) (1 nil)))) + +(cl-defmethod transient-format-value ((obj gptel--scope)) + (with-slots (value display-if-true display-if-false) obj + (format + (propertize "(%s)" 'face 'transient-delimiter) + (concat + (propertize display-if-false + 'face (if (null value) 'transient-value 'transient-inactive-value)) + (propertize "|" 'face 'transient-delimiter) + (propertize display-if-true + 'face (if (eq value t) 'transient-value 'transient-inactive-value)) + (propertize "|" 'face 'transient-delimiter) + (propertize "oneshot" 'face + (if (eql value 1) 'transient-value 'transient-inactive-value)))))) + +(cl-defmethod transient-infix-set ((obj gptel--scope) value) + (funcall (oref obj set-value) + (oref obj variable) + (oset obj value value))) + +;; ** Class for managing gptel's backend and model, singleton + +(defclass gptel-provider-variable (transient-lisp-variable) + ((backend :initarg :backend) + (backend-value :initarg :backend-value) + (always-read :initform t) + (set-value :initarg :set-value :initform #'set)) + "Class used for gptel-backends.") + +(cl-defmethod transient-format-value ((obj gptel-provider-variable)) + (propertize (concat + (gptel-backend-name + (buffer-local-value (oref obj backend) transient--original-buffer)) ":" + (gptel--model-name (oref obj value))) + 'face 'transient-value)) + +(cl-defmethod transient-infix-set ((obj gptel-provider-variable) value) + (pcase-let ((`(,backend-value ,model-value) value)) + (funcall (oref obj set-value) + (oref obj variable) + (oset obj value model-value) + gptel--set-buffer-locally) + (funcall (oref obj set-value) + (oref obj backend) + (oset obj backend-value backend-value) + gptel--set-buffer-locally)) + (transient-setup)) + +;; ** Class for infix options with in-buffer overlay display + +(defclass gptel-option-overlaid (transient-option) + ((display-nil :initarg :display-nil) + (overlay :initarg :overlay)) + "Transient options for overlays displayed in the working buffer.") + +(cl-defmethod transient-format-value ((obj gptel-option-overlaid)) + "Set up the in-buffer overlay for additional directive, a string. + +Also format the value of OBJ in the transient menu." + (let ((value (oref obj value)) + (ov (oref obj overlay)) + (argument (oref obj argument))) + ;; Making an overlay + (if (or (not value) (string-empty-p value)) + (when ov (delete-overlay ov)) + (with-current-buffer transient--original-buffer + (oset obj overlay (gptel--instructions-make-overlay value ov))) + (letrec ((ov-clear-hook + (lambda () (when-let* ((ov (oref obj overlay)) + ((overlayp ov))) + (remove-hook 'transient-exit-hook + ov-clear-hook) + (delete-overlay ov))))) + (add-hook 'transient-exit-hook ov-clear-hook))) + ;; Updating transient menu display + (if value + (propertize (concat argument (truncate-string-to-width value 35 nil nil t)) + 'face 'transient-value) + (propertize + (concat "(" (symbol-name (oref obj display-nil)) ")") + 'face 'transient-inactive-value)))) + + +;; * Transient Prefixes + +;;;###autoload (autoload 'gptel-menu "gptel-transient" nil t) +(transient-define-prefix gptel-menu () + "Change parameters of prompt to send to the LLM." + :incompatible '(("m" "y" "i") ("e" "g" "b" "k")) + ;; :value (list (concat "b" (buffer-name))) + [:description gptel-system-prompt--format + ["" + :if (lambda () (not (gptel--model-capable-p 'nosystem))) + "Instructions" + ("s" "Set system message" gptel-system-prompt :transient t) + (gptel--infix-add-directive)] + [:pad-keys t "" + (:info #'gptel--describe-infix-context + :face transient-heading :format "%d") + (gptel--infix-context-add-current-kill) + (gptel--infix-context-add-region) + (gptel--infix-context-add-buffer) + (gptel--infix-context-add-file) + (gptel--infix-context-remove-all) + (gptel--suffix-context-buffer)] + [:pad-keys t + :if (lambda () (and gptel-use-tools + (or gptel--known-tools (featurep 'gptel-integrations)))) + "" (:info + (lambda () + (concat + "Tools" (and gptel-tools + (concat " (" (propertize (format "%d selected" + (length gptel-tools)) + 'face 'warning) + ")")))) + :format "%d" :face transient-heading) + ("t" "Select tools" gptel-tools :transient t) + ("T" "Continue tool calls" + (lambda () (interactive) (gptel--handle-tool-use gptel--fsm-last)) + :if (lambda () (and gptel--fsm-last + (eq (gptel-fsm-state gptel--fsm-last) 'TOOL))))]] + [[(gptel-preset + :transient t + :key "@" :format "%d" + :description + (lambda () + (concat (propertize "Request Parameters" 'face 'transient-heading) + (gptel--format-preset-string)))) + (gptel--infix-variable-scope) + (gptel--infix-provider) + (gptel--infix-max-tokens) + (gptel--infix-num-messages-to-send + :if (lambda () (and gptel-expert-commands + (or gptel-mode gptel-track-response)))) + (gptel--infix-temperature :if (lambda () gptel-expert-commands)) + (gptel--infix-use-context) + (gptel--infix-include-reasoning) + (gptel--infix-use-tools) + (gptel--infix-track-response + :if (lambda () (and gptel-expert-commands (not gptel-mode)))) + (gptel--infix-track-media :if (lambda () gptel-mode))] + [" Response to" + ("e" "Echo area" "e") + ("b" "Other buffer" "b" + :class transient-option + :prompt "Output to buffer: " + :reader (lambda (prompt _ _history) + (read-buffer prompt (buffer-name (other-buffer)) nil))) + ("g" "gptel session" "g" + :class transient-option + :prompt "Existing or new gptel session: " + :reader + (lambda (prompt _ _history) + (read-buffer + prompt (generate-new-buffer-name + (concat "*" (gptel-backend-name gptel-backend) "*")) + nil (lambda (buf-name) + (if (consp buf-name) (setq buf-name (car buf-name))) + (let ((buf (get-buffer buf-name))) + (and (buffer-local-value 'gptel-mode buf) + (not (eq (current-buffer) buf)))))))) + ("k" "Kill-ring" "k")]] + [[:description (lambda () (concat (and gptel--rewrite-overlays "Continue ") + "Rewrite")) + :if (lambda () (or (use-region-p) + (and gptel--rewrite-overlays + (gptel--rewrite-sanitize-overlays)))) + ("r" + (lambda () (if (get-char-property (point) 'gptel-rewrite) + "Iterate" "Rewrite")) + gptel-rewrite)] + ["Tweak Response" :if gptel--in-response-p :pad-keys t + ("SPC" "Mark" gptel--mark-response) + ("M-RET" "Regenerate" gptel--regenerate :if gptel--in-response-p) + ("P" "Previous variant" gptel--previous-variant + :if gptel--at-response-history-p + :transient t) + ("N" "Next variant" gptel--previous-variant + :if gptel--at-response-history-p + :transient t) + ("E" "Ediff previous" gptel--ediff + :if gptel--at-response-history-p)] + ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands)) + ("I" "Inspect query (Lisp)" + (lambda () + "Inspect the query that will be sent as a lisp object." + (interactive) + (gptel--sanitize-model) + (gptel--inspect-query + (gptel--suffix-send + (cons "I" (transient-args transient-current-command)))))) + ("J" "Inspect query (JSON)" + (lambda () + "Inspect the query that will be sent as a JSON object." + (interactive) + (gptel--sanitize-model) + (gptel--inspect-query + (gptel--suffix-send + (cons "I" (transient-args transient-current-command))) + 'json)))] + ["Logging" + :if (lambda () (or gptel-log-level gptel-expert-commands)) + ("-l" "Log level" "-l" + :class gptel-lisp-variable + :variable gptel-log-level + :set-value gptel--set-with-scope + :display-nil "Off" + :prompt "Log level: " + :reader + (lambda (prompt _ _) + "Manage gptel's logging." + (let ((state (completing-read + prompt '("off" "info" "debug") nil t))) + (message "Log level set to %s" state) + (if (string= state "off") nil (intern state))))) + ("L" "Inspect Log" + (lambda () (interactive) + (pop-to-buffer (get-buffer-create gptel--log-buffer-name))) + :format " %k %d")]] + [(gptel--suffix-send)] + (interactive) + (gptel--sanitize-model) + (when gptel-context ;MAYBE: Move this to a dedicated sanitize function? + (setq gptel-context + (cl-delete-if + (lambda (entry) + (let ((first (or (car-safe entry) entry))) + (and (bufferp first) (not (buffer-live-p first))))) + gptel-context))) + (transient-setup 'gptel-menu)) + +;; ** Prefix for setting the system prompt. + +(defun gptel--setup-directive-menu (sym msg &optional external) + "Return a list of infix definitions for setting gptel directives. + +SYM is the symbol whose value is set to the selected directive.. +MSG is the meaning of symbol, used when messaging. +If EXTERNAL is non-nil, include external sources of directives." + (cl-loop for (type . prompt) in gptel-directives + ;; Avoid clashes with the custom directive key + with unused-keys = (delete ?s (nconc (number-sequence ?a ?z) + (number-sequence ?0 ?9))) + with width = (window-width) + for name = (symbol-name type) + for key = (seq-find (lambda (k) (member k unused-keys)) name (seq-first unused-keys)) + do (setq unused-keys (delete key unused-keys)) + ;; The explicit declaration ":transient transient--do-return" here + ;; appears to be required for Transient v0.5 and up. Without it, these + ;; are treated as suffixes when invoking `gptel-system-prompt' directly, + ;; and infixes when going through `gptel-menu'. + ;; TODO: Raise an issue with Transient. + collect + (list (key-description (list key)) + (concat (capitalize name) " " + (propertize " " 'display '(space :align-to 20)) + (propertize + (concat "(" (gptel--describe-directive prompt (- width 30)) ")") + 'face 'shadow)) + `(lambda () (interactive) + (message "%s: %s" ,msg ,(gptel--describe-directive prompt 100 "⮐ ")) + (gptel--set-with-scope ',sym ',prompt gptel--set-buffer-locally)) + :transient 'transient--do-return) + into prompt-suffixes + finally return + (nconc + prompt-suffixes + (list (list "DEL" "None" + `(lambda () (interactive) + (message "%s unset" ,msg) + (gptel--set-with-scope ',sym nil gptel--set-buffer-locally)) + :transient 'transient--do-return)) + (and external + (list (list "SPC" "Pick crowdsourced prompt" + 'gptel--read-crowdsourced-prompt + ;; NOTE: Quitting the completing read when picking a + ;; crowdsourced prompt will cause the transient to exit + ;; instead of returning to the system prompt menu. + :transient 'transient--do-exit)))))) + +;;;###autoload (autoload 'gptel-system-prompt "gptel-transient" nil t) +(transient-define-prefix gptel-system-prompt () + "Set the LLM system message for LLM interactions. + +The \"system message\" establishes directives for the chat +session and modifies the behavior of the LLM. Some examples of +system prompts are: + +You are a helpful assistant. Answer as concisely as possible. +Reply only with shell commands and no prose. +You are a poet. Reply only in verse. + +More extensive system messages can be useful for specific tasks. + +Customize `gptel-directives' for task-specific prompts." + [:description gptel-system-prompt--format + [(gptel--suffix-system-message)] + [(gptel--infix-variable-scope)]] + [:class transient-column + :setup-children + (lambda (_) (transient-parse-suffixes + 'gptel-system-prompt + (gptel--setup-directive-menu + 'gptel--system-message "Directive" t))) + :pad-keys t]) + +;; ** Prefix for saving and applying presets +;;;###autoload +(defun gptel-preset (preset &optional setter) + "Load gptel PRESET with SETTER. + +Interactively, query for PRESET, allow the preset scope to be set +dynamically, and offer to save the current gptel settings as a new or +existing preset, as well." + (interactive + (let ((hint (concat (propertize "C-s" 'face 'transient-value) + (propertize " Save as preset" + 'face 'transient-inactive-value) + ", " (propertize "=" 'face 'transient-value) + (propertize " Scope " 'face 'transient-inactive-argument))) + (scope-obj (gptel--scope :variable 'gptel--set-buffer-locally)) + (completion-extra-properties + (list :annotation-function + (lambda (cand) + (and-let* ((str (plist-get + (cdr (assq (intern cand) gptel--known-presets)) + :description))) + (concat (propertize " " 'display '(space :align-to 25)) + (truncate-string-to-width str (- (frame-width) 40) + nil nil t))))))) + (cl-flet* ((key-hint-ov () + (or (cdr-safe (get-char-property-and-overlay (point-min) 'gptel)) + (let ((ov (make-overlay (point-min) (minibuffer-prompt-end)))) + (overlay-put ov 'gptel 'prefix) + (overlay-put ov 'before-string + (concat hint (transient-format-value scope-obj) + "\n")) + ov))) + (save-preset () + (interactive) + (when (minibufferp) + (run-at-time 0 nil (lambda (menu) (call-interactively #'gptel--save-preset) + (when menu (transient-setup 'gptel-menu))) + transient--prefix) + (minibuffer-quit-recursive-edit))) + (update-scope () + (interactive) + (transient-infix-set + scope-obj + (pcase gptel--set-buffer-locally (1 nil) ('nil t) ('t 1))) + (overlay-put (key-hint-ov) 'before-string + (concat hint + (transient-format-value scope-obj) + "\n")))) + (minibuffer-with-setup-hook + (lambda () (use-local-map (make-composed-keymap + (define-keymap "C-s" #'save-preset "=" #'update-scope) + (current-local-map))) + (key-hint-ov)) + (list (intern (completing-read (format "Load preset: ") + gptel--known-presets nil t))))))) + (gptel--apply-preset preset + (or setter (lambda (sym val) (gptel--set-with-scope + sym val gptel--set-buffer-locally)))) + (when transient--prefix + (transient-setup 'gptel-menu))) + +;; ** Prefix for selecting tools + +;; gptel-tools offers a two-level menu for selecting tools, its design is a +;; little convoluted so here's an explanation: +;; +;; Normally a transient prefix exports its value via transient-args, to be +;; consumed by suffixes, where these args are determined by the state of the +;; menu at the time of export. The gptel-tools menu is dynamic and needs to +;; store tool selections that may not be visible in the meny any more, so we +;; cannot use the transient-args. +;; +;; We can not (should not?) control the value of the prefix directly, so we +;; instead use the scope (a secondary value) of the prefix to maintain the +;; history of selections. When running a suffix, we gather tool selections from +;; the scope. The scope is also used as a message channel for connecting the +;; category menu and the tool list menu for that category. + +;;;###autoload (autoload 'gptel-tools "gptel-transient" nil t) +(transient-define-prefix gptel-tools () + "Select tools to include with gptel requests. + +Tools are organized into categories. Selecting the category +toggles all the tools with that category. + +To add tools to this list, use `gptel-make-tool', which see. + +Using the scope option, you can set tools to use with gptel +requests globally, in this buffer or for the next request +only (\"oneshot\")." + :refresh-suffixes t + [:description "Provide the LLM with tools to run tasks for you" + ["" + (gptel--infix-variable-scope) + (gptel--infix-use-tools) + (gptel--infix-confirm-tool-calls) + (gptel--infix-include-tool-results)] + ["" + ("RET" "Confirm selection" + (lambda (tools) + ;; We don't care about the transient args of this prefix at all, since + ;; the state is managed entirely through its transient-scope: + (interactive (list (plist-get (transient-scope 'gptel-tools) :tools))) + (gptel--set-with-scope + 'gptel-tools + (mapcar (lambda (category-and-name) + (map-nested-elt gptel--known-tools category-and-name)) + (cl-delete-if-not #'consp tools)) + gptel--set-buffer-locally)) + :transient transient--do-return) + ("q" "Cancel" transient-quit-one)]] + [[:class transient-column ;Display known categories + :setup-children + (lambda (_) + (transient-parse-suffixes + 'gptel-tools + (cl-loop ;loop through gptel--known tools and collect categories + for (category . tools-alist) in gptel--known-tools + with unused-keys = (nconc (delete ?q (number-sequence ?a ?z)) + (number-sequence ?0 ?9) + (delete ?M (number-sequence ?A ?Z))) ;M used by MCP integration + for category-key = (seq-find (lambda (k) (member k unused-keys)) + (string-remove-prefix "mcp-" category) + (seq-first unused-keys)) + do (setq unused-keys (delete category-key unused-keys)) + collect (list (key-description (list category-key)) + (concat (propertize category 'face 'transient-heading) + (make-string (max (- 14 (length category)) 0) ? )) + (char-to-string category-key) + :format " %k %d %v" + :class 'gptel--switch-category + :category category) + into categories + finally do (plist-put (transient-scope) :keys unused-keys) + finally return categories)))] + [:class transient-column ;Display known tools for selected category + :setup-children + (lambda (_) + (transient-parse-suffixes + 'gptel-tools + (when-let* ((category (plist-get (transient-scope) :category)) + (tool-keys (plist-get (transient-scope) :keys))) + (cl-loop ;for each category, collect tools as infixes + with tools-alist = (cdr (assoc category gptel--known-tools)) + for (name . tool) in tools-alist + for tool-key = (seq-find (lambda (k) (member k tool-keys)) name (seq-first tool-keys)) + do (setq tool-keys (delete tool-key tool-keys)) + collect ;Each list is a transient infix of type gptel--switch + (list (key-description (list tool-key)) + (concat (make-string (max (- 20 (length name)) 0) ? ) + (propertize + (concat "(" (gptel--describe-directive + (gptel-tool-description tool) (- (window-width) 60)) + ")") + 'face 'shadow)) + (gptel-tool-name tool) + :format " %k %v %d" + :init-value #'gptel--tools-init-value + :class 'gptel--switch + :category category) + into infixes-for-category + finally return + (cons (list :info + (lambda () (concat + (propertize (plist-get (transient-scope) :key) + 'face 'transient-key) + (propertize " toggle all" 'face 'transient-heading))) + :format " %d") + infixes-for-category)))))]] + (interactive) + (transient-setup + 'gptel-tools nil nil + :scope (list :tools (mapcar (lambda (tool) (list (or (gptel-tool-category tool) "misc") + (gptel-tool-name tool))) + gptel-tools)))) + + +;; * Transient Infixes + +;; ** Infixes for context aggregation + +(transient-define-infix gptel--infix-use-context () + "Describe target destination for context injection. + +gptel will include with the LLM request any additional context +added with `gptel-add'. This context can be ignored, included +with the system message or included with the user prompt. + +Where in the request this context is included depends on the +value of `gptel-use-context', set from here." + :description "Include context" + :class 'gptel-lisp-variable + :variable 'gptel-use-context + :format " %k %d %v" + :set-value #'gptel--set-with-scope + :display-nil "No" + :display-map '((nil . "No") + (system . "with system message") + (user . "with user prompt")) + :key "-i" + :reader (lambda (prompt &rest _) + (let* ((choices '(("No" . nil) + ("with system message" . system) + ("with user prompt" . user))) + (destination (completing-read prompt choices nil t))) + (cdr (assoc destination choices))))) + +;; ** Infixes for model parameters + +(transient-define-infix gptel--infix-variable-scope () + "Set gptel's model parameters and system message in this buffer or globally." + :argument "scope" + :variable 'gptel--set-buffer-locally + :class 'gptel--scope + :format " %k %d %v" + :key "=" + :description (propertize "Scope" 'face 'transient-inactive-argument)) + +(transient-define-infix gptel--infix-num-messages-to-send () + "Number of recent messages to send with each exchange. + +By default, the full conversation history is sent with every new +prompt. This retains the full context of the conversation, but +can be expensive in token size. Set how many recent messages to +include." + :description "previous responses" + :class 'gptel-lisp-variable + :variable 'gptel--num-messages-to-send + :set-value #'gptel--set-with-scope + :display-nil 'all + :format " %k %v %d" + :key "-n" + :prompt "Number of past messages to include for context (leave empty for all): " + :reader 'gptel--transient-read-number) + +(transient-define-infix gptel--infix-max-tokens () + "Max tokens per response. + +This is roughly the number of words in the response. 100-300 is a +reasonable range for short answers, 400 or more for longer +responses." + :description "Response length (tokens)" + :class 'gptel-lisp-variable + :variable 'gptel-max-tokens + :set-value #'gptel--set-with-scope + :display-nil 'auto + :key "-c" + :prompt "Response length in tokens (leave empty: default, 80-200: short, 200-500: long): " + :reader 'gptel--transient-read-number) + +;; TODO(links): Run `gptel-refresh-buffer-hook' after a model change +(transient-define-infix gptel--infix-provider () + "AI Provider for Chat." + :description "Model" + :class 'gptel-provider-variable + :prompt "Model: " + :variable 'gptel-model + :set-value #'gptel--set-with-scope + :backend 'gptel-backend + :key "-m" + :reader (lambda (prompt &rest _) + (cl-loop + for (name . backend) in gptel--known-backends + nconc (cl-loop for model in (gptel-backend-models backend) + collect (list (concat name ":" (gptel--model-name model)) + backend model)) + into models-alist + with completion-extra-properties = + `(:annotation-function + ,(lambda (comp) + (let* ((model (nth 2 (assoc comp models-alist))) + (desc (get model :description)) + (caps (get model :capabilities)) + (context (get model :context-window)) + (input-cost (get model :input-cost)) + (output-cost (get model :output-cost)) + (cutoff (get model :cutoff-date))) + (when (or desc caps context input-cost output-cost cutoff) + (concat + (propertize " " 'display `(space :align-to 40)) + (when desc (truncate-string-to-width desc 70 nil ? t t)) + " " (propertize " " 'display `(space :align-to 112)) + (when caps (truncate-string-to-width (prin1-to-string caps) 21 nil ? t t)) + " " (propertize " " 'display `(space :align-to 134)) + (when context (format "%5dk" context)) + " " (propertize " " 'display `(space :align-to 142)) + (when input-cost (format "$%5.2f in" input-cost)) + (if (and input-cost output-cost) "," " ") + " " (propertize " " 'display `(space :align-to 153)) + (when output-cost (format "$%6.2f out" output-cost)) + " " (propertize " " 'display `(space :align-to 166)) + cutoff))))) + finally return + (cdr (assoc (completing-read prompt models-alist nil t nil nil + (concat (gptel-backend-name gptel-backend) ":" + (gptel--model-name gptel-model))) + models-alist))))) + +(transient-define-infix gptel--infix-temperature () + "Temperature of request." + :description "Temperature (0 - 2.0)" + :display-nil "default" + :class 'gptel-lisp-variable + :variable 'gptel-temperature + :set-value #'gptel--set-with-scope + :key "-T" + :prompt "Temperature controls the response randomness (0.0-2.0, leave empty for API default): " + :reader 'gptel--transient-read-number) + +(transient-define-infix gptel--infix-track-response () + "Distinguish between user messages and LLM responses. + +When creating a prompt to send to the LLM, gptel distinguishes +between text entered by the user and past LLM responses. This is +required for multi-turn conversations, and is always the case in +dedicated chat buffers (in `gptel-mode'). + +In regular buffers, you can toggle this behavior here or by +customizing `gptel-track-response'. When response tracking is +turned off, all text will be assigned the \"user\" role when +querying the LLM." + :description "Track LLM responses" + :class 'gptel--switches + :variable 'gptel-track-response + :set-value #'gptel--set-with-scope + :display-if-true "Yes" + :display-if-false "No" + :key "-R") + +(transient-define-suffix gptel--infix-track-media () + "Send media from links in the prompt. + +gptel can send images or other media from links in the buffer to the +LLM. What link types are sent depends on the mime-types the model +supports. See `gptel-track-media' for more information." + :description "Send media from links" + :transient t + :class 'gptel--switches + :variable 'gptel-track-media + :set-value #'gptel--set-with-scope + :display-if-true "Yes" + :display-if-false "No" + :key "-I" + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj)) + (transient--show)) + (if gptel-track-media + (run-hooks 'gptel-refresh-buffer-hook) + (gptel--annotate-link-clear))) + +;; ** Infixes for adding and removing context + +(declare-function gptel-context--at-point "gptel-context") +(declare-function gptel-add "gptel-context") +(declare-function gptel-context-add-current-kill "gptel-context") + +(transient-define-suffix gptel--infix-context-add-current-kill (&optional arg) + "Add current kill to gptel's context." + :transient 'transient--do-stay + :key "C-y" + :if (lambda () gptel-expert-commands) + :description + "Yank to context" + (interactive "P") + (require 'gptel-context) + (gptel-context-add-current-kill arg) + (transient-setup)) + +(transient-define-suffix gptel--infix-context-add-region () + "Add current region to gptel's context." + :transient 'transient--do-stay + :key "-r" + :if (lambda () (or (use-region-p) + (and (fboundp 'gptel-context--at-point) + (gptel-context--at-point)))) + :description + (lambda () + (if (and (fboundp 'gptel-context--at-point) + (gptel-context--at-point)) + "Remove context at point" + "Add region to context")) + (interactive) + (gptel-add) + (transient-setup)) + +(transient-define-suffix gptel--infix-context-add-buffer () + "Add a buffer to gptel's context." + :transient 'transient--do-stay + :key "-b" + :description "Add a buffer to context" + (interactive) + (gptel-add '(4)) + (transient-setup)) + +(declare-function gptel-add-file "gptel-context") +(declare-function gptel-context-remove-all "gptel-context") + +(transient-define-suffix gptel--infix-context-add-file () + "Add a file to gptel's context." + :transient 'transient--do-stay + :key "-f" + :description "Add a file to context" + (interactive) + (call-interactively #'gptel-add-file) + (transient-setup)) + +(transient-define-suffix gptel--infix-context-remove-all () + "Clear gptel's context." + :if (lambda () gptel-context) + :transient 'transient--do-stay + :key "-d" + :description "Remove all" + (interactive) + (gptel-context-remove-all t) + (transient-setup)) + +;; ** Infix for additional directive + +(transient-define-infix gptel--infix-add-directive () + "Additional directive intended for the next query only. + +This is useful to define a quick task on top of a more extensive +or detailed system message. + +For example, with code/text selected: + +- Rewrite this function to do X while avoiding Y. +- Change the tone of the following paragraph to be more direct. + +Or in an extended conversation: + +- Phrase you next response in ten words or less. +- Pretend for now that you're an anthropologist." + :class 'gptel-option-overlaid + ;; :variable 'gptel--instructions + :display-nil 'none + :overlay nil + :argument ":" + :prompt (concat "Add instructions for next request only (" + gptel--read-with-prefix-help ") ") + ;; TODO: Add the ability to edit this in a separate buffer, with + ;; `gptel--edit-directive'. This requires setting up gptel-menu with the + ;; result as the :scope. + :reader (lambda (prompt initial history) + (let* ((directive + (car-safe (gptel--parse-directive gptel--system-message 'raw))) + (cycle-prefix (lambda () (interactive) + (gptel--read-with-prefix directive))) + (minibuffer-local-map + (make-composed-keymap + (define-keymap "TAB" cycle-prefix "" cycle-prefix) + minibuffer-local-map)) + (extra (minibuffer-with-setup-hook cycle-prefix + (read-string prompt (or initial " ") history)))) + (unless (string-empty-p extra) extra))) + :format " %k %d %v" + :key "d" + :argument ":" + :description "Add instruction" + :transient t) + +;; ** Infix for reasoning block control + +(transient-define-infix gptel--infix-include-reasoning () + "How to handle reasoning/thinking response blocks. + +Some LLMs include in their response a \"thinking\" section. This +text improves the quality of the LLM's final output, but may not +be interesting to you by itself. + +You can control how gptel should handle the thinking blocks via +this option, or by setting the variable `gptel-include-reasoning' +via elisp, which see. + +Available behaviors are +- to include thinking blocks with the response, +- to omit them entirely, +- to include them but ignore them in consequent conversation turns, and +- to append them to a buffer of your choosing." + :description "Include reasoning" + :class 'gptel-lisp-variable + :variable 'gptel-include-reasoning + :format " %k %d %v" + :set-value #'gptel--set-with-scope + :display-nil "No" + :display-map '((nil . "No") + (ignore . "and ignore") + (t . "with response")) + :key "-v" + :prompt "Include reasoning: " + :reader (lambda (prompt &rest _) + (let* ((choices '(("no" . nil) + ("ignore" . ignore) + ("yes" . t) + ("other buffer" . buffer))) + (destination + (completing-read prompt choices nil t))) + (if (equal destination "other buffer") + (read-buffer "Append reasoning to buffer: ") + (cdr (assoc destination choices)))))) + +;; ** Infixes for tool use + +(transient-define-infix gptel--infix-use-tools () + "Whether LLM tool use with gptel is enabled. + +This is a three-way toggle. Assuming one or more tools to be +sent with requests have been selected, tool use can be + +- disabled, +- enabled, where the LLM may choose to respond with tool calls +- forced, where the LLM must respond with one or more tool calls. + +You can set this here or by customizing `gptel-use-tools', which +see." + :description "Use tools" + :class 'gptel-lisp-variable + :variable 'gptel-use-tools + :set-value (lambda (sym value scope) + (gptel--set-with-scope sym value scope) + (transient-setup)) + :display-nil "off" + :display-map '((nil . "off") + (t . "on") + (force . "force")) + :prompt "Use tools? " + :reader (lambda (prompt &rest _) + (let* ((choices '(("disable" . nil) + ("enable" . t) + ("force" . force))) + (pref (completing-read prompt choices nil t))) + (cdr (assoc pref choices)))) + :key "-t") + +(transient-define-infix gptel--infix-confirm-tool-calls () + "Whether tool calls should wait for the user to run them. + +This is a three-way toggle between these behaviors: + +- All tool calls run without confirmation. +- All tool calls wait for confirmation. +- Decided per-tool, according to the value of the tool spec's + :confirm slot. + +This sets the variable `gptel-confirm-tool-calls', which see." + :key "-c" + :description "Confirm tool calls" + :class 'gptel-lisp-variable + :variable 'gptel-confirm-tool-calls + :set-value #'gptel--set-with-scope + :display-nil "never" + :display-map '((nil . "never") + (t . "always") + (auto . "auto")) + :prompt "Tool calls require confirmation? " + :reader (lambda (prompt &rest _) + (let* ((choices '(("no" . nil) + ("always" . t) + ("tool decides" . auto))) + (pref (completing-read prompt choices nil t))) + (cdr (assoc pref choices))))) + +(transient-define-infix gptel--infix-include-tool-results () + "Whether tool call results should be included in the response. + +This is a three-way toggle between these behaviors: + +- All tool results are included. +- No tool results are included. +- Decided per-tool, according to the value of the tool spec's + :include slot. + +This sets the variable `gptel-include-tool-results', which see." + :key "-i" + :description "Include results " + :class 'gptel-lisp-variable + :variable 'gptel-include-tool-results + :set-value #'gptel--set-with-scope + :display-nil "never" + :display-map '((nil . "never") + (t . "always") + (auto . "auto")) + :prompt "Include tool results in LLM response? " + :reader (lambda (prompt &rest _) + (let* ((choices '(("never" . nil) + ("always" . t) + ("tool decides" . auto))) + (pref (completing-read prompt choices nil t))) + (cdr (assoc pref choices))))) + + +;; * Transient Suffixes + +;; ** Suffix to send prompt + +(transient-define-suffix gptel--suffix-send (args) + "Call `gptel-send' with ARGS." + :key "RET" + :description #'gptel--describe-suffix-send + (interactive (list (transient-args + (or transient-current-command 'gptel-menu)))) + (let ((stream gptel-stream) + (in-place (and (member "i" args) t)) + (redirect-output) + (backend gptel-backend) + (model gptel-model) + (backend-name (gptel-backend-name gptel-backend)) + (buffer) (position) + (callback) (gptel-buffer-name) + (system-extra (gptel--get-directive args)) + (dry-run (and (member "I" args) t)) + ;; Input redirection: grab prompt from elsewhere? + (prompt + (cond + ((member "m" args) (gptel--read-minibuffer-prompt)) + ((member "y" args) + (unless (car-safe kill-ring) + (user-error "`kill-ring' is empty! Nothing to send")) + (if current-prefix-arg + (read-from-kill-ring "Prompt from kill-ring: ") + (current-kill 0)))))) + + ;; Output redirection: Send response elsewhere? + (cond + ((member "e" args) ;Send to echo-area + (setq redirect-output t) + (setq stream nil) + (setq callback + (lambda (resp info &optional _raw) + (pcase resp + ((pred stringp) (message "%s response: %s" backend-name resp)) + (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer)) + (_ (when (and (null resp) (plist-get info :error)) + (message "%s response error: %s" + backend-name (plist-get info :status)))))))) + ((member "k" args) ;Send to kill-ring + (setq redirect-output t) + (setq stream nil) + (setq callback + (let ((accum)) + (lambda (resp info &optional _raw) + (pcase resp + ((pred stringp) (push resp accum) + (unless (plist-get info :tool-use) + (kill-new (apply #'concat (nreverse accum))) + (message "%s response: \"%s\" copied to kill-ring." backend-name + (truncate-string-to-width resp 30 nil nil t)))) + (`(tool-call . ,tool-calls) (gptel--display-tool-calls tool-calls info 'minibuffer)) + (_ (when (and (null resp) (plist-get info :error)) + (if accum (kill-new (apply #'concat (nreverse accum)))) + (message + (concat "%s response error: %s." + (and accum " Partial response copied to kill-ring.")) + backend-name (plist-get info :status))))))))) + ((setq gptel-buffer-name ;Send to gptel buffer + (cl-some (lambda (s) (and (stringp s) (string-prefix-p "g" s) + (substring s 1))) + args)) + (setq redirect-output t) + (let* ((reduced-prompt ;For inserting into the gptel buffer as + ;context, not the prompt used for the + ;request itself + (or prompt + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end)) + (buffer-substring-no-properties + (save-excursion + (text-property-search-backward + 'gptel 'response + (when (get-char-property (max (point-min) (1- (point))) + 'gptel) + t)) + (point)) + (gptel--at-word-end (point)))))) + (gptel-buffer (get-buffer gptel-buffer-name)) + (gptel-buffer-mode + (if (buffer-live-p gptel-buffer) + (buffer-local-value 'major-mode gptel-buffer) + gptel-default-mode))) + ;; Add code fences or Org src markers around the reduced-prompt + (cond ((and (stringp prompt) (eq major-mode gptel-buffer-mode))) + ((provided-mode-derived-p gptel-buffer-mode 'org-mode) + (setq reduced-prompt + (if (consp reduced-prompt);either (region . prompt) or prompt + (concat (and (car reduced-prompt) + (concat "#+begin_src " (gptel--strip-mode-suffix major-mode) + "\n" (org-escape-code-in-string (car reduced-prompt)) + "\n#+end_src\n\n")) + (cdr reduced-prompt)) + (concat "#+begin_src " (gptel--strip-mode-suffix major-mode) + "\n" (org-escape-code-in-string + (or (cdr-safe reduced-prompt) reduced-prompt)) + "\n#+end_src")))) + (t (setq reduced-prompt + (if (consp reduced-prompt);either (region . prompt) or prompt + (concat (and (car reduced-prompt) + (concat "``` " (gptel--strip-mode-suffix major-mode) "\n" + (car reduced-prompt) "\n```\n\n")) + (cdr reduced-prompt)) + (concat "``` " (gptel--strip-mode-suffix major-mode) "\n" + (or (cdr-safe reduced-prompt) reduced-prompt) "\n```" ))))) + (cond + ((buffer-live-p gptel-buffer) + ;; Insert into existing gptel session + (setq buffer gptel-buffer) + (with-current-buffer buffer + (goto-char (point-max)) + (unless (or buffer-read-only + (get-char-property (point) 'read-only)) + (unless (bolp) (insert "\n")) + (insert reduced-prompt)) + (setq position (point-marker)) + (when (and gptel-mode (not dry-run)) + (gptel--update-status " Waiting..." 'warning)))) + ;; Insert into new gptel session + (t (setq buffer + (gptel gptel-buffer-name + (condition-case nil + (gptel--get-api-key) + ((error user-error) + (setq gptel-api-key + (read-passwd + (format "%s API key: " + (gptel-backend-name + gptel-backend)))))) + reduced-prompt)) + ;; Set backend and model in new session from current buffer + (with-current-buffer buffer + (setq gptel-backend backend) + (setq gptel-model model) + (unless dry-run + (gptel--update-status " Waiting..." 'warning)) + (setq position (point-marker))))))) + ((setq gptel-buffer-name ;Send to specified buffer + (cl-some (lambda (s) (and (stringp s) (string-prefix-p "b" s) + (substring s 1))) + args)) + (setq redirect-output t) + (setq buffer (get-buffer-create gptel-buffer-name)) + (with-current-buffer buffer (setq position (point-marker))))) + + ;; MAYBE: This is no a good way to handle two-part (region + instruction) prompts + ;; If the prompt is a cons (region-text . instructions), collapse it + (when (consp prompt) (setq prompt (concat (car prompt) "\n\n" (cdr prompt)))) + + (prog1 (gptel-request prompt + :position position + :in-place in-place + :stream stream + :system + (if system-extra + (gptel--merge-additional-directive system-extra) + gptel--system-message) + :callback callback + :transforms gptel-prompt-transform-functions + :fsm (gptel-make-fsm :handlers gptel-send--handlers) + :dry-run dry-run) + + (unless dry-run + (gptel--update-status " Waiting..." 'warning)) + + ;; NOTE: Possible future race condition here if Emacs ever drops the GIL. + ;; The HTTP request callback might modify the buffer before the in-place + ;; text is killed below. + (when in-place + (if (or buffer-read-only (get-char-property (point) 'read-only)) + (cond + ((derived-mode-p 'vterm-mode) + (require 'gptel-integrations) + (gptel--vterm-delete)) + (t (message "Not replacing prompt: region is read-only"))) + (let ((beg (if (use-region-p) + (region-beginning) + (max (previous-single-property-change + (point) 'gptel nil (point-min)) + (previous-single-property-change + (point) 'read-only nil (point-min))))) + (end (if (use-region-p) (region-end) (point)))) + (unless redirect-output + ;; store the killed text in gptel-history + (gptel--attach-response-history + (list (buffer-substring-no-properties beg end)))) + (kill-region beg end)))) + + (when (and redirect-output gptel-buffer-name) + (message (concat "Prompt sent to buffer: " + (propertize gptel-buffer-name 'face 'help-key-binding))) + (display-buffer + buffer '((display-buffer-reuse-window + display-buffer-pop-up-window) + (reusable-frames . visible))))))) + +(defun gptel--merge-additional-directive (additional &optional full) + "Merge ADDITIONAL gptel directive with the full system message. + +The ADDITIONAL directive is typically specified from `gptel-menu' +and applies only to the next gptel request, see +`gptel--infix-add-directive'. + +FULL defaults to the active, full system message. It may be a +string, a list of prompts or a function, see `gptel-directives' +for details." + (setq full (or full gptel--system-message)) + (cl-typecase full + (string (concat full "\n\n" additional)) + (cons (let ((copy (copy-sequence full))) + (setcar copy (concat (car copy) "\n\n" additional)) + copy)) + (function (lambda () (gptel--merge-additional-directive + additional (funcall full)))) + (otherwise additional))) + +;; Allow calling from elisp +(put 'gptel--suffix-send 'interactive-only nil) + +;; ** Suffix to regenerate response + +(defun gptel--regenerate () + "Regenerate gptel response at point." + (interactive) + (when (gptel--in-response-p) + (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds)) + (history (get-char-property (point) 'gptel-history)) + (prev-responses (cons (buffer-substring-no-properties beg end) + history))) + (when gptel-mode ;Remove prefix/suffix + (save-excursion + (goto-char beg) + (when (looking-back (concat "\n+" (regexp-quote (gptel-response-prefix-string))) + (point-min) 'greedy) + (setq beg (match-beginning 0))) + (goto-char end) + (when (looking-at + (concat "\n+" (regexp-quote (gptel-prompt-prefix-string)))) + (setq end (match-end 0))))) + (delete-region beg end) + (gptel--attach-response-history prev-responses) + (call-interactively #'gptel--suffix-send)))) + +;; ** Set system message +(defun gptel--read-crowdsourced-prompt () + "Pick a crowdsourced system prompt for gptel. + +This uses the prompts in the variable +`gptel--crowdsourced-prompts', which see." + (interactive) + (if (not (hash-table-empty-p (gptel--crowdsourced-prompts))) + (let ((choice + (completing-read + "Pick and edit prompt: " + (lambda (str pred action) + (if (eq action 'metadata) + `(metadata + ( affixation-function . + (lambda (cands) + (mapcar + (lambda (c) + ( list c "" + (concat + (propertize " " 'display '(space :align-to 22)) + " " (propertize + (gptel--describe-directive + (gethash c gptel--crowdsourced-prompts) + 54 " ") + 'face 'completions-annotations)))) + cands)))) + (complete-with-action action gptel--crowdsourced-prompts str pred))) + nil t))) + (when-let* ((prompt (gethash choice gptel--crowdsourced-prompts))) + (gptel--set-with-scope + 'gptel--system-message prompt gptel--set-buffer-locally) + (gptel--edit-directive 'gptel--system-message + :callback (lambda (_) (call-interactively #'gptel-menu))))) + (message "No prompts available."))) + +(transient-define-suffix gptel--suffix-system-message (&optional cancel) + "Edit LLM system message. + +CANCEL is used to avoid touching dynamic system messages, +generated from functions." + :transient 'transient--do-exit + :description "Set or edit system message" + :format " %k %d" + :key "s" + (interactive + (list (and (functionp gptel--system-message) + (not (y-or-n-p + "Active directive is dynamically generated: Edit its current value instead?"))))) + (if cancel (progn (message "Edit canceled") + (call-interactively #'gptel-menu)) + (gptel--edit-directive 'gptel--system-message + :setup #'activate-mark + :callback (lambda (_) (call-interactively #'gptel-menu))))) + +;; MAYBE: Eventually can be simplified with string-edit, after we drop support +;; for Emacs 28.2. +(cl-defun gptel--edit-directive (&optional sym &key prompt initial callback setup buffer) + "Edit a gptel directive in a dedicated buffer. + +Store the result in SYM, a symbol. PROMPT and INITIAL are the heading +and initial text. If SETUP is a function, run it after setting up the +buffer. If CALLBACK is specified, it is run after exiting the edit. It +is called with one argument: the buffer text or with nil depending on +whether the action is confirmed/cancelled." + (declare (indent 1)) + (let ((orig-buf (or buffer (current-buffer))) + (msg-start (make-marker)) + (directive (symbol-value sym))) + (when (functionp directive) + (setq directive (funcall directive))) + ;; TODO: Handle editing list-of-strings directives + (with-current-buffer (get-buffer-create "*gptel-prompt*") + (let ((inhibit-read-only t) (inhibit-message t)) + (erase-buffer) + (text-mode) + (visual-line-mode 1) + (setq header-line-format + (concat "Edit your instructions below and press " + (propertize "C-c C-c" 'face 'help-key-binding) + " when ready, or " + (propertize "C-c C-k" 'face 'help-key-binding) + " to abort.")) + (insert + (or prompt + (concat + "# Example: You are a helpful assistant. Answer as concisely as possible.\n" + "# Example: Reply only with shell commands and no prose.\n" + "# Example: You are a poet. Reply only in verse.")) + "\n\n") + (add-text-properties + (point-min) (point) + (list 'read-only t 'face 'font-lock-comment-face 'front-sticky t 'rear-nonsticky t)) + (set-marker msg-start (point)) + (save-excursion + ;; If it's a list, insert only the system message part + ;; If all is nil, insert "" at least + (insert (or initial (car-safe (gptel--parse-directive directive 'raw)) "")) + (push-mark nil 'nomsg)) + (and (functionp setup) (funcall setup))) + (display-buffer (current-buffer) + `((display-buffer-below-selected + display-buffer-use-some-window) + (some-window . lru) + (body-function . ,#'select-window) + (window-height . ,#'fit-window-to-buffer))) + (let ((quit-to-menu + (lambda () "Cancel system message update and return." + (quit-window) + (unless (minibufferp) + (display-buffer orig-buf + `((display-buffer-reuse-window + display-buffer-use-some-window) + (body-function . ,#'select-window))))))) + (use-local-map + (make-composed-keymap + (define-keymap + "C-c C-c" + (lambda () "Confirm system message and return." + (interactive) + (let ((system-message + (buffer-substring-no-properties msg-start (point-max)))) + (when sym + (with-current-buffer orig-buf + (gptel--set-with-scope + sym (if (cdr-safe directive) ;Handle list of strings + (prog1 directive (setcar directive system-message)) + system-message) + gptel--set-buffer-locally))) + (funcall quit-to-menu) + (when (functionp callback) (funcall callback system-message)))) + "C-c C-k" (lambda () (interactive) + (funcall quit-to-menu) + (when (functionp callback) (funcall callback nil)))) + text-mode-map)))))) + +;; ** Suffix for displaying and removing context +(declare-function gptel-context--buffer-setup "gptel-context") +(declare-function gptel-context--collect "gptel-context") + +(transient-define-suffix gptel--suffix-context-buffer () + "Display all contexts from all buffers & files." + :transient 'transient--do-exit + :key " C" + :if (lambda () gptel-context) + :description "Inspect context" + (interactive) + (gptel-context--buffer-setup nil nil gptel-context)) + +(provide 'gptel-transient) +;;; gptel-transient.el ends here + +;; Local Variables: +;; outline-regexp: "^;; \\*+" +;; eval: (outline-minor-mode 1) +;; End: diff --git a/elpa/gptel-20260425.846/gptel.el b/elpa/gptel-20260425.846/gptel.el new file mode 100644 index 00000000..32bd1cbc --- /dev/null +++ b/elpa/gptel-20260425.846/gptel.el @@ -0,0 +1,2961 @@ +;;; gptel.el --- Interact with ChatGPT or other LLMs -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Karthik Chikmagalur + +;; Author: Karthik Chikmagalur +;; Package-Version: 20260425.846 +;; Package-Revision: 101904a1a856 +;; Package-Requires: ((emacs "27.1") (transient "0.7.4") (compat "30.1.0.0")) +;; Keywords: convenience, tools +;; URL: https://github.com/karthink/gptel + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; gptel is a simple Large Language Model chat client, with support for multiple +;; models and backends. +;; +;; It works in the spirit of Emacs, available at any time and in any buffer. +;; +;; gptel supports: +;; +;; - The services ChatGPT, Azure, Gemini, Anthropic AI, Together.ai, Perplexity, +;; AI/ML API, Anyscale, OpenRouter, Groq, PrivateGPT, DeepSeek, Cerebras, Github Models, +;; GitHub Copilot chat, AWS Bedrock, Novita AI, xAI, Sambanova, Mistral Le +;; Chat and Kagi (FastGPT & Summarizer). +;; - Local models via Ollama, Llama.cpp, Llamafiles or GPT4All +;; +;; Additionally, any LLM service (local or remote) that provides an +;; OpenAI-compatible API is supported. +;; +;; Features: +;; +;; - Interact with LLMs from anywhere in Emacs (any buffer, shell, minibuffer, +;; wherever). +;; - LLM responses are in Markdown or Org markup. +;; - Supports conversations and multiple independent sessions. +;; - Supports tool-use to equip LLMs with agentic capabilities. +;; - Supports Model Context Protocol (MCP) integration using the mcp.el package. +;; - Supports multi-modal models (send images, documents). +;; - Supports "reasoning" content in LLM responses. +;; - Save chats as regular Markdown/Org/Text files and resume them later. +;; - You can go back and edit your previous prompts or LLM responses when +;; continuing a conversation. These will be fed back to the model. +;; - Redirect prompts and responses easily +;; - Rewrite, refactor or fill in regions in buffers. +;; - Write your own commands for custom tasks with a simple API. +;; +;; Requirements for ChatGPT, Azure, Gemini or Kagi: +;; +;; - You need an appropriate API key. Set the variable `gptel-api-key' to the +;; key or to a function of no arguments that returns the key. (It tries to +;; use `auth-source' by default) +;; +;; ChatGPT is configured out of the box. For the other sources: +;; +;; - For Azure: define a gptel-backend with `gptel-make-azure'. +;; - For Gemini: define a gptel-backend with `gptel-make-gemini'. +;; - For Anthropic (Claude): define a gptel-backend with `gptel-make-anthropic'. +;; - For AI/ML API, Together.ai, Anyscale, Groq, OpenRouter, DeepSeek, Cerebras +;; or Github Models: define a gptel-backend with `gptel-make-openai'. +;; - For PrivateGPT: define a backend with `gptel-make-privategpt'. +;; - For Perplexity: define a backend with `gptel-make-perplexity'. +;; - For Deepseek: define a backend with `gptel-make-deepseek'. +;; - For Kagi: define a gptel-backend with `gptel-make-kagi'. +;; +;; For local models using Ollama, Llama.cpp or GPT4All: +;; +;; - The model has to be running on an accessible address (or localhost) +;; - Define a gptel-backend with `gptel-make-ollama' or `gptel-make-gpt4all'. +;; - Llama.cpp or Llamafiles: Define a gptel-backend with `gptel-make-openai'. +;; +;; Consult the package README for examples and more help with configuring +;; backends. +;; +;; Usage: +;; +;; gptel can be used in any buffer or in a dedicated chat buffer. The +;; interaction model is simple: Type in a query and the response will be +;; inserted below. You can continue the conversation by typing below the +;; response. +;; +;; To use this in any buffer: +;; +;; - Call `gptel-send' to send the buffer's text up to the cursor. Select a +;; region to send only the region. +;; +;; - You can select previous prompts and responses to continue the conversation. +;; +;; - Call `gptel-send' with a prefix argument to access a menu where you can set +;; your backend, model and other parameters, or to redirect the +;; prompt/response. +;; +;; To use this in a dedicated buffer: +;; +;; - M-x gptel: Start a chat session. +;; +;; - In the chat session: Press `C-c RET' (`gptel-send') to send your prompt. +;; Use a prefix argument (`C-u C-c RET') to access a menu. In this menu you +;; can set chat parameters like the system directives, active backend or +;; model, or choose to redirect the input or output elsewhere (such as to the +;; kill ring or the echo area). +;; +;; - You can save this buffer to a file. When opening this file, turn on +;; `gptel-mode' before editing it to restore the conversation state and +;; continue chatting. +;; +;; - To include media files with your request, you can add them to the context +;; (described next), or include them as links in Org or Markdown mode chat +;; buffers. Sending media is disabled by default, you can turn it on globally +;; via `gptel-track-media', or locally in a chat buffer via the header line. +;; +;; Include more context with requests: +;; +;; If you want to provide the LLM with more context, you can add arbitrary +;; regions, buffers, files or directories to the query with `gptel-add'. To add +;; text or media files, call `gptel-add' in Dired or use the dedicated +;; `gptel-add-file'. +;; +;; You can also add context from gptel's menu instead (`gptel-send' with a +;; prefix arg), as well as examine or modify context. +;; +;; When context is available, gptel will include it with each LLM query. +;; +;; LLM Tool use: +;; +;; gptel supports "tool calling" behavior, where LLMs can specify arguments with +;; which to call provided "tools" (elisp functions). The results of running the +;; tools are fed back to the LLM, giving it capabilities and knowledge beyond +;; what is available out of the box. For example, tools can perform web +;; searches or API lookups, modify files and directories, and so on. +;; +;; Tools can be specified via `gptel-make-tool', or obtained from other +;; repositories, or from Model Context Protocol (MCP) servers using the mcp.el +;; package. See the README for details. +;; +;; Tools can be included with LLM queries using gptel's menu, or from +;; `gptel-tools'. +;; +;; Rewrite interface +;; +;; In any buffer: with a region selected, you can rewrite prose, refactor code +;; or fill in the region. This is accessible via `gptel-rewrite', and also from +;; the `gptel-send' menu. +;; +;; Presets +;; +;; Define a bundle of configuration (model, backend, system message, tools etc) +;; as a "preset" that can be applied together, making it easy to switch between +;; tasks in gptel. Presets can be saved and applied from gptel's transient +;; menu. You can also include a cookie of the form "@preset-name" in the prompt +;; to send a request with a preset applied. This feature works everywhere, but +;; preset cookies are also fontified in chat buffers. +;; +;; gptel in Org mode: +;; +;; gptel offers a few extra conveniences in Org mode: +;; +;; - You can limit the conversation context to an Org heading with +;; `gptel-org-set-topic'. +;; +;; - You can have branching conversations in Org mode, where each hierarchical +;; outline path through the document is a separate conversation branch. +;; See the variable `gptel-org-branching-context'. +;; +;; - You can declare the gptel model, backend, temperature, system message and +;; other parameters as Org properties with the command +;; `gptel-org-set-properties'. gptel queries under the corresponding heading +;; will always use these settings, allowing you to create mostly reproducible +;; LLM chat notebooks. +;; +;; Finally, gptel offers a general purpose API for writing LLM ineractions that +;; suit your workflow. See `gptel-request', and `gptel-fsm' for more advanced +;; usage. + +;;; Code: +(defconst gptel-version "0.9.9.4") + +(declare-function markdown-mode "markdown-mode") +(declare-function gptel-menu "gptel-transient") +(declare-function gptel-system-prompt "gptel-transient") +(declare-function gptel-tools "gptel-transient") +(declare-function gptel--vterm-pre-insert "gptel-integrations") +(declare-function pulse-momentary-highlight-region "pulse") + +(declare-function ediff-make-cloned-buffer "ediff-util") +(declare-function ediff-regions-internal "ediff") +(declare-function hl-line-highlight "hl-line") + +(declare-function org-escape-code-in-string "org-src") +(declare-function gptel-org-set-topic "gptel-org") +(declare-function gptel-org--save-state "gptel-org") +(declare-function gptel-org--restore-state "gptel-org") +(declare-function gptel-org--annotate-links "gptel-org") +(define-obsolete-function-alias + 'gptel-set-topic 'gptel-org-set-topic "0.7.5") + +(declare-function markdown-link-at-pos "markdown-mode") + +(eval-when-compile + (require 'subr-x)) +(require 'cl-lib) +(require 'compat nil t) +(require 'url) +(require 'map) +(require 'text-property-search) +(require 'cl-generic) +(eval-and-compile (require 'gptel-request)) + + +;;; User options +(defcustom gptel-pre-response-hook nil + "Hook run before inserting the LLM response into the current buffer. + +This hook is called in the buffer where the LLM response will be +inserted. + +Note: this hook only runs if the request succeeds." + :type 'hook + :group 'gptel) + +(define-obsolete-variable-alias + 'gptel-post-response-hook 'gptel-post-response-functions + "0.6.0" + "Post-response functions are now called with two arguments: the +start and end buffer positions of the response.") + +(defcustom gptel-post-response-functions nil + "Abnormal hook run after inserting the LLM response into the current buffer. + +This hook is called in the buffer to which the LLM response is +sent, and after the full response has been inserted. Each +function is called with two arguments: the response beginning and +end positions. + +Note: this hook runs even if the request fails. In this case the +response beginning and end positions are both the cursor position +at the time of the request." + :type 'hook + :group 'gptel) + +(add-hook 'gptel-post-response-functions 'pulse-momentary-highlight-region 70) + +(defcustom gptel-post-stream-hook nil + "Hook run after each insertion of the LLM's streaming response. + +This hook is called in the buffer from which the prompt was sent +to the LLM, and after a text insertion." + :type 'hook + :group 'gptel) + +(defcustom gptel-pre-tool-call-functions nil + "Abnormal hook called before each tool call. + +Each hook function is called a plist with the following keys: + +:name - the name of the tool being called, a string +:args - a plist of the tool call arguments, as specified in the tool + definition. For a hypothetical edit_file tool that takes three + arguments, a FILENAME, an ORIGINAL and REPLACEMENT strings, this + plist is structured as + + (:filename \"/path/to/file.md\" + :original \"...\" + :replacement \"...\") + +:buffer - The name of the buffer from which the request was sent. +:backend - The name of the gptel backend used for the request. +:model - The name of the gptel model used for the request. + +The function can work by side effects and return nil, or return a plist +with one or more of the following keys. + +:stop - If non-nil, stop the request entirely. +:stop-reason - If :stop is non-nil, the reason for stopping. Intended + for the user, not the LLM. + +:block - If non-nil, continue the request but block this tool call and + mark it as having erred. Can be a string to send as the + result instead, typically an explanation for why the tool was + not run. Intended for the LLM, not the user. + +:confirm - Whether the tool call should seek confirmation from the user. + t and nil are both meaningful, signifying that the tool call + should and should not seek user confirmation, respectively. + When present, this key overrides all other confirmation + options (such as `gptel-confirm-tool-calls' and the tool's + CONFIRM slot). +:args - The updated argument plist for the tool call. +:result - The result of this tool call, used instead of the tool call + output. Not marked as an error." + :type 'hook + :group 'gptel) + +(defcustom gptel-post-tool-call-functions nil + "Abnormal hook called after each tool call. + +Each hook function is called a plist with the following keys: + +:name - the name of the tool being called, a string +:args - a plist of the tool call arguments, as specified in the tool + definition. For a hypothetical edit_file tool that takes three + arguments, a FILENAME, an ORIGINAL and REPLACEMENT strings, this + plist is structured as + + (:filename \"/path/to/file.md\" + :original \"...\" + :replacement \"...\") + +:result - The tool call result, serialized to a string. +:buffer - The name of the buffer from which the request was sent. +:backend - The name of the gptel backend used for the request. +:model - The name of the gptel model used for the request. + +The function can work by side effects and return nil, or return a plist +with one or more of the following keys. + +:stop - If non-nil, stop the request entirely. +:stop-reason - If :stop is non-nil, the reason for stopping. Intended + for the user, not the LLM. + +:block - If non-nil, continue the request but block this tool call and + mark it as having erred. Can be a string to send as the + result instead, typically an explanation for why the tool was + not run. Intended for the LLM, not the user. + +:result - The updated result of this tool call, used instead of the + tool call output. Not marked as an error." + :type 'hook + :group 'gptel) + +(defcustom gptel-save-state-hook nil + "Hook run before gptel saves model parameters to a file. + +You can use this hook to store additional conversation state or +model parameters to the chat buffer, or to modify the buffer in +some other way." + :type 'hook + :group 'gptel) + +(defcustom gptel-default-mode (if (fboundp 'markdown-mode) + 'markdown-mode + 'text-mode) + "The default major mode for dedicated chat buffers. + +If `markdown-mode' is available, it is used. Otherwise gptel +defaults to `text-mode'." + :type 'function + :group 'gptel) + +(defcustom gptel-use-header-line t + "Whether `gptel-mode' should use header-line for status information. + +When set to nil, use the mode line for (minimal) status +information and the echo area for messages." + :type 'boolean + :group 'gptel) + +;; Set minimally to avoid display-buffer action alist conflicts (#533) +(defcustom gptel-display-buffer-action `(nil (body-function . ,#'select-window)) + "The action used to display gptel chat buffers. + +The gptel buffer is displayed in a window using + + (display-buffer BUFFER gptel-display-buffer-action) + +The value of this option has the form (FUNCTION . ALIST), +where FUNCTION is a function or a list of functions. Each such +function should accept two arguments: a buffer to display and an +alist of the same form as ALIST. See info node `(elisp)Choosing +Window' for details." + :type display-buffer--action-custom-type + :group 'gptel) + +(defcustom gptel-crowdsourced-prompts-file + (let ((cache-dir (or (eval-when-compile + (require 'xdg) + (xdg-cache-home)) + user-emacs-directory))) + (expand-file-name "gptel-crowdsourced-prompts.csv" cache-dir)) + "File used to store crowdsourced system prompts. + +These are prompts cached from an online source (see +`gptel--crowdsourced-prompts-url'), and can be set from the +transient menu interface provided by `gptel-menu'." + :type 'file + :group 'gptel) + +(defvar gptel-refresh-buffer-hook '(jit-lock-refontify) + "Hook run in gptel buffers after changing gptel's configuration. + +This hook runs in gptel chat buffers after making a change to gptel's +configuration that might require a UI update.") + +(defvar-local gptel--bounds nil) +(put 'gptel--bounds 'safe-local-variable #'listp) + +(defvar gptel--preset nil + "Name of last applied gptel preset. + +For internal use only.") +(put 'gptel--preset 'safe-local-variable #'symbolp) + +(defvar-local gptel--tool-names nil + "Store to persist tool names to file across Emacs sessions. + +Note: Changing this variable does not affect gptel\\='s behavior +in any way.") +(put 'gptel--tool-names 'safe-local-variable #'listp) + +(defvar-local gptel--backend-name nil + "Store to persist backend name across Emacs sessions. + +Note: Changing this variable does not affect gptel\\='s behavior +in any way.") +(put 'gptel--backend-name 'safe-local-variable #'stringp) + +(defvar-local gptel--old-header-line nil) + +(defvar gptel--markdown-block-map + (define-keymap + "" 'gptel-markdown-cycle-block + "TAB" 'gptel-markdown-cycle-block) + "Keymap for folding and unfolding Markdown code blocks.") + + +;;; Utility functions +(defun gptel--modify-value (original new-spec) + "Combine ORIGINAL with NEW-SPEC and return the new result. + +This function is non-destructive, ORIGINAL is not modified. + +NEW-SPEC is either a declarative action spec (plist) of the form + (:key val ...), or a simple value. Recognized spec keys are :append, +:prepend, :eval, :function and :merge. If NEW-SPEC does not have this +form it is returned as is. + +- :append and :prepend will append/prepend val (a list or string) to ORIGINAL. + Actions on strings are idempotent, they will only be appended/prepended once. +- :eval will evaluate val and return the result, and +- :function will call val with ORIGINAL as its argument, and return the result. +- :merge will treat ORIGINAL and NEW-SPEC as plists and return a merged plist, + with NEW-SPEC taking precedence." + (if (not (and (consp new-spec) (keywordp (car new-spec)))) + new-spec + (let ((current original) (tail new-spec)) + (while tail + (let ((key (pop tail)) (form (pop tail))) + (setq current + (pcase key + (:append (if (stringp form) + (if (string-suffix-p form current t) + current (concat current form)) + (append current form))) + (:prepend (if (stringp form) + (if (string-prefix-p form current t) + current (concat form current)) + (append form current))) + (:eval (eval form t)) + (:function (funcall form current)) + (:merge (gptel--merge-plists (copy-sequence current) form)) + (_ new-spec))))) + current))) + +(defun gptel-auto-scroll () + "Scroll window if LLM response continues below viewport. + +Note: This will move the cursor." + (when-let* ((win (get-buffer-window (current-buffer) 'visible)) + ((not (pos-visible-in-window-p (point) win))) + (scroll-error-top-bottom t)) + (condition-case nil + (with-selected-window win + (scroll-up-command)) + (error nil)))) + +(defun gptel-beginning-of-response (&optional beg _end arg) + "Move point to BEG, or to the beginning of the LLM response ARG times." + (interactive (list nil nil + (prefix-numeric-value current-prefix-arg))) + (gptel-end-of-response beg nil (- (or arg 1)))) + +(defun gptel-end-of-response (&optional beg end arg) + "Move point to end of LLM response. + +With BEG, start search from BEG when ARG is negative. +With END, start search from END when ARG is positive. +Otherwise move ARG times, defaulting to 1." + (interactive (list nil nil + (prefix-numeric-value current-prefix-arg))) + (unless arg (setq arg 1)) + (let* ((search (if (> arg 0) + #'text-property-search-forward + #'text-property-search-backward)) + (goto-prefix-end + (lambda () (when-let* ((prefix (gptel-prompt-prefix-string)) + ((not (string-empty-p prefix))) + ((looking-at (concat "\n\\{1,2\\}" + (regexp-quote prefix) "?")))) + (goto-char (match-end 0))))) + (goto-prefix-beg + (lambda () (when-let* ((prefix (gptel-response-prefix-string)) + ((not (string-empty-p prefix))) + ((looking-back (concat (regexp-quote prefix) "?") + (point-min)))) + (goto-char (match-beginning 0)))))) + (cond + ((and end (> arg 0)) (goto-char end) (cl-decf arg) (funcall goto-prefix-end)) + ((and beg (< arg 0)) (goto-char beg) (cl-incf arg) (funcall goto-prefix-beg))) + (dotimes (_ (abs arg)) + (funcall search 'gptel 'response t) + (if (> arg 0) + (funcall goto-prefix-end) + (funcall goto-prefix-beg))))) + +(defun gptel-markdown-cycle-block () + "Cycle code blocks in Markdown." + (interactive) + (save-excursion + (forward-line 0) + (let (start end (parity 0)) + (cond ;Find start and end of block, with possible nested blocks + ((looking-at-p "^``` *\n") ;end of block, find corresponding start + (setq parity -1 end (line-end-position)) + (while (and (not (= parity 0)) (not (bobp)) (forward-line -1)) + (cond ((looking-at-p "^``` *\n") (cl-decf parity)) + ((looking-at-p "^``` ?[a-z]") (cl-incf parity)))) + (when (= parity 0) (setq start (point)))) + + ((looking-at-p "^``` ?[a-z]") ;beginning of block, find corresponding end + (setq parity 1 start (point)) + (while (and (not (= parity 0)) (not (eobp)) (forward-line 1)) + (cond ((looking-at-p "^``` *\n") (cl-decf parity)) + ((looking-at-p "^``` ?[a-z]") (cl-incf parity)))) + (when (= parity 0) (setq end (line-end-position))))) + (when (and start end) + (goto-char start) + (end-of-line) + (pcase-let* ((`(,value . ,hide-ov) + (get-char-property-and-overlay (point) 'invisible))) + (if (and hide-ov (eq value t)) + (delete-overlay hide-ov) + (unless hide-ov (setq hide-ov (make-overlay (point) end))) + (overlay-put hide-ov 'evaporate t) + (overlay-put hide-ov 'invisible t) + (overlay-put hide-ov 'before-string + (propertize "..." 'face 'shadow)))))))) + +(defsubst gptel--annotate-link (ov link-status) + "Annotate link overlay OV according to LINK-STATUS. + +LINK-STATUS is a list of link properties relevant to gptel queries, of +the form (valid . REST). See `gptel-markdown--validate-link' for +details. Indicate the (in)validity of the link for inclusion with gptel +queries via OV." + (cl-destructuring-bind + (valid _ path resource-type user-check readablep mime-valid _mime) + link-status + (if valid + (progn + (overlay-put + ov 'before-string + (concat (propertize "SEND" 'face '(:inherit success :height 0.8)) + (if (display-graphic-p) + (propertize " " 'display '(space :width 0.5)) " "))) + (overlay-put ov 'help-echo + (format "Sending %s %s with gptel requests" resource-type path))) + (overlay-put ov 'before-string + (concat (propertize "!" 'face '(:inherit error)) + (propertize " " 'display '(space :width 0.3)))) + (overlay-put + ov 'help-echo + (concat + "Sending only link text with gptel requests, " + "this link will not be followed to its source.\n\nReason: " + (cond + ((not resource-type) "Not a supported link type\ + (Only \"file\" and \"attachment\" are supported)") + ((not user-check) + (concat + "\nNot a standalone link -- separate link from text around it. \n (OR) +Link failed to validate, see `gptel-markdown-validate-link' or `gptel-org-validate-link'.")) + ((not readablep) (format "File %s is not readable" path)) + ((not mime-valid) + (pcase resource-type + ('file (format "%s does not support binary file %s" gptel-model path)) + ('url (format "%s does not support fetching non-image URLs" gptel-model)))))))))) + +(defun gptel--annotate-link-clear (&optional beg end) + "Delete all gptel org link annotations between BEG and END." + (mapc #'delete-overlay + (cl-delete-if-not + (lambda (o) (overlay-get o 'gptel-track-media)) + (overlays-in (or beg (point-min)) (or end (point-max)))))) + +;;;; Response text recognition + +(defun gptel--get-buffer-bounds () + "Return the gptel response boundaries in the buffer as an alist." + (save-excursion + (save-restriction + (widen) + (goto-char (point-max)) + (let ((bounds) (prev-pt (point))) + (while (and (/= prev-pt (point-min)) + (goto-char (previous-single-property-change + (point) 'gptel nil (point-min)))) + (when-let* ((prop (get-char-property (point) 'gptel))) + (let* ((prop-name (if (symbolp prop) prop (car prop))) + (val (when (consp prop) (cdr prop))) + (bound (if val + (list (point) prev-pt val) + (list (point) prev-pt)))) + (push bound (alist-get prop-name bounds)))) + (setq prev-pt (point))) + bounds)))) + +(define-obsolete-function-alias + 'gptel--get-bounds 'gptel--get-response-bounds "0.9.8") + +(defun gptel--get-response-bounds () + "Return the gptel response boundaries around point." + (let (prop) + (save-excursion + (when (text-property-search-forward + 'gptel 'response t) + (when (setq prop (text-property-search-backward + 'gptel 'response t)) + (cons (prop-match-beginning prop) + (prop-match-end prop))))))) + +(defun gptel--in-response-p (&optional pt) + "Check if position PT is inside a gptel response." + (eq (get-char-property (or pt (point)) 'gptel) 'response)) + +(defun gptel--at-response-history-p (&optional pt) + "Check if gptel response at position PT has variants." + (get-char-property (or pt (point)) 'gptel-history)) + + +;;; Saving and restoring state + +(defun gptel--restore-props (bounds-alist) + "Restore text properties from BOUNDS-ALIST. +BOUNDS-ALIST is (PROP . BOUNDS). BOUNDS is a list of BOUND. Each BOUND +is either (BEG END VAL) or (BEG END). + +For (BEG END VAL) forms, even if VAL is nil, the gptel property will be +set to (PROP . VAL). For (BEG END) forms, except when PROP is response, +the gptel property is set to just PROP. + +The legacy structure, a list of (BEG . END) is also supported and will be +applied before being re-persisted in the new structure." + ;; Run silently to avoid `gptel--inherit-stickiness' and other hooks that + ;; might modify the gptel text property. + (with-silent-modifications + (if (symbolp (caar bounds-alist)) + (mapc + (lambda (bounds) + (let* ((prop (pop bounds))) + (mapc + (lambda (bound) + (let ((prop-has-val (> (length bound) 2))) + (add-text-properties + (pop bound) (pop bound) + (if (eq prop 'response) + '(gptel response front-sticky (gptel)) + (list 'gptel + (if prop-has-val + (cons prop (pop bound)) + prop)))))) + bounds))) + bounds-alist) + (mapc (lambda (bound) + (add-text-properties + (car bound) (cdr bound) '(gptel response front-sticky (gptel)))) + bounds-alist)))) + +(defun gptel--restore-state () + "Restore gptel state when turning on `gptel-mode'." + (when (buffer-file-name) + (if (derived-mode-p 'org-mode) + (progn + (require 'gptel-org) + (gptel-org--restore-state)) + (when gptel--bounds + (gptel--restore-props gptel--bounds) + (message "gptel chat restored.")) + (when gptel--preset + (if (gptel-get-preset gptel--preset) + (gptel--apply-preset + gptel--preset (lambda (sym val) (set (make-local-variable sym) val))) + (display-warning + '(gptel presets) + (format "Could not activate gptel preset `%s' in buffer \"%s\"" + gptel--preset (buffer-name))))) + (when gptel--backend-name + (if-let* ((backend (alist-get + gptel--backend-name gptel--known-backends + nil nil #'equal))) + (setq-local gptel-backend backend) + (message + (substitute-command-keys + (concat + "Could not activate gptel backend \"%s\"! " + "Switch backends with \\[universal-argument] \\[gptel-send]" + " before using gptel.")) + gptel--backend-name))) + (when gptel--tool-names + (if-let* ((tools (cl-loop + for tname in gptel--tool-names + for tool = (with-demoted-errors "gptel: %S" + (gptel-get-tool tname)) + if tool collect tool else do + (display-warning + '(gptel org tools) + (format "Tool %s not found, ignoring" tname))))) + (setq-local gptel-tools tools)))))) + +(defun gptel--save-state () + "Write the gptel state to the buffer. + +This saves chat metadata when writing the buffer to disk. To +restore a chat session, turn on `gptel-mode' after opening the +file. + +If a gptel preset has been applied in this buffer, a reference to it is +saved. + +Additional metadata is stored only if no preset was applied or if it +differs from the preset specification. This is limited to the active +gptel model and backend names, the system message, active tools, the +response temperature, max tokens and number of conversation turns to +send in queries. (See `gptel--num-messages-to-send' for the last one.)" + (run-hooks 'gptel-save-state-hook) + (if (derived-mode-p 'org-mode) + (progn + (require 'gptel-org) + (gptel-org--save-state)) + (let ((print-escape-newlines t) + (preset-spec (and gptel--preset + (gptel-get-preset gptel--preset)))) + (save-excursion + (save-restriction + + (if preset-spec + (add-file-local-variable 'gptel--preset gptel--preset) + (delete-file-local-variable 'gptel--preset)) + + ;; Model and backend + (if (gptel--preset-mismatch-value preset-spec :model gptel-model) + (add-file-local-variable 'gptel-model gptel-model)) + (if (gptel--preset-mismatch-value preset-spec :backend gptel-backend) + (add-file-local-variable 'gptel--backend-name + (gptel-backend-name gptel-backend))) + ;; System message + (let ((parsed (car-safe (gptel--parse-directive gptel--system-message)))) + (if (gptel--preset-mismatch-value preset-spec :system parsed) + (add-file-local-variable 'gptel--system-message parsed) + (delete-file-local-variable 'gptel--system-message))) + ;; Tools + (let ((tool-names (mapcar #'gptel-tool-name gptel-tools))) + (if (gptel--preset-mismatch-value preset-spec :tools tool-names) + (add-file-local-variable 'gptel--tool-names tool-names) + (delete-file-local-variable 'gptel--tool-names))) + ;; Temperature, max tokens and cutoff + (if (and (gptel--preset-mismatch-value preset-spec :temperature gptel-temperature) + (not (equal (default-value 'gptel-temperature) gptel-temperature))) + (add-file-local-variable 'gptel-temperature gptel-temperature) + (delete-file-local-variable 'gptel-temperature)) + (if (and (gptel--preset-mismatch-value preset-spec :max-tokens gptel-max-tokens) + gptel-max-tokens) + (add-file-local-variable 'gptel-max-tokens gptel-max-tokens) + (delete-file-local-variable 'gptel-max-tokens)) + (if (and (gptel--preset-mismatch-value + preset-spec :num-messages-to-send gptel--num-messages-to-send) + (natnump gptel--num-messages-to-send)) + (add-file-local-variable 'gptel--num-messages-to-send + gptel--num-messages-to-send) + (delete-file-local-variable 'gptel--num-messages-to-send)) + (add-file-local-variable 'gptel--bounds (gptel--get-buffer-bounds))))))) + + +;;; Minor modes and UI + +;; NOTE: It's not clear that this is the best strategy: +(cl-pushnew '(gptel . t) (default-value 'text-property-default-nonsticky) + :test #'equal) + +(defun gptel--inherit-stickiness (beg end _pre) + "Mark any change to an LLM response region as a response. + +Intended to be added to `after-change-functions' in gptel chat buffers, +which see for BEG, END and PRE." + (and (/= beg end) (< end (point-max)) + (and-let* ((val (get-text-property end 'gptel))) + (add-text-properties + beg end `(gptel ,val front-sticky (gptel)))))) + +(defun gptel-markdown--annotate-links (beg end) + "Annotate Markdown links whose sources will be sent with `gptel-send'. + +Search between BEG and END." + (when gptel-track-media + (save-excursion + (goto-char beg) (forward-line -1) + (let ((link-ovs (cl-loop for o in (overlays-in (point) end) + if (overlay-get o 'gptel-track-media) + collect o into os finally return os))) + (while (re-search-forward gptel-markdown--link-regex end t) + (unless (gptel--in-response-p (1- (point))) + (let* ((link (markdown-link-at-pos (point))) + (from (car link)) (to (cadr link)) + (link-status (gptel-markdown--validate-link link)) + (ov (cl-loop for o in (overlays-in from to) + if (overlay-get o 'gptel-track-media) + return o))) + (if ov ; Ensure overlay over each link + (progn (move-overlay ov from to) + (setq link-ovs (delq ov link-ovs))) + (setq ov (make-overlay from to nil t)) + (overlay-put ov 'gptel-track-media t) + (overlay-put ov 'evaporate t) + (overlay-put ov 'priority -80)) + ;; Check if link will be sent, and annotate accordingly + (gptel--annotate-link ov link-status)))) + (and link-ovs (mapc #'delete-overlay link-ovs)))) + `(jit-lock-bounds ,beg . ,end))) + +(defvar gptel--header-line-info + '(:eval + (let* ((model (gptel--model-name gptel-model)) + (system + (propertize + (buttonize + (format "[Prompt: %s]" + (or (car-safe (rassoc gptel--system-message gptel-directives)) + (gptel--describe-directive gptel--system-message 15))) + (lambda (&rest _) (gptel-system-prompt))) + 'mouse-face 'highlight + 'help-echo "System message for session")) + (context + (and gptel-context + (cl-loop + for entry in gptel-context + if (bufferp (or (car-safe entry) entry)) count it into bufs + else count (stringp (or (car-safe entry) entry)) into files + finally return + (propertize + (buttonize + (concat "[Context: " + (and (> bufs 0) (format "%d buf" bufs)) + (and (> bufs 1) "s") + (and (> bufs 0) (> files 0) ", ") + (and (> files 0) (format "%d file" files)) + (and (> files 1) "s") + "]") + (lambda (&rest _) + (require 'gptel-context) + (gptel-context--buffer-setup))) + 'mouse-face 'highlight + 'help-echo "Active gptel context")))) + (toggle-track-media + (lambda (&rest _) + (setq-local gptel-track-media (not gptel-track-media)) + (if gptel-track-media + (progn + (run-hooks 'gptel-refresh-buffer-hook) + (message "Sending media from included links.")) + (without-restriction (gptel--annotate-link-clear)) + (message "Ignoring links. Only link text will be sent.")) + (run-at-time 0 nil #'force-mode-line-update))) + (track-media + (and (gptel--model-capable-p 'media) + (if gptel-track-media + (propertize + (buttonize "[Sending media]" toggle-track-media) + 'mouse-face 'highlight + 'help-echo + "Sending media from links/urls when supported.\nClick to toggle") + (propertize + (buttonize "[Ignoring media]" toggle-track-media) + 'mouse-face 'highlight + 'help-echo + "Ignoring media from links/urls.\nClick to toggle")))) + (toggle-tools (lambda (&rest _) (interactive) + (run-at-time 0 nil + (lambda () (call-interactively #'gptel-tools))))) + (tools (when (and gptel-use-tools gptel-tools) + (propertize + (buttonize (pcase (length gptel-tools) + (0 "[No tools]") (1 "[1 tool]") + (len (format "[%d tools]" len))) + toggle-tools) + 'mouse-face 'highlight + 'help-echo "Select tools")))) + (let ((rhs (concat + tools (and track-media " ") track-media + (and context " ") context " " system " " + (propertize + (buttonize (concat "[" model "]") + (lambda (&rest _) (gptel-menu))) + 'mouse-face 'highlight + 'help-echo "Model in use")))) + (concat + (propertize + " " 'display + (if (fboundp 'string-pixel-width) + `(space :align-to (- right (,(string-pixel-width rhs)))) + `(space :align-to (- right ,(+ 5 (string-width rhs)))))) + rhs)))) + "Information segment for the header-line in `gptel-mode'.") + +(defun gptel-use-header-line () + "Set up the header-line for a gptel buffer. + +It is composed of three segments: the backend name, the +status (Ready/Waiting etc) and the info segment, showing the current +context, tools, system prompt, model and more." + (setq + header-line-format + (list '(:eval (concat (propertize " " 'display '(space :align-to 0)) + (format "%s" (gptel-backend-name gptel-backend)))) + (propertize " Ready" 'face 'success) + gptel--header-line-info))) + +;;;###autoload +(define-minor-mode gptel-mode + "Minor mode for interacting with LLMs." + :lighter " GPT" + :keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c RET") #'gptel-send) + map) + (if gptel-mode + (progn + (unless (derived-mode-p 'org-mode 'markdown-mode 'text-mode) + (gptel-mode -1) + (user-error (format "`gptel-mode' is not supported in `%s'." major-mode))) + (add-hook 'before-save-hook #'gptel--save-state nil t) + (add-hook 'after-change-functions 'gptel--inherit-stickiness nil t) + (gptel--prettify-preset) + (cond + ((derived-mode-p 'org-mode) + (require 'gptel-org) + (jit-lock-register 'gptel-org--annotate-links) + ;; Work around bug in `org-fontify-extend-region'. + (add-hook 'gptel-post-response-functions #'font-lock-flush nil t)) + ((derived-mode-p 'markdown-mode) + (font-lock-add-keywords ;keymap is a font-lock-managed property in markdown-mode + nil '(("^```[ \t]*\\([[:alpha:]][^\n]*\\)?$" ;match code fences + 0 (list 'face nil 'keymap gptel--markdown-block-map)))) + (jit-lock-register 'gptel-markdown--annotate-links))) + (gptel--restore-state) + (if gptel-use-header-line + (progn (setq gptel--old-header-line header-line-format) + (gptel-use-header-line)) + (gptel--update-status " Ready" 'success))) + (remove-hook 'before-save-hook #'gptel--save-state t) + (remove-hook 'after-change-functions 'gptel--inherit-stickiness t) + (cond + ((derived-mode-p 'org-mode) + (jit-lock-unregister #'gptel-org--annotate-links) + (without-restriction (gptel--annotate-link-clear))) + ((derived-mode-p 'markdown-mode) + (jit-lock-unregister #'gptel-markdown--annotate-links) + (without-restriction (gptel--annotate-link-clear)))) + (gptel--prettify-preset) + (if gptel-use-header-line + (setq header-line-format gptel--old-header-line + gptel--old-header-line nil) + (setq mode-line-process nil)))) + +;; ;TODO(request-lib): Declaration no longer needed +(defvar gptel--fsm-last) ;Defined further below +(defun gptel--update-status (msg &optional face) + "Update status MSG with FACE." + (when gptel-mode + (let* ((inspect (lambda (&rest _) (gptel--inspect-fsm))) + (button (propertize (buttonize msg inspect) + 'mouse-face 'highlight))) + (when face (setq button (propertize button 'face face))) + (if gptel-use-header-line + (and (consp header-line-format) (setf (nth 1 header-line-format) button)) + (if (equal msg " Ready") + (setq mode-line-process + `(:eval (concat " " (buttonize (gptel--model-name gptel-model) + ,inspect)))) + (setq mode-line-process button) + (message msg)))) + (force-mode-line-update))) + + +;;;; gptel-highlight-mode + +(defcustom gptel-highlight-methods '(margin) + "Types of LLM response highlighting used by `gptel-highlight-mode'. + +This must be a list of symbols denoting types of highlighting for LLM responses: +- face: highlight LLM responses using face `gptel-response-highlight'. +- fringe: highlight using a (left) fringe marker. +- margin: highlight in the (left) display margin. + +margin and fringe markings are mutually exclusive, and use the +`gptel-response-fringe-highlight' face." + :type '(set (const :tag "Fringe marker" fringe) + (const :tag "Face highlighting" face) + (const :tag "Margin indicator" margin)) + :group 'gptel) + +(defface gptel-response-highlight + '((((background light) (min-colors 88)) :background "linen" :extend t) + (((background dark) (min-colors 88)) :background "gray14" :extend t) + (t :inherit mode-line)) + "Face used to highlight LLM responses when using `gptel-highlight-mode'. + +To enable this face for responses, `gptel-highlight-methods' must be set." + :group 'gptel) + +(defface gptel-response-fringe-highlight + ;; NOTE: Remove conditional after we drop Emacs 28.1 (#1254) + (if (< emacs-major-version 29) + '((t :inherit outline-1 :height 1.0)) + '((t :inherit outline-1 :height reset))) + "LLM response fringe/margin face when using `gptel-highlight-mode'. + +To enable response highlights in the fringe, `gptel-highlight-methods' +must be set." + :group 'gptel) + +(define-fringe-bitmap 'gptel-highlight-fringe + (make-vector 28 #b01100000) + nil nil 'center) + +;; Common options for margin indicator: +;; BOX DRAWINGS LIGHT VERTICAL 0x002502 +;; LEFT ONE QUARTER BLOCK 0x00258E +;; LEFT THREE EIGHTHS BLOCK 0x00258D +;; BOX DRAWINGS HEAVY VERTICAL 0x002503 +;; VERTICAL ONE EIGHTH BLOCK-2 0x01FB70 + +(defun gptel-highlight--margin-prefix (type) + "Create margin prefix string for TYPE. + +Supported TYPEs are response, ignore and tool calls." + (propertize ">" 'display + `( (margin left-margin) + ,(propertize "▎" 'face + (pcase type + ('response 'gptel-response-fringe-highlight) + ('ignore 'shadow) + (`(tool . ,_) 'shadow)))))) + +(defun gptel-highlight--fringe-prefix (type) + "Create fringe prefix string for TYPE. + +Supported TYPEs are response, ignore and tool calls." + (propertize ">" 'display + `( left-fringe gptel-highlight-fringe + ,(pcase type + ('response 'gptel-response-fringe-highlight) + ('ignore 'shadow) + (`(tool . ,_) 'shadow))))) + +(defun gptel-highlight--decorate (ov &optional val) + "Decorate gptel indicator overlay OV whose type is VAL." + (overlay-put ov 'evaporate t) + (overlay-put ov 'gptel-highlight t) + (when (memq 'face gptel-highlight-methods) + (overlay-put ov 'font-lock-face + (pcase val + ('response 'gptel-response-highlight) + ('ignore 'shadow) + (`(tool . ,_) 'shadow)))) + (when-let* ((prefix + (cond ((memq 'margin gptel-highlight-methods) + (gptel-highlight--margin-prefix (or val 'response))) + ((memq 'fringe gptel-highlight-methods) + (gptel-highlight--fringe-prefix (or val 'response)))))) + (overlay-put ov 'line-prefix prefix) + (overlay-put ov 'wrap-prefix prefix))) + +(defun gptel-highlight--update (beg end) + "JIT-lock function: mark gptel response/reasoning regions. + +BEG and END delimit the region to refresh." + (save-excursion ;Scan across region for the gptel text property + (let ((prev-pt (goto-char end))) + (while (and (goto-char (previous-single-property-change + (point) 'gptel nil beg)) + (/= (point) prev-pt)) + (pcase (get-char-property (point) 'gptel) + ((and (or 'response 'ignore `(tool . ,_)) val) + (if-let* ((ov (or (cdr-safe (get-char-property-and-overlay + (point) 'gptel-highlight)) + (cdr-safe (get-char-property-and-overlay + prev-pt 'gptel-highlight)))) + (from (overlay-start ov)) (to (overlay-end ov))) + (unless (<= from (point) prev-pt to) + (move-overlay ov (min from (point)) (max to prev-pt))) + (gptel-highlight--decorate ;Or make new overlay covering just region + (make-overlay (point) prev-pt nil t) val))) + ('nil ;If there's an overlay, we need to split it. + (when-let* ((ov (cdr-safe (get-char-property-and-overlay + (point) 'gptel-highlight))) + (from (overlay-start ov)) (to (overlay-end ov))) + (move-overlay ov from (point)) ;Move overlay to left side + (gptel-highlight--decorate ;Make a new one on the right + (make-overlay prev-pt to nil t) + (get-char-property prev-pt 'gptel))))) + (setq prev-pt (point))))) + `(jit-lock-bounds ,beg . ,end)) + +(define-minor-mode gptel-highlight-mode + "Visually highlight LLM respones regions. + +Highlighting is via fringe or margin markers, and optionally a response +face. See `gptel-highlight-methods' for highlighting methods, and +`gptel-response-highlight' and `gptel-response-fringe-highlight' for the +faces. + +This minor mode can be used anywhere in Emacs, and not just gptel chat +buffers." + :lighter nil + :global nil + (cond + (gptel-highlight-mode + (when (memq 'margin gptel-highlight-methods) + (setq left-margin-width (1+ left-margin-width)) + (if-let* ((win (get-buffer-window (current-buffer)))) + (set-window-buffer win (current-buffer)))) + (jit-lock-register #'gptel-highlight--update) + (gptel-highlight--update (point-min) (point-max))) + (t (when (memq 'margin gptel-highlight-methods) + (setq left-margin-width (max (1- left-margin-width) 0)) + (if-let* ((win (get-buffer-window (current-buffer)))) + (set-window-buffer win (current-buffer)))) + (jit-lock-unregister #'gptel-highlight--update) + (without-restriction + (remove-overlays nil nil 'gptel-highlight t))))) + + +;;; State machine additions for `gptel-send'. + +(defvar gptel-send--transitions + `((INIT . ((t . WAIT))) + (WAIT . ((t . TYPE))) + (TYPE . ((,#'gptel--error-p . ERRS) + (,#'gptel--tool-use-p . TPRE) + (t . DONE))) + (TPRE . ((,#'gptel--error-p . ERRS) + (t . TOOL))) + (TOOL . ((t . TRET))) + (TRET . ((,#'gptel--error-p . ERRS) + (,#'gptel--tool-result-p . WAIT) + (t . DONE)))) + "Alist specifying state transitions for `gptel-send'. + +See `gptel-request--transitions' for details.") + +(defvar gptel-send--handlers + `((WAIT ,#'gptel--handle-wait ,#'gptel--update-wait) + (TYPE ,#'gptel--handle-pre-insert) + (ERRS ,#'gptel--handle-error ,#'gptel--fsm-last) + (TPRE ,#'gptel--handle-pre-tool ,#'gptel--fsm-transition) + (TOOL ,#'gptel--update-tool-call ,#'gptel--handle-tool-use + ,#'gptel--update-tool-ask) + (TRET ,#'gptel--handle-post-tool ,#'gptel--handle-tool-result) + (DONE ,#'gptel--handle-post-insert ,#'gptel--fsm-last) + (ABRT ,#'gptel--handle-abort)) + "Alist specifying handlers for `gptel-send' state transitions. + +See `gptel-request--handlers' for details.") + +(defvar-local gptel--fsm-last nil + "State machine for latest request in the buffer.") + +(defun gptel--fsm-last (fsm) + "Capture the latest request state FSM for introspection." + (let ((info (gptel-fsm-info fsm))) + (unless gptel-log-level + (let ((data (plist-get info :data))) + (dolist (key '(:messages :contents :query)) + (setf (plist-get data key) nil)))) + (setf (gptel-fsm-info fsm) + (plist-put info :end-time (current-time-string))) + (with-current-buffer (plist-get info :buffer) + (setq gptel--fsm-last fsm)))) + +(defun gptel--inspect-fsm (&optional fsm) + "Inspect gptel request state FSM. + +FSM defaults to the state of the last request in the current +buffer." + (unless fsm + (setq fsm (or gptel--fsm-last + (cadr (cl-find-if + (lambda (proc-list) + (eq (thread-first (cadr proc-list) + (gptel-fsm-info) + (plist-get :buffer)) + (current-buffer))) + gptel--request-alist))))) + (unless (cl-typep fsm 'gptel-fsm) + (user-error "No gptel request log in this buffer yet!")) + (require 'tabulated-list) + (with-current-buffer (get-buffer-create "*gptel-diagnostic*") + (setq tabulated-list-format [("Request attribute" 30 t) ("Value" 30)]) + (let* ((pb (lambda (s) (propertize s 'face 'font-lock-builtin-face))) + (ps (lambda (s) (propertize s 'face 'font-lock-string-face))) + (fmt (lambda (s) (cond ((memq (car-safe s) '(closure lambda)) + (format "#" (sxhash s))) + ((byte-code-function-p s) + (format "#" (sxhash s))) + ((stringp s) (string-replace "\n" "⮐ " s)) + (t (prin1-to-string s))))) + (inhibit-read-only t) + (info (gptel-fsm-info fsm)) + (entries-info + (cl-loop + for idx upfrom 3 + for (key val) on info by #'cddr + unless (memq key '(:data :history :tools + :partial_text :partial_json)) + collect + (list idx `[,(funcall pb (symbol-name key)) + ,(funcall ps (funcall fmt val))]))) + (entries-data + (cl-loop + for idx upfrom 50 + for (key val) on (plist-get info :data) by #'cddr + unless (memq key '(:messages :stream :contents :query)) + collect + (list idx `[,(funcall pb (symbol-name key)) + ,(funcall ps (funcall fmt val))])))) + (setq tabulated-list-entries + (nconc (list `(2 [,(funcall pb ":state") + ,(funcall ps + (mapconcat + fmt (reverse (cons (gptel-fsm-state fsm) + (plist-get info :history))) + " → "))])) + entries-info + entries-data)) + (tabulated-list-print) + (tabulated-list-mode) + (tabulated-list-init-header) + (hl-line-mode 1) + (display-buffer + (current-buffer) + '((display-buffer-in-side-window) + (side . bottom) + (window-height . fit-window-to-buffer) + (slot . 10) + (body-function . select-window)))))) + +;;;; State machine handlers +;; The next few functions are default state handlers for gptel-send, see +;; `gptel-send--handlers'. + +(defun gptel--handle-pre-insert (fsm) + "Tasks before inserting the LLM response for state FSM. + +Handle read-only buffers and run pre-response hooks (but only if +the request succeeded)." + (let* ((info (gptel-fsm-info fsm)) + (start-marker (plist-get info :position))) + (when (memq (plist-get info :callback) + '(gptel--insert-response gptel-curl--stream-insert-response)) + (with-current-buffer (marker-buffer start-marker) + (when (or buffer-read-only (get-char-property start-marker 'read-only)) + (cond + ((derived-mode-p 'vterm-mode) + (require 'gptel-integrations) + (gptel--vterm-pre-insert info)) + (t + (message "Buffer is read only, displaying reply in buffer \"*LLM response*\"") + (display-buffer + (with-current-buffer (get-buffer-create "*LLM response*") + (visual-line-mode 1) + (goto-char (point-max)) + (move-marker start-marker (point) (current-buffer)) + (current-buffer)) + '((display-buffer-reuse-window + display-buffer-pop-up-window) + (reusable-frames . visible)))))))) + (with-current-buffer (marker-buffer start-marker) + (when (plist-get info :stream) + (gptel--update-status " Typing..." 'success)) + (save-excursion + (goto-char start-marker) + (when (and (member (plist-get info :http-status) '("200" "100")) + gptel-pre-response-hook) + (run-hooks 'gptel-pre-response-hook)))))) + +(defun gptel--handle-post-insert (fsm) + "Tasks after successfully inserting the LLM response with state FSM. + +Indicate gptel status, pulse the inserted text and run post-response hooks. + +No state transition here since that's handled by the process sentinels." + (let* ((info (gptel-fsm-info fsm)) + (start-marker (plist-get info :position)) + (tracking-marker (or (plist-get info :tracking-marker) + start-marker)) + ;; start-marker may have been moved if :buffer was read-only + (gptel-buffer (marker-buffer start-marker))) + (with-current-buffer gptel-buffer + (if (not tracking-marker) ;Empty response + (when gptel-mode (gptel--update-status " Empty response" 'success)) + (set-marker-insertion-type tracking-marker nil) ;Lock tracking-marker + (when gptel-mode + (unless (plist-get info :in-place) + (save-excursion (goto-char tracking-marker) + (insert gptel-response-separator + (gptel-prompt-prefix-string)))) + (gptel--update-status " Ready" 'success)))) + ;; Run hook in visible window to set window-point, BUG #269 + (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible))) + (with-selected-window gptel-window + (mapc (lambda (f) (funcall f info)) (plist-get info :post)) + (run-hook-with-args + 'gptel-post-response-functions + (marker-position start-marker) (marker-position tracking-marker))) + (with-current-buffer gptel-buffer + (mapc (lambda (f) (funcall f info)) (plist-get info :post)) + (run-hook-with-args + 'gptel-post-response-functions + (marker-position start-marker) (marker-position tracking-marker)))))) + +(defun gptel--handle-error (fsm) + "Check for errors in request state FSM. + +Perform UI updates and run post-response hooks." + (when-let* ((info (gptel-fsm-info fsm)) + (error-data (plist-get info :error))) + (let* ((status (plist-get info :status)) + (gptel-buffer (plist-get info :buffer)) + (start-marker (plist-get info :position)) + (tracking-marker (or (plist-get info :tracking-marker) + start-marker)) + (backend-name + (gptel-backend-name + (buffer-local-value 'gptel-backend gptel-buffer)))) + (if (stringp error-data) + (message "%s error: (%s) %s" backend-name status (string-trim error-data)) + (when-let* ((error-type (plist-get error-data :type))) + (setq status (concat "(" status ") " + (string-trim (gptel--to-string error-type))))) + (when-let* ((error-msg (plist-get error-data :message))) + (message "%s error: (%s) %s" backend-name status + (string-trim (gptel--to-string error-msg))))) + (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible))) + (with-selected-window gptel-window + (mapc (lambda (f) (funcall f info)) (plist-get info :post)) + (run-hook-with-args + 'gptel-post-response-functions + (marker-position start-marker) (marker-position tracking-marker))) + (with-current-buffer gptel-buffer + (mapc (lambda (f) (funcall f info)) (plist-get info :post)) + (run-hook-with-args + 'gptel-post-response-functions + (marker-position start-marker) (marker-position tracking-marker)))) + (with-current-buffer gptel-buffer + (when gptel-mode + (gptel--update-status + (format " Error: %s" status) 'error)))))) + +(defun gptel--handle-abort (fsm) + "Perform UI update on `gptel-abort' for FSM." + (when-let* ((info (gptel-fsm-info fsm)) + (gptel-buffer (plist-get info :buffer)) + (start-marker (plist-get info :position)) + (tracking-marker (or (plist-get info :tracking-marker) + start-marker))) + (if-let* ((gptel-window (get-buffer-window gptel-buffer 'visible))) + (with-selected-window gptel-window + (mapc (lambda (f) (funcall f info)) (plist-get info :post)) + (run-hook-with-args + 'gptel-post-response-functions + (marker-position start-marker) (marker-position tracking-marker))) + (with-current-buffer gptel-buffer + (mapc (lambda (f) (funcall f info)) (plist-get info :post)) + (run-hook-with-args + 'gptel-post-response-functions + (marker-position start-marker) (marker-position tracking-marker)))) + (with-current-buffer gptel-buffer + (when gptel-mode (gptel--update-status " Abort" 'error))))) + +(defun gptel--handle-pre-tool (fsm) + "Run `gptel-pre-tool-call-functions' for FSM." + (let* ((info (gptel-fsm-info fsm)) + (buffer (plist-get info :buffer))) + (when (buffer-local-value 'gptel-pre-tool-call-functions buffer) + ;; This function might run many times, so only act on the remaining tool calls. + (let ((tool-use (cl-remove-if (lambda (tc) (plist-get tc :result)) + (plist-get info :tool-use))) + (hook-func-args (list :buffer (buffer-name buffer) + :backend (plist-get info :backend) + :model (plist-get info :model)))) + (with-current-buffer buffer + (run-hook-wrapped ; Run pre tool call functions + 'gptel-pre-tool-call-functions + (lambda (hook-func) + (prog1 nil + (dolist (tool-call tool-use) + (let* ((name (plist-get tool-call :name)) + (args (plist-get tool-call :args)) + (hook-func-result + (with-demoted-errors "gptel-pre-tool-call hook error: %S" + (funcall hook-func (nconc (list :name name :args args) + hook-func-args))))) + (if (plist-get hook-func-result :stop) ; Stop the request immediately + (let ((reason (or (plist-get hook-func-result :stop-reason) + (concat "Request stopped by pre-tool-call hook " + (and (symbolp hook-func) + (symbol-name hook-func)) + " (tool \"" name "\")")))) + (plist-put info :stop-reason reason) + (plist-put info :status "Stopped by hook") + (plist-put info :error reason)) + ;; if hook-func returns :confirm, add the check + (when (plist-get hook-func-result :confirm) + (plist-put tool-call :confirm t)) + ;; if hook-func returns :args or :name, replace in the call + (when (or (plist-get hook-func-result :args) + (plist-get hook-func-result :name)) + ;; Merge with args in the messages array sent to the LLM + (gptel--inject-tool-call + (plist-get info :backend) (plist-get info :data) + tool-call hook-func-result) + ;; Merge with the tool-call in tool-use that actually runs + (gptel--merge-plists tool-call hook-func-result)) + ;; TODO(tool-hooks): :block behavior not final! + (let ((blockp (plist-get hook-func-result :block)) + (result (plist-get hook-func-result :result))) + (when blockp + (plist-put tool-call :error t) + (setq result + (concat "\n" + (if (stringp blockp) blockp + (format "Tool %s blocked by user" name)) + "\n"))) + (when result + (gptel--process-tool-call + fsm (cl-find-if (lambda (ts) (equal (gptel-tool-name ts) name)) + (plist-get info :tools)) + tool-call result)))))))))))))) + +(defun gptel--handle-post-tool (fsm) + "Run `gptel-post-tool-call-functions for FSM." + (let* ((info (gptel-fsm-info fsm)) + (buffer (plist-get info :buffer))) + (when (buffer-local-value 'gptel-post-tool-call-functions buffer) + (let ((hook-func-args (list :buffer (buffer-name buffer) + :backend (plist-get info :backend) + :model (plist-get info :model)))) + (with-current-buffer buffer + (run-hook-wrapped ; Run pre tool call functions + 'gptel-post-tool-call-functions + (lambda (hook-func) + (prog1 nil + (dolist (tool-call (plist-get info :tool-use)) + (let* ((name (plist-get tool-call :name)) + (args (plist-get tool-call :args)) + (hook-func-result + (with-demoted-errors "gptel-post-tool-call hook error: %S" + (funcall hook-func + (nconc (list :name name :args args + :result (plist-get tool-call :result)) + hook-func-args))))) + (if (plist-get hook-func-result :stop) + (let ((reason (or (plist-get hook-func-result :stop-reason) + (concat "Request stopped by post-tool-call hook " + (and (symbolp hook-func) + (symbol-name hook-func)) + " (tool \"" name "\")")))) + (plist-put info :stop-reason reason) + (plist-put info :status "Stopped by hook") + (plist-put info :error reason)) + ;; TODO(tool-hooks): :block behavior not final! + (let ((blockp (plist-get hook-func-result :block)) + (result (plist-get hook-func-result :result))) + (when blockp + (plist-put tool-call :error t) + (setq result + (concat "\n" + (if (stringp blockp) blockp + (format "Tool %s blocked by user" name)) + "\n"))) + (when result + (cl-loop ; Update results sent to callback + for call in (plist-get info :tool-result) + for (spec stored-args _) = call + when (and (equal (gptel-tool-name spec) name) + (null (cl-set-difference + stored-args args :test #'equal))) + do (setf (caddr call) result) and return nil + finally + (display-warning + '(gptel tools) + (format "Tool %s: Could not replace tool results" name))) + ;; Update results sent to LLM + (plist-put tool-call :result result)))))))))))))) + +(defun gptel--update-wait (fsm) + "Update gptel's status in FSM after sending a request." + (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer) + (when gptel-mode + (gptel--update-status " Waiting..." 'warning)))) + +(defun gptel--update-tool-call (fsm) + "Update gptel's status in FSM when calling a tool." + (with-current-buffer (plist-get (gptel-fsm-info fsm) :buffer) + (setq gptel--fsm-last fsm) + (when gptel-mode + (if-let* ((info (gptel-fsm-info fsm)) + (names (cl-loop for call in (plist-get info :tool-use) + collect (plist-get call :name)))) + (gptel--update-status + (concat + (propertize + (if (length> names 1) " Calling tools (" " Calling tool (") + 'face 'mode-line-emphasis) + (mapconcat (lambda (name) (propertize name 'face 'font-lock-keyword-face)) + names (propertize ", " 'face 'mode-line-emphasis)) + (propertize ")" 'face 'mode-line-emphasis))) + ;; FIXME: Is this branch reachable? + (gptel--update-status " Calling tool..." 'mode-line-emphasis))))) + +(defun gptel--update-tool-ask (fsm) + "Update gptel's status in FSM when there are pending tool-calls." + (when (plist-get (gptel-fsm-info fsm) :tool-pending) + (plist-put (gptel-fsm-info fsm) :tool-pending nil) + (when gptel-mode + (gptel--update-status " Run tools?" 'mode-line-emphasis)))) + + +;;; Send queries, handle responses +;;;###autoload +(defun gptel-send (&optional arg) + "Submit this prompt to the current LLM backend. + +By default, the contents of the buffer up to the cursor position +are sent. If the region is active, its contents are sent +instead. + +The response from the LLM is inserted below the cursor position +at the time of sending. To change this behavior or model +parameters, use prefix arg ARG activate a transient menu with +more options instead. + +This command is asynchronous, you can continue to use Emacs while +waiting for the response." + (interactive "P") + (if (and arg (require 'gptel-transient nil t)) + (call-interactively #'gptel-menu) + (gptel--sanitize-model) + (let ((fsm (gptel-make-fsm :table gptel-send--transitions + :handlers gptel-send--handlers))) + (gptel-request nil + :stream gptel-stream + :transforms gptel-prompt-transform-functions + :fsm fsm) + (message "Querying %s..." + (thread-first (gptel-fsm-info fsm) + (plist-get :backend) + (or gptel-backend) + (gptel-backend-name)))) + (gptel--update-status " Waiting..." 'warning))) + +(declare-function json-pretty-print-buffer "json") +(defun gptel--inspect-query (&optional request-fsm format) + "Show the full LLM query that will be sent in a buffer. + +This functions as a dry run of `gptel-send'. The request data +may be edited and the query continued from this buffer. + +REQUEST-FSM is the state of the request, as returned by +`gptel-request'. If FORMAT is the symbol json, show the encoded +JSON query instead of the Lisp structure gptel uses." + (unless request-fsm (setq request-fsm gptel--fsm-last)) + (if (bufferp (plist-get (gptel-fsm-info request-fsm) :data)) + (letrec ((dry-run-poll + (run-with-timer + 0 1 (lambda (fsm form) + (unless (bufferp (plist-get (gptel-fsm-info fsm) :data)) + (cancel-timer dry-run-poll) + (gptel--inspect-query fsm form))) + request-fsm format)))) + (with-current-buffer (plist-get (gptel-fsm-info request-fsm) :buffer) + (gptel--update-status " Ready" 'success)) + (with-current-buffer (get-buffer-create "*gptel-query*") + (let* ((standard-output (current-buffer)) + (inhibit-read-only t) + (request-data + (plist-get (gptel-fsm-info request-fsm) :data))) + (buffer-disable-undo) + (erase-buffer) + (if (eq format 'json) + (progn (fundamental-mode) + (insert (gptel--json-encode request-data)) + (json-pretty-print-buffer)) + (lisp-data-mode) + (prin1 request-data) + (pp-buffer)) + (setq-local gptel--fsm-last request-fsm) + (goto-char (point-min)) + (view-mode 1) + (setq buffer-undo-list nil) + (use-local-map + (make-composed-keymap + (define-keymap + "C-c C-c" #'gptel--continue-query + "C-c C-w" (lambda () "Copy Curl command for query." + (interactive) (gptel--continue-query 'copy)) + "C-c C-k" #'quit-window) + (current-local-map))) + (unless header-line-format + (setq header-line-format + (substitute-command-keys + (concat + "Edit request: \\[read-only-mode]," + " Send request: \\[gptel--continue-query]," + (format " Copy Curl: %s" + (propertize "C-c C-w" 'face 'help-key-binding)) + " Quit: \\[quit-window]")))) + (display-buffer (current-buffer) gptel-display-buffer-action))))) + +(defun gptel--continue-query (&optional copy) + "Continue sending the gptel query displayed in this buffer. + +The request is continued with the same parameters as originally +specified. + +With prefix arg COPY, copy the Curl command for the request to the +kill ring instead." + (interactive "P" lisp-data-mode fundamental-mode) + (unless (equal (buffer-name) "*gptel-query*") + (user-error "This command is meant for use in a gptel dry-run buffer")) + (save-excursion + (goto-char (point-min)) + (condition-case-unless-debug nil + (when-let* ((data (if (eq major-mode 'lisp-data-mode) + (read (current-buffer)) + (gptel--json-read)))) + (cl-assert (cl-typep gptel--fsm-last 'gptel-fsm)) + (plist-put (gptel-fsm-info gptel--fsm-last) :data data) + (if copy ;Copy Curl command instead of sending request + (let ((args (gptel-curl--get-args (gptel-fsm-info gptel--fsm-last) + (md5 (format "%s" (random))) t))) + (kill-new + (mapconcat #'shell-quote-argument + (cons (gptel--curl-path) args) " \\\n")) + (message "Curl command for request copied to kill-ring")) + (gptel--fsm-transition gptel--fsm-last) ;INIT -> WAIT + (quit-window))) + (error + (user-error "Can not resume request: could not read data from buffer!"))))) + +(defun gptel--insert-response (response info &optional raw) + "Insert the LLM RESPONSE into the gptel buffer. + +INFO is a plist containing information relevant to this buffer. +See `gptel--url-get-response' for details. + +Optional RAW disables text properties and transformation." + (let* ((gptel-buffer (plist-get info :buffer)) + (start-marker (plist-get info :position)) + (tracking-marker (plist-get info :tracking-marker))) + (pcase response + ((pred stringp) ;Response text + (with-current-buffer gptel-buffer + (when tracking-marker ;separate from previous response + (setq response (concat gptel-response-separator response))) + (save-excursion + (with-current-buffer (marker-buffer start-marker) + (goto-char (or tracking-marker start-marker)) + ;; (run-hooks 'gptel-pre-response-hook) + (unless (or (bobp) (plist-get info :in-place) + tracking-marker) + (insert gptel-response-separator) + (when gptel-mode + (insert (gptel-response-prefix-string))) + (move-marker start-marker (point))) + (unless raw + (when-let* ((transformer (plist-get info :transformer))) + (setq response (funcall transformer response))) + (add-text-properties + 0 (length response) '(gptel response front-sticky (gptel)) response)) + (insert response) + (plist-put info :tracking-marker (setq tracking-marker (point-marker))) + ;; for uniformity with streaming responses + (set-marker-insertion-type tracking-marker t))))) + (`(reasoning . ,text) + (when-let* ((include (plist-get info :include-reasoning))) + (if (stringp include) + (with-current-buffer (get-buffer-create + (plist-get info :include-reasoning)) + (save-excursion (goto-char (point-max)) (insert text))) + (with-current-buffer (marker-buffer start-marker) + (let ((separator ;Separate from response prefix if required + (and (not tracking-marker) gptel-mode + (not (string-suffix-p "\n" (gptel-response-prefix-string))) + "\n")) + (blocks (if (derived-mode-p 'org-mode) + `("#+begin_reasoning\n" . ,(concat "\n#+end_reasoning" + gptel-response-separator)) + ;; TODO(reasoning) remove properties and strip instead + (cons (propertize "``` reasoning\n" 'gptel 'ignore + 'keymap gptel--markdown-block-map) + (concat (propertize "\n```" 'gptel 'ignore + 'keymap gptel--markdown-block-map) + gptel-response-separator))))) + (if (eq include 'ignore) + (progn + (add-text-properties + 0 (length text) '(gptel ignore front-sticky (gptel)) text) + (gptel--insert-response + (concat (car blocks) text (cdr blocks)) info t)) + (gptel--insert-response (concat separator (car blocks)) info t) + (gptel--insert-response text info) + (gptel--insert-response (cdr blocks) info t)) + (save-excursion + (goto-char (plist-get info :tracking-marker)) + (if (derived-mode-p 'org-mode) ;fold block + (progn (search-backward "#+end_reasoning" start-marker t) + (when (looking-at "^#\\+end_reasoning") + (org-cycle))) + (when (re-search-backward "^```" start-marker t) + (gptel-markdown-cycle-block))))))))) + (`(tool-call . ,tool-calls) + (gptel--display-tool-calls tool-calls info)) + (`(tool-result . ,tool-results) + (gptel--display-tool-results tool-results info))))) + +(defun gptel-curl--stream-insert-response (response info &optional raw) + "Insert streaming RESPONSE from an LLM into the gptel buffer. + +INFO is a mutable plist containing information relevant to this buffer. +See `gptel--url-get-response' for details. + +Optional RAW disables text properties and transformation." + (pcase response + ((pred stringp) + (let ((start-marker (plist-get info :position)) + (tracking-marker (plist-get info :tracking-marker)) + (transformer (plist-get info :transformer))) + (with-current-buffer (marker-buffer start-marker) + (save-excursion + (unless tracking-marker + (goto-char start-marker) + (unless (or (bobp) (plist-get info :in-place)) + (insert gptel-response-separator) + (when gptel-mode + ;; Put prefix before AI response. + (insert (gptel-response-prefix-string))) + (move-marker start-marker (point))) + (setq tracking-marker (set-marker (make-marker) (point))) + (set-marker-insertion-type tracking-marker t) + (plist-put info :tracking-marker tracking-marker)) + (goto-char tracking-marker) + (unless raw + (when transformer + (setq response (funcall transformer response))) + (add-text-properties + 0 (length response) '(gptel response front-sticky (gptel)) + response)) + ;; (run-hooks 'gptel-pre-stream-hook) + (insert response) + (run-hooks 'gptel-post-stream-hook))))) + (`(reasoning . ,text) + (gptel--display-reasoning-stream text info)) + (`(tool-call . ,tool-calls) + (gptel--display-tool-calls tool-calls info)) + (`(tool-result . ,tool-results) + (gptel--display-tool-results tool-results info) + ;; Adjust for tool calls inside reasoning blocks + (when (eq (plist-get info :reasoning-block) 'in) + (when-let* ((rm (plist-get info :reasoning-marker)) + (tm (plist-get info :tracking-marker))) + (move-marker rm tm (marker-buffer tm))))))) + +;;;###autoload +(defun gptel (name &optional _ initial interactivep) + "Switch to or start a chat session with NAME. + +Ask for API-KEY if `gptel-api-key' is unset. + +If region is active, use it as the INITIAL prompt. Returns the +buffer created or switched to. + +INTERACTIVEP is t when gptel is called interactively." + (interactive + (progn + (gptel--sanitize-model :backend (default-value 'gptel-backend) + :shoosh t) + (let* ((backend (default-value 'gptel-backend)) + (backend-name + (format "*%s*" (gptel-backend-name backend)))) + (list (read-buffer + "Create or choose gptel buffer: " + backend-name nil ; DEFAULT and REQUIRE-MATCH + (lambda (b) ; PREDICATE + ;; NOTE: buffer check is required (#450) + (and-let* ((buf (get-buffer (or (car-safe b) b)))) + (buffer-local-value 'gptel-mode buf)))) + (condition-case nil + (gptel--get-api-key + (gptel-backend-key backend)) + ((error user-error) + (setq gptel-api-key + (read-passwd + (format "%s API key: " backend-name))))) + (and (use-region-p) + (buffer-substring (region-beginning) + (region-end))) + t)))) + (with-current-buffer (get-buffer-create name) + (cond ;Set major mode + ((eq major-mode gptel-default-mode)) + ((eq gptel-default-mode 'text-mode) + (text-mode) + (visual-line-mode 1)) + (t (funcall gptel-default-mode))) + (gptel--sanitize-model :backend (default-value 'gptel-backend) + :model (default-value 'gptel-model) + :shoosh nil) + (unless gptel-mode (gptel-mode 1)) + (goto-char (point-max)) + (skip-chars-backward "\t\r\n") + (if (bobp) (insert (or initial (gptel-prompt-prefix-string)))) + (when interactivep + (display-buffer (current-buffer) gptel-display-buffer-action) + (message "Send your query with %s!" + (substitute-command-keys "\\[gptel-send]"))) + (current-buffer))) + + +;;; Reasoning content UI +(defun gptel--display-reasoning-stream (text info) + "Show reasoning TEXT in an appropriate location. + +INFO is the request INFO, see `gptel--url-get-response'. This is +for streaming responses only." + (when-let* ((include (plist-get info :include-reasoning))) + (if (stringp include) + (unless (eq text t) + (with-current-buffer (get-buffer-create include) + (save-excursion (goto-char (point-max)) + (insert text)))) + (let* ((reasoning-marker (plist-get info :reasoning-marker)) + (tracking-marker (plist-get info :tracking-marker)) + (start-marker (plist-get info :position))) + (with-current-buffer (marker-buffer start-marker) + (if (eq text t) ;end of stream + (progn + (gptel-curl--stream-insert-response + (concat (if (derived-mode-p 'org-mode) + "\n#+end_reasoning" + ;; TODO(reasoning) remove properties and strip instead + (propertize "\n```" 'gptel 'ignore + 'keymap gptel--markdown-block-map)) + gptel-response-separator) + info t) + (ignore-errors ;fold block + (save-excursion + (goto-char tracking-marker) + (if (derived-mode-p 'org-mode) + (progn (search-backward "#+end_reasoning" start-marker t) + (when (looking-at "^#\\+end_reasoning") + (org-cycle))) + (when (re-search-backward "^```" start-marker t) + (gptel-markdown-cycle-block)))))) + (unless (and reasoning-marker tracking-marker + (= reasoning-marker tracking-marker)) + (let ((separator ;Separate from response prefix if required + (and (not tracking-marker) gptel-mode + (not (string-suffix-p + "\n" (gptel-response-prefix-string))) + "\n"))) + (gptel-curl--stream-insert-response + (concat separator + (if (derived-mode-p 'org-mode) + "#+begin_reasoning\n" + ;; TODO(reasoning) remove properties and strip instead + (propertize "``` reasoning\n" 'gptel 'ignore + 'keymap gptel--markdown-block-map))) + info t))) + (if (eq include 'ignore) + (progn + (add-text-properties + 0 (length text) '(gptel ignore front-sticky (gptel)) text) + (gptel-curl--stream-insert-response text info t)) + (gptel-curl--stream-insert-response text info))) + (setq tracking-marker (plist-get info :tracking-marker)) + (if reasoning-marker + (move-marker reasoning-marker tracking-marker) + (plist-put info :reasoning-marker + (copy-marker tracking-marker nil)))))))) + +(defvar gptel--tool-preview-alist nil + "Alist mapping tool names to preview functions for tools. + +Each key is a tool name (string) and value is a list of one or two +functions, for preview-setup and (optional) preview-teardown. + +The preview-setup function is called with two arguments: a plist of the +corresponding tool call arguments and the request INFO plist. It must +set up the preview for the tool call and return a handle to the preview, +which can be any object, but typically an overlay or a buffer. + +The preview-setup can integrate with gptel's default previewer by +inserting at point (and moving point), or use a different preview method +entirely. + +The preview-teardown function, if provided, is called with this handle +when the tool call is accepted or rejected, and it must clear the +preview. + +Note: This tool call preview API is currently experimental.") + + +;;; Tool use UI +(defvar-keymap gptel-tool-call-actions-map + :doc "Keymap for actions on tool calls." + "" #'gptel--dispatch-tool-calls + "C-c C-c" #'gptel--accept-tool-calls + "C-c C-k" #'gptel--reject-tool-calls + "C-c C-i" #'gptel--inspect-tool-calls) + +(defun gptel--display-tool-calls (tool-calls info &optional use-minibuffer) + "Handle tool call confirmation. + +TOOL-CALLS should be a list of tool call specifications or results, +structured as: + + ((tool args callback) ...) + +for tool call specifications to be confirmed. INFO contains the +state of the request. To prompt for tool call confirmation, use +either an overlay in the request buffer or the minibuffer (if +USE-MINIBUFFER is non-nil)." + (let* ((start-marker (plist-get info :position)) + (tracking-marker (plist-get info :tracking-marker))) + ;; pending tool calls look like ((tool callback args) ...) + (with-current-buffer (marker-buffer start-marker) + (if (or use-minibuffer ;prompt for confirmation from the minibuffer + buffer-read-only ;TEMP(tool-preview) Handle read-only buffers better + (get-char-property + (max (point-min) (1- (or tracking-marker start-marker))) + 'read-only)) + (let* ((minibuffer-allow-text-properties t) + (backend-name (gptel-backend-name (plist-get info :backend))) + (tool-call-names + (mapconcat (lambda (c) (propertize (gptel-tool-name (car c)) + 'face 'font-lock-keyword-face)) + tool-calls ", ")) + (len (length tool-calls)) + (prompt (format "%s wants to run %s tool %s (%s). " + backend-name len (if (> len 1) "calls" "call") + tool-call-names)) + (choices '((?y "Run tools") (?n "Cancel (resumable)") + (?i "Inspect or edit"))) + (choice (read-multiple-choice prompt choices))) + (pcase (car choice) + (?y (gptel--accept-tool-calls tool-calls)) + (?n (gptel--reject-tool-calls)) + (?i (gptel--inspect-tool-calls + ;; TODO Verify that the query buffer is the correct source to send + tool-calls (plist-get info :buffer))))) + ;; Prompt for confirmation from the response buffer + (let* ((backend-name (gptel-backend-name (plist-get info :backend))) + (actions-string + (concat (propertize "Run tools: " 'face 'font-lock-string-face) + (propertize "C-c C-c" 'face 'help-key-binding) + (propertize ", Cancel request: " 'face 'font-lock-string-face) + (propertize "C-c C-k" 'face 'help-key-binding) + (propertize ", Inspect or Edit: " 'face 'font-lock-string-face) + (propertize "C-c C-i" 'face 'help-key-binding))) + (confirm-strings) + ;; FIXME(tool) use a wrapper instead of a manual text-property search, + ;; this is fragile + (ov-start (save-excursion + (goto-char start-marker) + (text-property-search-backward 'gptel 'response) + (point))) + (preview-handlers) + (ov (or (cdr-safe (get-char-property-and-overlay + start-marker 'gptel-tool)) + (make-overlay ov-start (or tracking-marker start-marker) + nil nil nil))) + (arg-values) + (prompt-ov)) + ;; If the cursor is at the overlay-end, it ends up outside, so move it back + (unless tracking-marker + (when (= (point) start-marker) (ignore-errors (backward-char)))) + (save-excursion + (goto-char (overlay-end ov)) + (pcase-dolist (`(,tool-spec ,arg-plist _) tool-calls) + ;; Call tool-specific confirmation prompt + (setq arg-values (gptel--map-tool-args tool-spec arg-plist)) + (if-let* ((funcs (cdr (assoc (gptel-tool-name tool-spec) + gptel--tool-preview-alist))) + ((functionp (car-safe funcs)))) + ;;preview-teardown func preview-handle overlay/buffer + (push (list (cadr funcs) (funcall (car funcs) arg-values info)) + preview-handlers) + (push (gptel--format-tool-call (gptel-tool-name tool-spec) arg-values) + confirm-strings))) + (and confirm-strings (apply #'insert (nreverse confirm-strings))) + (add-text-properties (overlay-end ov) (1- (point)) + '(read-only t font-lock-fontified t)) + (setq prompt-ov (make-overlay (overlay-end ov) (point) nil t)) + (overlay-put + prompt-ov 'before-string + (concat + "\n" + (propertize " " 'display `(space :align-to (- right ,(length actions-string) 2)) + 'face '(:inherit font-lock-string-face :underline t :extend t)) + actions-string + (format (propertize "\n%s wants to run:\n\n" + 'face 'font-lock-string-face) + backend-name))) + (overlay-put + prompt-ov 'after-string + (concat (propertize "\n" 'face + '(:inherit font-lock-string-face :underline t :extend t)))) + (overlay-put prompt-ov 'evaporate t) + (overlay-put ov 'prompt (cons prompt-ov (overlay-get ov 'prompt))) + (move-overlay ov ov-start (point))) + ;; Add confirmation prompt to the overlay + (when preview-handlers + (overlay-put ov 'previews + (nconc (overlay-get ov 'previews) preview-handlers))) + (overlay-put ov 'mouse-face 'highlight) + (overlay-put ov 'gptel-tool + (nconc (overlay-get ov 'gptel-tool) tool-calls)) + (overlay-put ov 'help-echo + (concat "Tool call(s) requested: " actions-string)) + (overlay-put ov 'keymap gptel-tool-call-actions-map) + prompt-ov))))) + +(defun gptel--display-tool-results (tool-results info) + "Insert TOOL-RESULTS into buffer. + +TOOL-RESULTS is + + ((tool args result) ...) + +for tool call results. INFO contains the state of the request." + (let* ((start-marker (plist-get info :position)) + (tool-marker (plist-get info :tool-marker)) + (tracking-marker (plist-get info :tracking-marker))) + ;; Insert tool results + (with-current-buffer (marker-buffer start-marker) + (when gptel-include-tool-results + (cl-loop + for (tool args result) in tool-results + with include-names = + (mapcar #'gptel-tool-name + (cl-remove-if-not #'gptel-tool-include (plist-get info :tools))) + if (or (eq gptel-include-tool-results t) + (member (gptel-tool-name tool) include-names)) + do (funcall + (plist-get info :callback) + (let* ((name (gptel-tool-name tool)) + (separator ;Separate from response prefix if required + (cond ((not tracking-marker) + (and gptel-mode + (not (string-suffix-p + "\n" (gptel-response-prefix-string))) + "\n")) ;start of response + ((not tool-marker) gptel-response-separator) + ((and (not (= tracking-marker tool-marker)) + (not (eq (char-before tracking-marker) ?\n))) + gptel-response-separator))) + (tool-use + ;; TODO(tool) also check args since there may be more than + ;; one call/result for the same tool + (cl-find-if + (lambda (tu) (equal (plist-get tu :name) name)) + (plist-get info :tool-use))) + (id (plist-get tool-use :id)) + (display-call (format "(%s %s)" name + (string-trim (prin1-to-string args) "(" ")"))) + (call (prin1-to-string `(:name ,name :args ,args))) + (truncated-call + (string-replace "\n" " " + (truncate-string-to-width + display-call + (floor (* (window-width) 0.6)) 0 nil " ...)")))) + (if (derived-mode-p 'org-mode) + (concat + separator + "#+begin_tool " + truncated-call + (propertize + (org-escape-code-in-string (concat "\n" call "\n\n" result)) + 'gptel `(tool . ,id)) + "\n#+end_tool\n") + ;; TODO(tool) else branch is handling all front-ends as markdown. + ;; At least escape markdown. + (concat + separator + ;; TODO(tool) remove properties and strip instead of ignoring + (propertize (format "``` tool %s" truncated-call) + 'gptel 'ignore 'keymap gptel--markdown-block-map) + (propertize + ;; TODO(tool) escape markdown in result + (concat "\n" call "\n\n" result) + 'gptel `(tool . ,id)) + ;; TODO(tool) remove properties and strip instead of ignoring + (propertize "\n```\n" 'gptel 'ignore + 'keymap gptel--markdown-block-map)))) + info + 'raw) + ;; tool-result insertion has updated the tracking marker + (unless tracking-marker + (setq tracking-marker (plist-get info :tracking-marker))) + (if tool-marker + (move-marker tool-marker tracking-marker) + (setq tool-marker (copy-marker tracking-marker nil)) + (plist-put info :tool-marker tool-marker)) + (ignore-errors ;fold drawer + (save-excursion + (goto-char tracking-marker) + (forward-line -1) + (if (derived-mode-p 'org-mode) + (when (looking-at-p "^#\\+end_tool") (org-cycle)) + (when (looking-at-p "^```") (gptel-markdown-cycle-block)))))))))) + +(defun gptel--format-tool-call (name arg-values) + "Format a tool call for display in the buffer. + +NAME and ARG-VALUES are the name and arguments for the call." + (format "(%s %s)\n" + (propertize name 'font-lock-face 'font-lock-keyword-face) + (propertize + (mapconcat (lambda (arg) + (cond ((stringp arg) + (prin1-to-string + (replace-regexp-in-string + "\n" "⮐" (truncate-string-to-width + arg (floor (window-width) 2) + nil nil t)))) + (t (prin1-to-string arg)))) + arg-values " ") + 'font-lock-face 'font-lock-constant-face))) + +(defun gptel--accept-tool-calls (&optional tool-calls ov) + "Run pending tool-calls. + +TOOL-CALLS is the edited tool call list, OV is the tool call dispatch +overlay in the query buffer." + (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay + (point) 'gptel-tool))) + (list resp o))) + (when (overlayp ov) ;Update UI indicator + (with-current-buffer (overlay-buffer ov) + (when gptel-mode + (let ((names (cl-loop for call in tool-calls + collect (gptel-tool-name (car call))))) + (gptel--update-status + (concat + (propertize + (if (length> names 1) " Calling tools (" " Calling tool (") + 'face 'mode-line-emphasis) + (mapconcat (lambda (name) (propertize name 'face 'font-lock-keyword-face)) + names (propertize ", " 'face 'mode-line-emphasis)) + (propertize ")" 'face 'mode-line-emphasis))))))) + ;; Clear the overlays first, because we need the buffer to be cleaned up + ;; before inserting synchronous tool results. + (when (and (overlayp ov) (overlay-buffer ov)) + (with-current-buffer (overlay-buffer ov) + (when-let* ((preview-handles (overlay-get ov 'previews))) + (dolist (func-to-handle preview-handles) + (when (car func-to-handle) (apply func-to-handle)))) + (dolist (prompt-ov (overlay-get ov 'prompt)) + (when-let* (((overlay-buffer prompt-ov)) + (inhibit-read-only t)) + (delete-region (overlay-start prompt-ov) + (overlay-end prompt-ov))))) + (delete-overlay ov)) + (message "Continuing query...") + (cl-loop for (tool-spec arg-plist process-tool-result) in tool-calls + for arg-values = (gptel--map-tool-args tool-spec arg-plist) + do + (if (gptel-tool-async tool-spec) + (apply (gptel-tool-function tool-spec) + process-tool-result arg-values) + (let ((result + (condition-case errdata + (apply (gptel-tool-function tool-spec) arg-values) + (error (mapconcat #'gptel--to-string errdata " "))))) + (funcall process-tool-result result))))) + +(defun gptel--reject-tool-calls (&optional _tool-calls ov) + "Cancel pending tool-calls. + +OV is the tool call dispatch overlay." + (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay + (point) 'gptel-tool))) + (list resp o))) + (gptel--update-status " Tools cancelled" 'error) + (message (substitute-command-keys + "Tool calls canceled. \\[gptel-menu] to continue them!")) + (when (and (overlayp ov) (overlay-buffer ov)) + (with-current-buffer (overlay-buffer ov) + (when-let* ((preview-handles (overlay-get ov 'previews))) + (dolist (func-to-handle preview-handles) + (when (car func-to-handle) (apply func-to-handle)))) + (dolist (prompt-ov (overlay-get ov 'prompt)) + (when-let* (((overlay-buffer prompt-ov)) + (inhibit-read-only t)) + (delete-region (overlay-start prompt-ov) + (overlay-end prompt-ov))))) + (delete-overlay ov))) + +(defun gptel--dispatch-tool-calls (choice) + "Dispatch on tool-calls with CHOICE." + (interactive + (list + (let ((choices '((?y "yes") (?n "do nothing") + (?k "cancel request") (?i "inspect call(s)")))) + (read-multiple-choice "Run tool calls? " choices)))) + (pcase (car choice) + (?y (call-interactively #'gptel--accept-tool-calls)) + (?k (call-interactively #'gptel--reject-tool-calls)) + (?i (call-interactively #'gptel--inspect-tool-calls)))) + +;;;; Tool call inspection UI +(defvar-keymap gptel-tool-call-inspection-map + :doc "Actions in the gptel tool inspection buffer." + "C-c C-c" #'gptel--inspect-accept-tool-calls + "C-c C-k" #'gptel--inspect-reject-tool-calls + "C-c C-i" #'gptel--inspect-quit-tool-calls) + +(defun gptel--inspect-accept-tool-calls (&optional _) + "Run possibly edited tool-calls read from the tool call inspection buffer." + (interactive) + (let ((call) (index) + (read-error + (lambda () (user-error + "Cannot read modified arguments, please check modifications"))) + (apply-error + (lambda () (message "Cannot apply argument modifications. \ +This is a bug, please report it!")))) + (unless (gptel-fsm-p gptel--fsm-last) (funcall apply-error)) + (cond + ((buffer-modified-p) + (let* ((info (gptel-fsm-info gptel--fsm-last)) + (backend (plist-get info :backend)) + (tool-use (plist-get info :tool-use)) + (tool-spec-args-cb) (name) + (tool-calls)) + (dolist (o (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-overlay)) + (overlays-in (point-min) (point-max)))) + (goto-char (overlay-start o)) + (condition-case nil + (save-restriction + (narrow-to-region (point) (overlay-end o)) + (skip-chars-forward "\n\r\ ") + (unless (eobp) + (setq call (read (current-buffer)) + name (plist-get call :name)))) + (error (funcall read-error))) + (unless (integerp (setq index (overlay-get o 'gptel-overlay))) + (funcall read-error)) + ;; Merge with or remove from messages array... + (gptel--inject-tool-call + backend (plist-get info :data) (nth index tool-use) call) + (if (not call) + ;; Remove from tool-use + (plist-put info :tool-use + (append (cl-subseq tool-use 0 index) + (cl-subseq tool-use (1+ index)))) + ;; ...before modifying the tool use block + (gptel--merge-plists (nth index tool-use) call) + (setq tool-spec-args-cb (overlay-get o 'gptel-tool)) + ;; and modifying the arguments sent to the callback + (setf (nth 0 tool-spec-args-cb) + (or (cl-find name (plist-get info :tools) + :key #'gptel-tool-name :test #'string=) + (gptel-get-tool name))) + (setf (nth 1 tool-spec-args-cb) (plist-get call :args)) + (push tool-spec-args-cb tool-calls))) + (gptel--accept-tool-calls ;include overlay to clean up if there is one + tool-calls (cadr (plist-get info :tool-display))))) + (t (let* ((tool-display (plist-get (gptel-fsm-info gptel--fsm-last) + :tool-display))) + (apply #'gptel--accept-tool-calls tool-display))))) + (quit-window t)) + +(defun gptel--inspect-reject-tool-calls (&optional _) + "Cancel tool-calls and return to query buffer." + (interactive) + (quit-window t) + (apply #'gptel--reject-tool-calls + (thread-first (gptel-fsm-info gptel--fsm-last) + (plist-get :tool-display)))) + +(defun gptel--inspect-quit-tool-calls (&optional _) + "Quit inspection window and return to query buffer." + (interactive) + (quit-window t)) + +(defalias 'gptel--inspect-tool-post-command + (let ((highlight-ov)) + (lambda () + (unless (memq highlight-ov (overlays-at (point))) + (let ((context-ov + (cl-loop for ov in (overlays-at (point)) + thereis (and (overlay-get ov 'gptel-overlay) ov))) + (line (propertize "\n" 'font-lock-face + '(:inherit separator-line :extend t)))) + (when highlight-ov + (overlay-put highlight-ov 'face nil) + (overlay-put highlight-ov 'before-string nil) + (overlay-put highlight-ov 'after-string nil)) + (when context-ov + (overlay-put context-ov 'face 'gptel-response-highlight) + (overlay-put context-ov 'before-string line) + (overlay-put context-ov 'after-string (concat "\n" line))) + (setq highlight-ov context-ov))))) + "Highlight tool call under cursor in gptel tool call inspection buffers.") + +(defun gptel--inspect-tool-calls (&optional tool-calls loc) + "Set up and switch to a buffer to inspect pending tool-calls. + +TOOL-CALLS is the alist of tool calls. LOC is the source of the query; +either the query buffer or the tool call dispatch overlay in the query +buffer. If it is an overlay, it will be cleaned up when dispatching on +TOOL-CALLS." + (interactive (pcase-let ((`(,resp . ,o) (get-char-property-and-overlay + (point) 'gptel-tool))) + (list resp o))) + (with-current-buffer (get-buffer-create "*gptel-tool-calls*") + (let ((inhibit-read-only t) tool-use + (tool-overlay (and (overlayp loc) loc))) + (remove-overlays) + (erase-buffer) + (unless (derived-mode-p 'lisp-data-mode) + (lisp-data-mode) + (add-hook 'post-command-hook #'gptel--inspect-tool-post-command nil t)) + ;; NOTE: This needs to be called after setting the major mode, as + ;; buffer-local variables are wiped out. + (setq gptel--fsm-last + (buffer-local-value 'gptel--fsm-last + (if tool-overlay (overlay-buffer loc) loc)) + tool-use (plist-get (gptel-fsm-info gptel--fsm-last) :tool-use)) + ;; For access from the dispatch functions, add tool-calls and the location + ;; (if it's an overlay) to INFO. Overlays will be cleaned up. + (plist-put (gptel-fsm-info gptel--fsm-last) + :tool-display (list tool-calls tool-overlay)) + (insert ";; Inspect or edit tool calls. +;; Adding or deleting tool calls is not supported.\n\n") + (cl-loop for tool-spec-args-cb in tool-calls + for (tool-spec arg-plist _process-tool-result) = tool-spec-args-cb + with o + for name = (gptel-tool-name tool-spec) + for pt = (point) + for index = + (cl-position-if + (lambda (call) (and (not (plist-get call :result)) + (string= (plist-get call :name) name) + (null (cl-set-difference + (plist-get call :args) arg-plist + :test #'equal)))) + tool-use) + do (prin1 (list :name name :args arg-plist) + (current-buffer) '((length . nil) (level . nil))) + (insert "\n\n") ;Avoid extending the overlay + (setq o (make-overlay pt (- (point) 2) nil nil t)) + (overlay-put o 'gptel-tool tool-spec-args-cb) + (overlay-put o 'gptel-overlay index)) + (goto-char (point-min)) (forward-line 3)) + (use-local-map + (make-composed-keymap + gptel-tool-call-inspection-map (current-local-map))) + (unless header-line-format + (setq header-line-format + (substitute-command-keys + (concat + (propertize "Tool calls" 'face 'font-lock-string-face) ": " + (buttonize "Confirm" #'gptel--inspect-accept-tool-calls) + " \\[gptel--inspect-accept-tool-calls], " + (buttonize "Cancel" #'gptel--inspect-reject-tool-calls) + " \\[gptel--inspect-reject-tool-calls], " + (buttonize "Return" #'gptel--inspect-quit-tool-calls) + " \\[gptel--inspect-quit-tool-calls], " + (buttonize "Edit" (lambda (_) (read-only-mode 'toggle))) + " \\[read-only-mode]")))) + (set-buffer-modified-p nil) + (read-only-mode) + (gptel--inspect-tool-post-command) + (display-buffer (current-buffer) gptel-display-buffer-action))) + + +;;; Presets +;;;; Presets implementation +(defvar gptel--known-presets + '((gptel-default + :description "Use gptel's default configuration." + :context nil :use-context system + :tools nil :use-tools t + :temperature nil :max-tokens nil + :num-messages-to-send nil + :request-params nil + :org-convert-response t + :track-media nil + :track-response t + :system nil + :stream t + :cache nil)) + "Alist of presets for gptel. + +Each entry maps a preset name (a symbol) to a plist of +specifications (see `gptel-make-preset').") + +(defun gptel-make-preset (name &rest keys) + "Define a gptel preset with NAME. + +A preset is a combination of gptel options intended to be applied and +used together. Presets can make it less tedious to change gptel +settings on the fly. + +Typically this will include a model, backend, system message and perhaps +some tools, but any set of gptel options can be set this way. + +NAME must be a symbol. KEYS is a plist corresponding to the options +being set. All KEYS are optional. + +Recognized keys: + +DESCRIPTION is a description of the preset, used when selecting a +preset. + +PARENTS is a preset name (or list of preset names) to apply before this +one. + +PRE and POST are functions to run before and after the preset is +applied. They take no arguments. + +BACKEND is the `gptel-backend' to set, or its name (like \"ChatGPT\"). + +MODEL is the `gptel-model', a symbol. + +SYSTEM is the directive. It can be +- the system message (a string), +- a list of strings (a conversation template) +- or a function (dynamic system message). +- It can also be a symbol naming a directive in `gptel-directives'. + +TOOLS is a list of gptel tools or tool names, like +\\='(\"read_url\" \"read_buffer\" ...) + +Recognized keys are not limited to the above. Any other key (like +`:foo') corresponds to the value of either `gptel-foo' (preferred) or +`gptel--foo'. +- So TOOLS corresponds to option `gptel-tools', +- CONFIRM-TOOL-CALLS to `gptel-confirm-tool-calls', +- TEMPERATURE to `gptel-temperature' and so on. +See gptel's customization options for all available settings. + +Specifying the value of a key will set the corresponding gptel option to +it. For example, + + (gptel-make-preset \\='websearch + :tools \\='(\"search_web\" \"read_url\") + :system \"Use the provided tools to search the web + for up-to-date information\") + +will replace the currently active option `gptel-tools' and the system +message. + +Alternatively, + +- You can require that the value be appended or prepended to the + existing value instead of replacing it. This can be done by + specifying the value as a plist instead with the keys `:prepend' or + `:append'. + + (gptel-make-preset \\='websearch + :tools \\='(:append (\"search_web\" \"read_url\")) + :system \\='(:prepend \"Use the provided tools to search the web + for up-to-date information.\")) + +- You can dynamically compute the value for a key at the time the preset + is applied with `:eval' or `:function'. This is mostly useful when + using presets in the prompt, as @preset-name. + + An `:eval' form is evaluated when the preset is applied: + + (gptel-make-preset \\='visible-buffers + :description \"Include the full text of all buffers visible in the + frame.\" + :context \\='(:eval (mapcar #\\='window-buffer (window-list)))) + ▲ ▲ + │ ╰╴evaluated when preset is applied + ╰╴sets `gptel-context' + + `:function' should take the current value of the key as an input and + return the new value. Here we combine it with `:append' in the plist. + + (gptel-make-preset \\='github-read-only + :description \"Provide read-only GitHub tools\" + :pre (lambda () (gptel-mcp-connect \\='(\"github\") \\='sync)) + :tools + \\='( :append (\"mcp-github\") ;Adds all github MCP tools + :function (lambda (tools) + (cl-delete-if ;Remove \"write\" access to GitHub + (lambda (tool) + (string-match-p \"create_\" (gptel-tool-name tool))) + tools)))) + + NOTE: `:eval' and `:function' are evaluated in a temporary buffer, and + not the buffer from which the request is sent." + (declare (indent 1)) + (if-let* ((p (assoc name gptel--known-presets))) + (setcdr p keys) + (setq gptel--known-presets ;Add at end of presets for menu ordering + (nconc gptel--known-presets (list (cons name keys)))))) + +(defun gptel-get-preset (name) + "Get the gptel preset spec with NAME." + (alist-get name gptel--known-presets nil nil #'equal)) + +(defun gptel--save-preset (name &optional description) + "Save gptel's current settings as a preset with NAME. + +NAME must be a symbol. DESCRIPTION is added if provided. In addition +to registering the preset, elisp code to do the same is copied to the +`kill-ring'." + (interactive + (list (intern (completing-read "Save gptel settings to (existing or new) preset: " + gptel--known-presets)) + (read-string "Description (optional): "))) + (let ((preset-code + `(gptel-make-preset ',name + :description ,(when (and description + (not (string-blank-p description))) + description) + :backend ,(gptel-backend-name gptel-backend) + :model ',gptel-model + :system ,(if-let* ((directive (car-safe (rassoc gptel--system-message + gptel-directives)))) + `',directive + gptel--system-message) + :tools ',(mapcar #'gptel-tool-name gptel-tools) + :stream ,gptel-stream + :temperature ,gptel-temperature + :max-tokens ,gptel-max-tokens + :use-context ',gptel-use-context + :track-media ,gptel-track-media + :include-reasoning ,(let ((reasoning gptel-include-reasoning)) + (if (eq reasoning 'ignore) + ''ignore reasoning))))) + (kill-new (pp-to-string preset-code)) + (eval preset-code) + (message "Preset %s saved. (Lisp expression for preset saved to kill-ring)" + (propertize (symbol-name name) 'face 'highlight)))) + +(defvar gptel--rewrite-directive) +(defun gptel--apply-preset (preset &optional setter) + "Apply gptel PRESET with SETTER. + +PRESET is the name of a preset, or a spec (plist) of the form + (:KEY1 VAL1 :KEY2 VAL2 ...). + +SETTER is the function used to set the gptel options. It must accept +two arguments, the symbol being set and the value to set it to. It +defaults to `set', and can be set to a different function to (for +example) apply the preset buffer-locally." + (unless setter (setq setter #'set)) + (cl-flet ((preset-spec (preset) + (if (memq (type-of preset) '(symbol string)) + (or (gptel-get-preset preset) + (user-error "gptel preset \"%s\": Cannot find preset" + preset)) + preset))) + ;; Record preset name for persistence and UI display + (when (memq (type-of preset) '(string symbol)) + (funcall setter 'gptel--preset preset)) + ;; Ensure that preset is a plist spec + (setq preset (preset-spec preset)) + (when-let* ((func (plist-get preset :pre))) (funcall func)) + (when-let* ((parents (plist-get preset :parents))) + (mapc (lambda (parent) (gptel--apply-preset (preset-spec parent) setter)) + (ensure-list parents)))) + (map-do + (lambda (key val) + (pcase key + ((or :parents :description :pre :post) nil) + ((or :system :system-message :rewrite-directive) + (let ((sym (if (eq key :rewrite-directive) + 'gptel--rewrite-directive 'gptel--system-message))) + (when (consp val) + ;; Possibly complain about trying to compose a system message string + ;; with a non-string + ;; TODO(modify-list): Catch other incompatible combinations + (and (or (plist-member val :append) (plist-member val :prepend)) + (not (stringp (symbol-value sym))) + (user-error "Composing non-string system messages is not implemented")) + (setq val (gptel--modify-value (symbol-value sym) val))) + (if (and (symbolp val) (not (functionp val))) + (if-let* ((directive (alist-get val gptel-directives))) + (funcall setter sym directive) + (user-error "gptel preset: Cannot find directive %s" val)) + (funcall setter sym val)))) + (:backend + (when (consp val) (setq val (gptel--modify-value 'gptel-backend val))) + (setq val (cl-etypecase val + (gptel-backend val) + (string (gptel-get-backend val)))) + (unless val + (user-error "gptel preset: Cannot find backend %s" val)) + (funcall setter 'gptel-backend val)) + (:tools ;TEMP Confirm this `:append' convention + (setq val (gptel--modify-value gptel-tools val)) + (let* ((tools + (flatten-list + (cl-loop for tool-name in (ensure-list val) + for tool = (cl-etypecase tool-name + (gptel-tool tool-name) + (string (ignore-errors + (gptel-get-tool tool-name)))) + do (unless tool + (user-error "gptel preset: Cannot find tool %S" + tool-name)) + collect tool)))) + (funcall setter 'gptel-tools (cl-delete-duplicates tools :test #'eq)))) + ((and (let sym (or (intern-soft + (concat "gptel-" (substring (symbol-name key) 1))) + (intern-soft + (concat "gptel--" (substring (symbol-name key) 1))))) + (guard (and sym (boundp sym)))) + (funcall setter sym (if (consp val) + (gptel--modify-value (symbol-value sym) val) + val))) + (_ (display-warning + '(gptel presets) + (format "gptel preset: setting for %s not found, ignoring." key))))) + preset) + (when-let* ((func (plist-get preset :post))) (funcall func))) + +(defun gptel--preset-syms (preset) + "Return a list of gptel variables (symbols) set by PRESET. + +PRESET is the name of a preset, or a spec (plist) of the form + (:KEY1 VAL1 :KEY2 VAL2 ...)." + (when (memq (type-of preset) '(string symbol)) + (let ((spec (or (gptel-get-preset preset) + (user-error "gptel preset \"%s\": Cannot find preset" + preset)))) + (setq preset spec))) + (let* ((index preset) + syms key val) + (while index + (setq key (pop index) val (pop index)) + (pcase key + ((or :description :pre :post)) + (:parents + (setq syms + (nconc syms (mapcan #'gptel--preset-syms (ensure-list val))))) + (:system (push 'gptel--system-message syms)) + (_ (if-let* ((var (or (intern-soft + (concat "gptel-" (substring (symbol-name key) 1))) + (intern-soft + (concat "gptel--" (substring (symbol-name key) 1)))))) + (push var syms) + (display-warning + '(gptel presets) + (format "gptel preset \"%s\": setting for %s not found, ignoring." + (car preset) key)))))) + (cl-delete-duplicates syms))) + +;; This is identical to `cl-progv', only we let-bind symbols SYM from the preset +;; to their current values instead of evaluating the values explicitly. (#1005) +(defmacro gptel-with-preset (name &rest body) + "Run BODY with gptel preset NAME applied. + +This macro can be used to create `gptel-request' command with settings +from a gptel preset applied. + +NAME is the name of a preset, or a spec (plist) of the form + (:KEY1 VAL1 :KEY2 VAL2 ...). It must be quoted." + (declare (indent 1)) + (let ((syms (make-symbol "syms")) + (binds (make-symbol "binds")) + (bodyfun (make-symbol "body"))) + ;; Let-bind symbols that we want to modify with the presets. Also include + ;; `gptel--preset' in this list as we don't want to change its value outside + ;; of this macro's scope. + `(let* ((,syms (cons 'gptel--preset (gptel--preset-syms ,name))) + (,bodyfun (lambda () (gptel--apply-preset ,name) ,@body)) + (,binds nil)) + (while ,syms (push (list (car ,syms) (pop ,syms)) ,binds)) + (eval (list 'let (nreverse ,binds) (list 'funcall (list 'quote ,bodyfun))))))) + +(defun gptel--preset-mismatch-value (preset-spec key val) + "Determine if the value of KEY in PRESET-SPEC matches VAL. + +This is an imperfect check for whether the value corresponding to KEY (a +keyword) in PRESET-SPEC (a plist) matches VAL. This is required +primarily to identify which gptel variable values have changed since +PRESET-SPEC was applied, which is relevant when writing gptel metadata +to a chat file. + +See also `gptel--preset-mismatch-p'." + ;; In all cases, assume a mismatch if the preset's value for KEY is a + ;; modify-list spec, such as (:append ...) + ;; Mismatches may not even be well-defined/determinable in these cases. + (or (not preset-spec) + (pcase key + ;; special cases + ((or :system :system-message) + (let ((system (plist-get preset-spec :system))) + (or (and (stringp system) (not (equal system val))) + (functionp system) + (and (consp system) (keywordp (car system))) + (and (consp system) + (not (equal (car-safe (gptel--parse-directive system)) + val)))))) + (:backend + (let ((backend (plist-get preset-spec :backend))) + (or (and (consp backend) (keywordp (car-safe backend))) + (not (equal (or (and (gptel-backend-p val) (gptel-backend-name val)) + val) + (or (and (gptel-backend-p backend) (gptel-backend-name backend)) + backend)))))) + ;; FIXME: We're assuming that val is a list of tool names, not tools + (:tools + (and-let* ((preset-tools (plist-get preset-spec :tools))) + (or (keywordp (car-safe preset-tools)) + (cl-loop + for tool in preset-tools + for tool-name = + (or (and (stringp tool) tool) + (ignore-errors (gptel-tool-name tool))) + if (not (member tool-name uniq-tool-names)) + collect tool-name into uniq-tool-names + finally return + (not (equal (sort uniq-tool-names #'string-lessp) + (sort (copy-sequence (ensure-list val)) #'string-lessp))))))) + ;; Generic case + (_ (let ((field-val (plist-get preset-spec key))) + (or (and (consp field-val) (keywordp (car field-val))) + (not (equal field-val val)))))))) + +;;;; Presets in-buffer UI +(defun gptel--transform-apply-preset (_fsm) + "Apply a gptel preset to the buffer depending on the prompt. + +If the last user prompt includes @foo, the preset foo is applied. +Before applying the preset, \"@foo\" is removed from the prompt and +point is placed at its position." + (when gptel--known-presets + (text-property-search-backward 'gptel nil t) + (while (re-search-forward "@\\([^[:space:]]+\\)\\_>" nil t) + ;; The following convoluted check is because re-search is much faster if + ;; the search pattern begins with a non-whitespace char. + (when (or (= (match-beginning 0) (point-min)) + (memq (char-syntax (char-before (match-beginning 0))) '(32 62))) + (when-let* ((name (match-string 1)) + (preset (or (gptel-get-preset (intern-soft name)) + (gptel-get-preset name)))) + (delete-region (match-beginning 0) (match-end 0)) + ;; Point must be after @foo when the preset is applied to allow for + ;; more advanced transformations. + (gptel--apply-preset preset + (lambda (sym val) + (set (make-local-variable sym) val)))))))) + +;; ;; Alternative approach with string search +;; (search-forward "@" nil t) +;; (if (and (memq (char-syntax (char-before (1- (point)))) '(32 62)) +;; (looking-at "\\([^[:blank:]]+?\\)[[:punct:]]?\\s-+")) +;; do-stuff) + +(defun gptel--fontify-preset-keyword (end) + "Font-lock function for preset indicators in chat buffers. + +Return preset fontification info for text up to END." + (and (re-search-forward "@\\([^[:space:]]+\\)\\_>" end t) + (or (= (match-beginning 0) (point-min)) + (memq (char-syntax (char-before (match-beginning 0))) '(32 62))) + (not (plist-get (text-properties-at (match-beginning 1)) 'gptel)))) + +(defun gptel-preset-capf () + "Completion at point for gptel presets in `gptel-mode'. + +Add this to `completion-at-point-functions'." + (and gptel--known-presets + (save-excursion + (let ((num (- (skip-syntax-backward "w_")))) + (when (eql (char-before) ?@) + (list (point) (+ (point) num) + gptel--known-presets + :exclusive 'no + :annotation-function + #'(lambda (c) (thread-first + (intern-soft c) + (assq gptel--known-presets) (cdr) + (plist-get :description))))))))) + +(defun gptel--prettify-preset () + "Get visual and completion help with presets in gptel buffers. + +Intended to be added to `gptel-mode-hook'." + (let ((keyword '((gptel--fontify-preset-keyword + ;; subexp 0 here is not required, we retain it to make it + ;; easy to swtich to more complex patterns in the future + 0 (when-let* ((comps (all-completions (match-string 1) + gptel--known-presets)) + ((member (match-string 1) comps))) + '(:box -1 :inherit secondary-selection)) + prepend)))) + (cond + (gptel-mode + (font-lock-add-keywords nil keyword t) + (add-hook 'completion-at-point-functions #'gptel-preset-capf nil t)) + (t (font-lock-remove-keywords nil keyword) + (remove-hook 'completion-at-point-functions #'gptel-preset-capf t))))) + + +;;; Response tweaking commands + +(defun gptel--attach-response-history (history &optional buf) + "Attach HISTORY to the next gptel response in buffer BUF. + +HISTORY is a list of strings typically containing text replaced +by gptel. BUF is the current buffer if not specified. + +This is used to maintain variants of prompts or responses to diff +against if required." + (with-current-buffer (or buf (current-buffer)) + (letrec ((gptel--attach-after + (lambda (b e) + (when (and b e) + (add-text-properties + b e `(gptel-history + ,(append (ensure-list history) + (get-char-property (1- e) 'gptel-history)) + front-sticky (gptel gptel-history)))) + (remove-hook 'gptel-post-response-functions + gptel--attach-after 'local)))) + (add-hook 'gptel-post-response-functions gptel--attach-after + nil 'local)))) + +(defun gptel--ediff (&optional arg bounds-func) + "Ediff response at point against previous gptel responses. + +If prefix ARG is non-nil, select the previous response to ediff +against interactively. + +If specified, use BOUNDS-FUNC to compute the bounds of the +response at point. This can be used to include additional +context for the ediff session." + (interactive "P") + (when (gptel--at-response-history-p) + (pcase-let* ((`(,beg . ,end) (funcall (or bounds-func #'gptel--get-response-bounds))) + (prev-response + (if arg + (completing-read "Choose response variant to diff against: " + (get-char-property (point) 'gptel-history) + nil t) + (car-safe (get-char-property (point) 'gptel-history)))) + (buffer-mode major-mode) + (bufname (buffer-name)) + (`(,new-buf ,new-beg ,new-end) + (with-current-buffer + (get-buffer-create (concat bufname "-PREVIOUS-*")) + (let ((inhibit-read-only t)) + (erase-buffer) + (delay-mode-hooks (funcall buffer-mode)) + (visual-line-mode) + (insert prev-response) + (goto-char (point-min)) + (list (current-buffer) (point-min) (point-max)))))) + (unless prev-response (user-error "gptel response is additive: no changes to ediff")) + (require 'ediff) + (letrec ((cwc (current-window-configuration)) + (gptel--ediff-restore + (lambda () + (when (window-configuration-p cwc) + (set-window-configuration cwc)) + (kill-buffer (get-buffer (concat bufname "-PREVIOUS-*"))) + (kill-buffer (get-buffer (concat bufname "-CURRENT-*"))) + (remove-hook 'ediff-quit-hook gptel--ediff-restore)))) + (add-hook 'ediff-quit-hook gptel--ediff-restore) + (apply + #'ediff-regions-internal + (get-buffer (ediff-make-cloned-buffer (current-buffer) "-CURRENT-*")) + beg end new-buf new-beg new-end + nil + (list 'ediff-regions-wordwise 'word-wise nil) + ;; (if (transient-arg-value "-w" args) + ;; (list 'ediff-regions-wordwise 'word-wise nil) + ;; (list 'ediff-regions-linewise nil nil)) + ))))) + +(defun gptel--mark-response () + "Mark gptel response at point, if any." + (interactive) + (unless (gptel--in-response-p) (user-error "No gptel response at point")) + (pcase-let ((`(,beg . ,end) (gptel--get-response-bounds))) + (goto-char beg) (push-mark) (goto-char end) (activate-mark))) + +(defun gptel--previous-variant (&optional arg) + "Switch to ARG previous gptel-response at this point, if it exists." + (interactive "p") + (pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds)) + (history (get-char-property (point) 'gptel-history)) + (alt-response (car-safe history)) + (offset)) + (unless (and history alt-response) + (user-error "No variant responses available")) + (if (> arg 0) + (setq history (append (cdr history) + (list (buffer-substring-no-properties beg end)))) + (setq + alt-response (car (last history)) + history (cons (buffer-substring-no-properties beg end) + (nbutlast history)))) + (add-text-properties + 0 (length alt-response) + `(gptel response gptel-history ,history) + alt-response) + (setq offset (min (- (point) beg) (1- (length alt-response)))) + (delete-region beg end) + (insert alt-response) + (goto-char (+ beg offset)) + (pulse-momentary-highlight-region beg (+ beg (length alt-response))))) + +(defun gptel--next-variant (&optional arg) + "Switch to ARG next gptel-response at this point, if it exists." + (interactive "p") + (gptel--previous-variant (- arg))) + +(provide 'gptel) +;;; gptel.el ends here + +;; Local Variables: +;; bug-reference-url-format: "https://github.com/karthink/gptel/issues/%s" +;; End: