From 18c146170a21dccd576228b1c6e3bcba9f0d50e9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 2 Nov 2021 15:24:28 +0100 Subject: add support for receiving notifications when a user posts - mastodon-tl--notify-user-posts - mastodon-tl--no-notify-user-posts - + some schtick in notifications.el to make sure the notifs display ok. --- lisp/mastodon-notifications.el | 26 +++++++++++++++++++++++-- lisp/mastodon-tl.el | 44 ++++++++++++++++++++++++++++++++++++++---- 2 files changed, 64 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 2e9aea3..19b2d3c 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -53,7 +53,8 @@ ("follow" . mastodon-notifications--follow) ("favourite" . mastodon-notifications--favourite) ("reblog" . mastodon-notifications--reblog) - ("follow_request" . mastodon-notifications--follow-request)) + ("follow_request" . mastodon-notifications--follow-request) + ("status" . mastodon-notifications--status)) "Alist of notification types and their corresponding function.") (defvar mastodon-notifications--response-alist @@ -61,7 +62,8 @@ ("Followed" . "you") ("Favourited" . "your status from") ("Boosted" . "your status from") - ("Requested to follow" . "you")) + ("Requested to follow" . "you") + ("Posted" . "a post")) "Alist of subjects for notification types.") (defun mastodon-notifications--byline-concat (message) @@ -204,6 +206,26 @@ "Boosted")) id))) +(defun mastodon-notifications--status (note) + "Format for a `status' NOTE. +Status notifications are given when +`mastodon-tl--notify-user-posts' has been set." + (let ((id (cdr (assoc 'id note))) + (status (mastodon-tl--field 'status note))) + (mastodon-notifications--insert-status + status + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (mastodon-tl--content status))) + (lambda (_status) + (mastodon-tl--byline-author + note)) + (lambda (_status) + (mastodon-notifications--byline-concat + "Posted")) + id))) + (defun mastodon-notifications--insert-status (toot body author-byline action-byline &optional id) "Display the content and byline of timeline element TOOT. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9bbc44f..6cb5ab8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -945,8 +945,10 @@ webapp" (cdr (assoc 'descendants context)))))) (message "No Thread!")))) -(defun mastodon-tl--follow-user (user-handle) - "Query for USER-HANDLE from current status and follow that user." +(defun mastodon-tl--follow-user (user-handle &optional notify) + "Query for USER-HANDLE from current status and follow that user. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles @@ -959,12 +961,22 @@ webapp" user-handle (mastodon-profile--toot-json))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/follow" user-id)))) + (url (mastodon-http--api + (if notify + (format "accounts/%s/follow?notify=%s" user-id notify) + (format "accounts/%s/follow" user-id))))) (if account (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response (lambda () - (message "User %s (@%s) followed!" name user-handle)))) + (cond ((string-equal notify "true") + (message "Receiving notifications for user %s (@%s)!" + name user-handle)) + ((string-equal notify "false") + (message "Not receiving notifications for user %s (@%s)!" + name user-handle)) + ((eq notify nil) + (message "User %s (@%s) followed!" name user-handle)))))) (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--unfollow-user (user-handle) @@ -990,6 +1002,30 @@ webapp" (message "User %s (@%s) unfollowed!" name user-handle))))) (message "Cannot find a user with handle %S" user-handle)))) +(defun mastodon-tl--notify-user-posts (user-handle) + "Query for USER-HANDLE from current status and enable notifications when they post." + (interactive + (list + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "Receive notifications when user posts: " + user-handles + nil ; predicate + 'confirm)))) + (mastodon-tl--follow-user user-handle "true")) + +(defun mastodon-tl--no-notify-user-posts (user-handle) + "Query for USER-HANDLE from current status and disable notifications when they post." + (interactive + (list + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "Disable notifications when user posts: " + user-handles + nil ; predicate + 'confirm)))) + (mastodon-tl--follow-user user-handle "false")) + (defun mastodon-tl--mute-user (user-handle) "Query for USER-HANDLE from current status and mute that user." (interactive -- cgit v1.2.3 From 8d543a03694e575cd0352275b60b2d232bfeaeb5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 10:02:24 +0100 Subject: remove help-echo for faves/boosts/replies, it breaks img echo keymap --- lisp/mastodon-tl.el | 10 ---------- 1 file changed, 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 62d283b..5418374 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -720,16 +720,6 @@ takes a single function. By default it is (mastodon-tl--byline toot author-byline action-byline)) 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) - 'help-echo (when (and mastodon-tl--buffer-spec - (string-match-p - "context" ; when thread view - (plist-get mastodon-tl--buffer-spec 'endpoint))) - ;; prefer the reblog toot if present: - (let ((toot-to-use (or (alist-get 'reblog toot) toot))) - (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-use) - (alist-get 'reblogs_count toot-to-use) - (alist-get 'replies_count toot-to-use)))) 'toot-json toot) "\n") (when mastodon-tl--display-media-p -- cgit v1.2.3 From 6485f236ce9bab609a606d6f5896b1d39b3c114d Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 10:12:56 +0100 Subject: fetch media_attachments' "type" from server and store as property - if the type is not "image", it is displayed in`'help-echo' property. - the idea is to use this to handle gifs/videos differently to images. but for now i'm not sure how to actually render such media. but this way, at least the item could be viewed externally if the user wants to see it, or at least they know they're missing out on something. - NB: EWW can't handle content type "video/mp4". --- lisp/mastodon-media.el | 34 ++++++++++++++++++++-------------- lisp/mastodon-tl.el | 5 +++-- 2 files changed, 23 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index f7386c6..457628f 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -292,21 +292,27 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type) "Return the string to be written that renders the image at MEDIA-URL. -FULL-REMOTE-URL is used for `shr-browse-image'." - (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) - " ")) +FULL-REMOTE-URL is used for `shr-browse-image'. +TYPE is the attachment's type field on the server." + (let ((help-echo + "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) + (concat + (propertize "[img]" + 'media-url media-url + 'media-state 'needs-loading + 'media-type 'media-link + 'mastodon-media-type type + 'display (create-image mastodon-media--generic-broken-image-data nil t) + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (string= type "image") + help-echo + (concat help-echo "\ntype: " type))) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5418374..9bc7cf2 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -676,10 +676,11 @@ message is a link which unhides/hides the main body." (if (alist-get 'remote_url media-attachement) (alist-get 'remote_url media-attachement) ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement)))) + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering - preview-url remote-url) ; 2nd arg for shr-browse-url + preview-url remote-url type) ; 2nd arg for shr-browse-url (concat "Media::" preview-url "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p -- cgit v1.2.3 From 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(-) (limited to 'lisp') 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(-) (limited to 'lisp') 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(-) (limited to 'lisp') 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 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(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 753a659..9112fc9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -519,9 +519,10 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--mentions-company-candidates (prefix) "Given a company PREFIX query, build a list of candidates. The prefix can match against both user handles and display names." - (let (res) + (let ((prefix (substring prefix 1)) ;remove @ for search + (res)) (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (cadr item) t) + (when (or (string-prefix-p prefix (substring (cadr item) 1) t) (string-prefix-p prefix (car item) t)) (push (mastodon-toot--mentions-company-make-candidate item) res))) res)) @@ -533,11 +534,11 @@ The prefix can match against both user handles and display names." (url (caddr candidate))) (propertize handle 'annot display-name 'meta url))) -(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) +(defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) + (interactive (company-begin-backend 'mastodon-toot-mentions)) (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode (save-excursion (forward-whitespace -1) @@ -856,7 +857,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (when (require 'company nil :noerror) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) + (add-to-list 'company-backends 'mastodon-toot-mentions)) (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From 2259577b8616005fd0265e211ae63188f4b32a3d Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 10:39:20 +0100 Subject: a first hack to make media uploads immediate and async. this commit moves the call to -upload-attached-media into -attach-media. upload-attached-media now uploads a single item only, whichever file has just been selected at the prompt. but we still use the list of attached-media to handle preview displays. --- lisp/mastodon-http.el | 2 +- lisp/mastodon-toot.el | 45 ++++++++++++++++++++++----------------------- 2 files changed, 23 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1ec0dc0..a4f126f 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -261,7 +261,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." :parser 'json-read :headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - :sync t + :sync nil :success (cl-function (lambda (&key data &allow-other-keys) (when data diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9112fc9..6eac981 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -446,10 +446,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. -If media items have been attached with -`mastodon-toot--attach-media', upload them with -`mastodon-toot-upload-attached-media' and attach them to the -toot." +If media items have been attached and uploaded with +`mastodon-toot--attach-media', they are attached to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) (empty-toot-p (and (not mastodon-toot--media-attachments) @@ -465,7 +463,8 @@ toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done + ;; (mastodon-toot--upload-attached-media) + ;; moved upload to mastodon-toot--attach-media (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) @@ -614,9 +613,10 @@ The prefix can match against both user handles and display names." (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. -A preview is displayed in the toot create buffer, and the file -will be uploaded and attached to the toot upon sending." + "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the new toot buffer, and the file +is uploaded asynchronously using `mastodon-toot--upload-attached-media'. +File is actually attached to the toot upon posting." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -627,21 +627,20 @@ will be uploaded and attached to the toot upon sending." (:content-type . ,content-type) (:description . ,description) (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display)) - -(defun mastodon-toot--upload-attached-media () - "Actually upload attachments using `mastodon-http--post-media-attachment'. -The files to be uploaded are in `mastodon-toot--media-attachments'. -The items' ids are added to `mastodon-toot--media-attachment-ids', -which are used to attach them to a toot after uploading." - (mapcar (lambda (attachment) - (let* ((filename (expand-file-name - (alist-get :filename attachment))) - (caption (alist-get :description attachment)) - (url (concat mastodon-instance-url "/api/v2/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) - (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments)))) + +(defun mastodon-toot--upload-attached-media (attachment) + "Upload a single attachment using `mastodon-http--post-media-attachment'. +The item's id is added to `mastodon-toot--media-attachment-ids', +which is used to attach it to a toot when posting." + (let* ((filename (expand-file-name + (alist-get :filename attachment))) + (caption (alist-get :description attachment)) + (url (concat mastodon-instance-url "/api/v2/media"))) + (message "Uploading %s..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption))) (defun mastodon-toot--refresh-attachments-display () "Update the display attachment previews in toot draft buffer." -- cgit v1.2.3 From f2af3a64967c403145c9b32aefd08ea8932a4770 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 12:54:58 +0100 Subject: attach media test before post just test that length of --media-attachments == length of --media-attachment-ids. --- lisp/mastodon-toot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6eac981..9a88bd5 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -463,11 +463,14 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments + (if (= (length mastodon-toot--media-attachments) + (length mastodon-toot--media-attachment-ids)) ;; (mastodon-toot--upload-attached-media) ;; moved upload to mastodon-toot--attach-media - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mapcar (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids) + (message "Looks like something went wrong with your uploads. Maybe you want to try again.")))) (args (append args-media args-no-media))) (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.") -- cgit v1.2.3 From 0fd7f354e9474ca9eb63049558c3a44514228ba5 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 21:00:18 +0100 Subject: refactor un/follow, un/block, un/mute functions --- lisp/mastodon-tl.el | 188 ++++++++++++++++++++-------------------------------- 1 file changed, 72 insertions(+), 116 deletions(-) (limited to 'lisp') 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(-) (limited to 'lisp') 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(-) (limited to 'lisp') 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(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 742b247..46d999f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -287,13 +287,13 @@ Optionally start from POS." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - ;; TODO: Replace url browsing with native profile viewing - 'mastodon-tab-stop 'user-handle + ;; TODO: Replace url browsing with native profile viewing + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--byline-boosted (toot) @@ -986,10 +986,10 @@ webapp" "Get the list of user-handles for ACTION from the current toot." (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) - (completing-read (format "Handle of user to %s: " action) - user-handles - nil ; predicate - 'confirm))) + (completing-read (format "Handle of user to %s: " action) + user-handles + nil ; predicate + 'confirm))) (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) "Fetch the list of accounts for ACTION from the server. @@ -1004,10 +1004,10 @@ Action must be either \"unblock\" or \"mute\"." (alist-get 'acct user)) json))) (when accts - (completing-read (format "Handle of user to %s: " action) - accts - nil ; predicate - t)))) + (completing-read (format "Handle of user to %s: " action) + accts + nil ; predicate + t)))) (defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp) "Do ACTION on user NAME/USER-HANDLE. @@ -1029,7 +1029,7 @@ NEGP is whether the action involves un-doing something." (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--do-user-action-function (url name user-handle action) -"Post ACTION on user NAME/USER-HANDLE to URL." + "Post ACTION on user NAME/USER-HANDLE to URL." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response (lambda () -- cgit v1.2.3 From adfcd9bb45e3a59e8dbc5968708084e3dbf96b68 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 16 Dec 2021 15:52:22 +0100 Subject: refactor notify-user-posts functions this updates the functions to toggle receiving notifications when a user posts to work with the newly refactored follow-user function and associated functions. --- lisp/mastodon-tl.el | 57 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9305bea..46cd1d6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -954,34 +954,25 @@ webapp" (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. -If NOTIFY is \"false\", disable notifications when that user posts." +If NOTIFY is \"false\", disable notifications when that user posts. +This can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "follow"))) - (mastodon-tl--do-user-action-and-response user-handle "follow" notify)) + (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify)) -(defun mastodon-tl--notify-user-posts (user-handle) - "Query for USER-HANDLE from current status and enable notifications when they post." +(defun mastodon-tl--enable-notify-user-posts (user-handle) + "Query for USER-HANDLE and enable notifications when they post." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Receive notifications when user posts: " - user-handles - nil ; predicate - 'confirm)))) + (mastodon-tl--interactive-user-handles-get "enable"))) (mastodon-tl--follow-user user-handle "true")) -(defun mastodon-tl--no-notify-user-posts (user-handle) - "Query for USER-HANDLE from current status and disable notifications when they post." +(defun mastodon-tl--disable-notify-user-posts (user-handle) + "Query for USER-HANDLE and disable notifications when they post." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Disable notifications when user posts: " - user-handles - nil ; predicate - 'confirm)))) + (mastodon-tl--interactive-user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) (defun mastodon-tl--unfollow-user (user-handle) @@ -1027,7 +1018,10 @@ If NOTIFY is \"false\", disable notifications when that user posts." "Get the list of user-handles for ACTION from the current toot." (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) - (completing-read (format "Handle of user to %s: " action) + (completing-read (if (or (equal action "disable") + (equal action "enable")) + (format "%s notifications when user posts: " action) + (format "Handle of user to %s: " action)) user-handles nil ; predicate 'confirm))) @@ -1050,9 +1044,12 @@ Action must be either \"unblock\" or \"mute\"." nil ; predicate t)))) -(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp) +(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify) "Do ACTION on user NAME/USER-HANDLE. -NEGP is whether the action involves un-doing something." +NEGP is whether the action involves un-doing something. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts. +NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (let* ((account (if negp ;; TODO check if both are actually needed (mastodon-profile--search-account-by-handle @@ -1061,20 +1058,30 @@ NEGP is whether the action involves un-doing something." user-handle (mastodon-profile--toot-json)))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) + (url (mastodon-http--api + (if notify + (format "accounts/%s/%s?notify=%s" user-id action notify) + (format "accounts/%s/%s" user-id action))))) (if account (if (equal action "follow") ; y-or-n for all but follow - (mastodon-tl--do-user-action-function url name user-handle action) + (mastodon-tl--do-user-action-function url name user-handle action notify) (when (y-or-n-p (format "%s user %s? " action name)) (mastodon-tl--do-user-action-function url name user-handle action))) (message "Cannot find a user with handle %S" user-handle)))) -(defun mastodon-tl--do-user-action-function (url name user-handle action) +(defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify) "Post ACTION on user NAME/USER-HANDLE to URL." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response (lambda () - (message "User %s (@%s) %sed!" name user-handle action))))) + (cond ((string-equal notify "true") + (message "Receiving notifications for user %s (@%s)!" + name user-handle)) + ((string-equal notify "false") + (message "Not receiving notifications for user %s (@%s)!" + name user-handle)) + ((eq notify nil) + (message "User %s (@%s) %sed!" name user-handle action))))))) ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () -- cgit v1.2.3