diff options
| -rw-r--r-- | lisp/mastodon-media.el | 23 | ||||
| -rw-r--r-- | test/mastodon-media-tests.el | 179 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 2 |
3 files changed, 195 insertions, 9 deletions
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 734e11f..d1ec871 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -1,4 +1,4 @@ -;;; mastodon-media.el --- Functions for inlining Mastodon media -*- lexical-binding: t -*- +;;; mastodon-media.el --- Functions for inlining Mastodon media ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen <johnson.denen@gmail.com> @@ -161,9 +161,11 @@ IMAGE-URL is the URL that was retrieved. MEDIA-TYPE is a symbol and either 'avatar or 'media-link." ;; TODO: Cache the avatars (let ((image-options (when (image-type-available-p 'imagemagick) - (pcase media-type - ('avatar `(:height ,mastodon-avatar-height)) - ('media-link `(:max-height ,mastodon-preview-max-height)))))) + (cond + ((eq media-type 'avatar) + `(:height ,mastodon-avatar-height)) + ((eq media-type 'media-link) + `(:max-height ,mastodon-preview-max-height)))))) (url-retrieve url #'mastodon-media--process-image-response (list (copy-marker start) image-options region-length url)))) @@ -182,11 +184,14 @@ found." ;; do nothing - the loop will proceed ) (when next-pos - (pcase (get-text-property next-pos 'media-type) - ;; Avatars are just one character in the buffer - ('avatar (list next-pos (+ next-pos 1) 'avatar)) + (let ((media-type (get-text-property next-pos 'media-type))) + (cond + ;; Avatars are just one character in the buffer + ((eq media-type 'avatar) + (list next-pos (+ next-pos 1) 'avatar)) ;; Media links are 5 character ("[img]") - ('media-link (list next-pos (+ next-pos 5) 'media-link)))))) + ((eq media-type 'media-link) + (list next-pos (+ next-pos 5) 'media-link))))))) (defun mastodon-media--valid-link-p (link) "Checks to make sure that the missing string has @@ -204,7 +209,7 @@ not been returned." (while (setq line-details (mastodon-media--select-next-media-line)) (let* ((start (car line-details)) (end (cadr line-details)) - (media-type (caddr line-details)) + (media-type (cadr (cdr line-details))) (image-url (get-text-property start 'media-url))) (if (not (mastodon-media--valid-link-p image-url)) ;; mark it at least as not needing loading any more diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el new file mode 100644 index 0000000..9cd06b7 --- /dev/null +++ b/test/mastodon-media-tests.el @@ -0,0 +1,179 @@ +(require 'el-mock) + +(ert-deftest mastodon-media:get-avatar-rendering () + "Should return text with all expected properties." + (with-mock + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * 'imagemagick t :height 123) => :mock-image) + + (let* ((mastodon-avatar-height 123) + (result (mastodon-media--get-avatar-rendering "http://example.org/img.png")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= " " 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 'avatar (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display)))))) + +(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-preview-max-height 123) + (result (mastodon-media--get-media-link-rendering "http://example.org/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)))))) + +(ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () + "Should make the right call to url-retrieve." + (let ((url "http://example.org/image.png") + (mastodon-avatar-height 123)) + (with-mock + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * 'imagemagick t :height 123) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + url + #'mastodon-media--process-image-response + '(:my-marker (:height 123) 1 "http://example.org/image.png")) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) + +(ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic () + "Should make the right call to url-retrieve." + (let ((url "http://example.org/image.png")) + (with-mock + (mock (image-type-available-p 'imagemagick) => nil) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + url + #'mastodon-media--process-image-response + '(:my-marker () 1 "http://example.org/image.png")) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) + +(ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic () + "Should make the right call to url-retrieve." + (let ((url "http://example.org/image.png")) + (with-mock + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + "http://example.org/image.png" + #'mastodon-media--process-image-response + '(:my-marker (:max-height 321) 5 "http://example.org/image.png")) + => :called-as-expected) + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-media-link-rendering url) + ":rest")) + (let ((mastodon-preview-max-height 321)) + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) + +(ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic () + "Should make the right call to url-retrieve." + (let ((url "http://example.org/image.png")) + (with-mock + (mock (image-type-available-p 'imagemagick) => nil) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + "http://example.org/image.png" + #'mastodon-media--process-image-response + '(:my-marker () 5 "http://example.org/image.png")) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering url) + ":rest")) + (let ((mastodon-preview-max-height 321)) + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) + +(ert-deftest mastodon-media:process-image-response () + "Should process the HTTP response and adjust the source buffer." + (with-temp-buffer + (with-mock + (let ((source-buffer (current-buffer)) + used-marker + saved-marker) + (insert "start:") + (setq used-marker (copy-marker (point)) + saved-marker (copy-marker (point))) + ;; Mock needed for the preliminary image created in mastodon-media--get-avatar-rendering + (stub create-image => :fake-image) + (insert (mastodon-media--get-avatar-rendering "http://example.org/image.png") + ":end") + (with-temp-buffer + (insert "some irrelevant\n" + "http headers\n" + "which will be ignored\n\n" + "fake\nimage\ndata") + (goto-char (point-min)) + + (mock (create-image "fake\nimage\ndata" 'imagemagick t ':image :option) => :fake-image) + + (mastodon-media--process-image-response () used-marker '(:image :option) 1 "the-url") + + ;; the used marker has been unset: + (should (null (marker-position used-marker))) + ;; the media-state has been set to loaded and the image is being displayed + (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) + (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) + +(ert-deftest mastodon-media:inline-images () + "Should process all media in buffer." + (with-mock + ;; Stub needed for the test setup: + (stub create-image => '(image ignored)) + + (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar) + (with-temp-buffer + (insert "Some text before\n") + (setq marker-media-link (copy-marker (point))) + (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg") + " some more text ") + (setq marker-media-link-bad-url (copy-marker (point))) + (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png") + " some more text ") + (setq marker-false-media (copy-marker (point))) + (insert + ;; text that looks almost like an avatar but lacks the media-url property + (propertize "this won't be processed" + 'media-state 'needs-loading + 'media-type 'avatar) + "even more text ") + (setq marker-avatar (copy-marker (point))) + (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png") + " end of text") + (goto-char (point-min)) + + ;; stub for the actual test: + (stub mastodon-media--load-image-from-url) + (mastodon-media--inline-images) + + (should (eq 'loading (get-text-property marker-media-link 'media-state))) + (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state))) + (should (eq 'loading (get-text-property marker-avatar 'media-state))) + (should (eq 'needs-loading (get-text-property marker-false-media 'media-state))))))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 0d0458d..a91d6d5 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -122,6 +122,7 @@ (let ((mastodon-media-show-avatars-p t) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock + (stub create-image => '(image "fake data")) (mock (date-to-time timestamp) => '(22782 21551)) (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") @@ -204,6 +205,7 @@ (with-mock ;; We don't expect to use the toot's timestamp but the timestamp of the ;; reblogged toot: + (stub create-image => '(image "fake data")) (mock (date-to-time timestamp) => '(1 2)) (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) |