From: Andreas Gerler Date: Thu, 29 Jan 2026 21:22:14 +0000 (+0100) Subject: added gptel X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=b07f2b865c30b0ebaf956e906422b802baf1a8c6;p=emacsconfig.git added gptel --- diff --git a/bba.org b/bba.org index cc52f5fd..6e210e70 100644 --- a/bba.org +++ b/bba.org @@ -1413,6 +1413,26 @@ thus installed via github. (lsp-define-stdio-client lsp-sql "sql" (lsp-make-traverser #'(lambda (dir) (directory-files dir nil "sss.sql"))) '("~/.vscode/extensions/ms-mssql.mssql-1.4.0/sqltoolsservice/1.4.0/Ubuntu16/MicrosoftSqlToolsServiceLayer")) #+end_src +* gptel +[2026-01-29 Thu 10:14] + +#+begin_src emacs-lisp + (if (file-exists-p "/usr/local/bin/ollama") + (progn (require 'gptel) + (gptel-make-ollama "Ollama" ;Any name of your choosing + :host "localhost:11434" ;Where it's running + :stream t ;Stream responses + :models '(gpt-oss:20b)) + (setq + gptel-model 'gpt-oss:20b + gptel-backend (gptel-make-ollama "Ollama" + :host "localhost:11434" + :stream t + :models '(gpt-oss:20b)) + gptel-expert-commands t) + (define-key global-map (kbd "C-c ") 'gptel-send))) +#+end_src + * sql [2016-11-27 Sun 17:56] diff --git a/elpa/gptel-20260123.739/gptel-anthropic.el b/elpa/gptel-20260123.739/gptel-anthropic.el new file mode 100644 index 00000000..6ef77ba4 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-anthropic.el @@ -0,0 +1,722 @@ +;;; 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 new file mode 100644 index 00000000..d01e3cb8 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-autoloads.el @@ -0,0 +1,700 @@ +;;; 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 new file mode 100644 index 00000000..0ccbd5cf --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-bedrock.el @@ -0,0 +1,660 @@ +;;; 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 new file mode 100644 index 00000000..f243ac50 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-context.el @@ -0,0 +1,847 @@ +;;; 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 new file mode 100644 index 00000000..7af66816 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-gemini.el @@ -0,0 +1,635 @@ +;;; 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 new file mode 100644 index 00000000..5136bcf3 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-gh.el @@ -0,0 +1,435 @@ +;;; 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 new file mode 100644 index 00000000..65b7de38 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-integrations.el @@ -0,0 +1,275 @@ +;;; 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 new file mode 100644 index 00000000..97a8d9a7 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-kagi.el @@ -0,0 +1,188 @@ +;;; 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 new file mode 100644 index 00000000..abecfb6c --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-ollama.el @@ -0,0 +1,366 @@ +;;; 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 new file mode 100644 index 00000000..f8ed4d38 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-openai-extras.el @@ -0,0 +1,430 @@ +;;; 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 new file mode 100644 index 00000000..6f96bf19 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-openai.el @@ -0,0 +1,728 @@ +;;; 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 new file mode 100644 index 00000000..e46f81f2 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-org.el @@ -0,0 +1,846 @@ +;;; 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 new file mode 100644 index 00000000..af2614c2 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-pkg.el @@ -0,0 +1,12 @@ +;; -*- 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 new file mode 100644 index 00000000..041e03ae --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-request.el @@ -0,0 +1,2875 @@ +;;; 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 new file mode 100644 index 00000000..acd08b24 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-rewrite.el @@ -0,0 +1,796 @@ +;;; 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 new file mode 100644 index 00000000..881d3478 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel-transient.el @@ -0,0 +1,1993 @@ +;;; 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 new file mode 100644 index 00000000..ff2e55e2 --- /dev/null +++ b/elpa/gptel-20260123.739/gptel.el @@ -0,0 +1,2444 @@ +;;; 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: