add preview functions

1 files changed, 47 insertions, 0 deletions

diff --git a/llm-tools.el b/llm-tools.el
index 0b2474c..4fa4258 100644
--- a/llm-tools.el
+++ b/llm-tools.el
@@ -442,4 +442,51 @@ If required, consider using the url as the input to the `Read` tool to get the c
  :confirm nil
  :include t)
 
+;;;; Preview Functions
+(defun llm-tools--preview-teardown (ov)
+  "Delete region covered by overlay OV and remove the overlay."
+  (when (overlayp ov)
+    (with-current-buffer (overlay-buffer ov)
+      (let ((inhibit-read-only t))
+        (delete-region (overlay-start ov) (overlay-end ov)))
+      (delete-overlay ov))))
+
+(defun llm-tools--make-preview-setup (formatter)
+  "Return a preview setup function that calls FORMATTER with ARG-VALUES.
+FORMATTER is a function (ARG-VALUES) that inserts the preview text."
+  (lambda (arg-values _info)
+    (let ((from (point)))
+      (funcall formatter arg-values)
+      (make-overlay from (point)))))
+
+(defun llm-tools--format-bash-preview (arg-values)
+  (let ((command (car arg-values)))
+    (insert "("
+            (propertize "bash" 'font-lock-face 'font-lock-keyword-face)
+            " " command ")\n")))
+
+(defun llm-tools--format-edit-file-preview (arg-values)
+  (let ((patch (car arg-values)))
+    (insert "("
+            (propertize "edit_file" 'font-lock-face 'font-lock-keyword-face)
+            ")\n" patch "\n")))
+
+(defun llm-tools--format-write-file-preview (arg-values)
+  (let ((file (car arg-values))
+        (contents (cadr arg-values)))
+    (insert "("
+            (propertize "write_file" 'font-lock-face 'font-lock-keyword-face)
+            " " (prin1-to-string file) ")\n" contents "\n")))
+
+(dolist (tool '(("bash" llm-tools--format-bash-preview)
+                ("edit_file" llm-tools--format-edit-file-preview)
+                ("write_file" llm-tools--format-write-file-preview)))
+  (setf (alist-get (car tool)
+                   gptel--tool-preview-alist
+                   nil
+                   nil
+                   #'equal)
+        (list (llm-tools--make-preview-setup (cadr tool))
+              #'llm-tools--preview-teardown)))
+
 (provide 'llm-tools)