llm-tools-web.el (5980B)
1 ;;; llm-tools-web.el --- Web tools for llm-tools -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2026 Vineet K 4 5 ;; Author: Vineet K <git@vineetk.net> 6 ;; Version: 1.0 7 ;; Keywords: llm, gptel, processes 8 ;; Package-Requires: ((emacs "28.1")) 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; Web tools for the llm-tools package, adapted from gptel-agent. 26 ;; Provides functions for web searching and URL fetching. 27 28 ;;; Code: 29 30 (require 'cl-lib) 31 (require 'eww) 32 33 (defun llm-tools--fetch-with-timeout (url url-cb tool-cb failed-msg &rest args) 34 "Fetch URL and call URL-CB in the result buffer. 35 36 Call TOOL-CB if there is an error or a timeout. TOOL-CB and ARGS are 37 passed to URL-CB. FAILED-MSG is a fragment used for messaging. Handles 38 cleanup." 39 (let* ((timeout 30) timer done 40 (inherit-process-coding-system t) 41 (proc-buffer 42 (url-retrieve 43 url (lambda (status) 44 (setq done t) 45 (when timer (cancel-timer timer)) 46 (if-let* ((err (plist-get status :error))) 47 (funcall tool-cb 48 (format "Error: %s failed with error: %S" failed-msg err)) 49 (apply url-cb tool-cb args)) 50 (kill-buffer (current-buffer))) 51 args 'silent))) 52 (setq timer 53 (run-at-time 54 timeout nil 55 (lambda (buf cb) 56 (unless done 57 (setq done t) 58 (let ((kill-buffer-query-functions)) (kill-buffer buf)) 59 (funcall 60 cb (format "Error: %s timed out after %d seconds." 61 failed-msg timeout)))) 62 proc-buffer tool-cb)) 63 proc-buffer)) 64 65 ;;;; Web Searching, taken from gptel-agent 66 (defun llm-tools--shr-next-link () 67 "Jump to the next SHR link in the buffer. Return jump position." 68 (let ((current-prop (get-char-property (point) 'shr-url)) 69 (next-pos (point))) 70 (while (and (not (eobp)) 71 (setq next-pos 72 (or (next-single-property-change (point) 'shr-url) 73 (point-max))) 74 (let ((next-prop (get-char-property next-pos 'shr-url))) 75 (or (equal next-prop current-prop) 76 (equal next-prop nil)))) 77 (goto-char next-pos)) 78 (goto-char next-pos))) 79 80 (defvar llm-tools--web-search-active nil) 81 82 (defun llm-tools--web-search-eww (tool-cb query &optional count) 83 "Search the web using eww's default search engine (usually DuckDuckGo). 84 85 Call TOOL-CB with the results as a string. QUERY is the search string. 86 COUNT is the number of results to return (default 5)." 87 ;; No more than two active searches at one time 88 (setq llm-tools--web-search-active 89 (cl-delete-if-not 90 (lambda (buf) (and (buffer-live-p buf) 91 (process-live-p (get-buffer-process buf)))) 92 llm-tools--web-search-active)) 93 (if (>= (length llm-tools--web-search-active) 2) 94 (progn (message "Web search: waiting for turn") 95 (run-at-time 5 nil #'llm-tools--web-search-eww 96 tool-cb query count)) 97 (push (llm-tools--fetch-with-timeout 98 (concat eww-search-prefix (url-hexify-string query)) 99 #'llm-tools--web-search-eww-callback 100 tool-cb (format "Web search for \"%s\"" query)) 101 llm-tools--web-search-active))) 102 103 (defun llm-tools--web-search-eww-callback (cb) 104 "Extract website text and run callback CB with it." 105 (let* ((count 5) (results)) 106 (goto-char (point-min)) 107 (goto-char url-http-end-of-headers) 108 (let* ((dom (libxml-parse-html-region (point) (point-max))) 109 (result-count 0)) 110 (eww-score-readability dom) 111 (with-temp-buffer 112 (shr-insert-document (eww-highest-readability dom)) 113 (goto-char (point-min)) 114 (while (and (not (eobp)) (< result-count count)) 115 (let ((pos (point)) 116 (url (get-char-property (point) 'shr-url)) 117 (next-pos (llm-tools--shr-next-link))) 118 (when-let* (((stringp url)) 119 (idx (string-search "http" url)) 120 (url-fmt (url-unhex-string (substring url idx)))) 121 (cl-incf result-count) 122 (push (concat url-fmt "\n\n" 123 (string-trim 124 (buffer-substring-no-properties pos next-pos)) 125 "\n\n----\n") 126 results)))))) 127 (funcall cb (apply #'concat (nreverse results))))) 128 129 ;;;; Read URLs, taken from gptel-agent 130 (defun llm-tools--read-url (tool-cb url) 131 "Fetch URL text and call TOOL-CB with it." 132 (llm-tools--fetch-with-timeout 133 url 134 (lambda (cb) 135 (goto-char (point-min)) (forward-paragraph) 136 (condition-case errdata 137 (let ((dom (libxml-parse-html-region (point) (point-max)))) 138 (with-temp-buffer 139 (eww-score-readability dom) 140 (shr-insert-document (eww-highest-readability dom)) 141 (decode-coding-region (point-min) (point-max) 'utf-8) 142 (funcall 143 cb (buffer-substring-no-properties 144 (point-min) (point-max))))) 145 (error (funcall cb (format "Error: Request failed with error data:\n%S" 146 errdata))))) 147 tool-cb (format "Fetch for \"%s\"" url))) 148 149 (provide 'llm-tools-web)