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 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