DeCarabas/Init-Files
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

[emacs] Factor the tools lisp a little bit

Browse source 
To make things a bit easier.
This commit is contained in:
John Doty 2025-05-30 19:24:38 +00:00
parent eaedb40850
commit a3ccd09f9a
4 changed files with 308 additions and 209 deletions
Download patch file Download diff file Expand all files Collapse all files

218
site-lisp/doty-tools-buffer-map.el Normal file
View file

@ -0,0 +1,218 @@
;;; doty-tools-buffer-map.el --- gptel tools for getting buffer summaries for coding -*- lexical-binding: t; -*-
;; Copyright (C) 2025 John Doty
;; Author: John Doty <john@d0ty.me>
;; Package-Version: 20250512.0000
;; Package-Revision:
;; Package-Requires: ((gptel "20250512.0000"))
;; Keywords: convenience, tools
;; URL:
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;; This file is NOT part of GNU Emacs.
;;; Commentary:
;; These tools attempt to put together a condensed summary of a buffer for an
;; AI to think about. The idea is that we can provide an accurate overview or
;; summary without wasting tokens skimming through implementation details.
;;; Code:
(require 'gptel)
(require 'treesit)
(require 'doty-tools-utils)
(defvar doty-tools--treesit-queries
nil
"Tree-sitter queries that we've registered for various languages.")
(defun doty-tools--register-treesit-mapper (lang query)
"Register a mapper based on tree-sitter for LANG (a symbol) that uses QUERY."
(when (and (treesit-available-p)
(treesit-language-available-p lang))
(let ((query (seq-concatenate 'list
'((ERROR) @err (MISSING) @err)
query)))
(treesit-query-validate lang query)
(setq doty-tools--treesit-queries
(assq-delete-all lang doty-tools--treesit-queries))
(push (cons lang (treesit-query-compile lang query))
doty-tools--treesit-queries))))
(doty-tools--register-treesit-mapper
'python
`((module (expression_statement (assignment left: (identifier) @loc)))
(class_definition
name: (_) @loc
superclasses: (_) @loc
body: (block :anchor (expression_statement :anchor (string _ :*) @loc)) :?)
(function_definition
name: (_) @loc
parameters: (_) @loc
return_type: (_) :? @loc
body: (block :anchor (expression_statement :anchor (string _ :*) @loc)) :?)))
(doty-tools--register-treesit-mapper
'scala
`((trait_definition
name: (_) :? @loc
extend: (_) :? @loc)
(val_definition
(modifiers (_)) :? @loc
pattern: (_) @loc)
(function_definition
name: (_) :? @loc
parameters: (_) :? @loc
return_type: (_) :? @loc)
(class_definition
name: (_) :? @loc
class_parameters: (_) :? @loc
extend: (_) :? @loc)))
(doty-tools--register-treesit-mapper
'rust
`((mod_item
name: (_) :? @loc)
(struct_item
(visibility_modifier (_)) :? @loc
type_parameters: (_) :? @loc
name: (_) @loc
body: (_) @loc)
(impl_item
type_parameters: (_) :? @loc
trait: (_) :? @loc
type: (_) :? @loc)
(function_item
(visibility_modifier (_)) :? @loc
name: (_) :? @loc
type_parameters: (_) :? @loc
parameters: (_) :? @loc
return_type: (_) :? @loc)))
(defun doty-tools--node-is-error (node)
"Return t if NODE is some kind of error."
(or (treesit-node-check node 'has-error)
(treesit-node-check node 'missing)))
(defun doty-tools--map-buffer (file-or-buffer)
"Generate a map for FILE-OR-BUFFER."
(with-current-buffer (doty-tools--buffer-or-file file-or-buffer)
(let* ((registration (or (assoc (treesit-language-at (point-min))
doty-tools--treesit-queries)
(error "Language '%s' not registered as a tree-sitter mapper"
(treesit-language-at (point-min)))))
(loc-queries (cdr registration))
(decls (treesit-query-capture (treesit-buffer-root-node) loc-queries nil nil t))
;; Count errors.
(error-nodes (seq-filter #'doty-tools--node-is-error decls))
(error-count (length error-nodes))
;; Remove errors, don't care anymore.
(decls (seq-filter (lambda (node) (not (doty-tools--node-is-error node))) decls))
(ranges (mapcar (lambda (node)
(cons (treesit-node-start node)
(treesit-node-end node)))
decls))
;; Sort the result
(ranges (sort ranges :key #'car :in-place t)))
(save-excursion
(let* ((line-count (count-lines (point-min) (point-max)))
(width (1+ (floor (log line-count 10))))
(line-format (format "%%%dd: %%s" width))
(result-lines nil)
(line-number 1))
(if (> error-count 0)
(push (format "[STATUS: ERRORS] File contained %d parse errors, results might be wrong"
error-count)
result-lines)
(push "[STATUS: SUCCESS] File parsed successfully" result-lines))
(push "" result-lines)
(widen)
(goto-char (point-min))
(while (and ranges (not (eobp)))
(let ((line-start (line-beginning-position))
(line-end (line-end-position)))
;; Remove the head of the ranges while the head is
;; before the current line.
(while (and ranges (< (cdar ranges) line-start))
(setq ranges (cdr ranges)))
;; When the range intersects this line, append this line.
(when (and ranges
(>= (cdar ranges) line-start)
(<= (caar ranges) line-end))
(push (format line-format
line-number
(buffer-substring-no-properties line-start line-end))
result-lines))
(setq line-number (1+ line-number))
(forward-line 1)))
(mapconcat 'identity (nreverse result-lines) "\n"))))))
(defun doty-tools-register-mappers ()
"Re-register all available code mappers."
(interactive)
(gptel-make-tool
:name "emacs_get_code_map"
:function #'doty-tools--map-buffer
:description (format
"Returns structural outline of code files with declarations and their line numbers. Includes parse status. Cheaper than reading the entire file when supported. Supported languages are: %s.
Example:
[STATUS: ERRORS] File contained 2 parse errors, results might be wrong
10: LOG_ROOT = pathlib.Path.home() / \".local\" / \"share\" / \"goose\" / \"sessions\"
12: class MyClass(object):
15: def method(self) -> int:
19: def export_session(session: str):
80: SESSION = \"20250505_222637_59fcedc5\""
(let ((supported (string-join
(--map (symbol-name (car it)) doty-tools--treesit-queries)
", ")))
(if (string-empty-p supported)
"none"
supported)))
:args '((:name "buffer_or_file"
:type string
:description "Buffer name or file path"))
:category "reading"
:confirm nil
:include t))
(doty-tools-register-mappers)
(provide 'doty-tools-buffer-map)
;;; doty-tools-buffer-map.el ends here

86
site-lisp/doty-tools-utils.el Normal file
View file

@ -0,0 +1,86 @@
;;; doty-tools-utils.el --- utilities for doty-tools -*- lexical-binding: t; -*-
;; Copyright (C) 2025 John Doty
;; Author: John Doty <john@d0ty.me>
;; Package-Version: 20250512.0000
;; Package-Revision:
;; Package-Requires: ((gptel "20250512.0000"))
;; Keywords: convenience, tools
;; URL:
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;; This file is NOT part of GNU Emacs.
;;; Commentary:
;; These are just helper functions that support the rest of Doty's tools.
;;; Code:
(require 'dash)
(require 'gptel)
(defun doty-tools-bool (v)
"Convert V into a boolean, treating :json-false as nil."
(and v (not (eq v :json-false))))
(ert-deftest doty-tools--test--bool ()
(should (doty-tools-bool t))
(should (not (doty-tools-bool nil)))
(should (not (doty-tools-bool :json-false))))
;; === Testing Support
(defun doty-tools--test--find-tool (name)
"Find the registered tool named NAME for testing."
(alist-get name
(-flatten (--map (cdr it) gptel--known-tools))
nil nil #'equal))
(defun doty-tools--test--invoke-tool (name arg-plist)
"Invoke the tool named NAME and pass in the provided arguments from ARG-PLIST.
This is kinda like what happens inside gptel but that's not accessible."
(let* ((tool (doty-tools--test--find-tool name))
;; Ensure we have the correct JSON encoding.
(arg-plist (progn
;; (message "ARGS: %S" (gptel--json-encode arg-plist))
(gptel--json-read-string (gptel--json-encode arg-plist))))
(arg-values (-map (lambda (arg)
(let ((key (intern (concat ":" (plist-get arg :name)))))
(plist-get arg-plist key)))
(gptel-tool-args tool))))
(apply (gptel-tool-function tool) arg-values)))
(defun doty-tools--buffer-or-file (buffer-or-file)
"Return a buffer for BUFFER-OR-FILE for the well-behaved LLM tool.
If it is a buffer object, just return it. If there is exactly one buffer
that matches that name, return that buffer. Otherwise return nil. Otherwise,
assume that the LLM intends to open a file with that name and visit it."
(cond
((bufferp buffer-or-file) buffer-or-file)
((length= (match-buffers (regexp-quote buffer-or-file)) 1)
(car (match-buffers (regexp-quote buffer-or-file))))
(t
(find-file-noselect (expand-file-name buffer-or-file)))))
;; (t (error "File '%s' doesn't exist and does not name an open buffer"
;; buffer-or-file))))
(provide 'doty-tools-utils)
;;; doty-tools-utils.el ends here

210
site-lisp/doty-tools.el
View file

@ -37,38 +37,7 @@
(require 'project)
(require 'treesit)
(defun doty-tools-bool (v)
"Convert V into a boolean, treating :json-false as nil."
(and v (not (eq v :json-false))))
(ert-deftest doty-tools--test--bool ()
(should (doty-tools-bool t))
(should (not (doty-tools-bool nil)))
(should (not (doty-tools-bool :json-false))))
;; === Testing Support
(defun doty-tools--test--find-tool (name)
"Find the registered tool named NAME for testing."
(alist-get name
(-flatten (--map (cdr it) gptel--known-tools))
nil nil #'equal))
(defun doty-tools--test--invoke-tool (name arg-plist)
"Invoke the tool named NAME and pass in the provided arguments from ARG-PLIST.
This is kinda like what happens inside gptel but that's not accessible."
(let* ((tool (doty-tools--test--find-tool name))
;; Ensure we have the correct JSON encoding.
(arg-plist (progn
;; (message "ARGS: %S" (gptel--json-encode arg-plist))
(gptel--json-read-string (gptel--json-encode arg-plist))))
(arg-values (-map (lambda (arg)
(let ((key (intern (concat ":" (plist-get arg :name)))))
(plist-get arg-plist key)))
(gptel-tool-args tool))))
(apply (gptel-tool-function tool) arg-values)))
(require 'doty-tools-utils)
;; === Emacs tools
@ -153,21 +122,6 @@ This is kinda like what happens inside gptel but that's not accessible."
;; === File reading
(defun doty-tools--buffer-or-file (buffer-or-file)
"Return a buffer for BUFFER-OR-FILE for the well-behaved LLM tool.
If it is a buffer object, just return it. If it names a file, visit the
file. If there is exactly one buffer that matches that name, return
that buffer. Otherwise return nil."
(cond
((bufferp buffer-or-file) buffer-or-file)
((length= (match-buffers (regexp-quote buffer-or-file)) 1)
(car (match-buffers (regexp-quote buffer-or-file))))
(t
(find-file-noselect (expand-file-name buffer-or-file)))))
;; (t (error "File '%s' doesn't exist and does not name an open buffer"
;; buffer-or-file))))
;; NOTE: I THINK THIS TOOL ISN'T GREAT.
;; (defun doty-tools--open-file (filename &optional max-chars)
@ -625,166 +579,6 @@ Call CALLBACK when done."
;; === Code Indexing
(defvar doty-tools--treesit-queries
nil
"Tree-sitter queries that we've registered for various languages.")
(defun doty-tools--register-treesit-mapper (lang query)
"Register a mapper based on tree-sitter for LANG (a symbol) that uses QUERY."
(let ((query (seq-concatenate 'list
'((ERROR) @err (MISSING) @err)
query)))
(treesit-query-validate lang query)
(setq doty-tools--treesit-queries
(assq-delete-all lang doty-tools--treesit-queries))
(push (cons lang (treesit-query-compile lang query))
doty-tools--treesit-queries)))
(doty-tools--register-treesit-mapper
'python
`((module (expression_statement (assignment left: (identifier) @loc)))
(class_definition
name: (_) @loc
superclasses: (_) @loc
body: (block :anchor (expression_statement :anchor (string _ :*) @loc)) :?)
(function_definition
name: (_) @loc
parameters: (_) @loc
return_type: (_) :? @loc
body: (block :anchor (expression_statement :anchor (string _ :*) @loc)) :?)))
(doty-tools--register-treesit-mapper
'scala
`((trait_definition
name: (_) :? @loc
extend: (_) :? @loc)
(val_definition
(modifiers (_)) :? @loc
pattern: (_) @loc)
(function_definition
name: (_) :? @loc
parameters: (_) :? @loc
return_type: (_) :? @loc)
(class_definition
name: (_) :? @loc
class_parameters: (_) :? @loc
extend: (_) :? @loc)))
(doty-tools--register-treesit-mapper
'rust
`((mod_item
name: (_) :? @loc)
(struct_item
(visibility_modifier (_)) :? @loc
type_parameters: (_) :? @loc
name: (_) @loc
body: (_) @loc)
(impl_item
type_parameters: (_) :? @loc
trait: (_) :? @loc
type: (_) :? @loc)
(function_item
(visibility_modifier (_)) :? @loc
name: (_) :? @loc
type_parameters: (_) :? @loc
parameters: (_) :? @loc
return_type: (_) :? @loc)))
(defun doty-tools--node-is-error (node)
"Return t if NODE is some kind of error."
(or (treesit-node-check node 'has-error)
(treesit-node-check node 'missing)))
(defun doty-tools--map-buffer (file-or-buffer)
"Generate a map for FILE-OR-BUFFER."
(with-current-buffer (doty-tools--buffer-or-file file-or-buffer)
(let* ((registration (or (assoc (treesit-language-at (point-min))
doty-tools--treesit-queries)
(error "Language '%s' not registered as a tree-sitter mapper"
(treesit-language-at (point-min)))))
(loc-queries (cdr registration))
(decls (treesit-query-capture (treesit-buffer-root-node) loc-queries nil nil t))
;; Count errors.
(error-nodes (seq-filter #'doty-tools--node-is-error decls))
(error-count (length error-nodes))
;; Remove errors, don't care anymore.
(decls (seq-filter (lambda (node) (not (doty-tools--node-is-error node))) decls))
(ranges (mapcar (lambda (node)
(cons (treesit-node-start node)
(treesit-node-end node)))
decls))
;; Sort the result
(ranges (sort ranges :key #'car :in-place t)))
(save-excursion
(let* ((line-count (count-lines (point-min) (point-max)))
(width (1+ (floor (log line-count 10))))
(line-format (format "%%%dd: %%s" width))
(result-lines nil)
(line-number 1))
(if (> error-count 0)
(push (format "[STATUS: ERRORS] File contained %d parse errors"
error-count)
result-lines)
(push "[STATUS: SUCCESS] File parsed successfully" result-lines))
(push "" result-lines)
(widen)
(goto-char (point-min))
(while (and ranges (not (eobp)))
(let ((line-start (line-beginning-position))
(line-end (line-end-position)))
;; Remove the head of the ranges while the head is
;; before the current line.
(while (and ranges (< (cdar ranges) line-start))
(setq ranges (cdr ranges)))
;; When the range intersects this line, append this line.
(when (and ranges
(>= (cdar ranges) line-start)
(<= (caar ranges) line-end))
(push (format line-format
line-number
(buffer-substring-no-properties line-start line-end))
result-lines))
(setq line-number (1+ line-number))
(forward-line 1)))
(mapconcat 'identity (nreverse result-lines) "\n"))))))
(gptel-make-tool
:name "emacs_get_code_map"
:function #'doty-tools--map-buffer
:description "Returns structural outline of code files with declarations and their line numbers. Includes parse status. Cheaper than reading the entire file when supported. Supports python, scala, and rust code.
Example:
[STATUS: ERRORS] File contained 2 parse errors
10: LOG_ROOT = pathlib.Path.home() / \".local\" / \"share\" / \"goose\" / \"sessions\"
12: class MyClass(object):
15: def method(self) -> int:
19: def export_session(session: str):
80: SESSION = \"20250505_222637_59fcedc5\""
:args '((:name "buffer_or_file"
:type string
:description "Buffer name or file path"))
:category "reading"
:confirm nil
:include t)
;; === Editing tools
@ -1009,7 +803,7 @@ If END-LINE is not provided, only delete START-LINE."
(set-process-sentinel
(start-file-process-shell-command "gptel-async-command" output-buffer command)
(lambda (process event)
(lambda (_process event)
(when (string-match "finished" event)
(with-current-buffer output-buffer
(funcall callback (buffer-string)))