diff options
| -rw-r--r-- | lisp/mastodon-media.el | 34 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 5 | ||||
| -rw-r--r-- | test/mastodon-media-tests.el | 63 |
3 files changed, 67 insertions, 35 deletions
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index f7386c6..457628f 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -292,21 +292,27 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type) "Return the string to be written that renders the image at MEDIA-URL. -FULL-REMOTE-URL is used for `shr-browse-image'." - (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) - " ")) +FULL-REMOTE-URL is used for `shr-browse-image'. +TYPE is the attachment's type field on the server." + (let ((help-echo + "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) + (concat + (propertize "[img]" + 'media-url media-url + 'media-state 'needs-loading + 'media-type 'media-link + 'mastodon-media-type type + 'display (create-image mastodon-media--generic-broken-image-data nil t) + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (string= type "image") + help-echo + (concat help-echo "\ntype: " type))) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 034f3b6..fbebd69 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -676,10 +676,11 @@ message is a link which unhides/hides the main body." (if (alist-get 'remote_url media-attachement) (alist-get 'remote_url media-attachement) ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement)))) + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering - preview-url remote-url) ; 2nd arg for shr-browse-url + preview-url remote-url type) ; 2nd arg for shr-browse-url (concat "Media::" preview-url "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 6168aaf..0e1152a 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -21,25 +21,50 @@ (ert-deftest mastodon-media--get-media-link-rendering () "Should return text with all expected properties." (with-mock - (mock (create-image * nil t) => :mock-image) - - (let* ((mastodon-media--preview-max-height 123) - (result - (mastodon-media--get-media-link-rendering "http://example.org/img.png" - "http://example.org/remote/img.png")) - (result-no-properties (substring-no-properties result)) - (properties (text-properties-at 0 result))) - (should (string= "[img] " result-no-properties)) - (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) - (should (eq 'needs-loading (plist-get properties 'media-state))) - (should (eq 'media-link (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display))) - (should (eq 'highlight (plist-get properties 'mouse-face))) - (should (eq 'image (plist-get properties 'mastodon-tab-stop))) - (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) - (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) - (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" - (plist-get properties 'help-echo)))))) + (mock (create-image * nil t) => :mock-image) + (let* ((mastodon-media--preview-max-height 123) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png" + "image")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) + (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) + (should (string= "image" (plist-get properties 'mastodon-media-type))) + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" + (plist-get properties 'help-echo)))))) + +(ert-deftest mastodon-media:get-media-link-rendering-gif () + "Should return text with all expected properties." + (with-mock + (mock (create-image * nil t) => :mock-image) + (let* ((mastodon-media--preview-max-height 123) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png" + "gifv")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) + (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) + (should (string= "gifv" (plist-get properties 'mastodon-media-type))) + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview\ntype: gifv" + (plist-get properties 'help-echo)))))) (ert-deftest mastodon-media--load-image-from-url-avatar-with-imagemagic () "Should make the right call to url-retrieve." |