From ca4ac2e568690b7c1c0a2a1b3ebf11be2a963aa8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 9 Aug 2024 18:08:20 +0200 Subject: fix read-poll option check --- lisp/mastodon-tl.el | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 948ee37..6c6307d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1358,19 +1358,18 @@ OPTIONS is an alist." (defun mastodon-tl--read-poll-option () "Read a poll option to vote on a poll." (let* ((toot (mastodon-tl--property 'item-json)) - (poll (mastodon-tl--field 'poll toot)) - (options (mastodon-tl--field 'options poll)) - (titles (mastodon-tl--map-alist 'title options)) - (number-seq (number-sequence 1 (length options))) - (numbers (mapcar #'number-to-string number-seq)) - (options-alist (cl-mapcar #'cons numbers titles)) - - (candidates (mastodon-tl--format-read-poll-option options-alist)) - (choice (completing-read "Poll option to vote for: " - candidates nil :match))) + (poll (mastodon-tl--field 'poll toot))) (if (null poll) (user-error "No poll here") - (list (cdr (assoc choice candidates)))))) + (let* ((options (mastodon-tl--field 'options poll)) + (titles (mastodon-tl--map-alist 'title options)) + (number-seq (number-sequence 1 (length options))) + (numbers (mapcar #'number-to-string number-seq)) + (options-alist (cl-mapcar #'cons numbers titles)) + (candidates (mastodon-tl--format-read-poll-option options-alist)) + (choice (completing-read "Poll option to vote for: " + candidates nil :match))) + (list (cdr (assoc choice candidates))))))) (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 33f6feaf767a7a4b9ed49e28895daf753bd1d44e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 12 Aug 2024 15:49:45 +0200 Subject: fix toggle sensitive media --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6c6307d..9218037 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1232,12 +1232,12 @@ SENSITIVE is a flag from the item's JSON data." (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move)) ;; display: `( display ,data - sensitive-state showing)) + sensitive-state showing) ;; hide: `( sensitive-state hidden display ,(create-image - mastodon-media--sensitive-image-data nil t)))))) + mastodon-media--sensitive-image-data nil t))))))) ;; POLLS -- cgit v1.2.3 From 08a9357e33d80554108e28e57de3d50f6710914e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:27:53 +0200 Subject: instance desc - missing paren --- lisp/mastodon-views.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4b29115..4b6978d 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -752,7 +752,7 @@ MISSKEY means the instance is a Misskey or derived server." (mastodon-tl--do-if-item (let* ((toot (or (and (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'profile-json)) ; either profile - (mastodon-tl--property 'item-json)) ; or toot or user listing + (mastodon-tl--property 'item-json))) ; or toot or user listing (reblog (alist-get 'reblog toot)) (account (or (alist-get 'account reblog) (alist-get 'account toot) -- cgit v1.2.3 From 7c73068dd2400ceae3f789571a781c41561c3b44 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:32:16 +0200 Subject: indent tl.el --- lisp/mastodon-tl.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9218037..21aa1c4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1233,11 +1233,11 @@ SENSITIVE is a flag from the item's JSON data." ;; display: `( display ,data sensitive-state showing) - ;; hide: - `( sensitive-state hidden - display - ,(create-image - mastodon-media--sensitive-image-data nil t))))))) + ;; hide: + `( sensitive-state hidden + display + ,(create-image + mastodon-media--sensitive-image-data nil t))))))) ;; POLLS @@ -2345,7 +2345,7 @@ LANGS is the accumulated array param alist if we re-run recursively." (car user-handles) (completing-read (cond ((or ; TODO: make this "enable/disable notifications" (equal action "disable") - (equal action "enable")) + (equal action "enable")) (format "%s notifications when user posts: " action)) ((string-suffix-p "boosts" action) (format "%s by user: " action)) -- cgit v1.2.3 From 7eb3e40bab8282b9f20522e466f02d505dca8200 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:32:34 +0200 Subject: intent toot.el --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7c5472b..5f4116f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -225,7 +225,7 @@ Takes its form from `window-configuration-to-register'.") "The text of the toot being composed.") (persist-defvar mastodon-toot-draft-toots-list nil - "A list of toots that have been saved as drafts. + "A list of toots that have been saved as drafts. For the moment we just put all composed toots in here, as we want to also capture toots that are \"sent\" but that don't successfully send.") -- cgit v1.2.3 From da13c9a3eafa97fce47fcc9978469c2338f2f85c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:33:31 +0200 Subject: indent profile.el --- lisp/mastodon-profile.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0a17a25..093e0a8 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -127,7 +127,7 @@ It contains details of the current user's account.") "Keymap for `mastodon-profile-update-mode'.") (persist-defvar mastodon-profile-account-settings nil - "An alist of account settings saved from the server. + "An alist of account settings saved from the server. Other clients can change these settings on the server at any time, so this list is not the canonical source for settings. It is updated on entering mastodon mode and on toggle any setting it @@ -319,13 +319,13 @@ If value is :json-false, return nil." (defun mastodon-profile--update-note-count (&rest _args) "Display the character count of the profile note buffer." (let* ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'note-header + (header-region (mastodon-tl--find-property-range 'note-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'note-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'note-counter - (point-min))) - (count (number-to-string (mastodon-toot--count-toot-chars - (buffer-substring-no-properties - (cdr header-region) (point-max)))))) + (count (number-to-string (mastodon-toot--count-toot-chars + (buffer-substring-no-properties + (cdr header-region) (point-max)))))) (add-text-properties (car count-region) (cdr count-region) (list 'display count)))) -- cgit v1.2.3 From e8d8f6307628a4fedc2836fe5bd3f58dc9d0c61f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:44:10 +0200 Subject: do-if-item for scheduled toots --- lisp/mastodon-views.el | 58 +++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4b6978d..54f829d 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -513,7 +513,7 @@ JSON is the data returned by the server." 'item-type 'scheduled ; so we nav here 'face 'font-lock-comment-face 'keymap mastodon-views--scheduled-map - 'scheduled-json toot + 'item-json toot 'id .id) "\n"))) @@ -529,10 +529,8 @@ If ID, just return that toot." (defun mastodon-views--reschedule-toot () "Reschedule the scheduled toot at point." (interactive) - (let ((id (mastodon-tl--property 'id :no-move))) - (if (null id) - (user-error "no scheduled toot at point?") - (mastodon-toot--schedule-toot :reschedule)))) + (mastodon-tl--do-if-item + (mastodon-toot--schedule-toot :reschedule))) (defun mastodon-views--copy-scheduled-toot-text () "Copy the text of the scheduled toot at point." @@ -547,36 +545,34 @@ If ID, just return that toot." ID is that of the scheduled toot to cancel. NO-CONFIRM means there is no ask or message, there is only do." (interactive) - (let ((id (or id (mastodon-tl--property 'id :no-move)))) - (if (null id) - (user-error "no scheduled toot at point?") - (when (or no-confirm - (y-or-n-p "Cancel scheduled toot?")) - (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) - (response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda (_) - (mastodon-views--view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!"))))))))) + (mastodon-tl--do-if-item + (when (or no-confirm + (y-or-n-p "Cancel scheduled toot?")) + (let* ((id (or id (mastodon-tl--property 'id :no-move))) + (url (mastodon-http--api (format "scheduled_statuses/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda (_) + (mastodon-views--view-scheduled-toots) + (unless no-confirm + (message "Toot cancelled!")))))))) (defun mastodon-views--edit-scheduled-as-new () "Edit scheduled status as new toot." (interactive) - (let ((id (mastodon-tl--property 'id :no-move))) - (if (null id) - (user-error "no scheduled toot at point?") - (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) - (scheduled (alist-get 'scheduled_at toot))) - (let-alist (alist-get 'params toot) - ;; TODO: preserve polls - ;; (poll (alist-get 'poll params)) - (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) - (goto-char (point-max)) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties - .in_reply_to_id .visibility .spoiler_text .language - scheduled id (alist-get 'media_attachments toot))))))) + (mastodon-tl--do-if-item + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) + (id (mastodon-tl--property 'id :no-move)) + (scheduled (alist-get 'scheduled_at toot))) + (let-alist (alist-get 'params toot) + ;; TODO: preserve polls + ;; (poll (alist-get 'poll params)) + (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) + (goto-char (point-max)) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility .spoiler_text .language + scheduled id (alist-get 'media_attachments toot)))))) ;;; FILTERS -- cgit v1.2.3 From e1e44d43daf78c5fc83a8bcc8d29613d4fc56175 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 15:08:27 +0200 Subject: fix a bunch of tests --- lisp/mastodon-tl.el | 12 ++++++++---- test/mastodon-search-tests.el | 18 +++++++++--------- test/mastodon-tl-tests.el | 34 +++++++++++++++++----------------- 3 files changed, 34 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 21aa1c4..944e662 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -971,16 +971,20 @@ this should be of the form , e.g. \"@Gargon\"." buffer-text ; no instance suffix for local mention (concat buffer-text "@" host))))) -(defun mastodon-tl--hashtag-from-url (url _instance-url) +(defun mastodon-tl--hashtag-from-url (url instance-url) "Return the hashtag that URL points to or nil if URL is not a tag link. INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing the toot)." - ;; FIXME: do we rly need to check it against instance-url? - (let* ((parsed (url-generic-parse-url url)) + ;; TODO: do we rly need to check it against instance-url? + ;; test suggests we might + (let* ((instance-host (url-host + (url-generic-parse-url instance-url))) + (parsed (url-generic-parse-url url)) (path (url-filename parsed)) (split (string-split path "/"))) - (when (string-prefix-p "/tag" path) ;; "/tag/" or "/tags/" + (when (and (string= instance-host (url-host parsed)) + (string-prefix-p "/tag" path)) ;; "/tag/" or "/tags/" (nth 2 split)))) diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el index 8dc597a..c736c35 100644 --- a/test/mastodon-search-tests.el +++ b/test/mastodon-search-tests.el @@ -139,12 +139,12 @@ '("TeamBringBackVisibleScrollbars" "https://todon.nl/tags/TeamBringBackVisibleScrollbars")))) -(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) - '("107230316503209282" - "2021-11-06T13:19:40.628Z" - "" - "

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

