Skip to content

Create gptel define tool macro #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 5 commits into
base: experimental
Choose a base branch
from
Open

Create gptel define tool macro #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
dc16ec5
gptel: Use gptel-response-separator in post-insert
psionic-k Feb 13, 2025
52f1902
gptel-org: combine conditions in gptel-org--create-prompt
psionic-k Feb 17, 2025
53be24e
gptel-kagi: Use gptel--trim-prefixes
psionic-k Feb 15, 2025
2bcf06d
gptel: rename gptel--get-bounds
psionic-k Feb 13, 2025
3f73846
Start writing a gptel-define-tool macro
swflint Mar 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 4 additions & 7 deletions gptel-kagi.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -98,13 +98,10 @@
(user-error "No user prompt found!")
(let ((prompts
(if (or gptel-mode gptel-track-response)
(string-trim
(buffer-substring-no-properties (prop-match-beginning prop)
(prop-match-end prop))
(format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
(regexp-quote (gptel-prompt-prefix-string)))
(format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
(regexp-quote (gptel-response-prefix-string))))
(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 ""))))
Expand Down
92 changes: 46 additions & 46 deletions gptel-org.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -186,53 +186,53 @@ value of `gptel-org-branching-context', which see."
(when topic-start
;; narrow to GPTEL_TOPIC property scope
(narrow-to-region topic-start prompt-end))
(if gptel-org-branching-context
(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
(if (fboundp 'org-element-lineage-map)
(save-excursion
(let* ((org-buf (current-buffer))
(start-bounds (gptel-org--element-lineage-map
(org-element-at-point) #'gptel-org--element-begin
'(headline org-data) 'with-self))
(end-bounds
(cl-loop
for (pos . rest) on (cdr start-bounds)
while
(and (>= pos (point-min)) ;respect narrowing
(goto-char pos)
;; org-element-lineage always returns an extra
;; (org-data) element at point 1. If there is also a
;; heading here, it is either a false positive or we
;; would be double counting it. So we reject this node
;; when also at a heading.
(not (and (eq pos 1) (org-at-heading-p)
;; Skip if at the last element of start-bounds,
;; since we captured this heading already (#476)
(null rest))))
do (outline-next-heading)
collect (point) into ends
finally return (cons prompt-end ends))))
(with-temp-buffer
(setq-local gptel-backend (buffer-local-value 'gptel-backend org-buf)
gptel--system-message
(buffer-local-value 'gptel--system-message org-buf)
gptel-model (buffer-local-value 'gptel-model org-buf)
gptel-mode (buffer-local-value 'gptel-mode org-buf)
gptel-track-response
(buffer-local-value 'gptel-track-response org-buf)
gptel-track-media
(buffer-local-value 'gptel-track-media org-buf))
(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))
(let ((major-mode 'org-mode))
(gptel--parse-buffer gptel-backend max-entries)))))
(display-warning
'(gptel org)
"Using `gptel-org-branching-context' requires Org version 9.7 or higher, it will be ignored.")
(gptel--parse-buffer gptel-backend max-entries))
(save-excursion
(let* ((org-buf (current-buffer))
(start-bounds (gptel-org--element-lineage-map
(org-element-at-point) #'gptel-org--element-begin
'(headline org-data) 'with-self))
(end-bounds
(cl-loop
for (pos . rest) on (cdr start-bounds)
while
(and (>= pos (point-min)) ;respect narrowing
(goto-char pos)
;; org-element-lineage always returns an extra
;; (org-data) element at point 1. If there is also a
;; heading here, it is either a false positive or we
;; would be double counting it. So we reject this node
;; when also at a heading.
(not (and (eq pos 1) (org-at-heading-p)
;; Skip if at the last element of start-bounds,
;; since we captured this heading already (#476)
(null rest))))
do (outline-next-heading)
collect (point) into ends
finally return (cons prompt-end ends))))
(with-temp-buffer
(setq-local gptel-backend (buffer-local-value 'gptel-backend org-buf)
gptel--system-message
(buffer-local-value 'gptel--system-message org-buf)
gptel-model (buffer-local-value 'gptel-model org-buf)
gptel-mode (buffer-local-value 'gptel-mode org-buf)
gptel-track-response
(buffer-local-value 'gptel-track-response org-buf)
gptel-track-media
(buffer-local-value 'gptel-track-media org-buf))
(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))
(let ((major-mode 'org-mode))
(gptel--parse-buffer gptel-backend max-entries)))))
;; Create prompt the usual way
(gptel--parse-buffer gptel-backend max-entries))))

Expand Down
2 changes: 1 addition & 1 deletion gptel-transient.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1379,7 +1379,7 @@ for details."
"Regenerate gptel response at point."
(interactive)
(when (gptel--in-response-p)
(pcase-let* ((`(,beg . ,end) (gptel--get-bounds))
(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)))
Expand Down
69 changes: 63 additions & 6 deletions gptel.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -996,7 +996,10 @@ FILE is assumed to exist and be a regular file."
bounds))
bounds))))

(defun gptel--get-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
Expand All @@ -1005,7 +1008,7 @@ FILE is assumed to exist and be a regular file."
(when (setq prop (text-property-search-forward
'gptel 'response t))
(cons (prop-match-beginning prop)
(prop-match-end prop)))))))
(prop-match-end prop)))))))

(defun gptel--in-response-p (&optional pt)
"Check if position PT is inside a gptel response."
Expand Down Expand Up @@ -1599,6 +1602,59 @@ implementation, used by OpenAI-compatible APIs and Ollama."
:additionalProperties :json-false))))))
(ensure-list tools))))

(cl-defmacro gptel-define-tool (function-name
(&rest args-list)
(&key name
description
async
category
confirm
include
&allow-other-keys)
&body body
&aux
(docstring (when (stringp (car body))
(car body))))
"Define an LLM-callable tool, FUNCTION-NAME.

TODO: Write docstring

Note, this macro will define the function, and install it as a tool. If
it is re-run, any changes will be made as necessary."
(declare (indent 3)
(doc-string 4))
(let* ((tool-name (or name
(replace-regexp-in-string "-" "_" (format "%s" function-name))))
(function-arguments (mapcar (lambda (arg-defn)
(if (listp arg-defn)
(car arg-defn)
arg-defn))
args-list))
(argument-descriptions (mapcar (lambda (arg-defn)
(when (listp arg-defn)
(cons :name
(cons (replace-regexp-in-string "-" "_" (format "%s" (car arg-defn)))
(cdr arg-defn)))))
args-list))
(description (or description
(and (stringp docstring)
(car (string-split docstring "\n"))))))
(unless (stringp description)
(error "A description of tool %s must be provided" function-name))
`(progn
(defun ,function-name (,@function-arguments)
,@body)
(gptel-make-tool
:name ,tool-name
:args ',argument-descriptions
:description ,description
:function ',function-name
,@(when async (list :async async))
,@(when category (list :category category))
,@(when confirm (list :confirm confirm))
,@(when include (list :include include)))
',function-name)))

(cl-defgeneric gptel--parse-tool-results (backend results)
"Return a BACKEND-appropriate prompt containing tool call RESULTS.

Expand Down Expand Up @@ -1879,7 +1935,8 @@ No state transition here since that's handled by the process sentinels."
(pulse-momentary-highlight-region start-marker tracking-marker)
(when gptel-mode
(save-excursion (goto-char tracking-marker)
(insert "\n\n" (gptel-prompt-prefix-string)))
(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)))
Expand Down Expand Up @@ -2916,7 +2973,7 @@ 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-bounds)))
(pcase-let* ((`(,beg . ,end) (funcall (or bounds-func #'gptel--get-response-bounds)))
(prev-response
(if arg
(completing-read "Choose response variant to diff against: "
Expand Down Expand Up @@ -2961,13 +3018,13 @@ context for the ediff session."
"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-bounds)))
(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 previous gptel-response at this point, if it exists."
(interactive "p")
(pcase-let* ((`(,beg . ,end) (gptel--get-bounds))
(pcase-let* ((`(,beg . ,end) (gptel--get-response-bounds))
(history (get-char-property (point) 'gptel-history))
(alt-response (car-safe history))
(offset))
Expand Down