1 files changed, 118 insertions, 0 deletions

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)