diff options
| -rw-r--r-- | README.org | 1 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 16 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 180 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 11 | ||||
| -rw-r--r-- | lisp/mastodon.el | 21 | ||||
| -rw-r--r-- | test/mastodon-media-tests.el | 2 | ||||
| -rw-r--r-- | test/mastodon-profile-tests.el | 288 | ||||
| -rw-r--r-- | test/mastodon-search-tests.el | 5 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 2 |
10 files changed, 466 insertions, 61 deletions
@@ -34,6 +34,7 @@ It adds the following features: | | images scale properly | | | toot visibility (direct, followers only) icon appears in toot bylines | | | display toot's number of favorites, boosts and replies | +| | play gifs and videos (requires =mpv= to be installed) | | | customize option to cache images | | Toots: | | | | mention booster in replies by default | 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-search.el b/lisp/mastodon-search.el index 8c654cc..d17b054 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -39,6 +39,7 @@ (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-http--get-search-json "mastodon-http") +(autoload 'mastodon-http--api "mastodon-http") (defvar mastodon-instance-url) (defvar mastodon-tl--link-keymap) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a87fc2e..d69cb1a 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,9 @@ (autoload 'mastodon-notifications--get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive (autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-search--get-user-info "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 @@ -156,6 +161,7 @@ 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. @@ -168,6 +174,14 @@ types of mastodon links and not just shr.el-generated ones.") (keymap-canonicalize map)) "Keymap for viewing filters.") +(defvar mastodon-tl--byline-link-keymap + (when (require 'mpv nil :no-error) + (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. @@ -298,6 +312,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 @@ -306,29 +323,61 @@ 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)))) +Used as a help-echo when point is at the start of a byline, i.e. +where `mastodon-tl--goto-next-toot' leaves point. Also displays a +toot's media types and optionally the binding to play moving +image media from the byline." + (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-media-binding (when (and (or + (member "video" media-types) + (member "gifv" media-types)) + (require 'mpv nil :no-error)) + (format " | C-RET to view with mpv")))) + (format "%s" (concat format-faves format-media format-media-binding)))) + +(defun mastodon-tl--get-media-types (toot) + "Return a list of the media attachment types of the TOOT at point." + (let* ((attachments (mastodon-tl--field 'media_attachments toot))) + (mapcar (lambda (x) + (alist-get 'type x)) + attachments))) + +(defun mastodon-tl--get-attachments-for-byline (toot) + "Return a list of attachment URLs and types for TOOT. +The result is added as an attachments property to author-byline." + (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." @@ -415,9 +464,9 @@ TIME-STAMP is assumed to be in the past." (defun mastodon-tl--byline (toot author-byline action-byline) "Generate byline for TOOT. -AUTHOR-BYLINE is function for adding the author portion of +AUTHOR-BYLINE is a function for adding the author portion of the byline that takes one variable. -ACTION-BYLINE is a function for adding an action, such as boosting +ACTION-BYLINE is a function for adding an action, such as boosting, favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'" (let ((parsed-time (date-to-time (mastodon-tl--field 'created_at toot))) @@ -425,20 +474,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 technically 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 before 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 as 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) @@ -465,6 +513,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. @@ -716,10 +770,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 @@ -850,6 +903,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 @@ -1349,7 +1445,7 @@ is a no-op." ;; We need to re-schedule for an earlier time (cancel-timer mastodon-tl--timestamp-update-timer) (setq mastodon-tl--timestamp-update-timer - (run-at-time this-update + (run-at-time (time-to-seconds (time-subtract this-update (current-time))) nil ;; don't repeat #'mastodon-tl--update-timestamps-callback (current-buffer) nil))))))) @@ -1402,7 +1498,9 @@ from the start if it is nil." (copy-marker previous-timestamp)) ;; otherwise we are done for now; schedule a new run for when needed (setq mastodon-tl--timestamp-update-timer - (run-at-time mastodon-tl--timestamp-next-update + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) nil ;; don't repeat #'mastodon-tl--update-timestamps-callback buffer nil)))))))) @@ -1452,7 +1550,9 @@ JSON is the data returned from the server." update-function ,update-function) mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps - (run-at-time mastodon-tl--timestamp-next-update + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) nil ;; don't repeat #'mastodon-tl--update-timestamps-callback (current-buffer) @@ -1482,7 +1582,9 @@ Runs synchronously." ,update-function) mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps - (run-at-time mastodon-tl--timestamp-next-update + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) nil ;; don't repeat #'mastodon-tl--update-timestamps-callback (current-buffer) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b50cbf6..48e7d96 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -70,13 +70,11 @@ (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-toot "mastodon") -;;;###autoload (defgroup mastodon-toot nil "Tooting in Mastodon." :prefix "mastodon-toot-" :group 'mastodon) -;;;###autoload (defcustom mastodon-toot--default-visibility "public" "The default visibility for new toots. @@ -89,19 +87,16 @@ followers-only), or \"direct\"." (const :tag "followers only" "private") (const :tag "direct" "direct"))) -;;;###autoload (defcustom mastodon-toot--default-media-directory "~/" "The default directory when prompting for a media file to upload." :group 'mastodon-toot :type 'string) -;;;###autoload (defcustom mastodon-toot--attachment-height 80 "Height of the attached images preview in the toot draft buffer." :group 'mastodon-toot :type 'integer) -;;;###autoload (defcustom mastodon-toot--enable-completion-for-mentions (if (require 'company nil :noerror) "following" "off") "Whether to enable company completion for mentions. @@ -115,7 +110,6 @@ This is only used if company mode is installed." (const :tag "following only" "following") (const :tag "all users" "all"))) -;;;###autoload (defcustom mastodon-toot--enable-custom-instance-emoji nil "Whether to enable your instance's custom emoji by default." :group 'mastodon-toot @@ -200,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. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bd0a557..a52bf41 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -32,6 +32,7 @@ ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon +(require 'mastodon-toot) (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") @@ -52,10 +53,10 @@ (autoload 'mastodon-profile--get-toot-author "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-toot--compose-buffer "mastodon-toot") -(autoload 'mastodon-toot--reply "mastodon-toot") -(autoload 'mastodon-toot--toggle-boost "mastodon-toot") -(autoload 'mastodon-toot--toggle-favourite "mastodon-toot") +;; (autoload 'mastodon-toot--compose-buffer "mastodon-toot") +;; (autoload 'mastodon-toot--reply "mastodon-toot") +;; (autoload 'mastodon-toot--toggle-boost "mastodon-toot") +;; (autoload 'mastodon-toot--toggle-favourite "mastodon-toot") (autoload 'mastodon-discover "mastodon-discover") (autoload 'mastodon-tl--block-user "mastodon-tl") @@ -70,9 +71,9 @@ (autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") (autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") (autoload 'mastodon-search--search-query "mastodon-search") -(autoload 'mastodon-toot--delete-toot "mastodon-toot") -(autoload 'mastodon-toot--copy-toot-url "mastodon-toot") -(autoload 'mastodon-toot--pin-toot-toggle "mastodon-toot") +;; (autoload 'mastodon-toot--delete-toot "mastodon-toot") +;; (autoload 'mastodon-toot--copy-toot-url "mastodon-toot") +;; (autoload 'mastodon-toot--pin-toot-toggle "mastodon-toot") (autoload 'mastodon-auth--get-account-name "mastodon-auth") ;; (autoload 'mastodon-async--stream-federated "mastodon-async") ;; (autoload 'mastodon-async--stream-local "mastodon-async") @@ -82,11 +83,9 @@ (autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-tl--poll-vote "mastodon-http") -(autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot") +;; (autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot") (autoload 'mastodon-profile--view-bookmarks "mastodon-profile") -(autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot") -(autoload 'mastodon-toot--enable-custom-emoji "mastodon-toot") -(defvar mastodon-toot--enable-custom-instance-emoji) +;; (autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot") (defgroup mastodon nil "Interface with Mastodon." diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 0e1152a..abf9a1a 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -63,7 +63,7 @@ (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) (should (string= "gifv" (plist-get properties 'mastodon-media-type))) - (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview\ntype: gifv" + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview\nC-RET: play gifv with mpv" (plist-get properties 'help-echo)))))) (ert-deftest mastodon-media--load-image-from-url-avatar-with-imagemagic () diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el new file mode 100644 index 0000000..ca323ea --- /dev/null +++ b/test/mastodon-profile-tests.el @@ -0,0 +1,288 @@ +;;; mastodon-profile-test.el --- Tests for mastodon-profile.el -*- lexical-binding: nil -*- + +(require 'el-mock) + +(defconst gargron-profile-json + '((id . "1") + (username . "Gargron") + (acct . "Gargron") + (display_name . "Eugen") + (locked . :json-false) + (bot . :json-false) + (discoverable . t) + (group . :json-false) + (created_at . "2016-03-16T00:00:00.000Z") + (note . "<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>") + (url . "https://mastodon.social/@Gargron") + (avatar . "https://files.mastodon.social/accounts/avatars/000/000/001/original/d96d39a0abb45b92.jpg") + (avatar_static . "https://files.mastodon.social/accounts/avatars/000/000/001/original/d96d39a0abb45b92.jpg") + (header . "https://files.mastodon.social/accounts/headers/000/000/001/original/c91b871f294ea63e.png") + (header_static . "https://files.mastodon.social/accounts/headers/000/000/001/original/c91b871f294ea63e.png") + (followers_count . 470905) + (following_count . 451) + (statuses_count . 70741) + (last_status_at . "2021-11-14") + (emojis . []) + (fields . [((name . "Patreon") + (value . "<a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>") + (verified_at)) + ((name . "Homepage") + (value . "<a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>") + (verified_at . "2019-07-15T18:29:57.191+00:00"))]))) + +(defconst ccc-profile-json + '((id . "369027") + (username . "CCC") + (acct . "CCC@social.bau-ha.us") + (display_name . "") + (locked . :json-false) + (bot . :json-false) + (discoverable . :json-false) + (group . :json-false) + (created_at . "2018-06-03T00:00:00.000Z") + (note . "<p><a href=\"https://www.ccc.de/\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">ccc.de/</span><span class=\"invisible\"></span></a></p>") + (url . "https://social.bau-ha.us/@CCC") + (avatar . "https://files.mastodon.social/cache/accounts/avatars/000/369/027/original/6cfeb310f40e041a.jpg") + (avatar_static . "https://files.mastodon.social/cache/accounts/avatars/000/369/027/original/6cfeb310f40e041a.jpg") + (header . "https://files.mastodon.social/cache/accounts/headers/000/369/027/original/0d20bef6131b8139.jpg") + (header_static . "https://files.mastodon.social/cache/accounts/headers/000/369/027/original/0d20bef6131b8139.jpg") + (followers_count . 2733) + (following_count . 120) + (statuses_count . 1357) + (last_status_at . "2021-11-02") + (emojis . []) + (fields . []))) + +(defconst gargon-statuses-json + `[((id . "123456789012345678") + (created_at . "2021-11-11T11:11:11.111Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (language) + (uri . "https://mastodon.social/users/Gargron/statuses/123456789012345678/activity") + (url . "https://mastodon.social/users/Gargron/statuses/123456789012345678/activity") + (replies_count . 0) + (reblogs_count . 0) + (favourites_count . 0) + (favourited . :json-false) + (reblogged . :json-false) + (muted . :json-false) + (bookmarked . :json-false) + (content . "<p>Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.</p>") + (reblog) + (application) + (account ,@gargron-profile-json) + (media_attachments . []) + (mentions . []) + (tags . []) + (emojis . []) + (card) + (poll)) + ((id . "107279356043066700") + (created_at . "2021-11-11T00:00:00.000Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (language . "en") + (uri . "https://mastodon.social/users/Gargron/statuses/107279356043066700") + (url . "https://mastodon.social/@Gargron/107279356043066700") + (replies_count . 0) + (reblogs_count . 2) + (favourites_count . 0) + (favourited . :json-false) + (reblogged . :json-false) + (muted . :json-false) + (bookmarked . :json-false) + (content . "<p><span class=\"h-card\"><a href=\"https://social.bau-ha.us/@CCC\" class=\"u-url mention\">@<span>CCC</span></a></span> At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.</p>") + (reblog) + (application + (name . "Web") + (website)) + (account ,@gargron-profile-json) + (media_attachments . []) + (mentions . [((id . "369027") + (username . "CCC") + (url . "https://social.bau-ha.us/@CCC") + (acct . "CCC@social.bau-ha.us"))]) + (tags . []) + (emojis . []) + (card) + (poll))]) + +(ert-deftest mastodon-profile--add-author-bylines () + "Should correctly format short infos about one account. + +When formatting Gargon's state we want to see +- the short description of that profile, +- the url of the avatar (yet to be loaded) +- the info attached to the name" + (with-mock + ;; Don't start any image loading: + (mock (mastodon-media--inline-images * *) => nil) + ;; Let's not do formatting as that makes it hard to not rely on + ;; window width and reflowing the text. + (mock (shr-render-region * *) => nil) + (if (version< emacs-version "27.1") + (mock (image-type-available-p 'imagemagick) => t) + (mock (image-transforms-p) => t)) + + (with-temp-buffer + (let ((mastodon-tl--show-avatars t) + (mastodon-tl--display-media-p t)) + (mastodon-profile--add-author-bylines (list gargron-profile-json))) + + (should + (equal + (buffer-substring-no-properties (point-min) (point-max)) + "\n Eugen (@Gargron)\n<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>\n")) + + ;; Check the avatar at pos 2 + (should + (equal + (get-text-property 2 'media-url) + "https://files.mastodon.social/accounts/avatars/000/000/001/original/d96d39a0abb45b92.jpg")) + (should + (equal + (get-text-property 2 'media-state) + 'needs-loading)) + + ;; Check the byline state + (should + (equal + (get-text-property 4 'byline) + t)) + (should + (equal + (get-text-property 4 'toot-id) + (alist-get 'id gargron-profile-json))) + (should + (equal + (get-text-property 4 'toot-json) + gargron-profile-json))))) + +(ert-deftest mastodon-profile--search-account-by-handle--removes-at () + "Should ignore a leading at-sign in user handle. + +The search will happen as if called without the \"@\"." + (with-mock + + (mock (mastodon-http--get-json + "https://instance.url/api/v1/accounts/search?q=gargron")) + + (let ((mastodon-instance-url "https://instance.url")) + ;; We don't check anything from the return value. We only care + ;; that the mocked fetch was called with the expected URL. + (mastodon-profile--search-account-by-handle "@gargron")))) + +(ert-deftest mastodon-profile--search-account-by-handle--filters-out-false-results () + "Should ignore results that don't match the searched handle." + (with-mock + (mock (mastodon-http--get-json *) + => + (vector ccc-profile-json gargron-profile-json)) + + (let ((mastodon-instance-url "https://instance.url")) + (should + (equal + (mastodon-profile--search-account-by-handle "Gargron") + gargron-profile-json))))) + +(ert-deftest mastodon-profile--search-account-by-handle--filtering-is-case-sensitive () + "Should ignore results that don't match the searched handle with exact case. + +TODO: We need to decide if this is actually desired or not." + (with-mock + (mock (mastodon-http--get-json *) => (vector gargron-profile-json)) + + (let ((mastodon-instance-url "https://instance.url")) + (should + (null + (mastodon-profile--search-account-by-handle "gargron")))))) + +(ert-deftest mastodon-profile--account-from-id--correct-url () + "Should use the expected url for looking up by account id." + (with-mock + + (mock (mastodon-http--get-json + "https://instance.url/api/v1/accounts/1234567")) + + (let ((mastodon-instance-url "https://instance.url")) + ;; We don't check anything from the return value. We only care + ;; that the mocked fetch was called with the expected URL. + (mastodon-profile--account-from-id "1234567")))) + +(ert-deftest mastodon-profile--make-author-buffer () + "Should set up the buffer as expected for the given author. + +This is a far more complicated test as the +mastodon-profile--make-author-buffer function does so much. There +is a bit too much mocking and this may be brittle but it should +help identify when things change unexpectedly. + +TODO: Consider separating the data retrieval and the actual +content generation in the function under test." + (with-mock + ;; Don't start any image loading: + (mock (mastodon-media--inline-images * *) => nil) + (if (version< emacs-version "27.1") + (mock (image-type-available-p 'imagemagick) => t) + (mock (image-transforms-p) => t)) + (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") + => + gargon-statuses-json) + (mock (mastodon-profile--get-statuses-pinned *) + => + []) + (mock (mastodon-profile--relationships-get "1") + => + [((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . ""))]) + ;; Let's not do formatting as that makes it hard to not rely on + ;; window width and reflowing the text. + (mock (shr-render-region * *) => nil) + ;; Don't perform the actual update call at the end. + ;;(mock (mastodon-tl--timeline *)) + + (let ((mastodon-tl--show-avatars t) + (mastodon-tl--display-media-p t) + (mastodon-instance-url "https://instance.url")) + (mastodon-profile--make-author-buffer gargron-profile-json) + + (should + (equal + (buffer-substring-no-properties (point-min) (point-max)) + (concat + "\n" + "[img] \n" + "Eugen\n" + "@Gargron\n" + " ------------\n" + "<p>Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.</p>\n" + "_ Patreon __ :: <a href=\"https://www.patreon.com/mastodon\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://www.</span><span class=\"\">patreon.com/mastodon</span><span class=\"invisible\"></span></a>_ Homepage _ :: <a href=\"https://zeonfederated.com\" rel=\"me nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">zeonfederated.com</span><span class=\"invisible\"></span></a>\n" + " ------------\n" + " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" + " ------------\n" + "\n" + " ------------\n" + " TOOTS \n" + " ------------\n" + "\n" + "<p>Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.</p> \n" + " Eugen (@Gargron) 2021-11-11 12:11:11\n" + " ------------\n" + "\n" + "\n" + "<p><span class=\"h-card\"><a href=\"https://social.bau-ha.us/@CCC\" class=\"u-url mention\">@<span>CCC</span></a></span> At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.</p> \n" + " Eugen (@Gargron) 2021-11-11 01:00:00\n" + " ------------\n" + "\n" + ))) + + ;; Until the function gets refactored this creates a non-temp + ;; buffer with Gargron's statuses which we want to delete (if + ;; the tests succeed). + (kill-buffer)))) diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el index 996f786..e6d4cdb 100644 --- a/test/mastodon-search-tests.el +++ b/test/mastodon-search-tests.el @@ -126,7 +126,10 @@ (should (equal (mastodon-search--get-user-info mastodon-search--single-account-query) - '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot")))) + '(": ( ) { : | : & } ; :" + "mousebot" + "https://todon.nl/@mousebot" + "<p>poetry, writing, dmt, desertion, trash, black metal, translation, hegel, language, autonomia....</p><p><a href=\"https://anarchive.mooo.com\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">anarchive.mooo.com</span><span class=\"invisible\"></span></a><br /><a href=\"https://pleasantlybabykid.tumblr.com/\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">pleasantlybabykid.tumblr.com/</span><span class=\"invisible\"></span></a><br />IG: <a href=\"https://bibliogram.snopyta.org/u/martianhiatus\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"ellipsis\">bibliogram.snopyta.org/u/marti</span><span class=\"invisible\">anhiatus</span></a><br />photos alt: <span class=\"h-card\"><a href=\"https://todon.eu/@goosebot\" class=\"u-url mention\">@<span>goosebot</span></a></span><br />git: <a href=\"https://git.blast.noho.st/mouse\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">git.blast.noho.st/mouse</span><span class=\"invisible\"></span></a></p><p>want to trade chapbooks or zines? hmu!</p><p>he/him or they/them</p>")))) (ert-deftest mastodon-search--get-hashtag-info () "Should build a list of hashtag name and URL." diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index dd07416..a569c89 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -559,7 +559,7 @@ a string or a numeric." (mock (mastodon-tl--relative-time-details 'fake-timestamp) => (cons "xxx ago" soon-in-the-future)) (mock (cancel-timer 'initial-timer)) - (mock (run-at-time soon-in-the-future nil + (mock (run-at-time * nil #'mastodon-tl--update-timestamps-callback (current-buffer) nil) => 'new-timer) |