diff options
Diffstat (limited to 'lisp/mastodon-notifications.el')
| -rw-r--r-- | lisp/mastodon-notifications.el | 267 |
1 files changed, 150 insertions, 117 deletions
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 2091118..b758c6f 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -162,40 +162,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 'reblog)) - -(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 @@ -208,106 +174,173 @@ Status notifications are given when '(face (font-lock-comment-face shr-text))))) (buffer-string))) +(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_request . "Requested to follow") (follow . "Followed") (mention . "Mentioned") (status . "Posted") (poll . "Posted a poll") - (edit . "Edited"))) - -(defun mastodon-notifications--format-note (note type) - "Format for a NOTE of TYPE." + (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--format-note (group status accounts) + "Format for a GROUP notification. +JSON is the full notifications JSON." ;; 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 ((member type '(follow 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 - ((member type '(favourite reblog)) - 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 ((eq type 'follow) - (propertize "Congratulations, you have a new follower!" - 'face 'default)) - ((eq type 'follow-request) - (concat - (propertize - (format "You have a follow request from... %s" - follower) - 'face 'default) - (if mastodon-notifications--profile-note-in-foll-reqs + (let-alist group + ;; .sample_account_ids .status_id .notifications_count + ;; .most_recent_notifiation_id + (let* ((type .type) + (type-sym (intern .type)) + (profile-note + (when (eq 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 (car .sample_account_ids)) + (follower-name (mastodon-tl--field 'username (car accounts))) + (filtered (mastodon-tl--field 'filtered status)) ;;toot)) + (filters (when filtered + (mastodon-tl--current-filters filtered)))) + (if (and filtered (assoc "hide" filters)) + nil + (mastodon-tl--insert-status + ;; toot + (if (member type-sym '(follow follow_request)) + ;; Using reblog with an empty id will mark this as something + ;; non-boostable/non-favable. + ;; status + (cons '(reblog (id . nil)) status) ;;note)) + ;; reblogs/faves use 'note' to process their own json not the + ;; toot's. this ensures following etc. work on such notifs + status) ;; FIXME: fix following on these notifs + ;; 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 type-sym 'follow_request) + (mastodon-tl--render-text profile-note) + (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 ":\n" - (mastodon-notifications--comment-note-text body)) - ""))) - ((member type '(favourite reblog)) - (mastodon-notifications--comment-note-text body)) - (t body))) - ;; author-byline - (if (member type '(follow follow-request mention)) - 'mastodon-tl--byline-author - (lambda (_status &rest _args) ; unbreak stuff - (mastodon-tl--byline-author note))) - ;; action-byline - (lambda (_status) - (mastodon-notifications--byline-concat - (alist-get type mastodon-notifications--action-alist))) - id - ;; base toot - (when (member type '(favourite reblog)) - status))))) - -(defun mastodon-notifications--by-type (note) + (mastodon-notifications--comment-note-text body))))) + ((member type-sym '(favourite reblog)) + (mastodon-notifications--comment-note-text body)) + (t body))) + ;; author-byline + (cond ((member type-sym '(favourite reblog mention)) + (lambda (&rest _args) + (mastodon-notifications--byline-accounts accounts status group))) + ((eq type-sym 'follow_request) + (lambda (&rest _args) + (mastodon-tl--byline-uname-+-handle status nil (car accounts)))) + (t #'mastodon-tl--byline-author)) + ;; #'mastodon-tl--byline-author + ;; action-byline + (lambda (&rest _args) + (mastodon-notifications--byline-concat + (alist-get type-sym mastodon-notifications--action-alist))) + .status_id + ;; base toot + (when (member type-sym '(favourite reblog)) + status) + nil nil nil nil + nil group accounts))))) ;; insert status still needs our group data + +;; 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 domain) + "Propertize author byline ACCOUNT for TOOT, the item responded to. +With arg AVATAR, include the account's avatar image. +When DOMAIN, force inclusion of user's domain in their handle." + (let ((others-count (- (alist-get 'notifications_count group) + (length accounts)))) + (concat + (cl-loop + for account in accounts + 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)) + ;; username: + (mastodon-tl--byline-username toot account) + ;; handle: + " (" (mastodon-tl--byline-handle toot nil account) ")" + (if (< 1 (length accounts)) "\n" "")))) + (if (< 0 others-count) + (format "and %s others" others-count))))) + +(defun mastodon-notifications--by-type (groups json) "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 - ;; images-in-notifs custom is handeld in - ;; `mastodon-tl--media-attachment', not here - (mastodon-media--inline-images start-pos (point)))))) + (setq masto-grouped-notifs 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) - (goto-char (point-min)))) + (let ((groups (alist-get 'notification_groups json))) + ;; (mapc (lambda (x) + (mastodon-notifications--by-type groups json) + ;; grouped) + (goto-char (point-min))))) (defun mastodon-notifications--get-mentions () "Display mention notifications in buffer." |