Merge pull request #121 from hdurer/async-image-loading

Async image loading and avatars

2 files changed, 227 insertions, 6 deletions

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 e89d313..a91d6d5 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -105,7 +105,8 @@
 
 (ert-deftest mastodon-tl--byline-regular ()
   "Should format the regular toot correctly."
-  (let ((timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot))))
+  (let ((mastodon-media-show-avatars-p nil)
+        (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot))))
     (with-mock
       (mock (date-to-time timestamp) => '(22782 21551))
       (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22")
@@ -116,9 +117,25 @@
  | Account 42 (@acct42@example.space) 2999-99-99 00:11:22
   ------------")))))
 
+(ert-deftest mastodon-tl--byline-regular-with-avatar ()
+  "Should format the regular toot correctly."
+  (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")
+
+      (should (string= (substring-no-properties
+                        (mastodon-tl--byline mastodon-tl-test-base-toot))
+                       "
+ |   Account 42 (@acct42@example.space) 2999-99-99 00:11:22
+  ------------")))))
+
 (ert-deftest mastodon-tl--byline-boosted ()
   "Should format the boosted toot correctly."
-  (let* ((toot (cons '(reblogged . t) mastodon-tl-test-base-toot))
+  (let* ((mastodon-media-show-avatars-p nil)
+         (toot (cons '(reblogged . t) mastodon-tl-test-base-toot))
          (timestamp (cdr (assoc 'created_at toot))))
     (with-mock
       (mock (date-to-time timestamp) => '(22782 21551))
@@ -131,7 +148,8 @@
 
 (ert-deftest mastodon-tl--byline-favorited ()
   "Should format the favourited toot correctly."
-  (let* ((toot (cons '(favourited . t) mastodon-tl-test-base-toot))
+  (let* ((mastodon-media-show-avatars-p nil)
+         (toot (cons '(favourited . t) mastodon-tl-test-base-toot))
          (timestamp (cdr (assoc 'created_at toot))))
     (with-mock
       (mock (date-to-time timestamp) => '(22782 21551))
@@ -145,7 +163,8 @@
 
 (ert-deftest mastodon-tl--byline-boosted/favorited ()
   "Should format the boosted & favourited toot correctly."
-  (let* ((toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-toot))
+  (let* ((mastodon-media-show-avatars-p nil)
+         (toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-toot))
          (timestamp (cdr (assoc 'created_at toot))))
     (with-mock
       (mock (date-to-time timestamp) => '(22782 21551))
@@ -158,7 +177,8 @@
 
 (ert-deftest mastodon-tl--byline-reblogged ()
   "Should format the reblogged toot correctly."
-  (let* ((toot mastodon-tl-test-base-boosted-toot)
+  (let* ((mastodon-media-show-avatars-p nil)
+         (toot mastodon-tl-test-base-boosted-toot)
          (original-toot (cdr (assoc 'reblog mastodon-tl-test-base-boosted-toot)))
          (timestamp (cdr (assoc 'created_at toot)))
          (original-timestamp (cdr (assoc 'created_at original-toot))))
@@ -175,9 +195,31 @@
  | Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time
   ------------")))))
 
+(ert-deftest mastodon-tl--byline-reblogged-with-avatars ()
+  "Should format the reblogged toot correctly."
+  (let* ((mastodon-media-show-avatars-p t)
+         (toot mastodon-tl-test-base-boosted-toot)
+         (original-toot (cdr (assoc 'reblog mastodon-tl-test-base-boosted-toot)))
+         (timestamp (cdr (assoc 'created_at toot)))
+         (original-timestamp (cdr (assoc 'created_at original-toot))))
+    (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))
+      (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time")
+
+      (should (string= (substring-no-properties (mastodon-tl--byline toot))
+                      "
+ |   Account 42 (@acct42@example.space) Boosted   Account 43 (@acct43@example.space) original time
+  ------------")))))
+
 (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited ()
   "Should format the reblogged toot that was also boosted & favoritedcorrectly."
-  (let* ((toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-boosted-toot))
+  (let* ((mastodon-media-show-avatars-p nil)
+         (toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-boosted-toot))
          (original-toot (cdr (assoc 'reblog mastodon-tl-test-base-boosted-toot)))
          (timestamp (cdr (assoc 'created_at toot)))
          (original-timestamp (cdr (assoc 'created_at original-toot))))