Show users' avatars plus other image work.

- Shows users' avatars (makes only sense if Emacs is built with imagemagick)
- Scales media attachement previews to a max size (if Emacs is built with imagemagick)
- Enable cacheing of image fetches

Known issues:
- We should really cache the avatars to avoid having multiple identical images in memory.

3 files changed, 86 insertions, 45 deletions

diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 23fbc79..93ff1b7 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -1,4 +1,4 @@
-;;; mastodon-media.el --- Functions for inlining Mastodon media
+;;; mastodon-media.el --- Functions for inlining Mastodon media  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <johnson.denen@gmail.com>
@@ -32,66 +32,85 @@
 
 ;;; Code:
 (require 'mastodon-http  nil t)
+(require 'mastodon)
 
 (defgroup mastodon-media nil
   "Inline Mastadon media."
   :prefix "mastodon-media-"
   :group 'mastodon)
 
-(defun mastodon-media--image-from-url (url)
-  "Takes a URL and return an image."
-  (let ((buffer (url-retrieve-synchronously url)))
+(defvar mastodon-media-show-avatars-p
+  (image-type-available-p 'imagemagick)
+  "A boolean value stating whether to show avatars in timelines.")
+
+(defun mastodon-media--image-from-url (url media-type)
+  "Takes a URL and MEDIA-TYPE and return an image.
+
+MEDIA-TYPE is a symbol and either 'avatar or 'media-link."
+  ;; TODO: Cache the avatars 
+  (let* ((url-automatic-caching t)
+         (buffer (url-retrieve-synchronously url))
+         (image-options (when (image-type-available-p 'imagemagick)
+                          (case media-type
+                            ('avatar `(:height ,mastodon-avatar-height))
+                            ('media-link `(:max-height ,mastodon-preview-max-height))))))
     (unwind-protect
         (let ((data (with-current-buffer buffer
                       (goto-char (point-min))
                       (search-forward "\n\n")
                       (buffer-substring (point) (point-max)))))
-          (insert "\n")
-          (insert-image (create-image data nil t)))
+          (apply #'create-image data (when image-options 'imagemagick)
+                 t image-options))
       (kill-buffer buffer))))
 
 (defun mastodon-media--select-next-media-line ()
-  "Find coordinates of a line that contains `Media_Links::'
-
-Returns the cons of (`start' . `end') points of that line or nil no
-more media links were found."
-  (let ((foundp (search-forward-regexp "Media_Link::" nil t)))
-    (when foundp
-      (let ((start (progn (move-beginning-of-line nil) (point)))
-            (end (progn (move-end-of-line nil) (point))))
-        (cons start end)))))
+  "Find coordinates of the next media to load.
+
+Returns the list of (`start' . `end', `media-symbol') points of
+that line and string found or nil no more media links were
+found."
+  (let ((next-pos (point)))
+    (while (and (setq next-pos (next-single-property-change next-pos 'media-state))
+                (or (not (eq 'needs-loading (get-text-property next-pos 'media-state)))
+                    (null (get-text-property next-pos 'media-url))
+                    (null (get-text-property next-pos 'media-type))))
+      ;; do nothing - the loop will proceed
+      )
+    (when next-pos
+      (case (get-text-property next-pos 'media-type)
+        ;; Avatars are just one character in the buffer
+        ('avatar (list next-pos (+ next-pos 1) 'avatar))
+        ;; Media links are 5 character ("[img]")
+        ('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
 
 not been returned."
   (let ((missing "/files/small/missing.png"))
-    (not (equal link missing))))
-
-(defun mastodon-media--line-to-link (line-points)
-  "Returns the url of the media link given at the given point.
-
-`LINE-POINTS' is a cons of (`start' . `end') positions of the line with
-the `Media_Link:: <url>' text."
-  (replace-regexp-in-string "Media_Link:: " ""
-                            (buffer-substring
-                             (car line-points)
-                             (cdr line-points))))
-
-(defun mastodon-media--delete-line (line)
-  "Deletes the current media line"
-  (delete-region (car line) (cdr line)))
+    (and link
+         (not (equal link missing)))))
 
 (defun mastodon-media--inline-images ()
   "Find all `Media_Links:' in the buffer replacing them with the referenced image."
   (interactive)
   (goto-char (point-min))
-  (let (line-coordinates)
-    (while (setq line-coordinates (mastodon-media--select-next-media-line))
-      (let ((link (mastodon-media--line-to-link line-coordinates)))
-        (when (mastodon-media--valid-link-p link)
-          (mastodon-media--image-from-url link)
-          (mastodon-media--delete-line line-coordinates))))))
+  (let (line-details)
+    (while (setq line-details (mastodon-media--select-next-media-line))
+      (let* ((start (car line-details))
+             (end (cadr line-details))
+             (media-type (caddr line-details))
+             (image-url (get-text-property start 'media-url)))
+       
+        (if (not (mastodon-media--valid-link-p image-url))
+            (put-text-property start end 'media-state 'invalid-url)
+          (put-text-property start end 'media-state 'loading)
+          (let ((image (mastodon-media--image-from-url image-url media-type)))
+            (put-text-property start end 'media-state 'loaded)
+            (put-text-property start end
+                               'display (or
+                                         image
+                                         (format "Failed to load %s" image-url)))))))))
 
 (provide 'mastodon-media)
 ;;; mastodon-media.el ends here
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index e025a6e..1a5d9ae 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -104,8 +104,18 @@ Optionally start from POS."
   "Propertize author of TOOT."
   (let* ((account (cdr (assoc 'account toot)))
          (handle (cdr (assoc 'acct account)))
-         (name (cdr (assoc 'display_name account))))
+         (name (cdr (assoc 'display_name account)))
+         (avatar-url (cdr (assoc 'avatar account))))
     (concat
+     (when mastodon-media-show-avatars-p
+       ;; We use just an empty space as the textual representation.
+       ;; This is what a user will see on a non-graphical display
+       ;; where not showing an avatar at all is preferable.
+       (concat (propertize " "
+                           'media-url avatar-url
+                           'media-state 'needs-loading
+                           'media-type 'avatar)
+               " "))     
      (propertize name 'face 'warning)
      " (@"
      handle
@@ -177,14 +187,16 @@ also render the html"
 
 (defun mastodon-tl--media (toot)
   "Retrieve a media attachment link for TOOT if one exists."
-  (let ((media (mastodon-tl--field 'media_attachments toot)))
-        (mapconcat
-         (lambda (media-preview)
-           (concat "Media_Link:: "
-                   (mastodon-tl--set-face
-                    (cdr (assoc 'preview_url media-preview))
-                    'mouse-face nil)))
-         media "\n")))
+  (let ((media-attachements (mastodon-tl--field 'media_attachments toot)))
+    (mapconcat
+     (lambda (media-attachement)
+       (let ((preview-url (cdr (assoc 'preview_url media-attachement))))
+         (concat (propertize "[img]"
+                             'media-url preview-url
+                             'media-state 'needs-loading
+                             'media-type 'media-link)
+                 " ")))
+     media-attachements "")))
 
 (defun mastodon-tl--content (toot)
   "Retrieve text content from TOOT."
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 947cc6a..0dd7f10 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -60,6 +60,16 @@ Use. e.g. \"%c\" for your locale's date and time format."
   :group 'mastodon
   :type 'string)
 
+(defcustom mastodon-avatar-height 30
+  "Height of the user avatar images (if shown)."
+  :group 'mastodon
+  :type 'integer)
+
+(defcustom mastodon-preview-max-height 250
+  "Max height of any media attachment preview to be shown."
+  :group 'mastodon
+  :type 'integer)
+
 (defvar mastodon-mode-map
   (make-sparse-keymap)
   "Keymap for `mastodon-mode'.")