diff options
Diffstat (limited to 'lisp/mastodon-notifications.el')
| -rw-r--r-- | lisp/mastodon-notifications.el | 488 |
1 files changed, 322 insertions, 166 deletions
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 1c2aad7..f688f2d 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -1,10 +1,10 @@ ;;; mastodon-notifications.el --- Notification functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen -;; Copyright (C) 2020-2022 Marty Hiatt +;; Copyright (C) 2020-2024 Marty Hiatt ;; Author: Johnson Denen <johnson.denen@gmail.com> -;; Marty Hiatt <martianhiatus@riseup.net> -;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> +;; Marty Hiatt <mousebot@disroot.org> +;; Maintainer: Marty Hiatt <mousebot@disroot.org> ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -30,7 +30,8 @@ ;;; Code: -(require 'mastodon) +(eval-when-compile (require 'subr-x)) +(require 'cl-lib) (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-params-async-json "mastodon-http") @@ -45,13 +46,22 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--has-spoiler "mastodon-tl") (autoload 'mastodon-tl--init "mastodon-tl") -(autoload 'mastodon-tl--insert-status "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--spoiler "mastodon-tl") (autoload 'mastodon-tl--item-id "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") (autoload 'mastodon-views--view-follow-requests "mastodon-views") +(autoload 'mastodon-tl--current-filters "mastodon-views") +(autoload 'mastodon-tl--render-text "mastodon-tl") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--byline-uname-+-handle "mastodon-tl") +(autoload 'mastodon-tl--byline-username "mastodon-tl") +(autoload 'mastodon-tl--byline-handle "mastodon-tl") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-media--get-avatar-rendering "mastodon-media") +(autoload 'mastodon-tl--image-trans-check "mastodon-tl") +(autoload 'mastodon-tl--symbol "mastodon-tl") (defgroup mastodon-tl nil "Nofications in mastodon.el." @@ -70,29 +80,31 @@ If unset, profile notes of any size will be displayed, which may make them unweildy." :type '(integer)) +(defcustom mastodon-notifications--images-in-notifs nil + "Whether to display attached images in notifications." + :type '(boolean)) + (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) +(defvar mastodon-mode-map) +(defvar mastodon-tl--fold-toots-at-length) +(defvar mastodon-tl--show-avatars) -(defvar mastodon-notifications--types-alist - '(("follow" . mastodon-notifications--follow) - ("favourite" . mastodon-notifications--favourite) - ("reblog" . mastodon-notifications--reblog) - ("mention" . mastodon-notifications--mention) - ("poll" . mastodon-notifications--poll) - ("follow_request" . mastodon-notifications--follow-request) - ("status" . mastodon-notifications--status) - ("update" . mastodon-notifications--edit)) - "Alist of notification types and their corresponding function.") +(defvar mastodon-notifications--types + '("favourite" "reblog" "mention" "poll" + "follow_request" "follow" "status" "update" + "severed_relationships" "moderation_warning") + "A list of notification types according to their name on the server.") (defvar mastodon-notifications--response-alist '(("Followed" . "you") - ("Favourited" . "your status from") - ("Boosted" . "your status from") + ("Favourited" . "your post") + ("Boosted" . "your post") ("Mentioned" . "you") ("Posted a poll" . "that has now ended") ("Requested to follow" . "you") ("Posted" . "a post") - ("Edited" . "a post from")) + ("Edited" . "their post")) "Alist of subjects for notification types.") (defvar mastodon-notifications--map @@ -106,8 +118,10 @@ make them unweildy." (defun mastodon-notifications--byline-concat (message) "Add byline for TOOT with MESSAGE." - (concat " " (propertize message 'face 'highlight) - " " (cdr (assoc message mastodon-notifications--response-alist)))) + (concat " " + (propertize message 'face 'mastodon-boosted-face) + " " (cdr (assoc message mastodon-notifications--response-alist)) + "\n")) (defun mastodon-notifications--follow-request-process (&optional reject) "Process the follow request at point. @@ -119,7 +133,9 @@ follow-requests view." (let* ((item-json (mastodon-tl--property 'item-json)) (f-reqs-view-p (string= "follow_requests" (plist-get mastodon-tl--buffer-spec 'endpoint))) - (f-req-p (or (string= "follow_request" (alist-get 'type item-json)) ;notifs + (f-req-p (or (string= "follow_request" + (mastodon-tl--property 'notification-type + :no-move)) f-reqs-view-p))) (if (not f-req-p) (user-error "No follow request at point?") @@ -153,40 +169,6 @@ Can be called in notifications view or in follow-requests view." (interactive) (mastodon-notifications--follow-request-process :reject)) -(defun mastodon-notifications--mention (note) - "Format for a `mention' NOTE." - (mastodon-notifications--format-note note 'mention)) - -(defun mastodon-notifications--follow (note) - "Format for a `follow' NOTE." - (mastodon-notifications--format-note note 'follow)) - -(defun mastodon-notifications--follow-request (note) - "Format for a `follow-request' NOTE." - (mastodon-notifications--format-note note 'follow-request)) - -(defun mastodon-notifications--favourite (note) - "Format for a `favourite' NOTE." - (mastodon-notifications--format-note note 'favourite)) - -(defun mastodon-notifications--reblog (note) - "Format for a `boost' NOTE." - (mastodon-notifications--format-note note 'boost)) - -(defun mastodon-notifications--status (note) - "Format for a `status' NOTE. -Status notifications are given when -`mastodon-tl--enable-notify-user-posts' has been set." - (mastodon-notifications--format-note note 'status)) - -(defun mastodon-notifications--poll (note) - "Format for a `poll' NOTE." - (mastodon-notifications--format-note note 'poll)) - -(defun mastodon-notifications--edit (note) - "Format for an `edit' NOTE." - (mastodon-notifications--format-note note 'edit)) - (defun mastodon-notifications--comment-note-text (str) "Add comment face to all text in STR with `shr-text' face only." (with-temp-buffer @@ -199,115 +181,264 @@ Status notifications are given when '(face (font-lock-comment-face shr-text))))) (buffer-string))) -(defun mastodon-notifications--format-note (note type) - "Format for a NOTE of TYPE." - ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' - (let* ((id (alist-get 'id note)) - (profile-note - (when (eq 'follow-request type) - (let ((str (mastodon-tl--field - 'note - (mastodon-tl--field 'account note)))) - (if mastodon-notifications--profile-note-in-foll-reqs-max-length - (string-limit str mastodon-notifications--profile-note-in-foll-reqs-max-length) - str)))) - (status (mastodon-tl--field 'status note)) - (follower (alist-get 'username (alist-get 'account note))) - (toot (alist-get 'status note)) - (filtered (mastodon-tl--field 'filtered toot)) - (filters (when filtered - (mastodon-tl--current-filters filtered)))) - (if (and filtered (assoc "hide" filters)) - nil - (mastodon-tl--insert-status - ;; toot - (cond ((or (eq type 'follow) - (eq type 'follow-request)) - ;; Using reblog with an empty id will mark this as something - ;; non-boostable/non-favable. - (cons '(reblog (id . nil)) note)) - ;; reblogs/faves use 'note' to process their own json - ;; not the toot's. this ensures following etc. work on such notifs - ((or (eq type 'favourite) - (eq type 'boost)) - note) - (t - status)) - ;; body - (let ((body (if-let ((match (assoc "warn" filters))) - (mastodon-tl--spoiler toot (cadr match)) - (mastodon-tl--clean-tabs-and-nl - (if (mastodon-tl--has-spoiler status) - (mastodon-tl--spoiler status) - (if (eq 'follow-request type) - (mastodon-tl--render-text profile-note) - (mastodon-tl--content status))))))) - (cond ((or (eq type 'follow) - (eq type 'follow-request)) - (if (eq type 'follow) - (propertize "Congratulations, you have a new follower!" - 'face 'default) +(defvar mastodon-notifications-grouped-types + '(follow reblog favourite) + "List of notification types for which grouping is implemented.") + +(defvar mastodon-notifications--action-alist + '((reblog . "Boosted") + (favourite . "Favourited") + (follow_request . "Requested to follow") + (follow . "Followed") + (mention . "Mentioned") + (status . "Posted") + (poll . "Posted a poll") + (update . "Edited")) + "Action strings keyed by notification type. +Types are those of the Mastodon API.") + +(defun mastodon-notifications--alist-by-value (str field json) + "From JSON, return the alist whose FIELD value matches STR. +JSON is a list of alists." + (cl-some (lambda (y) + (when (string= str (alist-get field y)) + y)) + json)) + +(defun mastodon-notifications--group-accounts (ids json) + "For IDS, return account data in JSON." + (cl-loop + for x in ids + collect (mastodon-notifications--alist-by-value x 'id json))) + +(defun mastodon-notifications--severance-body (group) + "Return a body for a severance notification GROUP." + ;; FIXME: actually implement this when we encounter one in the wild! + (let-alist (alist-get 'event group) + (concat .description ": " + .target_name + "\nRelationships affected: " + .relationships_count))) + +(defun mastodon-notifications--mod-warning-body (group) + "Return a body for a moderation warning notification GROUP." + (let-alist (alist-get ) + (concat .description ": " + .text + "\nStatuses: " + .status_ids + "\nfor account: " + .target_account))) + +(defun mastodon-notifications--format-note (group status accounts) + "Format for a GROUP notification. +STATUS is the status's JSON. +ACCOUNTS is data of the accounts that have reacted to the notification." + (let ((folded nil)) + ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' + (let-alist group + (let* ((type-sym (intern .type)) + (profile-note + (when (member type-sym '(follow_request)) + (let ((str (mastodon-tl--field 'note (car accounts)))) + (if mastodon-notifications--profile-note-in-foll-reqs-max-length + (string-limit str mastodon-notifications--profile-note-in-foll-reqs-max-length) + str)))) + (follower (when (member type-sym '(follow follow_request)) + (car accounts))) + (follower-name (mastodon-tl--field 'username follower)) + (filtered (mastodon-tl--field 'filtered status)) + (filters (when filtered + (mastodon-tl--current-filters filtered)))) + (unless (and filtered (assoc "hide" filters)) + (mastodon-notifications--insert-note + ;; toot + (if (member type-sym '(follow follow_request)) + follower + status) + ;; body + (let ((body (if-let ((match (assoc "warn" filters))) + (mastodon-tl--spoiler status (cadr match)) + (mastodon-tl--clean-tabs-and-nl + (cond ((mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status)) + ((eq type-sym 'follow_request) + (mastodon-tl--render-text profile-note)) + (t (mastodon-tl--content status))))))) + (cond + ((eq type-sym 'follow) + (propertize "Congratulations, you have a new follower!" + 'face 'default)) + ((eq type-sym 'follow_request) + (concat + (propertize (format "You have a follow request from %s" + follower-name) + 'face 'default) + (when mastodon-notifications--profile-note-in-foll-reqs (concat - (propertize - (format "You have a follow request from... %s" - follower) - 'face 'default) - (when mastodon-notifications--profile-note-in-foll-reqs - (concat - ":\n" - (mastodon-notifications--comment-note-text body)))))) - ((or (eq type 'favourite) - (eq type 'boost)) - (mastodon-notifications--comment-note-text body)) - (t body))) - ;; author-byline - (if (or (eq type 'follow) - (eq type 'follow-request) - (eq type 'mention)) - 'mastodon-tl--byline-author - (lambda (_status &rest _args) ; unbreak stuff - (mastodon-tl--byline-author note))) - ;; action-byline - (lambda (_status) - (mastodon-notifications--byline-concat - (cond ((eq type 'boost) - "Boosted") - ((eq type 'favourite) - "Favourited") - ((eq type 'follow-request) - "Requested to follow") - ((eq type 'follow) - "Followed") - ((eq type 'mention) - "Mentioned") - ((eq type 'status) - "Posted") - ((eq type 'poll) - "Posted a poll") - ((eq type 'edit) - "Edited")))) - id - ;; base toot - (when (or (eq type 'favourite) - (eq type 'boost)) - status))))) - -(defun mastodon-notifications--by-type (note) - "Filter NOTE for those listed in `mastodon-notifications--types-alist'. -Call its function in that list on NOTE." - (let* ((type (mastodon-tl--field 'type note)) - (fun (cdr (assoc type mastodon-notifications--types-alist))) - (start-pos (point))) - (when fun - (funcall fun note) - (when mastodon-tl--display-media-p - (mastodon-media--inline-images start-pos (point)))))) + ":\n" + (mastodon-notifications--comment-note-text body))))) + ((eq type-sym 'severed_relationships) + (mastodon-notifications--severance-body group)) + ((eq type-sym 'moderation_warning) + (mastodon-notifications--mod-warning-body group)) + ((member type-sym '(favourite reblog)) + (propertize + (mastodon-notifications--comment-note-text body))) + (t body))) + ;; author-byline + #'mastodon-tl--byline-author + ;; action-byline + (unless (member type-sym '(follow follow_request mention)) + (downcase + (mastodon-notifications--byline-concat + (alist-get type-sym mastodon-notifications--action-alist)))) + ;; action authors + (cond ((member type-sym '(follow follow_request mention)) + "") ;; mentions are normal statuses + (t (mastodon-notifications--byline-accounts + accounts status group))) + ;; action symbol: + (unless (eq type-sym 'mention) + (mastodon-tl--symbol type-sym)) + ;; base toot (no need for update/poll/?) + (when (member type-sym '(favourite reblog)) + status) + folded group accounts)))))) + +(defun mastodon-notifications--insert-note + (toot body author-byline action-byline action-authors action-symbol + &optional base-toot unfolded group accounts) + "Display the content and byline of timeline element TOOT. +BODY will form the section of the toot above the byline. +AUTHOR-BYLINE is an optional function for adding the author +portion of the byline that takes one variable. By default it is +`mastodon-tl--byline-author'. +ACTION-BYLINE is a string, obtained by calling +`mastodon-notifications--byline-concat'. +ACTION-AUTHORS is a string of those who have responded to the +current item, obtained by calling +`mastodon-notifications--byline-accounts'. +ACTION-SYMBOL is a symbol indicating a favourite, boost, or edit. +ID is that of the status if it is a notification, which is +attached as a `item-id' property if provided. If the +status is a favourite or boost notification, BASE-TOOT is the +JSON of the toot responded to. +UNFOLDED is a boolean meaning whether to unfold or fold item if +foldable. +GROUP is the notification group data. +ACCOUNTS is the notification accounts data." + (let* ((type (alist-get 'type (or group toot))) + (toot-foldable + (and mastodon-tl--fold-toots-at-length + (length> body mastodon-tl--fold-toots-at-length)))) + (insert + (propertize ;; top byline, body + byline: + (concat + (propertize ;; top byline + (if (equal type "mention") + "" + (concat action-symbol " " action-authors + action-byline)) + 'byline-top t) + (propertize ;; body only + body + 'toot-body t) ;; includes newlines etc. for folding + "\n" + ;; actual byline: + (mastodon-tl--byline toot author-byline nil nil + base-toot group + (if (member type '("follow" "follow_request")) + toot))) ;; account data! + 'item-type 'toot ;; for nav, actions, etc. + 'item-id (or (alist-get 'page_max_id group) ;; newest notif + (alist-get 'id toot)) ; toot id + 'base-item-id (mastodon-tl--item-id + ;; if status is a notif, get id from base-toot + ;; (-tl--item-id toot) will not work here: + (or base-toot + toot)) ; else normal toot with reblog check + 'item-json toot + 'base-toot base-toot + 'cursor-face 'mastodon-cursor-highlight-face + 'toot-foldable toot-foldable + 'toot-folded (and toot-foldable (not unfolded)) + ;; grouped notifs data: + 'notification-type type + 'notification-id (alist-get 'group_key group) + 'notification-group group + 'notification-accounts accounts + ;; for pagination: + 'notifications-min-id (alist-get 'page_min_id group) + 'notifications-max-id (alist-get 'page_max_id group)) + "\n"))) + +;; FIXME: REFACTOR with -tl--byline?: +;; we provide account directly, rather than let-alisting toot +;; almost everything is .account.field anyway +;; but toot still needed also, for attachments, etc. +(defun mastodon-notifications--byline-accounts + (accounts toot group &optional avatar) + "Propertize author byline ACCOUNTS for TOOT, the item responded to. +GROUP is the group notification data. +When AVATAR, include the account's avatar image. +When DOMAIN, force inclusion of user's domain in their handle." + (let ((total (alist-get 'notifications_count group)) + (accts 2)) + (concat + (string-trim ;; remove trailing newline + (cl-loop + for account in accounts + repeat accts + concat + (let-alist account + (concat + ;; avatar insertion moved up to `mastodon-tl--byline' by + ;; default to be outside 'byline propt. + (when (and avatar ; used by `mastodon-profile--format-user' + mastodon-tl--show-avatars + mastodon-tl--display-media-p + (mastodon-tl--image-trans-check)) + (mastodon-media--get-avatar-rendering .avatar)) + (let ((uname (mastodon-tl--display-or-uname account))) + (mastodon-tl--byline-handle toot nil account + uname 'mastodon-display-name-face)) + ", "))) + nil ", ") + (if (< accts total) + (let ((diff (- total accts))) + (propertize ;; help-echo remaining notifs authors: + (format " and %s other%s" diff (if (= 1 diff) "" "s")) + 'help-echo (mapconcat (lambda (a) + (propertize (alist-get 'username a) + 'face 'mastodon-display-name-face)) + (cddr accounts) ;; not first two + ", "))))))) + +(defun mastodon-notifications--render (json) + "Display grouped notifications in JSON." + ;; (setq masto-grouped-notifs json) + (let ((groups (alist-get 'notification_groups json))) + (cl-loop + for g in groups + for start-pos = (point) + for accounts = (mastodon-notifications--group-accounts + (alist-get 'sample_account_ids g) + (alist-get 'accounts json)) + for status = (mastodon-notifications--alist-by-value + (alist-get 'status_id g) 'id + (alist-get 'statuses json)) + do (mastodon-notifications--format-note g status accounts) + (when mastodon-tl--display-media-p + ;; images-in-notifs custom is handeld in + ;; `mastodon-tl--media-attachment', not here + (mastodon-media--inline-images start-pos (point)))))) (defun mastodon-notifications--timeline (json) "Format JSON in Emacs buffer." (if (seq-empty-p json) (user-error "Looks like you have no (more) notifications for now") - (mapc #'mastodon-notifications--by-type json) + (mastodon-notifications--render json) (goto-char (point-min)))) (defun mastodon-notifications--get-mentions () @@ -339,8 +470,7 @@ Status notifications are created when you call (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE removed." - (let ((types (mapcar #'car mastodon-notifications--types-alist))) - (remove type types))) + (remove type mastodon-notifications--types)) (defun mastodon-notifications--clear-all () "Clear all notifications." @@ -357,17 +487,43 @@ Status notifications are created when you call (defun mastodon-notifications--clear-current () "Dismiss the notification at point." (interactive) - (let* ((id (or (mastodon-tl--property 'item-id) - (mastodon-tl--field 'id - (mastodon-tl--property 'item-json)))) - (response - (mastodon-http--post (mastodon-http--api - (format "notifications/%s/dismiss" id))))) + (let* ((id (or (or (mastodon-tl--property 'notification-id) ;; grouped + (mastodon-tl--property 'item-id) + (mastodon-tl--field + 'id + (mastodon-tl--property 'item-json))))) + (endpoint (mastodon-http--api + (format "notifications/%s/dismiss" id) + "v2")) + (response (mastodon-http--post endpoint))) (mastodon-http--triage response (lambda (_) (when mastodon-tl--buffer-spec (mastodon-tl--reload-timeline-or-profile)) (message "Notification dismissed!"))))) +(defun mastodon-notifications--get-single-notif () + "Return a single notification JSON for v2 notifs." + (interactive) + (let* ((id (mastodon-tl--property + 'notification-id)) ;; grouped, doesn't work for ungrouped! + ;; (key (format "ungrouped-%s" + ;; (mastodon-tl--property 'item-id))) + (endpoint (mastodon-http--api + (format "notifications/%s" id) + "v2")) + (response (mastodon-http--get-json endpoint))) + (mastodon-http--triage + response (lambda (_) + (message "%s" (prin1-to-string response)))))) + +(defun mastodon-notifications--get-unread-count () + "Return the number of unread notifications for the current account." + ;; params: limit - max 1000, default 100, types[], exclude_types[], account_id + (let* ((endpoint "notifications/unread_count") + (url (mastodon-http--api endpoint)) + (resp (mastodon-http--get-json url))) + (alist-get 'count resp))) + (provide 'mastodon-notifications) ;;; mastodon-notifications.el ends here |