From b2b8fe39b6863a1398bf7d50e9ee9bc3143d2fe2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 15:03:20 +0100 Subject: display icon for boosts will later follow rougier's lead on this, but just wanted to see how it looked --- lisp/mastodon-tl.el | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..e65d3a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -600,9 +600,6 @@ this just means displaying toot client." (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) (avatar-url (alist-get 'avatar account)) @@ -617,12 +614,14 @@ this just means displaying toot client." ;; displayed for an already boosted/favourited toot or as the result of ;; the toot having just been favourited/boosted. (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline "B")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-boost-char))) (when faved (mastodon-tl--format-faved-or-boosted-byline (mastodon-tl--return-fave-char))) (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-bookmark-char)))) ;; we remove avatars from the byline also, so that they also do not mess ;; with `mastodon-tl--goto-next-toot': (when (and mastodon-tl--show-avatars @@ -667,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -694,6 +693,14 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--return-boost-char () + "" + (cond + ((fontp (char-displayable-p #10r128257)) + "🔁") + (t + "B"))) + (defun mastodon-tl--return-fave-char () "" (cond @@ -704,6 +711,12 @@ this just means displaying toot client." (t "F"))) +(defun mastodon-tl--return-bookmark-char () + "" + (if (fontp (char-displayable-p #10r128278)) + "🔖" + "K")) + (defun mastodon-tl--format-edit-timestamp (timestamp) "Convert edit TIMESTAMP into a descriptive string." (let ((parsed (ts-human-duration -- cgit v1.2.3 From 143232e53d05bd42560d5ee9265bcb74245a29e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:02:01 +0100 Subject: remove trailing double space from sparator tl-tests: remove trailing double spaces from separator again --- lisp/mastodon-tl.el | 2 +- test/mastodon-tl-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..159c2cc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -685,7 +685,7 @@ this just means displaying toot client." (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n " 'face 'default)) + (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index f9b315c..a80c3ee 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -317,7 +317,7 @@ Strict-Transport-Security: max-age=31536000 byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - ")) +")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -418,7 +418,7 @@ Strict-Transport-Security: max-age=31536000 "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - ")) +")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) -- cgit v1.2.3 From 383f31d06cbf8327507aabfa71d6d6fd85618873 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:37:33 +0100 Subject: caption + props for media urls as well as actual media adds fun mastodon-tl--propertize-img-str-or-url, to prop both. --- lisp/mastodon-media.el | 35 +++++++++++------------------ lisp/mastodon-tl.el | 60 +++++++++++++++++++++++++++++++++++++------------- 2 files changed, 58 insertions(+), 37 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9715a6c..c783130 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -35,6 +35,8 @@ ;;; Code: (require 'url-cache) +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") + (defvar url-show-status) (defvar mastodon-tl--shr-image-map-replacement) @@ -306,34 +308,23 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url + type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") - (help-echo (if caption - (concat help-echo-base - "\n\"" - caption "\"") - help-echo-base))) + (help-echo (if caption + (concat help-echo-base + "\n\"" + caption "\"") + help-echo-base))) (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 (or (string= type "image") - (string= type nil) - (string= type "unknown")) ;handle borked images - help-echo - (concat help-echo "\nC-RET: play " type " with mpv"))) - " "))) + (mastodon-tl--propertize-img-str-or-url + "[img]" media-url full-remote-url type help-echo + (create-image mastodon-media--generic-broken-image-data nil t)) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 159c2cc..b74ac84 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1019,26 +1019,56 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string (mapconcat - (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat "Media::" preview-url "\n")))) - media-attachements ""))) + (media-string + (mapconcat + (lambda (media-attachement) + (let ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) + preview-url remote-url type caption nil 'shr-link) + "\n")))) + media-attachements ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type + help-echo &optional display face) + "Propertize an media placeholder string \"[img]\" or media URL. + +STR is the string to propertize, MEDIA-URL is the preview link, +FULL-REMOTE-URL is the link to the full resolution image on the +server, TYPE is the media type. +HELP-ECHO, DISPLAY, and FACE are the text properties to add." + (propertize str + 'media-url media-url + 'media-state (when (string= str "[img]") 'needs-loading) + 'media-type 'media-link + 'mastodon-media-type type + 'display display + 'face face + '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 (or (string= type "image") + (string= type nil) + (string= type "unknown")) ;handle borked images + help-echo + (concat help-echo "\nC-RET: play " type " with mpv")))) + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." -- cgit v1.2.3 From 021ae971f25a96428927cf5b3d82980b5464d820 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:50:51 +0100 Subject: set 'display to the image caption if we have one --- lisp/mastodon-tl.el | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b74ac84..aac5761 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1022,21 +1022,29 @@ message is a link which unhides/hides the main body." (media-string (mapconcat (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) + (let* ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement)) + (display-str (if caption + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering preview-url remote-url type caption) ; 2nd arg for shr-browse-url (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) - preview-url remote-url type caption nil 'shr-link) + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p -- cgit v1.2.3 From 3717b6cb86c8d0037ca49d4f500a44560c9ac5ae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 16:19:19 +0100 Subject: refactor tl--media-attachment + customize to display caption not URL --- lisp/mastodon-tl.el | 70 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 29 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aac5761..d907915 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -107,6 +107,13 @@ By default fixed width fonts are used." :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) +(defcustom mastodon-tl--display-caption-not-url-when-no-media t + "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." + :group 'mastodon-tl + :type 'boolean) + (defvar-local mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -1018,40 +1025,45 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." - (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string - (mapconcat - (lambda (media-attachement) - (let* ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement)) - (display-str (if caption - (concat "Media:: " caption) - (concat "Media:: " preview-url)))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat - (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) ;; string - preview-url remote-url type caption - display-str ;; display - ;; FIXME: shr-link underlining is awful for captions with - ;; newlines, as the underlining runs to the edge of the - ;; frame even if the text doesn' - 'shr-link) - "\n")))) - media-attachements ""))) + (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) + (media-string (mapconcat #'mastodon-tl--media-attachment + media-attachments ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--media-attachment (media-attachment) + "Return a propertized string for MEDIA-ATTACHMENT." + (let* ((preview-url + (alist-get 'preview_url media-attachment)) + (remote-url + (or (alist-get 'remote_url media-attachment) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachment))) + (type (alist-get 'type media-attachment)) + (caption (alist-get 'description media-attachment)) + (display-str + (if (and mastodon-tl--display-caption-not-url-when-no-media + caption) + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) + (if mastodon-tl--display-media-p + ;; return placeholder [img]: + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + ;; return URL/caption: + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) + "\n")))) + (defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type help-echo &optional display face) "Propertize an media placeholder string \"[img]\" or media URL. -- cgit v1.2.3