diff options
| -rw-r--r-- | lisp/mastodon-media.el | 16 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 151 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 5 |
3 files changed, 139 insertions, 33 deletions
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 4e4a15d..9441bdb 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -272,6 +272,20 @@ Replace them with the referenced image." (put-text-property start end 'media-state 'loading) (mastodon-media--load-image-from-url image-url media-type start (- end start)))))))) + ;; (mastodon-media--moving-image-overlay start end))))))) + +;; (defun mastodon-media--moving-image-overlay (start end) +;; "Add play symbol overlay to moving image media items." +;; (let ((ov (make-overlay start end)) +;; (type (get-text-property start 'mastodon-media-type))) +;; (when (or (equal type "gifv") +;; (equal type "video")) +;; (overlay-put +;; ov +;; 'after-string +;; (propertize " " +;; 'face +;; '((:height 1.5 :inherit 'font-lock-comment-face))))))) (defun mastodon-media--get-avatar-rendering (avatar-url) "Return the string to be written that renders the avatar at AVATAR-URL." @@ -312,7 +326,7 @@ TYPE is the attachment's type field on the server." 'keymap mastodon-tl--shr-image-map-replacement 'help-echo (if (string= type "image") help-echo - (concat help-echo "\ntype: " type))) + (concat help-echo "\nC-RET: play " type " with mpv"))) " "))) (provide 'mastodon-media) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8921259..3b3b692 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -36,6 +36,8 @@ (require 'time-date) (require 'cl-lib) ; for cl-mapcar +(require 'mpv nil :no-error) + (autoload 'mastodon-auth--get-account-name "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") @@ -61,6 +63,8 @@ (autoload 'mastodon-notifications--get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive (autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(when (require 'mpv nil :no-error) + (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) (defvar mastodon-toot-timestamp-format) (defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this @@ -114,6 +118,16 @@ If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--timestamp-update-timer nil "The timer that, when set will scan the buffer to update the timestamps.") +(defun mastodon-tl--get-media-types (toot) + "Return a list of the media attachment types of the TOOT at point." + (let* (;(toot (mastodon-tl--property 'toot-json)) + (medias (or (alist-get 'media_attachments + (alist-get 'reblog toot)) + (alist-get 'media_attachments toot)))) + (mapcar (lambda (x) + (alist-get 'type x)) + medias))) + (defvar mastodon-tl--link-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'mastodon-tl--do-link-action-at-point) @@ -156,12 +170,20 @@ types of mastodon links and not just shr.el-generated ones.") (define-key map (kbd "u") 'mastodon-tl--update) ;; keep new my-profile binding; shr 'O' doesn't work here anyway (define-key map (kbd "O") 'mastodon-profile--my-profile) + (define-key map (kbd "<C-return>") 'mastodon-tl--mpv-play-video-at-point) (keymap-canonicalize map)) "The keymap to be set for shr.el generated image links. We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") +(defvar mastodon-tl--byline-link-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "<C-return>") 'mastodon-tl--mpv-play-video-from-byline) + (keymap-canonicalize map)) + "The keymap to be set for the author byline. +The idea is that you can play media without navigating to it.") + (defun mastodon-tl--next-tab-item () "Move to the next interesting item. @@ -292,6 +314,9 @@ Optionally start from POS." (mastodon-media--get-avatar-rendering avatar-url)) (propertize name 'face 'mastodon-display-name-face + ;; enable playing of videos when point is on byline: + 'attachments (mastodon-tl--get-attachments-for-byline toot) + 'keymap mastodon-tl--byline-link-keymap ;; echo faves count when point on post author name: ;; which is where --goto-next-toot puts point. 'help-echo @@ -300,29 +325,46 @@ Optionally start from POS." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - ;; TODO: Replace url browsing with native profile viewing - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--format-faves-count (toot) "Format a favorites, boosts, replies count for a TOOT. Used to help-echo when point is at the start of a byline, i.e. where `mastodon-tl--goto-next-toot' leaves point." - (let ((toot-to-count - (or - ;; simply praying this order works - (alist-get 'status toot) ; notifications timeline - (alist-get 'reblog toot) ; boosts - toot))) ; everything else - (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-count) - (alist-get 'reblogs_count toot-to-count) - (alist-get 'replies_count toot-to-count)))) + (let* ((toot-to-count + (or + ;; simply praying this order works + (alist-get 'status toot) ; notifications timeline + (alist-get 'reblog toot) ; boosts + toot)) ; everything else + (media-types (mastodon-tl--get-media-types toot)) + (format-faves (format "%s faves | %s boosts | %s replies" + (alist-get 'favourites_count toot-to-count) + (alist-get 'reblogs_count toot-to-count) + (alist-get 'replies_count toot-to-count))) + (format-media (when media-types + (format " | media: %s" + (mapconcat #'identity media-types " "))))) + (format "%s" (concat format-faves format-media)))) + +(defun mastodon-tl--get-attachments-for-byline (toot) + "Return a list of attachment URLs and types for TOOT." + (let ((media-attachments (mastodon-tl--field 'media_attachments toot))) + (mapcar + (lambda (attachement) + (let ((remote-url + (or (alist-get 'remote_url attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url attachement))) + (type (alist-get 'type attachement))) + `(:url ,remote-url :type ,type))) + media-attachments))) (defun mastodon-tl--byline-boosted (toot) "Add byline for boosted data from TOOT." @@ -419,20 +461,19 @@ By default it is `mastodon-tl--byline-boosted'" (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (visibility (mastodon-tl--field 'visibility toot))) (concat - ;; (propertize "\n | " 'face 'default) - (propertize + ;; Boosted/favourited markers are not part of the byline, so we don't + ;; propertize them with 'byline t', as per the rest. This ensures that + ;; `mastodon-tl--goto-next-toot' puts point on author-byline not on the + ;; (F) or (B) marker. Not propertizing like this makes the behaviour of + ;; these markers consistent whether they are displayed for an already + ;; boosted/favourited toot or the result of the toot having just been + ;; favourited/boosted. (concat (when boosted - (format - (propertize "(%s) " - 'help-echo - (mastodon-tl--format-faves-count toot)) - (propertize "B" 'face 'mastodon-boost-fave-face))) + (mastodon-tl--format-faved-or-boosted-byline "B")) (when faved - (format - (propertize "(%s) " - 'help-echo - (mastodon-tl--format-faves-count toot)) - (propertize "F" 'face 'mastodon-boost-fave-face))) + (mastodon-tl--format-faved-or-boosted-byline "F"))) + (propertize + (concat ;; we propertize help-echo format faves for author name ;; in `mastodon-tl--byline-author' (funcall author-byline toot) @@ -459,6 +500,12 @@ By default it is `mastodon-tl--byline-boosted'" 'boosted-p boosted 'byline t)))) +(defun mastodon-tl--format-faved-or-boosted-byline (letter) + "Format the byline marker for a boosted or favorited status. +LETTER is a string, either F or B." + (format "(%s) " + (propertize letter 'face 'mastodon-boost-fave-face))) + (defun mastodon-tl--render-text (string toot) "Return a propertized text rendering the given HTML string STRING. @@ -710,10 +757,9 @@ message is a link which unhides/hides the main body." (let ((preview-url (alist-get 'preview_url media-attachement)) (remote-url - (if (alist-get 'remote_url media-attachement) - (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) + (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))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering @@ -844,6 +890,49 @@ a notification." (message "You voted for option %s: %s!" (car option) (cdr option))))))) +(defun mastodon-tl--find-first-video-in-attachments () + "Return the first media attachment that is a moving image." + (let ((attachments (mastodon-tl--property 'attachments)) + vids) + (mapc (lambda (x) + (let ((att-type (plist-get x :type))) + (when (or (string= "video" att-type) + (string= "gifv" att-type)) + (push x vids)))) + attachments) + (car vids))) + +(defun mastodon-tl--mpv-play-video-from-byline () + "Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post." + (interactive) + (let* ((video (mastodon-tl--find-first-video-in-attachments)) + (url (plist-get video :url)) + (type (plist-get video :type))) + (mastodon-tl--mpv-play-video-at-point url type))) + +(defun mastodon-tl--mpv-play-video-at-point (&optional url type) + "Play the video or gif at point with an mpv process. +URL and TYPE are provided when called while point is on byline, +in which case play first video or gif from current toot." + (interactive) + (let ((url (or + ;; point in byline: + url + ;; point in toot: + (get-text-property (point) 'image-url))) + (type (or ;; in byline: + type + ;; point in toot: + (mastodon-tl--property 'mastodon-media-type)))) + (if url + (if (or (equal type "gifv") + (equal type "video")) + (progn + (message "'q' to kill mpv.") + (mpv-start "--loop" url)) + (message "no moving image here?")) + (message "no moving image here?")))) + (defun mastodon-tl--toot (toot) "Formats TOOT and insertes it into the buffer." (mastodon-tl--insert-status diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3978e12..48e7d96 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -194,7 +194,10 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (unless remove (goto-char bol) (insert (format "(%s) " - (propertize marker 'face 'success))))))) + (propertize marker 'face 'success))))) + ;; leave point after the marker: + (unless remove + (mastodon-tl--goto-next-toot)))) (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. |