import web_search and web_fetch wholesale from gptel-agent

3 files changed, 160 insertions, 2 deletions

diff --git a/llm-tools-hl.el b/llm-tools-hl.el
index c682334..4bf3a6e 100644
--- a/llm-tools-hl.el
+++ b/llm-tools-hl.el
@@ -105,3 +105,5 @@ If INCLUDE-CONTENT is non-nil, append `|LINE' after each hash."
 ;; maybe if it just shifted a little bit (since the anchor is line number and hash of the line's content), there can be some kind of autohealing?
 ;; rather, the llm would not format it like the reads. it's just going to provide text according to what the anchors it gives say
 ;; so I just need to verify if the anchors didn't change
+
+(provide 'llm-tools-hl)
diff --git a/llm-tools-web.el b/llm-tools-web.el
new file mode 100644
index 0000000..7002713
--- /dev/null
+++ b/llm-tools-web.el
@@ -0,0 +1,118 @@
+;;; Web tools, taken from gptel-agent
+(defun gptel-agent--fetch-with-timeout (url url-cb tool-cb failed-msg &rest args)
+  "Fetch URL and call URL-CB in the result buffer.
+
+Call TOOL-CB if there is an error or a timeout.  TOOL-CB and ARGS are
+passed to URL-CB.  FAILED-MSG is a fragment used for messaging.  Handles
+cleanup."
+  (let* ((timeout 30) timer done
+         (inherit-process-coding-system t)
+         (proc-buffer
+          (url-retrieve
+           url (lambda (status)
+                 (setq done t)
+                 (when timer (cancel-timer timer))
+                 (if-let* ((err (plist-get status :error)))
+                     (funcall tool-cb
+                              (format "Error: %s failed with error: %S" failed-msg err))
+                   (apply url-cb tool-cb args))
+                 (kill-buffer (current-buffer)))
+           args 'silent)))
+    (setq timer
+          (run-at-time
+           timeout nil
+           (lambda (buf cb)
+             (unless done
+               (setq done t)
+               (let ((kill-buffer-query-functions)) (kill-buffer buf))
+               (funcall
+                cb (format "Error: %s timed out after %d seconds."
+                           failed-msg timeout))))
+           proc-buffer tool-cb))
+    proc-buffer))
+
+;;;; Web Searching, taken from gptel-agent
+(defun llm-tools--shr-next-link ()
+  "Jump to the next SHR link in the buffer.  Return jump position."
+  (let ((current-prop (get-char-property (point) 'shr-url))
+        (next-pos (point)))
+    (while (and (not (eobp))
+                (setq next-pos
+                      (or (next-single-property-change (point) 'shr-url)
+                          (point-max)))
+                (let ((next-prop (get-char-property next-pos 'shr-url)))
+                  (or (equal next-prop current-prop)
+                      (equal next-prop nil))))
+      (goto-char next-pos))
+    (goto-char next-pos)))
+
+(defvar llm-tools--web-search-active nil)
+
+(defun llm-tools--web-search-eww (tool-cb query &optional count)
+  "Search the web using eww's default search engine (usually DuckDuckGo).
+
+Call TOOL-CB with the results as a string.  QUERY is the search string.
+COUNT is the number of results to return (default 5)."
+  ;; No more than two active searches at one time
+  (setq llm-tools--web-search-active
+        (cl-delete-if-not
+         (lambda (buf) (and (buffer-live-p buf)
+                       (process-live-p (get-buffer-process buf))))
+         llm-tools--web-search-active))
+  (if (>= (length llm-tools--web-search-active) 2)
+      (progn (message "Web search: waiting for turn")
+             (run-at-time 5 nil #'llm-tools--web-search-eww
+                          tool-cb query count))
+    (push (llm-tools--fetch-with-timeout
+           (concat eww-search-prefix (url-hexify-string query))
+           #'llm-tools--web-search-eww-callback
+           tool-cb (format "Web search for \"%s\"" query))
+          llm-tools--web-search-active)))
+
+(defun llm-tools--web-search-eww-callback (cb)
+  "Extract website text and run callback CB with it."
+  (let* ((count 5) (results))
+    (goto-char (point-min))
+    (goto-char url-http-end-of-headers)
+    (let* ((dom (libxml-parse-html-region (point) (point-max)))
+           (result-count 0))
+      (eww-score-readability dom)
+      (with-temp-buffer
+        (shr-insert-document (eww-highest-readability dom))
+        (goto-char (point-min))
+        (while (and (not (eobp)) (< result-count count))
+          (let ((pos (point))
+                (url (get-char-property (point) 'shr-url))
+                (next-pos (llm-tools--shr-next-link)))
+            (when-let* (((stringp url))
+                        (idx (string-search "http" url))
+                        (url-fmt (url-unhex-string (substring url idx))))
+              (cl-incf result-count)
+              (push (concat url-fmt "\n\n"
+                            (string-trim
+                             (buffer-substring-no-properties pos next-pos))
+                            "\n\n----\n")
+                    results))))))
+    (funcall cb (apply #'concat (nreverse results)))))
+
+;;;; Read URLs, taken from gptel-agent
+(defun llm-tools--read-url (tool-cb url)
+  "Fetch URL text and call TOOL-CB with it."
+  (llm-tools--fetch-with-timeout
+   url
+   (lambda (cb)
+     (goto-char (point-min)) (forward-paragraph)
+     (condition-case errdata
+         (let ((dom (libxml-parse-html-region (point) (point-max))))
+           (with-temp-buffer
+             (eww-score-readability dom)
+             (shr-insert-document (eww-highest-readability dom))
+             (decode-coding-region (point-min) (point-max) 'utf-8)
+             (funcall
+              cb (buffer-substring-no-properties
+                  (point-min) (point-max)))))
+       (error (funcall cb (format "Error: Request failed with error data:\n%S"
+                                  errdata)))))
+   tool-cb (format "Fetch for \"%s\"" url)))
+
+(provide 'llm-tools-web)
diff --git a/llm-tools.el b/llm-tools.el
index 41f6c56..855f12f 100644
--- a/llm-tools.el
+++ b/llm-tools.el
@@ -1,3 +1,6 @@
+(require 'llm-tools-hl)
+(require 'llm-tools-web)
+
 ;; read_file (hl-file-read)
 (gptel-make-tool
  :name "read_file"
@@ -203,5 +206,40 @@ working directory. Defaults to current directory if omitted."
  :confirm nil
  :include t)
 
-;; TODO fetch_url (use gptel-agent's one as a base, but needs mime handling like PDFs and images)
-;; TODO web_search (use gptel-agent's eww/shr method as a base)
+;; web_search (taken wholesale from gptel-agent)
+(gptel-make-tool
+ :name "web_search"
+ :function #'llm-tools--web-search-eww
+ :description "Search the web for the first five results to a query.  The query can be an arbitrary string.  Returns the top five results from the search engine as a list of plists.  Each object has the keys `:url` and `:excerpt` for the corresponding search result.
+
+This tool uses the Emacs web browser (eww) with its default search engine to perform searches. No API key is required.
+
+If required, consider using the url as the input to the `Read` tool to get the contents of the url.  Note that this might not work as the `Read` tool does not handle javascript-enabled pages."
+ :args '((:name "query"
+                :type string
+                :description "The natural language search query, can be multiple words.")
+         (:name "count"
+                :type integer
+                :description "Number of results to return (default 5)"
+                :optional t))
+ :include t
+ :confirm nil
+ :async t)
+
+;; fetch_url (use gptel-agent's one as a base, but adds mime handling like PDFs and images)
+; TODO add mime handling for documents and images
+(gptel-make-tool
+ :function #'llm-tools--read-url
+ :name "web_fetch"
+ :description "Fetch and read the contents of a URL.
+
+- Returns the text of the URL (not HTML) formatted for reading.
+- Request times out after 30 seconds."
+ :args '(( :name "url"
+           :type "string"
+           :description "The URL to read"))
+ :async t
+ :confirm nil
+ :include t)
+
+(provide 'llm-tools)