Merge branch 'develop'

1 files changed, 272 insertions, 160 deletions

diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index 1c2aad7..b16b5a6 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,30 @@ 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")
+  "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 +117,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 +132,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 +168,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 +180,239 @@ 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--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)))))
+              ((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-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)
+                                    (alist-get 'username a))
+                                  (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 +444,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."
@@ -369,5 +473,13 @@ Status notifications are created when you call
                   (mastodon-tl--reload-timeline-or-profile))
                 (message "Notification dismissed!")))))
 
+(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