branch: elpa/gptel
commit 0720b8087a6c4958e00e584ca484fea972f904cd
Author: Karthik Chikmagalur <[email protected]>
Commit: Karthik Chikmagalur <[email protected]>
gptel-org: Make Org link validation comprehensive
* gptel-org.el (gptel-org--annotate-links): Make link validation
more comprehensive by checking for everything about a link -- we
want to ensure that a link will be sent under the current gptel
configuration iff jit-lock indicates that it will.
This means doing all the link checks: file readability, binary
file check, mimetype support, url capability and so on inside
jit-lock. This check is in the process of being optimized.
* gptel-request.el (gptel--link-type-cache): Cache to store
determination of binary status of files. This is required
because:
1. We read 512 bytes from the file in `gptel--file-binary-p' to
determine if the file is binary-encoded.
2. When validating links, this check runs via jit-lock, and can
thus run too many times. In general it's a bad idea to do file
access inside jit-lock.
3. To get around this we cache the binary status of files we've
seen.
---
gptel-org.el | 86 ++++++++++++++++++++++++++++++++++++++------------------
gptel-request.el | 5 ++++
2 files changed, 64 insertions(+), 27 deletions(-)
diff --git a/gptel-org.el b/gptel-org.el
index 7caae2a9eb8..9c59e6c7194 100644
--- a/gptel-org.el
+++ b/gptel-org.el
@@ -37,6 +37,7 @@
(defvar gptel-model)
(defvar gptel-temperature)
(defvar gptel-max-tokens)
+(defvar gptel--link-type-cache)
(defvar org-link-angle-re)
(defvar org-link-bracket-re)
@@ -403,41 +404,72 @@ for inclusion into the user prompt for the gptel request."
(nreverse parts)))
(defun gptel-org--annotate-links (beg end)
+ "Annotate links whose sources are eligible to be sent with `gptel-send.'
+
+Search between BEG and END."
(when gptel-track-media
(save-excursion
- (goto-char beg)
- (forward-line -1)
- (let ((link-ovs (cl-delete-if-not
- (lambda (o) (overlay-get o 'gptel-track-media))
- (overlays-in (point) end))))
+ (goto-char beg) (forward-line -1)
+ (let ((link-ovs (cl-loop for o in (overlays-in (point) end)
+ if (overlay-get o 'gptel-track-media)
+ collect o into os finally return os)))
(while (re-search-forward gptel-org--link-regex end t)
- (if-let* ((link (org-element-context))
- (from (org-element-begin link))
- (to (org-element-end link))
- ((gptel-org--link-standalone-p link))
- (type (org-element-property :type link))
- ;; (path (org-element-property :path link))
- ((member type `("attachment" "file"
- ,@(and (gptel--model-capable-p 'url)
- '("http" "https" "ftp"))))))
- (if-let* ((ov (cl-loop
- for o in (overlays-in from to)
- if (overlay-get o 'gptel-track-media)
- return o)))
+ (unless (gptel--in-response-p (1- (point)))
+ (let* ((link (org-element-context))
+ (from (org-element-begin link))
+ (to (org-element-end link))
+ (ov (cl-loop for o in (overlays-in from to)
+ if (overlay-get o 'gptel-track-media)
+ return o)))
+ (if ov ; Ensure overlay over each link
(progn (move-overlay ov from to)
(setq link-ovs (delq ov link-ovs)))
(setq ov (make-overlay from to nil t))
(overlay-put ov 'gptel-track-media t)
- (overlay-put ov 'before-string
- (concat
- (propertize "SEND" 'face '( :inherit success
:box t
- :height 0.9 :weight
semi-light))
- (propertize " @" 'face 'success)))
- (overlay-put ov 'help-echo
- (propertize "Sending file with gptel requests"))
+ (overlay-put ov 'evaporate t)
(overlay-put ov 'priority -80))
- (dolist (o (overlays-in from to))
- (when (overlay-get o 'gptel-track-media) (delete-overlay o)))))
+ ;; Check if link will be sent, and annotate accordingly
+ (if-let* ((type (org-element-property :type link))
+ (filep (member type `("attachment" "file"
+ ,@(and (gptel--model-capable-p
'url)
+ '("http" "https"
"ftp")))))
+ (placementp (gptel-org--link-standalone-p link))
+ (path (org-element-property :path link))
+ (readablep (or (member type '("http" "https" "ftp"))
+ (file-remote-p path)
+ (file-readable-p path)))
+ (supportedp
+ (or (not (cdr (with-memoization
+ (alist-get (expand-file-name path)
+ gptel--link-type-cache
+ nil nil #'string=)
+ (cons t (gptel--file-binary-p
path)))))
+ (gptel--model-mime-capable-p
+ (mailcap-file-name-to-mime-type path)))))
+ (progn
+ (overlay-put
+ ov 'before-string
+ (concat (propertize "SEND" 'face '(:inherit success
:height 0.9))
+ (if (display-graphic-p)
+ (propertize " " 'display '(space :width 0.5))
" ")))
+ (overlay-put ov 'help-echo
+ (format "Sending file %s with gptel requests"
path)))
+ (overlay-put ov 'before-string
+ (concat (propertize "!" 'face '(:inherit error))
+ (propertize " " 'display '(space :width
0.3))))
+ (overlay-put
+ ov 'help-echo
+ (concat
+ "Only sending link text with gptel requests, "
+ "link will not be followed to source.\n\nReason: "
+ (cond
+ ((not filep) "Not a supported link type \
+(Only \"file\" or \"attachment\" are supported)")
+ ((not placementp)
+ "Not a standalone link. (Separate link from text around
it.)")
+ ((not readablep) (format "File %s is not readable" path))
+ ((not supportedp) (format "%s does not support binary file
%s"
+ gptel-model path)))))))))
(and link-ovs (mapc #'delete-overlay link-ovs))))
`(jit-lock-bounds ,beg . ,end)))
diff --git a/gptel-request.el b/gptel-request.el
index cabdc3055f0..4295aaa7f6c 100644
--- a/gptel-request.el
+++ b/gptel-request.el
@@ -780,6 +780,11 @@ See `gptel-backend'."
"-XPOST" "-y7200" "-Y1" "-D-"))
"Arguments always passed to Curl for gptel queries.")
+(defvar gptel--link-type-cache nil
+ "Cache of checks for binary files. Each alist entry maps an absolute
+file path to a cons cell of the form (t . binaryp), where binaryp is
+non-nil if the file is binary-encoded.")
+
;;; Utility functions
