diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-media.el | 91 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 30 | ||||
| -rw-r--r-- | lisp/mastodon.el | 10 |
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'.") |