")))) +;; (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) +;; '("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 02e1157..6d9ab9a 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -41,9 +41,9 @@ (following_count . 13) (statuses_count . 101) (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) + (media_attachments . ()) + (mentions . ()) + (tags . ()) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") (url . "https://example.space/users/acct42/updates/123456789") (content . "

Just some text

") @@ -70,9 +70,9 @@ (following_count . 13) (statuses_count . 101) (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) + (media_attachments . ()) + (mentions . ()) + (tags . ()) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") (url . "https://example.space/users/acct42/updates/123456789") (reblogs_count . 0) @@ -95,12 +95,12 @@ (following_count . 1) (statuses_count . 1) (note . "Other account")) - (media_attachments . []) - (mentions . [((url . "https://mastodon.social/@johnson") + (media_attachments . ()) + (mentions . (((url . "https://mastodon.social/@johnson") (acct . "acct42") (id . 42) - (username . "acct42"))]) - (tags . []) + (username . "acct42")))) + (tags . ()) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") (content . "

@acct42 boost

") (url . "https://example.space/users/acct42/updates/123456789") @@ -1014,27 +1014,27 @@ constant." (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 + (should (equal (mastodon-tl--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 + (should (equal (mastodon-tl--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 + (should (null (mastodon-tl--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 + (should (null (mastodon-tl--hashtag-from-url "https://example.org/@userid" "https://example.org")))) @@ -1063,20 +1063,20 @@ constant." (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 + (should (equal (mastodon-tl--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 + (should (null (mastodon-tl--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 + (should (null (mastodon-tl--userhandle-from-url "https://example.org/@someuser?shouldnot=behere" "SomeUser")))) -- cgit v1.2.3