From 18c146170a21dccd576228b1c6e3bcba9f0d50e9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 2 Nov 2021 15:24:28 +0100 Subject: add support for receiving notifications when a user posts - mastodon-tl--notify-user-posts - mastodon-tl--no-notify-user-posts - + some schtick in notifications.el to make sure the notifs display ok. --- lisp/mastodon-notifications.el | 26 +++++++++++++++++++++++-- lisp/mastodon-tl.el | 44 ++++++++++++++++++++++++++++++++++++++---- 2 files changed, 64 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 2e9aea3..19b2d3c 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -53,7 +53,8 @@ ("follow" . mastodon-notifications--follow) ("favourite" . mastodon-notifications--favourite) ("reblog" . mastodon-notifications--reblog) - ("follow_request" . mastodon-notifications--follow-request)) + ("follow_request" . mastodon-notifications--follow-request) + ("status" . mastodon-notifications--status)) "Alist of notification types and their corresponding function.") (defvar mastodon-notifications--response-alist @@ -61,7 +62,8 @@ ("Followed" . "you") ("Favourited" . "your status from") ("Boosted" . "your status from") - ("Requested to follow" . "you")) + ("Requested to follow" . "you") + ("Posted" . "a post")) "Alist of subjects for notification types.") (defun mastodon-notifications--byline-concat (message) @@ -204,6 +206,26 @@ "Boosted")) id))) +(defun mastodon-notifications--status (note) + "Format for a `status' NOTE. +Status notifications are given when +`mastodon-tl--notify-user-posts' has been set." + (let ((id (cdr (assoc 'id note))) + (status (mastodon-tl--field 'status note))) + (mastodon-notifications--insert-status + status + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (mastodon-tl--content status))) + (lambda (_status) + (mastodon-tl--byline-author + note)) + (lambda (_status) + (mastodon-notifications--byline-concat + "Posted")) + id))) + (defun mastodon-notifications--insert-status (toot body author-byline action-byline &optional id) "Display the content and byline of timeline element TOOT. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9bbc44f..6cb5ab8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -945,8 +945,10 @@ webapp" (cdr (assoc 'descendants context)))))) (message "No Thread!")))) -(defun mastodon-tl--follow-user (user-handle) - "Query for USER-HANDLE from current status and follow that user." +(defun mastodon-tl--follow-user (user-handle &optional notify) + "Query for USER-HANDLE from current status and follow that user. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles @@ -959,12 +961,22 @@ webapp" user-handle (mastodon-profile--toot-json))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/follow" user-id)))) + (url (mastodon-http--api + (if notify + (format "accounts/%s/follow?notify=%s" user-id notify) + (format "accounts/%s/follow" user-id))))) (if account (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response (lambda () - (message "User %s (@%s) followed!" name user-handle)))) + (cond ((string-equal notify "true") + (message "Receiving notifications for user %s (@%s)!" + name user-handle)) + ((string-equal notify "false") + (message "Not receiving notifications for user %s (@%s)!" + name user-handle)) + ((eq notify nil) + (message "User %s (@%s) followed!" name user-handle)))))) (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--unfollow-user (user-handle) @@ -990,6 +1002,30 @@ webapp" (message "User %s (@%s) unfollowed!" name user-handle))))) (message "Cannot find a user with handle %S" user-handle)))) +(defun mastodon-tl--notify-user-posts (user-handle) + "Query for USER-HANDLE from current status and enable notifications when they post." + (interactive + (list + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "Receive notifications when user posts: " + user-handles + nil ; predicate + 'confirm)))) + (mastodon-tl--follow-user user-handle "true")) + +(defun mastodon-tl--no-notify-user-posts (user-handle) + "Query for USER-HANDLE from current status and disable notifications when they post." + (interactive + (list + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "Disable notifications when user posts: " + user-handles + nil ; predicate + 'confirm)))) + (mastodon-tl--follow-user user-handle "false")) + (defun mastodon-tl--mute-user (user-handle) "Query for USER-HANDLE from current status and mute that user." (interactive -- cgit v1.2.3 From af72d4943ad942712ec74a387e79fb1d53e6bee8 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 6 Nov 2021 15:06:25 +0100 Subject: update mastodon-notifications--test-byline-concat for post notify --- test/mastodon-notifications-test.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/mastodon-notifications-test.el b/test/mastodon-notifications-test.el index 19b591d..7b88de0 100644 --- a/test/mastodon-notifications-test.el +++ b/test/mastodon-notifications-test.el @@ -208,6 +208,8 @@ notification to be tested." (string= " Favourited your status from" (mastodon-notifications--byline-concat "Favourited")) (string= " Boosted your status from" - (mastodon-notifications--byline-concat "Boosted"))))) + (mastodon-notifications--byline-concat "Boosted")) + (string= " Posted a post" + (mastodon-notifications--byline-concat "Posted"))))) -- cgit v1.2.3 From 8d543a03694e575cd0352275b60b2d232bfeaeb5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 10:02:24 +0100 Subject: remove help-echo for faves/boosts/replies, it breaks img echo keymap --- lisp/mastodon-tl.el | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 62d283b..5418374 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -720,16 +720,6 @@ takes a single function. By default it is (mastodon-tl--byline toot author-byline action-byline)) 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) - 'help-echo (when (and mastodon-tl--buffer-spec - (string-match-p - "context" ; when thread view - (plist-get mastodon-tl--buffer-spec 'endpoint))) - ;; prefer the reblog toot if present: - (let ((toot-to-use (or (alist-get 'reblog toot) toot))) - (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-use) - (alist-get 'reblogs_count toot-to-use) - (alist-get 'replies_count toot-to-use)))) 'toot-json toot) "\n") (when mastodon-tl--display-media-p -- cgit v1.2.3 From b02782226b34507508020179e3100c307738eeee Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 10:37:57 +0100 Subject: update test mastodon-media:get-media-link-rendering with extra props --- test/mastodon-media-tests.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index b537dfe..7124672 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -22,14 +22,22 @@ (mock (create-image * nil t) => :mock-image) (let* ((mastodon-media--preview-max-height 123) - (result (mastodon-media--get-media-link-rendering "http://example.org/img.png")) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png")) (result-no-properties (substring-no-properties result)) (properties (text-properties-at 0 result))) (should (string= "[img] " result-no-properties)) (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) (should (eq 'needs-loading (plist-get properties 'media-state))) (should (eq 'media-link (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display)))))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (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= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" + (plist-get properties 'help-echo)))))) (ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () "Should make the right call to url-retrieve." -- cgit v1.2.3 From 6485f236ce9bab609a606d6f5896b1d39b3c114d Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 10:12:56 +0100 Subject: fetch media_attachments' "type" from server and store as property - if the type is not "image", it is displayed in`'help-echo' property. - the idea is to use this to handle gifs/videos differently to images. but for now i'm not sure how to actually render such media. but this way, at least the item could be viewed externally if the user wants to see it, or at least they know they're missing out on something. - NB: EWW can't handle content type "video/mp4". --- lisp/mastodon-media.el | 34 ++++++++++++++++++++-------------- lisp/mastodon-tl.el | 5 +++-- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index f7386c6..457628f 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -292,21 +292,27 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type) "Return the string to be written that renders the image at MEDIA-URL. -FULL-REMOTE-URL is used for `shr-browse-image'." - (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - '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 (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) - " ")) +FULL-REMOTE-URL is used for `shr-browse-image'. +TYPE is the attachment's type field on the server." + (let ((help-echo + "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) + (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 (string= type "image") + help-echo + (concat help-echo "\ntype: " type))) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5418374..9bc7cf2 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -676,10 +676,11 @@ message is a link which unhides/hides the main body." (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)))) + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering - preview-url remote-url) ; 2nd arg for shr-browse-url + preview-url remote-url type) ; 2nd arg for shr-browse-url (concat "Media::" preview-url "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p -- cgit v1.2.3 From 3014e10ec268250a130ac490b5f32b3d263ad21b Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 11:35:57 +0100 Subject: update mastodon-media:get-media-link-rendering{-gif} to handle adding property "type" to media, and to display in help-echo if not an image. --- test/mastodon-media-tests.el | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 7124672..252c819 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -24,7 +24,8 @@ (let* ((mastodon-media--preview-max-height 123) (result (mastodon-media--get-media-link-rendering "http://example.org/img.png" - "http://example.org/remote/img.png")) + "http://example.org/remote/img.png" + "image")) (result-no-properties (substring-no-properties result)) (properties (text-properties-at 0 result))) (should (string= "[img] " result-no-properties)) @@ -36,7 +37,33 @@ (should (eq 'image (plist-get properties 'mastodon-tab-stop))) (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= "image" (plist-get properties 'mastodon-media-type))) (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" + (plist-get properties 'help-echo)))))) + +(ert-deftest mastodon-media:get-media-link-rendering-gif () + "Should return text with all expected properties." + (with-mock + (mock (create-image * nil t) => :mock-image) + + (let* ((mastodon-media--preview-max-height 123) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png" + "gifv")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (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" (plist-get properties 'help-echo)))))) (ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () -- cgit v1.2.3 From 4885cb1f3a564584eb90153051c0277c46f77ca4 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 11:43:01 +0100 Subject: autocompletion ignores case of handles/display names --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 885db1d..753a659 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -521,8 +521,8 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." The prefix can match against both user handles and display names." (let (res) (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (cadr item)) - (string-prefix-p prefix (car item))) + (when (or (string-prefix-p prefix (cadr item) t) + (string-prefix-p prefix (car item) t)) (push (mastodon-toot--mentions-company-make-candidate item) res))) res)) -- cgit v1.2.3 From 3dd4fea29835702a9664d7dd36014066edd1e49a Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 10 Nov 2021 08:38:28 +0100 Subject: move profile--my-profile binding to 'O' to avoid using C-S- bindings, which don't always work for others. --- lisp/mastodon.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 826787a..f9c18a0 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -145,7 +145,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user) (define-key map (kbd "M") #'mastodon-tl--mute-user) (define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user) - (define-key map (kbd "C-S-P") #'mastodon-profile--my-profile) + (define-key map (kbd "O") #'mastodon-profile--my-profile) (define-key map (kbd "S") #'mastodon-search--search-query) (define-key map (kbd "d") #'mastodon-toot--delete-toot) (define-key map (kbd "D") #'mastodon-toot--delete-and-redraft-toot) -- cgit v1.2.3 From 1892014062229f3b68136495e53e90a51dfa58a1 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 10 Nov 2021 10:21:42 +0100 Subject: move profile view followers/following bindings to 's'/'g'. because 'O' is no longer available, being used for --my-profile. the actual solution is to just have one binding that cycles through the profile views. --- lisp/mastodon-profile.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 81ab837..7a9edc3 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -68,8 +68,8 @@ ;; this way you can update it with C-M-x: (defvar mastodon-profile-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "O") #'mastodon-profile--open-followers) - (define-key map (kbd "o") #'mastodon-profile--open-following) + (define-key map (kbd "s") #'mastodon-profile--open-followers) + (define-key map (kbd "g") #'mastodon-profile--open-following) (define-key map (kbd "a") #'mastodon-profile--follow-request-accept) (define-key map (kbd "j") #'mastodon-profile--follow-request-reject) map) -- cgit v1.2.3 From 6b4a47290bf32f5be670d6aa92c3e7780e667ff3 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Mon, 8 Nov 2021 20:17:23 +0100 Subject: Change `mastodon-auth-test.el` to not expect errors. Instead let's catch the error and then assert the correct error text. This is more specific and also looks nicer on a test run as there are no `F` symbols for the (expected) failures. --- test/mastodon-auth-test.el | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/test/mastodon-auth-test.el b/test/mastodon-auth-test.el index 9a765b9..4372047 100644 --- a/test/mastodon-auth-test.el +++ b/test/mastodon-auth-test.el @@ -36,12 +36,24 @@ (should (string= "foo" (mastodon-auth--handle-token-response '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0))))) (ert-deftest mastodon-auth--handle-token-response--unknown () - :expected-result :failed - (mastodon-auth--handle-token-response '(:herp "derp"))) + (should + (equal + '(error "Unknown response from mastodon-auth--get-token!") + (condition-case error + (progn + (mastodon-auth--handle-token-response '(:herp "derp")) + nil) + (t error))))) (ert-deftest mastodon-auth--handle-token-response--failure () - :expected-result :failed - (mastodon-auth--handle-token-response '(:error "invalid_grant" :error_description "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client."))) + (let ((error-message "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client.")) + (should + (equal + `(error ,(format "Mastodon-auth--access-token: invalid_grant: %s" error-message)) + (condition-case error + (mastodon-auth--handle-token-response + `(:error "invalid_grant" :error_description ,error-message)) + (t error)))))) (provide 'mastodon-auth--test) ;;; mastodon-auth--test.el ends here -- cgit v1.2.3 From 5df05d94926ada6843cbc65aea4b64c18429fdf1 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Mon, 8 Nov 2021 20:28:25 +0100 Subject: Reformatting `mastodon-search-tests.el`. - Remove redundant let binding of vars - Re-indent various things to better fit reasonably on a screen. --- test/mastodon-auth-tests.el | 80 +++---- test/mastodon-client-tests.el | 78 +++---- test/mastodon-http-tests.el | 6 +- test/mastodon-media-tests.el | 344 ++++++++++++++--------------- test/mastodon-notifications-test.el | 4 +- test/mastodon-search-tests.el | 92 ++++---- test/mastodon-tl-tests.el | 418 ++++++++++++++++++------------------ test/mastodon-toot-tests.el | 6 +- 8 files changed, 517 insertions(+), 511 deletions(-) diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 69c34a4..fda04eb 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -3,52 +3,52 @@ (ert-deftest generate-token--no-storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock - (let ((mastodon-auth-source-file "") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (read-string "Email: " user-mail-address) => "foo@bar.com") - (mock (read-passwd "Password: ") => "password") - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) + (let ((mastodon-auth-source-file "") + (mastodon-instance-url "https://instance.url")) + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (read-string "Email: " user-mail-address) => "foo@bar.com") + (mock (read-passwd "Password: ") => "password") + (mock (mastodon-http--post "https://instance.url/oauth/token" + '(("client_id" . "id") + ("client_secret" . "secret") + ("grant_type" . "password") + ("username" . "foo@bar.com") + ("password" . "password") + ("scope" . "read write follow")) + nil + :unauthenticated)) + (mastodon-auth--generate-token)))) (ert-deftest generate-token--storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock - (let ((mastodon-auth-source-file "~/.authinfo") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (auth-source-search :create t - :host "https://instance.url" - :port 443 - :require '(:user :secret)) - => '((:user "foo@bar.com" :secret (lambda () "password")))) - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) + (let ((mastodon-auth-source-file "~/.authinfo") + (mastodon-instance-url "https://instance.url")) + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (auth-source-search :create t + :host "https://instance.url" + :port 443 + :require '(:user :secret)) + => '((:user "foo@bar.com" :secret (lambda () "password")))) + (mock (mastodon-http--post "https://instance.url/oauth/token" + '(("client_id" . "id") + ("client_secret" . "secret") + ("grant_type" . "password") + ("username" . "foo@bar.com") + ("password" . "password") + ("scope" . "read write follow")) + nil + :unauthenticated)) + (mastodon-auth--generate-token)))) (ert-deftest get-token () "Should generate token and return JSON response." (with-temp-buffer (with-mock - (mock (mastodon-auth--generate-token) => (progn - (insert "\n\n{\"access_token\":\"abcdefg\"}") - (current-buffer))) - (should (equal (mastodon-auth--get-token) '(:access_token "abcdefg")))))) + (mock (mastodon-auth--generate-token) => (progn + (insert "\n\n{\"access_token\":\"abcdefg\"}") + (current-buffer))) + (should (equal (mastodon-auth--get-token) '(:access_token "abcdefg")))))) (ert-deftest access-token-found () "Should return value in `mastodon-auth--token-alist' if found." @@ -61,6 +61,6 @@ (let ((mastodon-instance-url "https://instance.url") (mastodon-auth--token nil)) (with-mock - (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) - (should (string= (mastodon-auth--access-token) "foobaz")) - (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) + (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) + (should (string= (mastodon-auth--access-token) "foobaz")) + (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el index d7f750d..12d2350 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -3,35 +3,35 @@ (ert-deftest register () "Should POST to /apps." (with-mock - (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") - (mock (mastodon-http--post "https://instance.url/api/v1/apps" - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) - nil - :unauthenticated)) - (mastodon-client--register))) + (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") + (mock (mastodon-http--post "https://instance.url/api/v1/apps" + '(("client_name" . "mastodon.el") + ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") + ("scopes" . "read write follow") + ("website" . "https://github.com/jdenen/mastodon.el")) + nil + :unauthenticated)) + (mastodon-client--register))) (ert-deftest fetch () "Should return client registration JSON." (with-temp-buffer (with-mock - (mock (mastodon-client--register) => (progn - (insert "\n\n{\"foo\":\"bar\"}") - (current-buffer))) - (should (equal (mastodon-client--fetch) '(:foo "bar")))))) + (mock (mastodon-client--register) => (progn + (insert "\n\n{\"foo\":\"bar\"}") + (current-buffer))) + (should (equal (mastodon-client--fetch) '(:foo "bar")))))) (ert-deftest store-1 () "Should return the client plist." (let ((mastodon-instance-url "http://mastodon.example") (plist '(:client_id "id" :client_secret "secret"))) (with-mock - (mock (mastodon-client--token-file) => "stubfile.plstore") - (mock (mastodon-client--fetch) => '(:client_id "id" :client_secret "secret")) - (let* ((plstore (plstore-open "stubfile.plstore")) - (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) - (should (equal (mastodon-client--store) plist)))))) + (mock (mastodon-client--token-file) => "stubfile.plstore") + (mock (mastodon-client--fetch) => '(:client_id "id" :client_secret "secret")) + (let* ((plstore (plstore-open "stubfile.plstore")) + (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) + (should (equal (mastodon-client--store) plist)))))) (ert-deftest store-2 () "Should store client in `mastodon-client--token-file'." @@ -46,22 +46,22 @@ "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.example")) (with-mock - (mock (mastodon-client--token-file) => "fixture/client.plstore") - (should (equal (mastodon-client--read) - '(:client_id "id2" :client_secret "secret2")))))) + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--read) + '(:client_id "id2" :client_secret "secret2")))))) (ert-deftest read-finds-no-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.social")) (with-mock - (mock (mastodon-client--token-file) => "fixture/client.plstore") - (should (equal (mastodon-client--read) nil))))) + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--read) nil))))) (ert-deftest read-empty-store () "Should return nil if mastodon client is not present in the plstore." (with-mock - (mock (mastodon-client--token-file) => "fixture/empty.plstore") - (should (equal (mastodon-client--read) nil)))) + (mock (mastodon-client--token-file) => "fixture/empty.plstore") + (should (equal (mastodon-client--read) nil)))) (ert-deftest client-set-and-matching () "Should return `mastondon-client' if `mastodon-client--client-details-alist' is non-nil and instance url is included." @@ -75,29 +75,29 @@ (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("http://other.example" :wrong)))) (with-mock - (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) - (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) - (should (equal mastodon-client--client-details-alist - '(("http://mastodon.example" :client_id "foo" :client_secret "bar") - ("http://other.example" :wrong))))))) + (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) + (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) + (should (equal mastodon-client--client-details-alist + '(("http://mastodon.example" :client_id "foo" :client_secret "bar") + ("http://other.example" :wrong))))))) (ert-deftest client-unset () "Should read from `mastodon-token-file' if available." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) (with-mock - (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) - (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) - (should (equal mastodon-client--client-details-alist - '(("http://mastodon.example" :client_id "foo" :client_secret "bar"))))))) + (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) + (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) + (should (equal mastodon-client--client-details-alist + '(("http://mastodon.example" :client_id "foo" :client_secret "bar"))))))) (ert-deftest client-unset-and-not-in-storage () "Should store client data in plstore if it can't be read." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) (with-mock - (mock (mastodon-client--read)) - (mock (mastodon-client--store) => '(:client_id "foo" :client_secret "baz")) - (should (equal (mastodon-client) '(:client_id "foo" :client_secret "baz"))) - (should (equal mastodon-client--client-details-alist - '(("http://mastodon.example" :client_id "foo" :client_secret "baz"))))))) + (mock (mastodon-client--read)) + (mock (mastodon-client--store) => '(:client_id "foo" :client_secret "baz")) + (should (equal (mastodon-client) '(:client_id "foo" :client_secret "baz"))) + (should (equal mastodon-client--client-details-alist + '(("http://mastodon.example" :client_id "foo" :client_secret "baz"))))))) diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el index 03d4f94..d0f715e 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -4,6 +4,6 @@ "Should make a `url-retrieve' of the given URL." (let ((callback-double (lambda () "double"))) (with-mock - (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) - (mock (mastodon-auth--access-token) => "test-token") - (mastodon-http--get "https://foo.bar/baz")))) + (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) + (mock (mastodon-auth--access-token) => "test-token") + (mastodon-http--get "https://foo.bar/baz")))) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 7124672..3345e74 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -3,215 +3,215 @@ (ert-deftest mastodon-media:get-avatar-rendering () "Should return text with all expected properties." (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * (when (version< emacs-version "27.1") 'imagemagick) t :height 123) => :mock-image) - - (let* ((mastodon-media--avatar-height 123) - (result (mastodon-media--get-avatar-rendering "http://example.org/img.png")) - (result-no-properties (substring-no-properties result)) - (properties (text-properties-at 0 result))) - (should (string= " " result-no-properties)) - (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) - (should (eq 'needs-loading (plist-get properties 'media-state))) - (should (eq 'avatar (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display)))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * (when (version< emacs-version "27.1") 'imagemagick) t :height 123) => :mock-image) + + (let* ((mastodon-media--avatar-height 123) + (result (mastodon-media--get-avatar-rendering "http://example.org/img.png")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= " " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'avatar (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display)))))) (ert-deftest mastodon-media:get-media-link-rendering () "Should return text with all expected properties." (with-mock - (mock (create-image * nil t) => :mock-image) - - (let* ((mastodon-media--preview-max-height 123) - (result - (mastodon-media--get-media-link-rendering "http://example.org/img.png" - "http://example.org/remote/img.png")) - (result-no-properties (substring-no-properties result)) - (properties (text-properties-at 0 result))) - (should (string= "[img] " result-no-properties)) - (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) - (should (eq 'needs-loading (plist-get properties 'media-state))) - (should (eq 'media-link (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display))) - (should (eq 'highlight (plist-get properties 'mouse-face))) - (should (eq 'image (plist-get properties 'mastodon-tab-stop))) - (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= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" - (plist-get properties 'help-echo)))))) + (mock (create-image * nil t) => :mock-image) + + (let* ((mastodon-media--preview-max-height 123) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (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= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" + (plist-get properties 'help-echo)))))) (ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image - * - (when (version< emacs-version "27.1") 'imagemagick) - t :height 123) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - url - #'mastodon-media--process-image-response - `(:my-marker (:height 123) 1 ,url)) - => :called-as-expected) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering "http://example.org/img.png") - ":rest")) - - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image + * + (when (version< emacs-version "27.1") 'imagemagick) + t :height 123) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + url + #'mastodon-media--process-image-response + `(:my-marker (:height 123) 1 ,url)) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) (ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock - (mock (image-type-available-p 'imagemagick) => nil) - (mock (create-image * nil t) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - url - #'mastodon-media--process-image-response - `(:my-marker () 1 ,url)) - => :called-as-expected) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering "http://example.org/img.png") - ":rest")) - - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) + (mock (image-type-available-p 'imagemagick) => nil) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + url + #'mastodon-media--process-image-response + `(:my-marker () 1 ,url)) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) (ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * nil t) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - "http://example.org/image.png" - #'mastodon-media--process-image-response - '(:my-marker (:max-height 321) 5 "http://example.org/image.png")) - => :called-as-expected) - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-media-link-rendering url) - ":rest")) - (let ((mastodon-media--preview-max-height 321)) - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + "http://example.org/image.png" + #'mastodon-media--process-image-response + '(:my-marker (:max-height 321) 5 "http://example.org/image.png")) + => :called-as-expected) + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-media-link-rendering url) + ":rest")) + (let ((mastodon-media--preview-max-height 321)) + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) (ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock - (mock (image-type-available-p 'imagemagick) => nil) - (mock (create-image * nil t) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - "http://example.org/image.png" - #'mastodon-media--process-image-response - '(:my-marker () 5 "http://example.org/image.png")) - => :called-as-expected) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering url) - ":rest")) - (let ((mastodon-media--preview-max-height 321)) - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) + (mock (image-type-available-p 'imagemagick) => nil) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + "http://example.org/image.png" + #'mastodon-media--process-image-response + '(:my-marker () 5 "http://example.org/image.png")) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering url) + ":rest")) + (let ((mastodon-media--preview-max-height 321)) + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) (ert-deftest mastodon-media:load-image-from-url:url-fetching-fails () "Should cope with failures in url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image - * - (when (version< emacs-version "27.1") 'imagemagick) - t :height 123) => '(image foo)) - (stub url-retrieve => (error "url-retrieve failed")) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering "http://example.org/img.png") - ":rest")) - - (should (eq :loading-failed (mastodon-media--load-image-from-url url 'avatar 7 1))) - ;; the media state was updated so we won't load this again: - (should (eq 'loading-failed (get-text-property 7 'media-state))))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image + * + (when (version< emacs-version "27.1") 'imagemagick) + t :height 123) => '(image foo)) + (stub url-retrieve => (error "url-retrieve failed")) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :loading-failed (mastodon-media--load-image-from-url url 'avatar 7 1))) + ;; the media state was updated so we won't load this again: + (should (eq 'loading-failed (get-text-property 7 'media-state))))))) (ert-deftest mastodon-media:process-image-response () "Should process the HTTP response and adjust the source buffer." (with-temp-buffer (with-mock - (let ((source-buffer (current-buffer)) - used-marker - saved-marker) - (insert "start:") - (setq used-marker (copy-marker (point)) - saved-marker (copy-marker (point))) - ;; Mock needed for the preliminary image created in - ;; mastodon-media--get-avatar-rendering - (stub create-image => :fake-image) - (insert (mastodon-media--get-avatar-rendering - "http://example.org/image.png.") - ":end") - (with-temp-buffer - (insert "some irrelevant\n" - "http headers\n" - "which will be ignored\n\n" - "fake\nimage\ndata") - (goto-char (point-min)) - - (mock (create-image - "fake\nimage\ndata" - (when (version< emacs-version "27.1") 'imagemagick) - t ':image :option) => :fake-image) - - (mastodon-media--process-image-response - () used-marker '(:image :option) 1 "http://example.org/image.png") - - ;; the used marker has been unset: - (should (null (marker-position used-marker))) - ;; the media-state has been set to loaded and the image is being displayed - (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) - (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) + (let ((source-buffer (current-buffer)) + used-marker + saved-marker) + (insert "start:") + (setq used-marker (copy-marker (point)) + saved-marker (copy-marker (point))) + ;; Mock needed for the preliminary image created in + ;; mastodon-media--get-avatar-rendering + (stub create-image => :fake-image) + (insert (mastodon-media--get-avatar-rendering + "http://example.org/image.png.") + ":end") + (with-temp-buffer + (insert "some irrelevant\n" + "http headers\n" + "which will be ignored\n\n" + "fake\nimage\ndata") + (goto-char (point-min)) + + (mock (create-image + "fake\nimage\ndata" + (when (version< emacs-version "27.1") 'imagemagick) + t ':image :option) => :fake-image) + + (mastodon-media--process-image-response + () used-marker '(:image :option) 1 "http://example.org/image.png") + + ;; the used marker has been unset: + (should (null (marker-position used-marker))) + ;; the media-state has been set to loaded and the image is being displayed + (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) + (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) (ert-deftest mastodon-media:inline-images () "Should process all media in buffer." (with-mock - ;; Stub needed for the test setup: - (stub create-image => '(image ignored)) - - (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar) - (with-temp-buffer - (insert "Some text before\n") - (setq marker-media-link (copy-marker (point))) - (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg") - " some more text ") - (setq marker-media-link-bad-url (copy-marker (point))) - (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png") - " some more text ") - (setq marker-false-media (copy-marker (point))) - (insert - ;; text that looks almost like an avatar but lacks the media-url property - (propertize "this won't be processed" - 'media-state 'needs-loading - 'media-type 'avatar) - "even more text ") - (setq marker-avatar (copy-marker (point))) - (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png") - " end of text") - (goto-char (point-min)) - - ;; stub for the actual test: - (stub mastodon-media--load-image-from-url) - (mastodon-media--inline-images (point-min) (point-max)) - - (should (eq 'loading (get-text-property marker-media-link 'media-state))) - (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state))) - (should (eq 'loading (get-text-property marker-avatar 'media-state))) - (should (eq 'needs-loading (get-text-property marker-false-media 'media-state))))))) + ;; Stub needed for the test setup: + (stub create-image => '(image ignored)) + + (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar) + (with-temp-buffer + (insert "Some text before\n") + (setq marker-media-link (copy-marker (point))) + (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg") + " some more text ") + (setq marker-media-link-bad-url (copy-marker (point))) + (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png") + " some more text ") + (setq marker-false-media (copy-marker (point))) + (insert + ;; text that looks almost like an avatar but lacks the media-url property + (propertize "this won't be processed" + 'media-state 'needs-loading + 'media-type 'avatar) + "even more text ") + (setq marker-avatar (copy-marker (point))) + (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png") + " end of text") + (goto-char (point-min)) + + ;; stub for the actual test: + (stub mastodon-media--load-image-from-url) + (mastodon-media--inline-images (point-min) (point-max)) + + (should (eq 'loading (get-text-property marker-media-link 'media-state))) + (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state))) + (should (eq 'loading (get-text-property marker-avatar 'media-state))) + (should (eq 'needs-loading (get-text-property marker-false-media 'media-state))))))) diff --git a/test/mastodon-notifications-test.el b/test/mastodon-notifications-test.el index 3047ae6..778d350 100644 --- a/test/mastodon-notifications-test.el +++ b/test/mastodon-notifications-test.el @@ -185,8 +185,8 @@ "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) - (mastodon-notifications--get)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) + (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el index b8521f3..552f467 100644 --- a/test/mastodon-search-tests.el +++ b/test/mastodon-search-tests.el @@ -38,7 +38,15 @@ "A sample mastodon account search result (parsed json)") (defconst mastodon-search-test-single-tag - '((name . "TeamBringBackVisibleScrollbars") (url . "https://todon.nl/tags/TeamBringBackVisibleScrollbars") (history . [((day . "1636156800") (uses . "0") (accounts . "0")) ((day . "1636070400") (uses . "0") (accounts . "0")) ((day . "1635984000") (uses . "0") (accounts . "0")) ((day . "1635897600") (uses . "0") (accounts . "0")) ((day . "1635811200") (uses . "0") (accounts . "0")) ((day . "1635724800") (uses . "0") (accounts . "0")) ((day . "1635638400") (uses . "0") (accounts . "0"))]))) + '((name . "TeamBringBackVisibleScrollbars") + (url . "https://todon.nl/tags/TeamBringBackVisibleScrollbars") + (history . [((day . "1636156800") (uses . "0") (accounts . "0")) + ((day . "1636070400") (uses . "0") (accounts . "0")) + ((day . "1635984000") (uses . "0") (accounts . "0")) + ((day . "1635897600") (uses . "0") (accounts . "0")) + ((day . "1635811200") (uses . "0") (accounts . "0")) + ((day . "1635724800") (uses . "0") (accounts . "0")) + ((day . "1635638400") (uses . "0") (accounts . "0"))]))) (defconst mastodon-search-test-single-status '((id . "107230316503209282") @@ -83,59 +91,57 @@ (following_count . 634) (statuses_count . 3807) (last_status_at . "2021-11-05") - (emojis . - []) - (fields . - [((name . "dark to") - (value . "themselves") - (verified_at)) - ((name . "its raining") - (value . "plastic") - (verified_at)) - ((name . "dis") - (value . "integration") - (verified_at)) - ((name . "ungleichzeitigkeit und") - (value . "gleichzeitigkeit, philosophisch") - (verified_at))])) - (media_attachments . - []) - (mentions . - [((id . "242971") - (username . "mousebot") - (url . "https://todon.nl/@mousebot") - (acct . "mousebot"))]) - (tags . - []) - (emojis . - []) + (emojis . []) + (fields . [((name . "dark to") + (value . "themselves") + (verified_at)) + ((name . "its raining") + (value . "plastic") + (verified_at)) + ((name . "dis") + (value . "integration") + (verified_at)) + ((name . "ungleichzeitigkeit und") + (value . "gleichzeitigkeit, philosophisch") + (verified_at))])) + (media_attachments . []) + (mentions . [((id . "242971") + (username . "mousebot") + (url . "https://todon.nl/@mousebot") + (acct . "mousebot"))]) + (tags . []) + (emojis . []) (card) (poll))) (ert-deftest mastodon-search-test-get-user-info-@ () "Should build a list from a single account for company completion." - (let ((account mastodon-search--single-account-query)) - (should (equal (mastodon-search--get-user-info-@ account) - '(": ( ) { : | : & } ; :" "@mousebot" "https://todon.nl/@mousebot"))))) + (should + (equal + (mastodon-search--get-user-info-@ mastodon-search--single-account-query) + '(": ( ) { : | : & } ; :" "@mousebot" "https://todon.nl/@mousebot")))) (ert-deftest mastodon-search-test-get-user-info () "Should build a list from a single account for company completion." - (let ((account mastodon-search--single-account-query)) - (should (equal (mastodon-search--get-user-info account) - '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot"))))) + (should + (equal + (mastodon-search--get-user-info mastodon-search--single-account-query) + '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot")))) (ert-deftest mastodon-search-test-get-hashtag-info () "Should build a list of hashtag name and URL." - (let ((tag mastodon-search-test-single-tag)) - (should (equal (mastodon-search--get-hashtag-info tag) - '("TeamBringBackVisibleScrollbars" - "https://todon.nl/tags/TeamBringBackVisibleScrollbars"))))) + (should + (equal + (mastodon-search--get-hashtag-info mastodon-search-test-single-tag) + '("TeamBringBackVisibleScrollbars" + "https://todon.nl/tags/TeamBringBackVisibleScrollbars")))) (ert-deftest mastodon-search-test-get-status-info () "Should return a list of ID, timestamp, content, and spoiler." - (let ((status mastodon-search-test-single-status)) - (should (equal (mastodon-search--get-status-info status) - '("107230316503209282" - "2021-11-06T13:19:40.628Z" - "" - "

This is a nice test toot, for testing purposes. Thank you.

"))))) + (should + (equal + (mastodon-search--get-status-info mastodon-search-test-single-status) + '("107230316503209282" + "2021-11-06T13:19:40.628Z" + "" + "

This is a nice test toot, for testing purposes. Thank you.

")))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 4edf5d5..e4606cc 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -125,8 +125,8 @@ "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" 12345)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mastodon-tl--more-json "timelines/foo" 12345)))) (ert-deftest more-json-id-string () "Should request toots older than max_id. @@ -135,8 +135,8 @@ a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" "12345")))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest update-json-id-string () "Should request toots more recent than since_id. @@ -145,8 +145,8 @@ a string or a numeric." a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) - (mastodon-tl--updated-json "timelines/foo" "12345")))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) + (mastodon-tl--updated-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--relative-time-description () "Should format relative time as expected" @@ -253,39 +253,39 @@ a string or a numeric." (let ((mastodon-tl--show-avatars-p nil) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (handle-location 20)) - (should (string= (substring-no-properties - byline) - "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (handle-location 20)) + (should (string= (substring-no-properties + 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) - "@acct42@example.space")) - (should (equal (get-text-property handle-location 'help-echo byline) - "Browse user profile of @acct42@example.space")))))) + (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (string= (get-text-property handle-location 'mastodon-handle byline) + "@acct42@example.space")) + (should (equal (get-text-property handle-location 'help-echo byline) + "Browse user profile of @acct42@example.space")))))) (ert-deftest mastodon-tl--byline-regular-with-avatar () "Should format the regular toot correctly." (let ((mastodon-tl--show-avatars-p t) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock - (stub create-image => '(image "fake data")) - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (stub create-image => '(image "fake data")) + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline mastodon-tl-test-base-toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -295,14 +295,14 @@ a string or a numeric." (toot (cons '(reblogged . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -312,14 +312,14 @@ a string or a numeric." (toot (cons '(favourited . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -330,14 +330,14 @@ a string or a numeric." (toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -349,31 +349,31 @@ a string or a numeric." (timestamp (cdr (assoc 'created_at toot))) (original-timestamp (cdr (assoc 'created_at original-toot)))) (with-mock - ;; We don't expect to use the toot's timestamp but the timestamp of the - ;; reblogged toot: - (mock (date-to-time timestamp) => '(1 2)) - (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") - (mock (date-to-time original-timestamp) => '(3 4)) - (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") - - (let ((byline (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (handle1-location 20) - (handle2-location 65)) - (should (string= (substring-no-properties byline) - "Account 42 (@acct42@example.space) + ;; We don't expect to use the toot's timestamp but the timestamp of the + ;; reblogged toot: + (mock (date-to-time timestamp) => '(1 2)) + (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") + (mock (date-to-time original-timestamp) => '(3 4)) + (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + + (let ((byline (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (handle1-location 20) + (handle2-location 65)) + (should (string= (substring-no-properties byline) + "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) - "Browse user profile of @acct42@example.space")) - (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) - 'user-handle)) - (should (equal (get-text-property handle2-location 'help-echo byline) - "Browse user profile of @acct43@example.space")))))) + (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (equal (get-text-property handle1-location 'help-echo byline) + "Browse user profile of @acct42@example.space")) + (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (equal (get-text-property handle2-location 'help-echo byline) + "Browse user profile of @acct43@example.space")))))) (ert-deftest mastodon-tl--byline-reblogged-with-avatars () "Should format the reblogged toot correctly." @@ -383,19 +383,19 @@ a string or a numeric." (timestamp (cdr (assoc 'created_at toot))) (original-timestamp (cdr (assoc 'created_at original-toot)))) (with-mock - ;; We don't expect to use the toot's timestamp but the timestamp of the - ;; reblogged toot: - (stub create-image => '(image "fake data")) - (mock (date-to-time timestamp) => '(1 2)) - (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") - (mock (date-to-time original-timestamp) => '(3 4)) - (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "Account 42 (@acct42@example.space) + ;; We don't expect to use the toot's timestamp but the timestamp of the + ;; reblogged toot: + (stub create-image => '(image "fake data")) + (mock (date-to-time timestamp) => '(1 2)) + (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") + (mock (date-to-time original-timestamp) => '(3 4)) + (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ "))))) @@ -408,18 +408,18 @@ a string or a numeric." (timestamp (cdr (assoc 'created_at toot))) (original-timestamp (cdr (assoc 'created_at original-toot)))) (with-mock - ;; We don't expect to use the toot's timestamp but the timestamp of the - ;; reblogged toot: - (mock (date-to-time timestamp) => '(1 2)) - (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") - (mock (date-to-time original-timestamp) => '(3 4)) - (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) (F) Account 42 (@acct42@example.space) + ;; We don't expect to use the toot's timestamp but the timestamp of the + ;; reblogged toot: + (mock (date-to-time timestamp) => '(1 2)) + (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") + (mock (date-to-time original-timestamp) => '(3 4)) + (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ "))))) @@ -429,17 +429,17 @@ a string or a numeric." (let ((mastodon-tl--show-avatars-p nil) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (current-time) => '(22782 22000)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (let* ((formatted-string (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (timestamp-start (string-match "2999-99-99" formatted-string)) - (properties (text-properties-at timestamp-start formatted-string))) - (should (equal '(22782 21551) (plist-get properties 'timestamp))) - (should (string-equal "7 minutes ago" (plist-get properties 'display))))))) + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (current-time) => '(22782 22000)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (let* ((formatted-string (mastodon-tl--byline mastodon-tl-test-base-toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (timestamp-start (string-match "2999-99-99" formatted-string)) + (properties (text-properties-at timestamp-start formatted-string))) + (should (equal '(22782 21551) (plist-get properties 'timestamp))) + (should (string-equal "7 minutes ago" (plist-get properties 'display))))))) (ert-deftest mastodon-tl--consider-timestamp-for-updates-no-active-callback () "Should update the timestamp update variables as expected." @@ -454,33 +454,33 @@ a string or a numeric." ;; something a later update doesn't update: (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (null mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) + (should (null mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) ;; something only shortly sooner doesn't update: (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" (time-subtract long-in-the-future (seconds-to-time 9)))) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" (time-subtract long-in-the-future (seconds-to-time 9)))) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (null mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) + (should (null mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) ;; something much sooner, does update (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" soon-in-the-future)) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" soon-in-the-future)) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (null mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) + (should (null mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) ))) (ert-deftest mastodon-tl--consider-timestamp-for-updates-with-active-callback () @@ -496,27 +496,27 @@ a string or a numeric." ;; something a later update doesn't update: (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (eq 'initial-timer mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) + (should (eq 'initial-timer mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) ;; something much sooner, does update (with-mock - (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 - #'mastodon-tl--update-timestamps-callback - (current-buffer) nil) => 'new-timer) + (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 + #'mastodon-tl--update-timestamps-callback + (current-buffer) nil) => 'new-timer) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (eq 'new-timer mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) + (should (eq 'new-timer mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) ))) (ert-deftest mastodon-tl--find-property-range--no-tag () @@ -691,20 +691,20 @@ a string or a numeric." (list 'r3 r3 r2 r3) (list 'end end r3 end)))) (with-mock - (stub message => nil) ;; don't mess up our test output with the function's messages - (cl-dolist (test test-cases) - (let ((test-name (cl-first test)) - (test-start (cl-second test)) - (expected-prev (cl-third test)) - (expected-next (cl-fourth test))) - (goto-char test-start) - (mastodon-tl--previous-tab-item) - (should (equal (list 'prev test-name expected-prev) - (list 'prev test-name (point)))) - (goto-char test-start) - (mastodon-tl--next-tab-item) - (should (equal (list 'next test-name expected-next) - (list 'next test-name (point))))))))))) + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) (ert-deftest mastodon-tl--next-tab-item--no-spaces-at-ends () "Should do the correct tab actions even with regions right at buffer ends." @@ -739,20 +739,20 @@ a string or a numeric." (list 'gap2 gap2 r3 r4) (list 'r4 r4 r3 r4)))) (with-mock - (stub message => nil) ;; don't mess up our test output with the function's messages - (cl-dolist (test test-cases) - (let ((test-name (cl-first test)) - (test-start (cl-second test)) - (expected-prev (cl-third test)) - (expected-next (cl-fourth test))) - (goto-char test-start) - (mastodon-tl--previous-tab-item) - (should (equal (list 'prev test-name expected-prev) - (list 'prev test-name (point)))) - (goto-char test-start) - (mastodon-tl--next-tab-item) - (should (equal (list 'next test-name expected-next) - (list 'next test-name (point))))))))))) + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) (defun tl-tests--property-values-at (property ranges) @@ -781,33 +781,33 @@ constant." (setq markers (nreverse markers)) (with-mock - (mock (current-time) => now) - (stub run-at-time => 'fake-timer) - - ;; make the initial call - (mastodon-tl--update-timestamps-callback (current-buffer) nil) - (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" - "unset 7" "unset 8" "unset 9" "unset 10" "unset 11" "unset 12" "unset 13") - (tl-tests--property-values-at 'display - (tl-tests--all-regions-with-property 'timestamp)))) - - ;; fake the follow-up call - (mastodon-tl--update-timestamps-callback (current-buffer) (nth 4 markers)) - (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" - "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" - "unset 12" "unset 13") - (tl-tests--property-values-at 'display - (tl-tests--all-regions-with-property 'timestamp)))) - (should (null (marker-position (nth 4 markers)))) - - ;; fake the follow-up call - (mastodon-tl--update-timestamps-callback (current-buffer) (nth 9 markers)) - (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" - "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" - "12 minutes ago" "13 minutes ago") - (tl-tests--property-values-at 'display - (tl-tests--all-regions-with-property 'timestamp)))) - (should (null (marker-position (nth 9 markers))))))))) + (mock (current-time) => now) + (stub run-at-time => 'fake-timer) + + ;; make the initial call + (mastodon-tl--update-timestamps-callback (current-buffer) nil) + (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" + "unset 7" "unset 8" "unset 9" "unset 10" "unset 11" "unset 12" "unset 13") + (tl-tests--property-values-at 'display + (tl-tests--all-regions-with-property 'timestamp)))) + + ;; fake the follow-up call + (mastodon-tl--update-timestamps-callback (current-buffer) (nth 4 markers)) + (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" + "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" + "unset 12" "unset 13") + (tl-tests--property-values-at 'display + (tl-tests--all-regions-with-property 'timestamp)))) + (should (null (marker-position (nth 4 markers)))) + + ;; fake the follow-up call + (mastodon-tl--update-timestamps-callback (current-buffer) (nth 9 markers)) + (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" + "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" + "12 minutes ago" "13 minutes ago") + (tl-tests--property-values-at 'display + (tl-tests--all-regions-with-property 'timestamp)))) + (should (null (marker-position (nth 9 markers))))))))) (ert-deftest mastodon-tl--has-spoiler () "Should be able to detect toots with spoiler text as expected" @@ -833,10 +833,10 @@ constant." (insert "some text before\n") (setq toot-start (point)) (with-mock - (stub create-image => '(image "fake data")) - (stub shr-render-region => nil) ;; Travis's Emacs doesn't have libxml - (insert - (mastodon-tl--spoiler normal-toot-with-spoiler))) + (stub create-image => '(image "fake data")) + (stub shr-render-region => nil) ;; Travis's Emacs doesn't have libxml + (insert + (mastodon-tl--spoiler normal-toot-with-spoiler))) (setq toot-end (point)) (insert "\nsome more text.") (add-text-properties @@ -899,10 +899,10 @@ constant." 'help-echo "https://example.space/tags/sampletag") " some text after")) (rendered (with-mock - (stub shr-render-region => nil) - (mastodon-tl--render-text - fake-input-text - mastodon-tl-test-base-toot))) + (stub shr-render-region => nil) + (mastodon-tl--render-text + fake-input-text + mastodon-tl-test-base-toot))) (tag-location 7)) (should (eq (get-text-property tag-location 'mastodon-tab-stop rendered) 'hashtag)) @@ -946,10 +946,10 @@ constant." 'help-echo "https://bar.example/@foo") " some text after")) (rendered (with-mock - (stub shr-render-region => nil) - (mastodon-tl--render-text - fake-input-text - mastodon-tl-test-base-toot))) + (stub shr-render-region => nil) + (mastodon-tl--render-text + fake-input-text + mastodon-tl-test-base-toot))) (mention-location 11)) (should (eq (get-text-property mention-location 'mastodon-tab-stop rendered) 'user-handle)) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index abc66d0..06da870 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -41,6 +41,6 @@ (ert-deftest cancel () (with-mock - (mock (kill-buffer-and-window)) - (mastodon-toot--cancel) - (mock-verify))) + (mock (kill-buffer-and-window)) + (mastodon-toot--cancel) + (mock-verify))) -- cgit v1.2.3 From 522926bcca0caf45516da3dcd00c944066641965 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Tue, 9 Nov 2021 18:24:54 +0100 Subject: Hamonize tests. - Add a header comment explicitly switching off lexical binding - Harmonize naming (always start with module and double hyphen) - Ensure all tests have at least a minimal doc string. - Move tests from `mastodon-auth-test.el` to `mastodon-auth-tests.el` --- test/mastodon-auth-test.el | 59 ------------------------------------- test/mastodon-auth-tests.el | 59 ++++++++++++++++++++++++++++++------- test/mastodon-client-tests.el | 26 ++++++++-------- test/mastodon-http-tests.el | 13 ++++---- test/mastodon-media-tests.el | 20 +++++++------ test/mastodon-notifications-test.el | 14 +++++---- test/mastodon-search-tests.el | 18 +++++------ test/mastodon-tl-tests.el | 27 +++++++++++------ test/mastodon-toot-tests.el | 25 +++++++++++----- 9 files changed, 134 insertions(+), 127 deletions(-) delete mode 100644 test/mastodon-auth-test.el diff --git a/test/mastodon-auth-test.el b/test/mastodon-auth-test.el deleted file mode 100644 index 4372047..0000000 --- a/test/mastodon-auth-test.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; mastodon-auth--test.el --- Tests for mastodon-auth -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Ian Eure - -;; Author: Ian Eure -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "26.1")) - -;; This file is not part of GNU Emacs. - -;; This file is part of mastodon.el. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; mastodon-auth--test.el provides ERT tests for mastodon-auth.el - -;;; Code: - -(require 'ert) - -(ert-deftest mastodon-auth--handle-token-response--good () - (should (string= "foo" (mastodon-auth--handle-token-response '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0))))) - -(ert-deftest mastodon-auth--handle-token-response--unknown () - (should - (equal - '(error "Unknown response from mastodon-auth--get-token!") - (condition-case error - (progn - (mastodon-auth--handle-token-response '(:herp "derp")) - nil) - (t error))))) - -(ert-deftest mastodon-auth--handle-token-response--failure () - (let ((error-message "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client.")) - (should - (equal - `(error ,(format "Mastodon-auth--access-token: invalid_grant: %s" error-message)) - (condition-case error - (mastodon-auth--handle-token-response - `(:error "invalid_grant" :error_description ,error-message)) - (t error)))))) - -(provide 'mastodon-auth--test) -;;; mastodon-auth--test.el ends here diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index fda04eb..6a090b7 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -1,6 +1,38 @@ +;;; mastodon-auth-test.el --- Tests for mastodon-auth.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest generate-token--no-storing-credentials () +(ert-deftest mastodon-auth--handle-token-response--good () + "Should extract the access token from a good response." + (should + (string= + "foo" + (mastodon-auth--handle-token-response + '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0))))) + +(ert-deftest mastodon-auth--handle-token-response--unknown () + "Should throw an error when the response is unparsable." + (should + (equal + '(error "Unknown response from mastodon-auth--get-token!") + (condition-case error + (progn + (mastodon-auth--handle-token-response '(:herp "derp")) + nil) + (t error))))) + +(ert-deftest mastodon-auth--handle-token-response--failure () + "Should throw an error when the response indicates an error." + (let ((error-message "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client.")) + (should + (equal + `(error ,(format "Mastodon-auth--access-token: invalid_grant: %s" error-message)) + (condition-case error + (mastodon-auth--handle-token-response + `(:error "invalid_grant" :error_description ,error-message)) + (t error)))))) + +(ert-deftest mastodon-auth--generate-token--no-storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock (let ((mastodon-auth-source-file "") @@ -19,7 +51,7 @@ :unauthenticated)) (mastodon-auth--generate-token)))) -(ert-deftest generate-token--storing-credentials () +(ert-deftest mastodon-auth--generate-token--storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock (let ((mastodon-auth-source-file "~/.authinfo") @@ -41,26 +73,33 @@ :unauthenticated)) (mastodon-auth--generate-token)))) -(ert-deftest get-token () +(ert-deftest mastodon-auth--get-token () "Should generate token and return JSON response." (with-temp-buffer (with-mock (mock (mastodon-auth--generate-token) => (progn (insert "\n\n{\"access_token\":\"abcdefg\"}") (current-buffer))) - (should (equal (mastodon-auth--get-token) '(:access_token "abcdefg")))))) + (should + (equal (mastodon-auth--get-token) + '(:access_token "abcdefg")))))) -(ert-deftest access-token-found () +(ert-deftest mastodon-auth--access-token-found () "Should return value in `mastodon-auth--token-alist' if found." (let ((mastodon-instance-url "https://instance.url") (mastodon-auth--token-alist '(("https://instance.url" . "foobar")) )) - (should (string= (mastodon-auth--access-token) "foobar")))) + (should + (string= (mastodon-auth--access-token) "foobar")))) -(ert-deftest access-token-2 () +(ert-deftest mastodon-auth--access-token-not-found () "Should set and return `mastodon-auth--token' if nil." (let ((mastodon-instance-url "https://instance.url") - (mastodon-auth--token nil)) + (mastodon-auth--token-alist nil)) (with-mock (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) - (should (string= (mastodon-auth--access-token) "foobaz")) - (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) + (should + (string= (mastodon-auth--access-token) + "foobaz")) + (should + (equal mastodon-auth--token-alist + '(("https://instance.url" . "foobaz"))))))) diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el index 12d2350..b112729 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -1,6 +1,8 @@ +;;; mastodon-client-test.el --- Tests for mastodon-client.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest register () +(ert-deftest mastodon-client--register () "Should POST to /apps." (with-mock (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") @@ -13,7 +15,7 @@ :unauthenticated)) (mastodon-client--register))) -(ert-deftest fetch () +(ert-deftest mastodon-client--fetch () "Should return client registration JSON." (with-temp-buffer (with-mock @@ -22,7 +24,7 @@ (current-buffer))) (should (equal (mastodon-client--fetch) '(:foo "bar")))))) -(ert-deftest store-1 () +(ert-deftest mastodon-client--store-1 () "Should return the client plist." (let ((mastodon-instance-url "http://mastodon.example") (plist '(:client_id "id" :client_secret "secret"))) @@ -33,8 +35,8 @@ (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) (should (equal (mastodon-client--store) plist)))))) -(ert-deftest store-2 () - "Should store client in `mastodon-client--token-file'." +(ert-deftest mastodon-client--store-2 () + "Should store client in `mastodon-client--token-file'." (let* ((mastodon-instance-url "http://mastodon.example") (plstore (plstore-open "stubfile.plstore")) (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) @@ -42,7 +44,7 @@ (should (string= (plist-get client :client_id) "id")) (should (string= (plist-get client :client_secret) "secret")))) -(ert-deftest read-finds-match () +(ert-deftest mastodon-client--read-finds-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.example")) (with-mock @@ -50,27 +52,27 @@ (should (equal (mastodon-client--read) '(:client_id "id2" :client_secret "secret2")))))) -(ert-deftest read-finds-no-match () +(ert-deftest mastodon-client--read-finds-no-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.social")) (with-mock (mock (mastodon-client--token-file) => "fixture/client.plstore") (should (equal (mastodon-client--read) nil))))) -(ert-deftest read-empty-store () +(ert-deftest mastodon-client--read-empty-store () "Should return nil if mastodon client is not present in the plstore." (with-mock (mock (mastodon-client--token-file) => "fixture/empty.plstore") (should (equal (mastodon-client--read) nil)))) -(ert-deftest client-set-and-matching () +(ert-deftest mastodon-client--client-set-and-matching () "Should return `mastondon-client' if `mastodon-client--client-details-alist' is non-nil and instance url is included." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("https://other.example" . :no-match) ("http://mastodon.example" . :matches)))) (should (eq (mastodon-client) :matches)))) -(ert-deftest client-set-but-not-matching () +(ert-deftest mastodon-client--client-set-but-not-matching () "Should read from `mastodon-token-file' if wrong data is cached." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("http://other.example" :wrong)))) @@ -81,7 +83,7 @@ '(("http://mastodon.example" :client_id "foo" :client_secret "bar") ("http://other.example" :wrong))))))) -(ert-deftest client-unset () +(ert-deftest mastodon-client--client-unset () "Should read from `mastodon-token-file' if available." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) @@ -91,7 +93,7 @@ (should (equal mastodon-client--client-details-alist '(("http://mastodon.example" :client_id "foo" :client_secret "bar"))))))) -(ert-deftest client-unset-and-not-in-storage () +(ert-deftest mastodon-client--client-unset-and-not-in-storage () "Should store client data in plstore if it can't be read." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el index d0f715e..00e1f41 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -1,9 +1,10 @@ +;;; mastodon-http-test.el --- Tests for mastodon-http.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest mastodon-http:get:retrieves-endpoint () +(ert-deftest mastodon-http--get-retrieves-endpoint () "Should make a `url-retrieve' of the given URL." - (let ((callback-double (lambda () "double"))) - (with-mock - (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) - (mock (mastodon-auth--access-token) => "test-token") - (mastodon-http--get "https://foo.bar/baz")))) + (with-mock + (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) + (mock (mastodon-auth--access-token) => "test-token") + (mastodon-http--get "https://foo.bar/baz"))) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 3345e74..886c7b0 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -1,6 +1,8 @@ +;;; mastodon-media-test.el --- Tests for mastodon-media.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest mastodon-media:get-avatar-rendering () +(ert-deftest mastodon-media--get-avatar-rendering () "Should return text with all expected properties." (with-mock (mock (image-type-available-p 'imagemagick) => t) @@ -16,7 +18,7 @@ (should (eq 'avatar (plist-get properties 'media-type))) (should (eq :mock-image (plist-get properties 'display)))))) -(ert-deftest mastodon-media:get-media-link-rendering () +(ert-deftest mastodon-media--get-media-link-rendering () "Should return text with all expected properties." (with-mock (mock (create-image * nil t) => :mock-image) @@ -39,7 +41,7 @@ (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" (plist-get properties 'help-echo)))))) -(ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-avatar-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) @@ -63,7 +65,7 @@ (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) -(ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-avatar-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock @@ -83,7 +85,7 @@ (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) -(ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-media-link-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock @@ -102,7 +104,7 @@ (let ((mastodon-media--preview-max-height 321)) (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) -(ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-media-link-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock @@ -122,7 +124,7 @@ (let ((mastodon-media--preview-max-height 321)) (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) -(ert-deftest mastodon-media:load-image-from-url:url-fetching-fails () +(ert-deftest mastodon-media--load-image-from-url-url-fetching-fails () "Should cope with failures in url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) @@ -143,7 +145,7 @@ ;; the media state was updated so we won't load this again: (should (eq 'loading-failed (get-text-property 7 'media-state))))))) -(ert-deftest mastodon-media:process-image-response () +(ert-deftest mastodon-media--process-image-response () "Should process the HTTP response and adjust the source buffer." (with-temp-buffer (with-mock @@ -180,7 +182,7 @@ (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) -(ert-deftest mastodon-media:inline-images () +(ert-deftest mastodon-media--inline-images () "Should process all media in buffer." (with-mock ;; Stub needed for the test setup: diff --git a/test/mastodon-notifications-test.el b/test/mastodon-notifications-test.el index 778d350..ee6748a 100644 --- a/test/mastodon-notifications-test.el +++ b/test/mastodon-notifications-test.el @@ -1,8 +1,10 @@ +;;; mastodon-notifications-test.el --- Tests for mastodon-notifications.el -*- lexical-binding: nil -*- + (require 'cl-lib) (require 'cl-macs) (require 'el-mock) -(defconst mastodon-notifications-test-base-mentioned +(defconst mastodon-notifications--test-base-mentioned '((id . "1234") (type . "mention") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -43,7 +45,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-favourite +(defconst mastodon-notifications--test-base-favourite '((id . "1234") (type . "favourite") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -84,7 +86,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-boosted +(defconst mastodon-notifications--test-base-boosted '((id . "1234") (type . "reblog") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -125,7 +127,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-followed +(defconst mastodon-notifications--test-base-followed '((id . "1234") (type . "follow") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -166,7 +168,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-favourite +(defconst mastodon-notifications--test-base-favourite '((id . "1234") (type . "mention") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -181,7 +183,7 @@ (statuses_count . 101) (note . "E")))) -(ert-deftest notification-get () +(ert-deftest mastodon-notifications--notification-get () "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el index 552f467..996f786 100644 --- a/test/mastodon-search-tests.el +++ b/test/mastodon-search-tests.el @@ -1,4 +1,4 @@ - +;;; mastodon-search-test.el --- Tests for mastodon-search.el -*- lexical-binding: nil -*- (defconst mastodon-search--single-account-query '((id . "242971") @@ -37,7 +37,7 @@ (verified_at))])) "A sample mastodon account search result (parsed json)") -(defconst mastodon-search-test-single-tag +(defconst mastodon-search--test-single-tag '((name . "TeamBringBackVisibleScrollbars") (url . "https://todon.nl/tags/TeamBringBackVisibleScrollbars") (history . [((day . "1636156800") (uses . "0") (accounts . "0")) @@ -48,7 +48,7 @@ ((day . "1635724800") (uses . "0") (accounts . "0")) ((day . "1635638400") (uses . "0") (accounts . "0"))]))) -(defconst mastodon-search-test-single-status +(defconst mastodon-search--test-single-status '((id . "107230316503209282") (created_at . "2021-11-06T13:19:40.628Z") (in_reply_to_id) @@ -114,33 +114,33 @@ (card) (poll))) -(ert-deftest mastodon-search-test-get-user-info-@ () +(ert-deftest mastodon-search--get-user-info-@ () "Should build a list from a single account for company completion." (should (equal (mastodon-search--get-user-info-@ mastodon-search--single-account-query) '(": ( ) { : | : & } ; :" "@mousebot" "https://todon.nl/@mousebot")))) -(ert-deftest mastodon-search-test-get-user-info () +(ert-deftest mastodon-search--get-user-info () "Should build a list from a single account for company completion." (should (equal (mastodon-search--get-user-info mastodon-search--single-account-query) '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot")))) -(ert-deftest mastodon-search-test-get-hashtag-info () +(ert-deftest mastodon-search--get-hashtag-info () "Should build a list of hashtag name and URL." (should (equal - (mastodon-search--get-hashtag-info mastodon-search-test-single-tag) + (mastodon-search--get-hashtag-info mastodon-search--test-single-tag) '("TeamBringBackVisibleScrollbars" "https://todon.nl/tags/TeamBringBackVisibleScrollbars")))) -(ert-deftest mastodon-search-test-get-status-info () +(ert-deftest mastodon-search--get-status-info () "Should return a list of ID, timestamp, content, and spoiler." (should (equal - (mastodon-search--get-status-info mastodon-search-test-single-status) + (mastodon-search--get-status-info mastodon-search--test-single-status) '("107230316503209282" "2021-11-06T13:19:40.628Z" "" diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index e4606cc..da3b315 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1,3 +1,5 @@ +;;; mastodon-tl-test.el --- Tests for mastodon-tl.el -*- lexical-binding: nil -*- + (require 'cl-lib) (require 'cl-macs) (require 'el-mock) @@ -89,46 +91,46 @@ (reblogged))) "A sample reblogged/boosted toot (parsed json)") -(ert-deftest remove-html-1 () +(ert-deftest mastodon-tl--remove-html-1 () "Should remove all tags." (let ((input "foobar foobaz")) (should (string= (mastodon-tl--remove-html input) "foobar foobaz")))) -(ert-deftest remove-html-2 () +(ert-deftest mastodon-tl--remove-html-2 () "Should replace <\p> tags with two new lines." (let ((input "foobar

")) (should (string= (mastodon-tl--remove-html input) "foobar\n\n")))) -(ert-deftest toot-id-boosted () +(ert-deftest mastodon-tl--toot-id-boosted () "If a toot is boostedm, return the reblog id." (should (string= (mastodon-tl--as-string (mastodon-tl--toot-id mastodon-tl-test-base-boosted-toot)) "4543919"))) -(ert-deftest toot-id () +(ert-deftest mastodon-tl--toot-id () "If a toot is boostedm, return the reblog id." (should (string= (mastodon-tl--as-string (mastodon-tl--toot-id mastodon-tl-test-base-toot)) "61208"))) -(ert-deftest as-string-1 () +(ert-deftest mastodon-tl--as-string-1 () "Should accept a string or number and return a string." (let ((id "1000")) (should (string= (mastodon-tl--as-string id) id)))) -(ert-deftest as-string-2 () +(ert-deftest mastodon-tl--as-string-2 () "Should accept a string or number and return a string." (let ((id 1000)) (should (string= (mastodon-tl--as-string id) (number-to-string id))))) -(ert-deftest more-json () +(ert-deftest mastodon-tl--more-json () "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) (mastodon-tl--more-json "timelines/foo" 12345)))) -(ert-deftest more-json-id-string () +(ert-deftest mastodon-tl--more-json-id-string () "Should request toots older than max_id. `mastodon-tl--more-json' should accept and id that is either @@ -138,7 +140,7 @@ a string or a numeric." (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) (mastodon-tl--more-json "timelines/foo" "12345")))) -(ert-deftest update-json-id-string () +(ert-deftest mastodon-tl--update-json-id-string () "Should request toots more recent than since_id. `mastodon-tl--updated-json' should accept and id that is either @@ -912,23 +914,27 @@ constant." "Browse tag #sampletag")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-mastodon-link () + "Should extract the hashtag from a tags url." (should (equal (mastodon-tl--extract-hashtag-from-url "https://example.org/tags/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-other-link () + "Should extract the hashtag from a tag url." (should (equal (mastodon-tl--extract-hashtag-from-url "https://example.org/tag/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-wrong-instance () + "Should not find a tag when the instance doesn't match." (should (null (mastodon-tl--extract-hashtag-from-url "https://example.org/tags/foo" "https://other.example.org")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-not-tag () + "Should not find a hashtag when not a tag url" (should (null (mastodon-tl--extract-hashtag-from-url "https://example.org/@userid" "https://example.org")))) @@ -957,17 +963,20 @@ constant." "Browse user profile of @foo@bar.example")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-correct-case () + "Should extract the user handle from url." (should (equal (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser" "@SomeUser") "@SomeUser@example.org"))) (ert-deftest mastodon-tl--extract-userhandle-from-url-missing-at-in-text () + "Should not extract a user handle from url if the text is wrong." (should (null (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser" "SomeUser")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-query-in-url () + "Should not extract a user handle from url if there is a query param." (should (null (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser?shouldnot=behere" "SomeUser")))) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 06da870..804c55a 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -1,6 +1,8 @@ +;;; mastodon-toot-test.el --- Tests for mastodon-toot.el -*- lexical-binding: nil -*- + (require 'el-mock) -(defconst mastodon-toot-multi-mention +(defconst mastodon-toot--multi-mention '((mentions . [((id . "1") (username . "federated") @@ -18,28 +20,37 @@ (defconst mastodon-toot-no-mention '((mentions . []))) -(ert-deftest toot-multi-mentions () +(ert-deftest mastodon-toot--multi-mentions () + "Should build a correct mention string from the test toot data. + +Even the local name \"local\" gets a domain name added." (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) (mastodon-instance-url "https://local.social")) (should (string= - (mastodon-toot--mentions mastodon-toot-multi-mention) + (mastodon-toot--mentions mastodon-toot--multi-mention) "@local@local.social @federated@federated.social @federated@federated.cafe ")))) -(ert-deftest toot-multi-mentions-with-name () +(ert-deftest mastodon-toot--multi-mentions-with-name () + "Should build a correct mention string omitting self. + +Here \"local\" is the user themselves and gets omitted from the +mention string." (let ((mastodon-auth--acct-alist '(("https://local.social". "local"))) (mastodon-instance-url "https://local.social")) (should (string= - (mastodon-toot--mentions mastodon-toot-multi-mention) + (mastodon-toot--mentions mastodon-toot--multi-mention) "@federated@federated.social @federated@federated.cafe ")))) -(ert-deftest toot-no-mention () +(ert-deftest mastodon-toot--no-mention () + "Should construct an empty mention string without mentions." (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) (mastodon-instance-url "https://local.social")) (should (string= (mastodon-toot--mentions mastodon-toot-no-mention) "")))) -(ert-deftest cancel () +(ert-deftest mastodon-toot--cancel () + "Should kill the buffer when cancelling the toot." (with-mock (mock (kill-buffer-and-window)) (mastodon-toot--cancel) -- cgit v1.2.3 From eb922191259721d6b1b232de41bbd43ebdb10d2f Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Tue, 9 Nov 2021 21:06:04 +0100 Subject: Make the local ert runner pass. When just loading the lisp and test files one can run `M-x ert` but because things are subtly different we need to tweak a few more things to make things pass in that mode. --- test/fixture | 1 + test/mastodon-client-tests.el | 2 +- test/mastodon-media-tests.el | 2 ++ 3 files changed, 4 insertions(+), 1 deletion(-) create mode 120000 test/fixture diff --git a/test/fixture b/test/fixture new file mode 120000 index 0000000..f418013 --- /dev/null +++ b/test/fixture @@ -0,0 +1 @@ +../fixture \ No newline at end of file diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el index b112729..9123286 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -36,7 +36,7 @@ (should (equal (mastodon-client--store) plist)))))) (ert-deftest mastodon-client--store-2 () - "Should store client in `mastodon-client--token-file'." + "Should store client in `mastodon-client--token-file'." (let* ((mastodon-instance-url "http://mastodon.example") (plstore (plstore-open "stubfile.plstore")) (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 886c7b0..6168aaf 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -70,6 +70,7 @@ (let ((url "http://example.org/image.png")) (with-mock (mock (image-type-available-p 'imagemagick) => nil) + (mock (image-transforms-p) => nil) (mock (create-image * nil t) => '(image foo)) (mock (copy-marker 7) => :my-marker ) (mock (url-retrieve @@ -109,6 +110,7 @@ (let ((url "http://example.org/image.png")) (with-mock (mock (image-type-available-p 'imagemagick) => nil) + (mock (image-transforms-p) => nil) (mock (create-image * nil t) => '(image foo)) (mock (copy-marker 7) => :my-marker ) (mock (url-retrieve -- cgit v1.2.3 From f22cfa60d301a1b834cb86f6f9b75b57d9dab6e8 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sun, 12 Dec 2021 10:41:35 +0100 Subject: rename company mentions to 'mastodon-toot-mentions' and fix matching for both user handle and user display name. --- lisp/mastodon-toot.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 753a659..9112fc9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -519,9 +519,10 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--mentions-company-candidates (prefix) "Given a company PREFIX query, build a list of candidates. The prefix can match against both user handles and display names." - (let (res) + (let ((prefix (substring prefix 1)) ;remove @ for search + (res)) (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (cadr item) t) + (when (or (string-prefix-p prefix (substring (cadr item) 1) t) (string-prefix-p prefix (car item) t)) (push (mastodon-toot--mentions-company-make-candidate item) res))) res)) @@ -533,11 +534,11 @@ The prefix can match against both user handles and display names." (url (caddr candidate))) (propertize handle 'annot display-name 'meta url))) -(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) +(defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) + (interactive (company-begin-backend 'mastodon-toot-mentions)) (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode (save-excursion (forward-whitespace -1) @@ -856,7 +857,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (when (require 'company nil :noerror) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) + (add-to-list 'company-backends 'mastodon-toot-mentions)) (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From 2259577b8616005fd0265e211ae63188f4b32a3d Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 10:39:20 +0100 Subject: a first hack to make media uploads immediate and async. this commit moves the call to -upload-attached-media into -attach-media. upload-attached-media now uploads a single item only, whichever file has just been selected at the prompt. but we still use the list of attached-media to handle preview displays. --- lisp/mastodon-http.el | 2 +- lisp/mastodon-toot.el | 45 ++++++++++++++++++++++----------------------- 2 files changed, 23 insertions(+), 24 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1ec0dc0..a4f126f 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -261,7 +261,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." :parser 'json-read :headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - :sync t + :sync nil :success (cl-function (lambda (&key data &allow-other-keys) (when data diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9112fc9..6eac981 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -446,10 +446,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. -If media items have been attached with -`mastodon-toot--attach-media', upload them with -`mastodon-toot-upload-attached-media' and attach them to the -toot." +If media items have been attached and uploaded with +`mastodon-toot--attach-media', they are attached to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) (empty-toot-p (and (not mastodon-toot--media-attachments) @@ -465,7 +463,8 @@ toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done + ;; (mastodon-toot--upload-attached-media) + ;; moved upload to mastodon-toot--attach-media (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) @@ -614,9 +613,10 @@ The prefix can match against both user handles and display names." (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. -A preview is displayed in the toot create buffer, and the file -will be uploaded and attached to the toot upon sending." + "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the new toot buffer, and the file +is uploaded asynchronously using `mastodon-toot--upload-attached-media'. +File is actually attached to the toot upon posting." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -627,21 +627,20 @@ will be uploaded and attached to the toot upon sending." (:content-type . ,content-type) (:description . ,description) (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display)) - -(defun mastodon-toot--upload-attached-media () - "Actually upload attachments using `mastodon-http--post-media-attachment'. -The files to be uploaded are in `mastodon-toot--media-attachments'. -The items' ids are added to `mastodon-toot--media-attachment-ids', -which are used to attach them to a toot after uploading." - (mapcar (lambda (attachment) - (let* ((filename (expand-file-name - (alist-get :filename attachment))) - (caption (alist-get :description attachment)) - (url (concat mastodon-instance-url "/api/v2/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) - (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments)))) + +(defun mastodon-toot--upload-attached-media (attachment) + "Upload a single attachment using `mastodon-http--post-media-attachment'. +The item's id is added to `mastodon-toot--media-attachment-ids', +which is used to attach it to a toot when posting." + (let* ((filename (expand-file-name + (alist-get :filename attachment))) + (caption (alist-get :description attachment)) + (url (concat mastodon-instance-url "/api/v2/media"))) + (message "Uploading %s..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption))) (defun mastodon-toot--refresh-attachments-display () "Update the display attachment previews in toot draft buffer." -- cgit v1.2.3 From f2af3a64967c403145c9b32aefd08ea8932a4770 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 12:54:58 +0100 Subject: attach media test before post just test that length of --media-attachments == length of --media-attachment-ids. --- lisp/mastodon-toot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6eac981..9a88bd5 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -463,11 +463,14 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments + (if (= (length mastodon-toot--media-attachments) + (length mastodon-toot--media-attachment-ids)) ;; (mastodon-toot--upload-attached-media) ;; moved upload to mastodon-toot--attach-media - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mapcar (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids) + (message "Looks like something went wrong with your uploads. Maybe you want to try again.")))) (args (append args-media args-no-media))) (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.") -- cgit v1.2.3 From 0fd7f354e9474ca9eb63049558c3a44514228ba5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 21:00:18 +0100 Subject: refactor un/follow, un/block, un/mute functions --- lisp/mastodon-tl.el | 188 ++++++++++++++++++++-------------------------------- 1 file changed, 72 insertions(+), 116 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5418374..742b247 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -940,145 +940,101 @@ webapp" "Query for USER-HANDLE from current status and follow that user." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to follow: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) - (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/follow" user-id)))) - (if account - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) followed!" name user-handle)))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "follow"))) + (mastodon-tl--do-user-action-and-response user-handle "follow")) (defun mastodon-tl--unfollow-user (user-handle) "Query for USER-HANDLE from current status and unfollow that user." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to unfollow: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) - (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/unfollow" user-id)))) - (if account - (when (y-or-n-p (format "Unfollow user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) unfollowed!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "unfollow"))) + (mastodon-tl--do-user-action-and-response user-handle "unfollow" t)) -(defun mastodon-tl--mute-user (user-handle) - "Query for USER-HANDLE from current status and mute that user." +(defun mastodon-tl--block-user (user-handle) + "Query for USER-HANDLE from current status and block that user." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to mute: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) - (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/mute" user-id)))) - (if account - (when (y-or-n-p (format "Mute user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) muted!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "block"))) + (mastodon-tl--do-user-action-and-response user-handle "block")) -(defun mastodon-tl--unmute-user (user-handle) - "Query for USER-HANDLE from list of muted users and unmute that user." +(defun mastodon-tl--unblock-user (user-handle) + "Query for USER-HANDLE from list of blocked users and unblock that user." (interactive (list - (let* ((mutes-url (mastodon-http--api (format "mutes"))) - (mutes-json (mastodon-http--get-json mutes-url)) - (muted-accts (mapcar (lambda (muted) - (alist-get 'acct muted)) - mutes-json))) - (completing-read "Handle of user to unmute: " - muted-accts - nil ; predicate - t)))) - (let* ((account (mastodon-profile--search-account-by-handle - user-handle)) - (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/unmute" user-id)))) - (if account - (when (y-or-n-p (format "Unmute user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) unmuted!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-blocks-or-mutes-list-get "unblock"))) + (if (not user-handle) + (message "Looks like you have no blocks to unblock!") + (mastodon-tl--do-user-action-and-response user-handle "unblock" t))) -(defun mastodon-tl--block-user (user-handle) - "Query for USER-HANDLE from current status and block that user." +(defun mastodon-tl--mute-user (user-handle) + "Query for USER-HANDLE from current status and mute that user." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to block: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) - (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/block" user-id)))) - (if account - (when (y-or-n-p (format "Block user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) blocked!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "mute"))) + (mastodon-tl--do-user-action-and-response user-handle "mute")) -(defun mastodon-tl--unblock-user (user-handle) - "Query for USER-HANDLE from list of blocked users and unblock that user." +(defun mastodon-tl--unmute-user (user-handle) + "Query for USER-HANDLE from list of muted users and unmute that user." (interactive (list - (let* ((blocks-url (mastodon-http--api (format "blocks"))) - (blocks-json (mastodon-http--get-json blocks-url)) - (blocked-accts (mapcar (lambda (blocked) - (alist-get 'acct blocked)) - blocks-json))) - (completing-read "Handle of user to unblock: " - blocked-accts + (mastodon-tl--interactive-blocks-or-mutes-list-get "unmute"))) + (if (not user-handle) + (message "Looks like you have no mutes to unmute!") + (mastodon-tl--do-user-action-and-response user-handle "unmute" t))) + +(defun mastodon-tl--interactive-user-handles-get (action) + "Get the list of user-handles for ACTION from the current toot." + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read (format "Handle of user to %s: " action) + user-handles nil ; predicate - t)))) - (let* ((account (mastodon-profile--search-account-by-handle - user-handle)) + 'confirm))) + +(defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) + "Fetch the list of accounts for ACTION from the server. +Action must be either \"unblock\" or \"mute\"." + (let* ((endpoint (cond ((equal action "unblock") + "blocks") + ((equal action "unmute") + "mutes"))) + (url (mastodon-http--api endpoint)) + (json (mastodon-http--get-json url)) + (accts (mapcar (lambda (user) + (alist-get 'acct user)) + json))) + (when accts + (completing-read (format "Handle of user to %s: " action) + accts + nil ; predicate + t)))) + +(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp) + "Do ACTION on user NAME/USER-HANDLE. +NEGP is whether the action involves un-doing something." + (let* ((account (if negp + ;; TODO check if both are actually needed + (mastodon-profile--search-account-by-handle + user-handle) + (mastodon-profile--lookup-account-in-status + user-handle (mastodon-profile--toot-json)))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/unblock" user-id)))) + (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) (if account - (when (y-or-n-p (format "Unblock user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) unblocked!" name user-handle))))) + (if (equal action "follow") ; y-or-n for all but follow + (mastodon-tl--do-user-action-function url name user-handle action) + (when (y-or-n-p (format "%s user %s? " action name)) + (mastodon-tl--do-user-action-function url name user-handle action))) (message "Cannot find a user with handle %S" user-handle)))) +(defun mastodon-tl--do-user-action-function (url name user-handle action) +"Post ACTION on user NAME/USER-HANDLE to URL." + (let ((response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (message "User %s (@%s) %sed!" name user-handle action))))) + ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () "Reload the current timeline or profile page. -- cgit v1.2.3 From 834dabcb9147e45633166b3f3b35b2b1d6fc64cc Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 21:16:24 +0100 Subject: customize option to enable custom emoji by default. --- lisp/mastodon-toot.el | 5 +++++ lisp/mastodon.el | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9112fc9..cb3cd44 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -106,6 +106,11 @@ This is only used if company mode is installed." (const :tag "following only" "following") (const :tag "all users" "all"))) +(defcustom mastodon-toot--enable-custom-instance-emoji nil + "Whether to enable your instance's custom emoji by default." + :group 'mastodon-toot + :type 'boolean) + (defvar-local mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index f9c18a0..662b691 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -223,7 +223,9 @@ If REPLY-JSON is the json of the toot being replied to." ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () (when (require 'emojify nil :noerror) - (emojify-mode t)))) + (emojify-mode t) + (when mastodon-toot--enable-custom-instance-emoji + (mastodon-toot--enable-custom-emoji))))) (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." -- cgit v1.2.3 From 663993bdac18f3c5dea4bc5d928f3c71d22b4824 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 16 Dec 2021 12:18:49 +0100 Subject: improve display of polls: place them after toot content and add padding for vote count display. --- lisp/mastodon-tl.el | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5418374..c57a9b1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -695,9 +695,9 @@ message is a link which unhides/hides the main body." (alist-get 'poll reblog) (alist-get 'poll toot)))) (concat + (mastodon-tl--render-text content toot) (when poll-p (mastodon-tl--get-poll toot)) - (mastodon-tl--render-text content toot) (mastodon-tl--media toot)))) (defun mastodon-tl--insert-status (toot body author-byline action-byline) @@ -729,16 +729,30 @@ takes a single function. By default it is "If post TOOT is a poll, return a formatted string of poll." (let* ((poll (mastodon-tl--field 'poll toot)) (options (mastodon-tl--field 'options poll)) + (option-titles (mapcar (lambda (x) + (alist-get 'title x)) + options)) + (longest-option (car (sort option-titles + (lambda (x y) + (> (length x) + (length y)))))) (option-counter 0)) - (concat "Poll: \n\n" + (concat "\nPoll: \n\n" (mapconcat (lambda (option) (progn - (format "Option %s: %s, %s votes.\n" + (format "Option %s: %s%s [%s votes].\n" (setq option-counter (1+ option-counter)) (alist-get 'title option) + (make-string + (1+ + (- (length longest-option) + (length (alist-get 'title + option)))) + ?\ ) (alist-get 'votes_count option)))) options - "\n") "\n"))) + "\n") + "\n"))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." -- cgit v1.2.3 From 29fc628c128b82a91c87de226ebcb66db248fd4d Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 16 Dec 2021 14:12:52 +0100 Subject: indent-buffer on -tl.el --- lisp/mastodon-tl.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 742b247..46d999f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -287,13 +287,13 @@ 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 + ;; TODO: Replace url browsing with native profile viewing + '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--byline-boosted (toot) @@ -986,10 +986,10 @@ webapp" "Get the list of user-handles for ACTION from the current toot." (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) - (completing-read (format "Handle of user to %s: " action) - user-handles - nil ; predicate - 'confirm))) + (completing-read (format "Handle of user to %s: " action) + user-handles + nil ; predicate + 'confirm))) (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) "Fetch the list of accounts for ACTION from the server. @@ -1004,10 +1004,10 @@ Action must be either \"unblock\" or \"mute\"." (alist-get 'acct user)) json))) (when accts - (completing-read (format "Handle of user to %s: " action) - accts - nil ; predicate - t)))) + (completing-read (format "Handle of user to %s: " action) + accts + nil ; predicate + t)))) (defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp) "Do ACTION on user NAME/USER-HANDLE. @@ -1029,7 +1029,7 @@ NEGP is whether the action involves un-doing something." (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--do-user-action-function (url name user-handle action) -"Post ACTION on user NAME/USER-HANDLE to URL." + "Post ACTION on user NAME/USER-HANDLE to URL." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response (lambda () -- cgit v1.2.3 From adfcd9bb45e3a59e8dbc5968708084e3dbf96b68 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 16 Dec 2021 15:52:22 +0100 Subject: refactor notify-user-posts functions this updates the functions to toggle receiving notifications when a user posts to work with the newly refactored follow-user function and associated functions. --- lisp/mastodon-tl.el | 57 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 25 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9305bea..46cd1d6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -954,34 +954,25 @@ webapp" (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. -If NOTIFY is \"false\", disable notifications when that user posts." +If NOTIFY is \"false\", disable notifications when that user posts. +This can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "follow"))) - (mastodon-tl--do-user-action-and-response user-handle "follow" notify)) + (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify)) -(defun mastodon-tl--notify-user-posts (user-handle) - "Query for USER-HANDLE from current status and enable notifications when they post." +(defun mastodon-tl--enable-notify-user-posts (user-handle) + "Query for USER-HANDLE and enable notifications when they post." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Receive notifications when user posts: " - user-handles - nil ; predicate - 'confirm)))) + (mastodon-tl--interactive-user-handles-get "enable"))) (mastodon-tl--follow-user user-handle "true")) -(defun mastodon-tl--no-notify-user-posts (user-handle) - "Query for USER-HANDLE from current status and disable notifications when they post." +(defun mastodon-tl--disable-notify-user-posts (user-handle) + "Query for USER-HANDLE and disable notifications when they post." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Disable notifications when user posts: " - user-handles - nil ; predicate - 'confirm)))) + (mastodon-tl--interactive-user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) (defun mastodon-tl--unfollow-user (user-handle) @@ -1027,7 +1018,10 @@ If NOTIFY is \"false\", disable notifications when that user posts." "Get the list of user-handles for ACTION from the current toot." (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) - (completing-read (format "Handle of user to %s: " action) + (completing-read (if (or (equal action "disable") + (equal action "enable")) + (format "%s notifications when user posts: " action) + (format "Handle of user to %s: " action)) user-handles nil ; predicate 'confirm))) @@ -1050,9 +1044,12 @@ Action must be either \"unblock\" or \"mute\"." nil ; predicate t)))) -(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp) +(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify) "Do ACTION on user NAME/USER-HANDLE. -NEGP is whether the action involves un-doing something." +NEGP is whether the action involves un-doing something. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts. +NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (let* ((account (if negp ;; TODO check if both are actually needed (mastodon-profile--search-account-by-handle @@ -1061,20 +1058,30 @@ NEGP is whether the action involves un-doing something." user-handle (mastodon-profile--toot-json)))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) + (url (mastodon-http--api + (if notify + (format "accounts/%s/%s?notify=%s" user-id action notify) + (format "accounts/%s/%s" user-id action))))) (if account (if (equal action "follow") ; y-or-n for all but follow - (mastodon-tl--do-user-action-function url name user-handle action) + (mastodon-tl--do-user-action-function url name user-handle action notify) (when (y-or-n-p (format "%s user %s? " action name)) (mastodon-tl--do-user-action-function url name user-handle action))) (message "Cannot find a user with handle %S" user-handle)))) -(defun mastodon-tl--do-user-action-function (url name user-handle action) +(defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify) "Post ACTION on user NAME/USER-HANDLE to URL." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response (lambda () - (message "User %s (@%s) %sed!" name user-handle action))))) + (cond ((string-equal notify "true") + (message "Receiving notifications for user %s (@%s)!" + name user-handle)) + ((string-equal notify "false") + (message "Not receiving notifications for user %s (@%s)!" + name user-handle)) + ((eq notify nil) + (message "User %s (@%s) %sed!" name user-handle action))))))) ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () -- cgit v1.2.3