llm-tools-web.el (5965B)
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 32 (defun llm-tools--fetch-with-timeout (url url-cb tool-cb failed-msg &rest args) 33 "Fetch URL and call URL-CB in the result buffer. 34 35 Call TOOL-CB if there is an error or a timeout. TOOL-CB and ARGS are 36 passed to URL-CB. FAILED-MSG is a fragment used for messaging. Handles 37 cleanup." 38 (let* ((timeout 30) timer done 39 (inherit-process-coding-system t) 40 (proc-buffer 41 (url-retrieve 42 url (lambda (status) 43 (setq done t) 44 (when timer (cancel-timer timer)) 45 (if-let* ((err (plist-get status :error))) 46 (funcall tool-cb 47 (format "Error: %s failed with error: %S" failed-msg err)) 48 (apply url-cb tool-cb args)) 49 (kill-buffer (current-buffer))) 50 args 'silent))) 51 (setq timer 52 (run-at-time 53 timeout nil 54 (lambda (buf cb) 55 (unless done 56 (setq done t) 57 (let ((kill-buffer-query-functions)) (kill-buffer buf)) 58 (funcall 59 cb (format "Error: %s timed out after %d seconds." 60 failed-msg timeout)))) 61 proc-buffer tool-cb)) 62 proc-buffer)) 63 64 ;;;; Web Searching, taken from gptel-agent 65 (defun llm-tools--shr-next-link () 66 "Jump to the next SHR link in the buffer. Return jump position." 67 (let ((current-prop (get-char-property (point) 'shr-url)) 68 (next-pos (point))) 69 (while (and (not (eobp)) 70 (setq next-pos 71 (or (next-single-property-change (point) 'shr-url) 72 (point-max))) 73 (let ((next-prop (get-char-property next-pos 'shr-url))) 74 (or (equal next-prop current-prop) 75 (equal next-prop nil)))) 76 (goto-char next-pos)) 77 (goto-char next-pos))) 78 79 (defvar llm-tools--web-search-active nil) 80 81 (defun llm-tools--web-search-eww (tool-cb query &optional count) 82 "Search the web using eww's default search engine (usually DuckDuckGo). 83 84 Call TOOL-CB with the results as a string. QUERY is the search string. 85 COUNT is the number of results to return (default 5)." 86 ;; No more than two active searches at one time 87 (setq llm-tools--web-search-active 88 (cl-delete-if-not 89 (lambda (buf) (and (buffer-live-p buf) 90 (process-live-p (get-buffer-process buf)))) 91 llm-tools--web-search-active)) 92 (if (>= (length llm-tools--web-search-active) 2) 93 (progn (message "Web search: waiting for turn") 94 (run-at-time 5 nil #'llm-tools--web-search-eww 95 tool-cb query count)) 96 (push (llm-tools--fetch-with-timeout 97 (concat eww-search-prefix (url-hexify-string query)) 98 #'llm-tools--web-search-eww-callback 99 tool-cb (format "Web search for \"%s\"" query)) 100 llm-tools--web-search-active))) 101 102 (defun llm-tools--web-search-eww-callback (cb) 103 "Extract website text and run callback CB with it." 104 (let* ((count 5) (results)) 105 (goto-char (point-min)) 106 (goto-char url-http-end-of-headers) 107 (let* ((dom (libxml-parse-html-region (point) (point-max))) 108 (result-count 0)) 109 (eww-score-readability dom) 110 (with-temp-buffer 111 (shr-insert-document (eww-highest-readability dom)) 112 (goto-char (point-min)) 113 (while (and (not (eobp)) (< result-count count)) 114 (let ((pos (point)) 115 (url (get-char-property (point) 'shr-url)) 116 (next-pos (llm-tools--shr-next-link))) 117 (when-let* (((stringp url)) 118 (idx (string-search "http" url)) 119 (url-fmt (url-unhex-string (substring url idx)))) 120 (cl-incf result-count) 121 (push (concat url-fmt "\n\n" 122 (string-trim 123 (buffer-substring-no-properties pos next-pos)) 124 "\n\n----\n") 125 results)))))) 126 (funcall cb (apply #'concat (nreverse results))))) 127 128 ;;;; Read URLs, taken from gptel-agent 129 (defun llm-tools--read-url (tool-cb url) 130 "Fetch URL text and call TOOL-CB with it." 131 (llm-tools--fetch-with-timeout 132 url 133 (lambda (cb) 134 (goto-char (point-min)) (forward-paragraph) 135 (condition-case errdata 136 (let ((dom (libxml-parse-html-region (point) (point-max)))) 137 (with-temp-buffer 138 (eww-score-readability dom) 139 (shr-insert-document (eww-highest-readability dom)) 140 (decode-coding-region (point-min) (point-max) 'utf-8) 141 (funcall 142 cb (buffer-substring-no-properties 143 (point-min) (point-max))))) 144 (error (funcall cb (format "Error: Request failed with error data:\n%S" 145 errdata))))) 146 tool-cb (format "Fetch for \"%s\"" url))) 147 148 (provide 'llm-tools-web)