blob: cadf17526e0522646f92186e667ef71b66e90a71 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
;;; Web tools, taken from gptel-agent -*- lexical-binding: t; -*-
(defun llm-tools--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)
|
