branch: elpa/jabber
commit 0d11b2911e29e0e1cee3d0c51038ebfb8df284db
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
chat: Load undisplayed image URLs inline with RET
---
lisp/jabber-chat.el | 68 ++++++++++++++++++++++------
tests/jabber-test-chat.el | 112 ++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 167 insertions(+), 13 deletions(-)
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index 5e8ee4f456..8c6cfb683d 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -125,19 +125,20 @@ t means auto-display in every chat buffer.
nil means never fetch automatically.
The symbol `roster' means auto-display only in one-to-one chats
whose peer is on the roster; in MUC buffers and chats with
-unknown peers, image URLs stay clickable.
+unknown peers, image URLs stay clickable and RET loads them.
Automatic display is further limited to the image types in
`jabber-chat-image-auto-types' and the size limit in
`jabber-image-max-bytes'."
:type '(choice (const :tag "All chat buffers" t)
(const :tag "Roster contacts only" roster)
- (const :tag "Never" nil)))
+ (const :tag "Never (load with RET)" nil)))
(defcustom jabber-chat-image-auto-types '(png jpeg gif webp)
"Image types eligible for automatic inline display.
The type is detected from the downloaded bytes, never from the
-URL. Images of other types stay clickable URLs."
+URL. Images of other types stay clickable URLs; loading them
+with RET bypasses this list but not `jabber-image-max-bytes'."
:type '(repeat (symbol :tag "Image type")))
(defface jabber-rare-time-face
@@ -1701,15 +1702,55 @@ When nil, use the last download directory from this
session or
(setq jabber-chat-last-download-directory
(file-name-directory dest)))
-(defun jabber-chat-url-action-at-point ()
- "Download the file or image URL at point.
-Handles aesgcm:// URLs by decrypting after download."
- (interactive)
- (let ((url (or (get-text-property (point) 'jabber-chat-file-url)
- (get-text-property (point) 'jabber-chat-image-url))))
- (unless url
- (user-error "No downloadable URL at point"))
- (jabber-chat-download-url url)))
+(defun jabber-chat--image-url-bounds (&optional position)
+ "Return (BEG END URL) for the image URL at POSITION, or nil.
+POSITION defaults to point."
+ (let* ((position (or position (point)))
+ (url (get-text-property position 'jabber-chat-image-url)))
+ (when url
+ (list (or (previous-single-property-change
+ (1+ position) 'jabber-chat-image-url)
+ (point-min))
+ (or (next-single-property-change
+ position 'jabber-chat-image-url)
+ (point-max))
+ url))))
+
+(defun jabber-chat--load-image-at-point ()
+ "Fetch and display the image URL at point inline.
+Bypasses `jabber-chat-display-images' and
+`jabber-chat-image-auto-types' as an explicit user action, but
+not `jabber-image-max-bytes'."
+ (pcase-let ((`(,beg ,end ,url) (jabber-chat--image-url-bounds)))
+ (cond ((null url)
+ (user-error "No image URL at point"))
+ ((not (display-graphic-p))
+ (user-error "Cannot display images on a text terminal"))
+ ((equal (jabber-chat--image-fetch-state beg) url)
+ (message "Image fetch already in progress"))
+ ((jabber-chat--restore-cached-image url beg end))
+ (t
+ (let ((inhibit-read-only t))
+ (jabber-chat--start-image-fetch url beg end nil))
+ (message "Loading image...")))))
+
+(defun jabber-chat-url-action-at-point (&optional arg)
+ "Load the image URL at point inline, or download the URL at point.
+An image URL that is not yet displayed is fetched and shown
+inline. Displayed images, file URLs, and any URL with prefix
+ARG are downloaded to a file, decrypting aesgcm:// URLs after
+download."
+ (interactive "P")
+ (let ((file-url (get-text-property (point) 'jabber-chat-file-url))
+ (image-url (get-text-property (point) 'jabber-chat-image-url)))
+ (cond (file-url
+ (jabber-chat-download-url file-url))
+ ((null image-url)
+ (user-error "No downloadable URL at point"))
+ ((or arg (get-text-property (point) 'display))
+ (jabber-chat-download-url image-url))
+ (t
+ (jabber-chat--load-image-at-point)))))
(defun jabber-chat-download-url (url)
"Prompt to download URL to a local file.
@@ -1919,7 +1960,8 @@ Must be called with BUFFER current."
(defun jabber-chat--replace-url-with-image (image url beg end buffer)
"Display fetched IMAGE over URL text between markers BEG and END.
Cache IMAGE by URL. When IMAGE is nil, mark the URL text in
-BUFFER as a failed fetch so the automatic scan does not retry it."
+BUFFER as a failed fetch so the automatic scan does not retry it;
+manual loading with RET still may."
(when image
(jabber-chat--cache-image url image))
(when (buffer-live-p buffer)
diff --git a/tests/jabber-test-chat.el b/tests/jabber-test-chat.el
index 453627e6d6..bc589e5560 100644
--- a/tests/jabber-test-chat.el
+++ b/tests/jabber-test-chat.el
@@ -1090,6 +1090,118 @@ calls and `url', `beg' and `end' to the URL and its
bounds."
(should (equal (cons 1 (point-max))
(jabber-chat--isolate-image-url 1 (point-max))))))
+;;; Group 16: manual image load with RET
+
+(ert-deftest jabber-test-chat-image-url-bounds-at-point ()
+ (with-temp-buffer
+ (insert "x")
+ (insert (propertize jabber-test-chat--scan-url
+ 'jabber-chat-image-url jabber-test-chat--scan-url))
+ (goto-char 3)
+ (should (equal (jabber-chat--image-url-bounds)
+ (list 2 (point-max) jabber-test-chat--scan-url)))))
+
+(ert-deftest jabber-test-chat-image-url-bounds-nil-without-property ()
+ (with-temp-buffer
+ (insert "no url here")
+ (goto-char (point-min))
+ (should-not (jabber-chat--image-url-bounds))))
+
+(defmacro jabber-test-chat--with-manual-load-buffer (&rest body)
+ "Run BODY in a temp buffer with point on an undisplayed image URL.
+Bind `fetches' to recorded `jabber-chat--start-image-fetch' calls
+and `url' to the URL; `display-graphic-p' is stubbed to t."
+ `(with-temp-buffer
+ (let ((fetches nil)
+ (url jabber-test-chat--scan-url))
+ (insert (propertize url 'jabber-chat-image-url url))
+ (goto-char (point-min))
+ (cl-letf (((symbol-function 'jabber-chat--start-image-fetch)
+ (lambda (&rest args) (push args fetches)))
+ ((symbol-function 'display-graphic-p)
+ (lambda (&optional _) t)))
+ ,@body))))
+
+(ert-deftest jabber-test-chat-manual-load-bypasses-allowlist ()
+ "Manual load passes nil ALLOWED-TYPES to the fetch."
+ (jabber-test-chat--with-manual-load-buffer
+ (jabber-chat--load-image-at-point)
+ (should (equal fetches (list (list url 1 (point-max) nil))))))
+
+(ert-deftest jabber-test-chat-manual-load-blocked-while-in-flight ()
+ (jabber-test-chat--with-manual-load-buffer
+ (put-text-property 1 (point-max) 'jabber-chat-image-fetching url)
+ (jabber-chat--load-image-at-point)
+ (should (null fetches))))
+
+(ert-deftest jabber-test-chat-manual-load-retries-after-failure ()
+ (jabber-test-chat--with-manual-load-buffer
+ (put-text-property 1 (point-max) 'jabber-chat-image-fetching 'failed)
+ (jabber-chat--load-image-at-point)
+ (should (= 1 (length fetches)))))
+
+(ert-deftest jabber-test-chat-manual-load-uses-cache ()
+ (jabber-test-chat--with-manual-load-buffer
+ (unwind-protect
+ (progn
+ (jabber-chat--cache-image url '(image :type png))
+ (jabber-chat--load-image-at-point)
+ (should (null fetches))
+ (should (get-text-property 1 'display)))
+ (remhash url jabber-chat--image-cache))))
+
+(ert-deftest jabber-test-chat-ret-loads-undisplayed-image ()
+ (jabber-test-chat--with-manual-load-buffer
+ (cl-letf (((symbol-function 'jabber-chat-download-url)
+ (lambda (_) (error "Should not download"))))
+ (jabber-chat-url-action-at-point)
+ (should (= 1 (length fetches))))))
+
+(ert-deftest jabber-test-chat-ret-downloads-displayed-image ()
+ (jabber-test-chat--with-manual-load-buffer
+ (let ((downloads nil))
+ (cl-letf (((symbol-function 'jabber-chat-download-url)
+ (lambda (u) (push u downloads))))
+ (put-text-property 1 (point-max) 'display '(image :type png))
+ (jabber-chat-url-action-at-point)
+ (should (equal downloads (list url)))
+ (should (null fetches))))))
+
+(ert-deftest jabber-test-chat-ret-prefix-downloads-undisplayed ()
+ (jabber-test-chat--with-manual-load-buffer
+ (let ((downloads nil))
+ (cl-letf (((symbol-function 'jabber-chat-download-url)
+ (lambda (u) (push u downloads))))
+ (jabber-chat-url-action-at-point '(4))
+ (should (equal downloads (list url)))
+ (should (null fetches))))))
+
+(ert-deftest jabber-test-chat-ret-prefers-file-url ()
+ (jabber-test-chat--with-manual-load-buffer
+ (let ((downloads nil))
+ (cl-letf (((symbol-function 'jabber-chat-download-url)
+ (lambda (u) (push u downloads))))
+ (put-text-property 1 (point-max) 'jabber-chat-file-url
+ "https://example.com/doc.pdf";)
+ (jabber-chat-url-action-at-point)
+ (should (equal downloads '("https://example.com/doc.pdf";)))
+ (should (null fetches))))))
+
+(ert-deftest jabber-test-chat-manual-load-tty-errors ()
+ "Batch Emacs is not graphical, so the tty branch errors."
+ (with-temp-buffer
+ (let ((url jabber-test-chat--scan-url))
+ (insert (propertize url 'jabber-chat-image-url url))
+ (goto-char (point-min))
+ (should-error (jabber-chat--load-image-at-point)
+ :type 'user-error))))
+
+(ert-deftest jabber-test-chat-ret-errors-without-url ()
+ (with-temp-buffer
+ (insert "plain text")
+ (goto-char (point-min))
+ (should-error (jabber-chat-url-action-at-point) :type 'user-error)))
+
(provide 'jabber-test-chat)
;;; jabber-test-chat.el ends here
