aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus@riseup.net>2024-10-21 17:14:00 +0200
committermarty hiatt <martianhiatus@riseup.net>2024-10-21 17:14:00 +0200
commitabe02e818d484da65fe23bbe5899ed15d43f1e67 (patch)
treeee6ffa148d9f9a9c50752b3f89038e2f646e3e94 /lisp
parente593ad461ae275c641c6c4c90f67d62a920610a0 (diff)
parentef6762986de6f4c85405dbc01ae19854cd2687fd (diff)
Merge branch 'develop'
Diffstat (limited to 'lisp')
-rw-r--r--lisp/.dir-locals.el7
-rw-r--r--lisp/mastodon-async.el2
-rw-r--r--lisp/mastodon-auth.el2
-rw-r--r--lisp/mastodon-client.el2
-rw-r--r--lisp/mastodon-discover.el6
-rw-r--r--lisp/mastodon-http.el39
-rw-r--r--lisp/mastodon-inspect.el6
-rw-r--r--lisp/mastodon-iso.el2
-rw-r--r--lisp/mastodon-media.el7
-rw-r--r--lisp/mastodon-notifications.el432
-rw-r--r--lisp/mastodon-profile.el25
-rw-r--r--lisp/mastodon-search.el55
-rw-r--r--lisp/mastodon-tl.el539
-rw-r--r--lisp/mastodon-toot.el55
-rw-r--r--lisp/mastodon-transient.el230
-rw-r--r--lisp/mastodon-views.el6
-rw-r--r--lisp/mastodon.el50
17 files changed, 1028 insertions, 437 deletions
diff --git a/lisp/.dir-locals.el b/lisp/.dir-locals.el
index bcb8ba5..da012d6 100644
--- a/lisp/.dir-locals.el
+++ b/lisp/.dir-locals.el
@@ -1,7 +1,6 @@
-;;; Directory Local Variables
+;;; Directory Local Variables -*- no-byte-compile: t -*-
;;; For more information see (info "(emacs) Directory Variables")
-;; Preferred indentation style:
((nil . ((indent-tabs-mode . nil)))
- ;; setting this makes package-lint look in the main file for deps:
- (emacs-lisp-mode . ((package-lint-main-file . "mastodon.el"))))
+ (emacs-lisp-mode . ((elisp-flymake-byte-compile-load-path . load-path)
+ (package-lint-main-file . "mastodon.el"))))
diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el
index 317be93..b059407 100644
--- a/lisp/mastodon-async.el
+++ b/lisp/mastodon-async.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2017 Alex J. Griffith
;; Author: Alex J. Griffith <griffitaj@gmail.com>
-;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
+;; Maintainer: Marty Hiatt <mousebot@disroot.org>
;; Package-Requires: ((emacs "27.1"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index 3796b7e..01639fb 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
;; Author: Johnson Denen <johnson.denen@gmail.com>
-;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
+;; Maintainer: Marty Hiatt <mousebot@disroot.org>
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el
index 6e55829..c0db3d6 100644
--- a/lisp/mastodon-client.el
+++ b/lisp/mastodon-client.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
;; Author: Johnson Denen <johnson.denen@gmail.com>
-;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
+;; Maintainer: Marty Hiatt <mousebot@disroot.org>
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el
index c34d85f..993cc27 100644
--- a/lisp/mastodon-discover.el
+++ b/lisp/mastodon-discover.el
@@ -1,10 +1,10 @@
;;; mastodon-discover.el --- Use Mastodon.el with discover.el -*- lexical-binding: t -*-
;; Copyright (C) 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.
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index fbae8a7..1093de1 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -1,10 +1,10 @@
;;; mastodon-http.el --- HTTP request/response 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.
@@ -157,16 +157,18 @@ the request data. If it is :raw, just use the plain params."
(let* ((url-request-data
(when params
(cond ((eq json :json)
- (json-encode
- params))
+ (json-encode params))
((eq json :raw)
params)
(t
(mastodon-http--build-params-string params)))))
(url-request-extra-headers
(append url-request-extra-headers ; auth set in macro
- (unless (assoc "Content-Type" headers) ; pleroma compat:
- '(("Content-Type" . "application/x-www-form-urlencoded")))
+ (if json
+ '(("Content-Type" . "application/json")
+ ("Accept" . "application/json"))
+ (unless (assoc "Content-Type" headers) ; pleroma compat:
+ '(("Content-Type" . "application/x-www-form-urlencoded"))))
headers)))
(with-temp-buffer
(mastodon-http--url-retrieve-synchronously url)))
@@ -298,11 +300,26 @@ Optionally specify the PARAMS to send."
(with-current-buffer (mastodon-http--patch url params)
(mastodon-http--process-json)))
-(defun mastodon-http--patch (base-url &optional params)
- "Make synchronous PATCH request to BASE-URL.
-Optionally specify the PARAMS to send."
+(defun mastodon-http--patch (url &optional params json)
+ "Make synchronous PATCH request to URL.
+Optionally specify the PARAMS to send.
+JSON means send params as JSON data."
(mastodon-http--authorized-request "PATCH"
- (let ((url (mastodon-http--concat-params-to-url base-url params)))
+ ;; NB: unlike POST, PATCHing only works if we use query params!
+ ;; so here, unless JSON arg, we use query params and do not set
+ ;; `url-request-data'. this is probably an error, i don't understand it.
+ (let* ((url-request-data
+ (when (and params json)
+ (encode-coding-string
+ (json-encode params) 'utf-8)))
+ ;; (mastodon-http--build-params-string params))))
+ (url (unless json
+ (mastodon-http--concat-params-to-url url params)))
+ (headers (when json
+ '(("Content-Type" . "application/json")
+ ("Accept" . "application/json"))))
+ (url-request-extra-headers
+ (append url-request-extra-headers headers)))
(mastodon-http--url-retrieve-synchronously url))))
;; Asynchronous functions
diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el
index 43c8ba4..4981943 100644
--- a/lisp/mastodon-inspect.el
+++ b/lisp/mastodon-inspect.el
@@ -1,10 +1,10 @@
;;; mastodon-inspect.el --- Client for Mastodon -*- 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.
diff --git a/lisp/mastodon-iso.el b/lisp/mastodon-iso.el
index 8ea5635..6199cbe 100644
--- a/lisp/mastodon-iso.el
+++ b/lisp/mastodon-iso.el
@@ -1,7 +1,7 @@
;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2022 Marty Hiatt
-;; Author: Marty Hiatt <martianhiatus@riseup.net>
+;; Author: Marty Hiatt <mousebot@disroot.org>
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 2ec498e..8601410 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -1,10 +1,10 @@
;;; mastodon-media.el --- Functions for inlining Mastodon media -*- 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.
@@ -38,6 +38,7 @@
(require 'image-mode)
(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl")
+(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
(defvar url-show-status)
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
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 6410591..40f834c 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -1,10 +1,10 @@
;;; mastodon-profile.el --- Functions for inspecting Mastodon profiles -*- 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.
@@ -84,6 +84,7 @@
(autoload 'mastodon-search--query "mastodon-search")
(autoload 'mastodon-tl--field-status "mastodon-tl")
+(defvar mastodon-active-user)
(defvar mastodon-tl--horiz-bar)
(defvar mastodon-tl--update-point)
(defvar mastodon-toot--max-toot-chars)
@@ -386,6 +387,8 @@ This is done after changing the setting on the server."
Only do so if `mastodon-profile-account-settings' is nil."
(mastodon-profile--fetch-server-account-settings :no-force))
+;; FIXME: this does one request per setting! should just do one request then
+;; parse
(defun mastodon-profile--fetch-server-account-settings (&optional no-force)
"Fetch basic account settings from the server.
Store the values in `mastodon-profile-account-settings'.
@@ -859,13 +862,15 @@ These include the author, author of reblogged entries and any user mentioned."
status)) ; status is a user listing
(mentions (mastodon-tl--field-status 'mentions status))
(reblog (mastodon-tl--field-status 'reblog status)))
- (seq-filter #'stringp
- (seq-uniq
- (seq-concatenate
- 'list
- (list (alist-get 'acct this-account))
- (mastodon-profile--extract-users-handles reblog)
- (mastodon-tl--map-alist 'acct mentions)))))))
+ (seq-remove
+ (lambda (x) (string= x mastodon-active-user))
+ (seq-filter #'stringp
+ (seq-uniq
+ (seq-concatenate
+ 'list
+ (list (alist-get 'acct this-account))
+ (mastodon-profile--extract-users-handles reblog)
+ (mastodon-tl--map-alist 'acct mentions))))))))
(defun mastodon-profile--lookup-account-in-status (handle status)
"Return account for HANDLE using hints in STATUS if possible."
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 7fc4de3..25db7d8 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -1,8 +1,8 @@
;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Marty Hiatt
-;; Author: Marty Hiatt <martianhiatus@riseup.net>
-;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
+;; Author: 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.
@@ -28,8 +28,7 @@
;;; Code:
(require 'json)
-(eval-when-compile
- (require 'mastodon-tl))
+(require 'mastodon-tl)
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
@@ -44,6 +43,7 @@
(autoload 'mastodon-tl--timeline "mastodon-tl")
(autoload 'mastodon-tl--toot "mastodon-tl")
(autoload 'mastodon-tl--buffer-property "mastodon-tl")
+(autoload 'mastodon-http--api-v2 "mastodon-http")
(defvar mastodon-toot--completion-style-for-mentions)
(defvar mastodon-instance-url)
@@ -97,6 +97,41 @@ QUERY is the string to search."
(mastodon-search--view-trending "statuses"
#'mastodon-tl--timeline))
+(defun mastodon-search--trending-links ()
+ "Display a list of links trending on your instance."
+ (interactive)
+ (mastodon-search--view-trending "links"
+ #'mastodon-search--render-links))
+
+(defun mastodon-search--render-links (links)
+ "Render trending LINKS."
+ (cl-loop for l in links
+ do (mastodon-search--render-link l)))
+
+(defun mastodon-search--render-link (link)
+ "Render a trending LINK."
+ (let-alist link
+ (insert
+ (propertize
+ (mastodon-tl--render-text
+ (concat "<a href=\"" .url "\">" .url "</a>\n" .title)
+ link)
+ 'item-type 'link
+ 'item-json link
+ 'shr-url .url
+ 'byline t ;; nav
+ 'help-echo
+ (substitute-command-keys
+ "\\[`mastodon-search--load-link-posts'] to view a link's timeline"))
+ ;; TODO: display card link author here
+ "\n\n")))
+
+(defun mastodon-search--load-link-posts ()
+ "Load timeline of posts containing link at point."
+ (interactive)
+ (let* ((url (mastodon-tl--property 'shr-url)))
+ (mastodon-tl--link-timeline url)))
+
(defun mastodon-search--view-trending (type print-fun)
"Display a list of tags trending on your instance.
TYPE is a string, either tags, statuses, or links.
@@ -109,7 +144,8 @@ PRINT-FUN is the function used to print the data from the response."
(offset '(("offset" . "0")))
(params (push limit offset))
(data (mastodon-http--get-json url params))
- (buffer (get-buffer-create (format "*mastodon-trending-%s*" type))))
+ (buffer (get-buffer-create
+ (format "*mastodon-trending-%s*" type))))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-tl--set-buffer-spec (buffer-name buffer)
(format "trends/%s" type)
@@ -129,7 +165,8 @@ Optionally add string TYPE after HEADING."
(defun mastodon-search--format-heading (str &optional type no-newline)
"Format STR as a heading.
-Optionally add string TYPE after HEADING."
+Optionally add string TYPE after HEADING.
+NO-NEWLINE means don't add add a newline at end."
(mastodon-tl--set-face
(concat "\n " mastodon-tl--horiz-bar "\n "
(upcase str) " "
@@ -153,7 +190,7 @@ is used for pagination."
;; TODO: handle no results
(interactive "sSearch mastodon for: ")
(let* ((url (mastodon-http--api-v2 "search"))
- (following (when (or following (eq current-prefix-arg '(4)))
+ (following (when (or following (equal current-prefix-arg '(4)))
"true"))
(type (or type
(if (eq current-prefix-arg '(4))
@@ -294,9 +331,7 @@ If NOTE is non-nil, include user's profile note. This is also
(defun mastodon-search--get-user-info (account)
"Get user handle, display name, account URL and profile note from ACCOUNT."
- (list (if (not (string-empty-p (alist-get 'display_name account)))
- (alist-get 'display_name account)
- (alist-get 'username account))
+ (list (mastodon-tl--display-or-uname account)
(alist-get 'acct account)
(alist-get 'url account)
(alist-get 'note account)))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 3384a2a..1a4df7f 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -1,10 +1,10 @@
;;; mastodon-tl.el --- Timeline 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.
@@ -92,10 +92,12 @@
(autoload 'mastodon-toot--with-toot-item "mastodon-toot")
(autoload 'mastodon-media--image-or-cached "mastodon-media")
(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot")
+(autoload 'mastodon-search--load-link-posts "mastodon-search")
(defvar mastodon-toot--visibility)
(defvar mastodon-toot-mode)
(defvar mastodon-active-user)
+(defvar mastodon-notifications--images-in-notifs)
(when (require 'mpv nil :no-error)
(declare-function mpv-start "mpv"))
@@ -151,18 +153,24 @@ nil."
:type 'boolean)
(defcustom mastodon-tl--symbols
- '((reply . ("💬" . "R"))
- (boost . ("🔁" . "B"))
- (favourite . ("⭐" . "F"))
- (bookmark . ("🔖" . "K"))
- (media . ("📹" . "[media]"))
- (verified . ("" . "V"))
- (locked . ("🔒" . "[locked]"))
- (private . ("🔒" . "[followers]"))
- (direct . ("✉" . "[direct]"))
- (edited . ("✍" . "[edited]"))
- (replied . ("⬇" . "↓"))
- (reply-bar . ("┃" . "|")))
+ '((reply . ("💬" . "R"))
+ (boost . ("🔁" . "B"))
+ (reblog . ("🔁" . "B")) ;; server compat
+ (favourite . ("⭐" . "F"))
+ (bookmark . ("🔖" . "K"))
+ (media . ("📹" . "[media]"))
+ (verified . ("" . "V"))
+ (locked . ("🔒" . "[locked]"))
+ (private . ("🔒" . "[followers]"))
+ (direct . ("✉" . "[direct]"))
+ (edited . ("✍" . "[edited]"))
+ (update . ("✍" . "[edited]")) ;; server compat
+ (status . ("✍" . "[posted]"))
+ (replied . ("⬇" . "↓"))
+ (reply-bar . ("┃" . "|"))
+ (poll . ("📊" . ""))
+ (follow . ("👤" . "+"))
+ (follow_request . ("👤" . "+")))
"A set of symbols (and fallback strings) to be used in timeline.
If a symbol does not look right (tofu), it means your
font settings do not support it."
@@ -278,6 +286,7 @@ etc.")
;; is already bound to w also
(define-key map (kbd "u") #'mastodon-tl--update)
(define-key map [remap shr-browse-url] #'mastodon-url-lookup)
+ (define-key map (kbd "M-RET") #'mastodon-search--load-link-posts)
map)
"The keymap to be set for shr.el generated links that are not images.
We need to override the keymap so tabbing will navigate to all
@@ -574,6 +583,13 @@ With a double PREFIX arg, limit results to your own instance."
(concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth
'mastodon-tl--timeline nil params)))
+(defun mastodon-tl--link-timeline (url)
+ "Load a link timeline, displaying posts containing URL."
+ (let ((params `(("url" . ,url))))
+ (mastodon-tl--init "links" "timelines/link"
+ 'mastodon-tl--timeline nil
+ params)))
+
;;; BYLINES, etc.
@@ -588,51 +604,102 @@ Do so if type of status at poins is not follow_request/follow."
(string= type "follow")) ; no counts for these
(message "%s" echo)))))
-(defun mastodon-tl--byline-author (toot &optional avatar domain)
+;; FIXME: now that this can also be used for non byline rendering, let's
+;; remove the toot arg, and deal with attachments higher up (on real
+;; author byline only) removing toot arg makes it easier to render notifs
+;; that have no status (foll_reqs)
+(defun mastodon-tl--byline-username (toot &optional account)
+ "Format a byline username from account in TOOT.
+ACCOUNT is optionally acccount data to use."
+ (let-alist (or account (alist-get 'account toot))
+ (propertize (if (not (string-empty-p .display_name))
+ .display_name
+ .username)
+ 'face 'mastodon-display-name-face
+ ;; enable playing of videos when point is on byline:
+ ;; 'attachments (mastodon-tl--get-attachments-for-byline toot)
+ 'keymap mastodon-tl--byline-link-keymap
+ ;; echo faves count when point on post author name:
+ ;; which is where --goto-next-toot puts point.
+ 'help-echo
+ ;; but don't add it to "following"/"follows" on
+ ;; profile views: we don't have a tl--buffer-spec
+ ;; yet:
+ (unless (or (string-suffix-p "-followers*" (buffer-name))
+ (string-suffix-p "-following*" (buffer-name)))
+ (mastodon-tl--format-byline-help-echo toot)))))
+
+(defun mastodon-tl--byline-handle (toot &optional domain account string face)
+ "Format a byline handle from account in TOOT.
+DOMAIN is optionally added to the handle.
+ACCOUNT is optionally acccount data to use.
+STRING is optionally the string to propertize.
+FACE is optionally the face to use.
+The last two args allow for display a username as a clickable
+handle."
+ (let-alist (or account (alist-get 'account toot))
+ (propertize (or string
+ (concat "@" .acct
+ (when domain
+ (concat "@"
+ (url-host
+ (url-generic-parse-url .url))))))
+ 'face (or face 'mastodon-handle-face)
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'account account
+ 'shr-url .url
+ 'keymap mastodon-tl--link-keymap
+ 'mastodon-handle (concat "@" .acct)
+ 'help-echo (concat "Browse user profile of @" .acct))))
+
+(defun mastodon-tl--byline-uname-+-handle (data &optional domain account)
+ "Concatenate a byline username and handle.
+DATA is the (toot) data to use.
+DOMAIN is optionally a domain for the handle.
+ACCOUNT is optionally acccount data to use."
+ (concat (mastodon-tl--byline-username data account)
+ " (" (mastodon-tl--byline-handle data domain account) ")"))
+
+(defun mastodon-tl--display-or-uname (account)
+ "Return display name or username from ACCOUNT data."
+ (if (not (string-empty-p (alist-get 'display_name account)))
+ (alist-get 'display_name account)
+ (alist-get 'username account)))
+
+(defun mastodon-tl--byline-author (toot &optional avatar domain base account)
"Propertize author of TOOT.
+If TOOT contains a reblog, return author of reblogged item.
With arg AVATAR, include the account's avatar image.
-When DOMAIN, force inclusion of user's domain in their handle."
- (let-alist toot
+When DOMAIN, force inclusion of user's domain in their handle.
+BASE means to use data from the base item (reblog slot) if possible.
+If BASE is nil, we are a boosted byline, so show less info.
+ACCOUNT is optionally acccount data to use."
+ (let* ((data (if base
+ (mastodon-tl--toot-or-base toot)
+ toot))
+ (account (or account (alist-get 'account data)))
+ (uname (mastodon-tl--display-or-uname account)))
(concat
- ;; avatar insertion moved up to `mastodon-tl--byline' by default to be
- ;; outside 'byline propt.
+ ;; 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 .account.avatar))
- ;; username:
- (propertize (if (not (string-empty-p .account.display_name))
- .account.display_name
- .account.username)
- 'face 'mastodon-display-name-face
- ;; enable playing of videos when point is on byline:
- 'attachments (mastodon-tl--get-attachments-for-byline toot)
- 'keymap mastodon-tl--byline-link-keymap
- ;; echo faves count when point on post author name:
- ;; which is where --goto-next-toot puts point.
- 'help-echo
- ;; but don't add it to "following"/"follows" on profile views:
- ;; we don't have a tl--buffer-spec yet:
- (unless (or (string-suffix-p "-followers*" (buffer-name))
- (string-suffix-p "-following*" (buffer-name)))
- (mastodon-tl--format-byline-help-echo toot)))
- ;; handle:
- " ("
- (propertize (concat "@" .account.acct
- (when domain
- (concat "@"
- (url-host
- (url-generic-parse-url .account.url)))))
- 'face 'mastodon-handle-face
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'user-handle
- 'account .account
- 'shr-url .account.url
- 'keymap mastodon-tl--link-keymap
- 'mastodon-handle (concat "@" .account.acct)
- 'help-echo (concat "Browse user profile of @" .account.acct))
- ")")))
+ (mastodon-media--get-avatar-rendering
+ (map-nested-elt data '(account avatar))))
+ (if (not base)
+ ;; boost symbol:
+ (concat (mastodon-tl--symbol 'boost)
+ " "
+ ;; username as button:
+ (mastodon-tl--byline-handle
+ data domain account
+ ;; display uname not handle (for boosts):
+ uname 'mastodon-display-name-face))
+ ;; normal combo author byline:
+ (mastodon-tl--byline-uname-+-handle data domain account)))))
(defun mastodon-tl--format-byline-help-echo (toot)
"Format a help-echo for byline of TOOT.
@@ -680,13 +747,27 @@ The result is added as an attachments property to author-byline."
:type .type)))
media)))
-(defun mastodon-tl--byline-boosted (toot)
- "Add byline for boosted data from TOOT."
+(defun mastodon-tl--byline-booster (toot)
+ "Add author byline for booster from TOOT.
+Only return something if TOOT contains a reblog."
(let ((reblog (alist-get 'reblog toot)))
- (when reblog
- (concat
- "\n " (propertize "Boosted" 'face 'mastodon-boosted-face)
- " " (mastodon-tl--byline-author reblog)))))
+ (if reblog
+ (mastodon-tl--byline-author toot)
+ "")))
+
+(defun mastodon-tl--byline-booster-str (toot)
+ "Format boosted string for action byline.
+Only return string if TOOT contains a reblog."
+ (let ((reblog (alist-get 'reblog toot)))
+ (if reblog
+ (concat
+ " " (propertize "boosted" 'face 'mastodon-boosted-face) "\n")
+ "")))
+
+(defun mastodon-tl--byline-boost (toot)
+ "Format a boost action-byline element for TOOT."
+ (concat (mastodon-tl--byline-booster toot)
+ (mastodon-tl--byline-booster-str toot)))
(defun mastodon-tl--format-faved-or-boosted-byline (letter)
"Format the byline marker for a boosted or favourited status.
@@ -709,36 +790,41 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked."
(image-type-available-p 'imagemagick)
(image-transforms-p)))
-(defun mastodon-tl--byline (toot author-byline action-byline
- &optional detailed-p domain base-toot)
+(defun mastodon-tl--byline (toot author-byline &optional detailed-p
+ domain base-toot group account)
"Generate byline for TOOT.
AUTHOR-BYLINE is a function for adding the author portion of
the byline that takes one variable.
ACTION-BYLINE is a function for adding an action, such as boosting,
favouriting and following to the byline. It also takes a single function.
-By default it is `mastodon-tl--byline-boosted'.
+By default it is `mastodon-tl--byline-author'
DETAILED-P means display more detailed info. For now
this just means displaying toot client.
When DOMAIN, force inclusion of user's domain in their handle.
-BASE-TOOT is JSON for the base toot, if any."
+BASE-TOOT is JSON for the base toot, if any.
+GROUP is the notification group if any.
+ACCOUNT is the notification account if any."
(let* ((created-time
- ;; bosts and faves in notifs view
- ;; (makes timestamps be for the original toot not the boost/fave):
- (or (mastodon-tl--field 'created_at
- (mastodon-tl--field 'status toot))
- ;; all other toots, inc. boosts/faves in timelines:
- ;; (mastodon-tl--field auto fetches from reblogs if needed):
- (mastodon-tl--field 'created_at toot)))
+ (if group
+ (mastodon-tl--field 'latest_page_notification_at group)
+ ;; bosts and faves in notifs view
+ ;; (makes timestamps be for the original toot not the boost/fave):
+ (or (mastodon-tl--field 'created_at
+ (mastodon-tl--field 'status toot))
+ ;; all other toots, inc. boosts/faves in timelines:
+ ;; (mastodon-tl--field auto fetches from reblogs if needed):
+ (mastodon-tl--field 'created_at toot))))
(parsed-time (date-to-time created-time))
(faved (eq t (mastodon-tl--field 'favourited toot)))
(boosted (eq t (mastodon-tl--field 'reblogged toot)))
(bookmarked (eq t (mastodon-tl--field 'bookmarked toot)))
(visibility (mastodon-tl--field 'visibility toot))
- (account (alist-get 'account toot))
- (avatar-url (alist-get 'avatar account))
- (type (alist-get 'type toot))
+ (type (alist-get 'type (or group toot)))
(base-toot-maybe (or base-toot ;; show edits for notifs
(mastodon-tl--toot-or-base toot))) ;; for boosts
+ (account (or account
+ (alist-get 'account base-toot-maybe)))
+ (avatar-url (alist-get 'avatar account))
(edited-time (alist-get 'edited_at base-toot-maybe))
(edited-parsed (when edited-time (date-to-time edited-time))))
(concat
@@ -758,17 +844,18 @@ BASE-TOOT is JSON for the base toot, if any."
(when bookmarked
(mastodon-tl--format-faved-or-boosted-byline
(mastodon-tl--symbol 'bookmark))))
- ;; we remove avatars from the byline also, so that they also do not mess
- ;; with `mastodon-tl--goto-next-item':
+ ;; we remove avatars from the byline also, so that they also do not
+ ;; mess with `mastodon-tl--goto-next-item':
(when (and mastodon-tl--show-avatars
mastodon-tl--display-media-p
(mastodon-tl--image-trans-check))
(mastodon-media--get-avatar-rendering avatar-url))
(propertize
(concat
- ;; we propertize help-echo format faves for author name
- ;; in `mastodon-tl--byline-author'
- (funcall author-byline toot nil domain)
+ ;; NB: action-byline (boost) is now added in insert-status, so no
+ ;; longer part of the byline.
+ ;; (base) author byline:
+ (funcall author-byline toot nil domain :base account)
;; visibility:
(cond ((string= visibility "direct")
(propertize (concat " " (mastodon-tl--symbol 'direct))
@@ -776,22 +863,22 @@ BASE-TOOT is JSON for the base toot, if any."
((string= visibility "private")
(propertize (concat " " (mastodon-tl--symbol 'private))
'help-echo visibility)))
- ;;action byline:
- (funcall action-byline toot)
" "
;; timestamp:
- (propertize
- (format-time-string mastodon-toot-timestamp-format parsed-time)
- 'timestamp parsed-time
- 'display (if mastodon-tl--enable-relative-timestamps
- (mastodon-tl--relative-time-description parsed-time)
- parsed-time))
+ (let ((ts (format-time-string
+ mastodon-toot-timestamp-format parsed-time)))
+ (propertize ts
+ 'timestamp parsed-time
+ 'display
+ (if mastodon-tl--enable-relative-timestamps
+ (mastodon-tl--relative-time-description parsed-time)
+ parsed-time)
+ 'help-echo ts))
;; detailed:
(when detailed-p
- (let* ((app (alist-get 'application toot))
- (app-name (alist-get 'name app))
- (app-url (alist-get 'website app)))
- (when app
+ (let* ((app-name (map-nested-elt toot '(application name)))
+ (app-url (map-nested-elt toot '(application website))))
+ (when app-name
(concat
(propertize " via " 'face 'default)
(propertize app-name
@@ -826,6 +913,8 @@ BASE-TOOT is JSON for the base toot, if any."
'favourited-p faved
'boosted-p boosted
'bookmarked-p bookmarked
+ ;; enable playing of videos when point is on byline:
+ 'attachments (mastodon-tl--get-attachments-for-byline toot)
'edited edited-time
'edit-history (when edited-time
(mastodon-toot--get-toot-edits
@@ -874,17 +963,59 @@ links in the text. If TOOT is nil no parsing occurs."
0
(- (window-width) 3)))))
(shr-render-region (point-min) (point-max)))
- ;; Make all links a tab stop recognized by our own logic, make things point
- ;; to our own logic (e.g. hashtags), and update keymaps where needed:
+ ;; Make all links a tab stop recognized by our own logic, make
+ ;; things point to our own logic (e.g. hashtags), and update keymaps
+ ;; where needed:
(when toot
(let (region)
(while (setq region (mastodon-tl--find-property-range
'shr-url (or (cdr region) (point-min))))
(mastodon-tl--process-link toot
(car region) (cdr region)
- (get-text-property (car region) 'shr-url)))))
+ (get-text-property (car region) 'shr-url))
+ (when (proper-list-p toot) ;; not on profile fields cons cells
+ ;; render card author maybe:
+ (let* ((card-url (map-nested-elt toot '(card url)))
+ (authors (map-nested-elt toot '(card authors)))
+ (url (buffer-substring (car region) (cdr region)))
+ (url-no-query (car (split-string url "?"))))
+ (when (and (string= url-no-query card-url)
+ ;; only if we have an account's data:
+ (alist-get 'account (car authors)))
+ (goto-char (point-max))
+ (mastodon-tl--insert-card-authors authors)))))))
(buffer-string))))
+(defun mastodon-tl--insert-card-authors (authors)
+ "Insert a string of card AUTHORS."
+ (let ((authors-str (format "Author%s: "
+ (if (< 1 (length authors)) "s" ""))))
+ (insert
+ (concat
+ "\n(" authors-str
+ (mapconcat #'mastodon-tl--format-card-author authors "\n")
+ ")\n"))))
+
+(defun mastodon-tl--format-card-author (data)
+ "Render card author DATA."
+ (when-let ((account (alist-get 'account data))) ;.account
+ (let-alist account ;.account
+ ;; FIXME: replace with refactored handle render fun
+ ;; in byline refactor branch:
+ (concat
+ (propertize .username
+ 'face 'mastodon-display-name-face
+ 'item-type 'user
+ 'item-id .id)
+ " "
+ (propertize (concat "@" .acct)
+ 'face 'mastodon-handle-face
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'keymap mastodon-tl--link-keymap
+ 'mastodon-handle (concat "@" .acct)
+ 'help-echo (concat "Browse user profile of @" .acct))))))
+
(defun mastodon-tl--process-link (toot start end url)
"Process link URL in TOOT as hashtag, userhandle, or normal link.
START and END are the boundaries of the link in the toot."
@@ -991,7 +1122,7 @@ the toot)."
(url-generic-parse-url instance-url)))
(parsed (url-generic-parse-url url))
(path (url-filename parsed))
- (split (string-split path "/")))
+ (split (split-string path "/")))
(when (and (string= instance-host (url-host parsed))
(string-prefix-p "/tag" path)) ;; "/tag/" or "/tags/"
(nth 2 split))))
@@ -1182,16 +1313,22 @@ SENSITIVE is a flag from the item's JSON data."
(concat "Media:: "
(if (and mastodon-tl--display-caption-not-url-when-no-media
.description)
- .description)
- .preview_url)))
- (if mastodon-tl--display-media-p
+ .description
+ .preview_url)))
+ (remote-url (or .remote_url .url)))
+ (if (and mastodon-tl--display-media-p
+ ;; if in notifs, also check notifs images custom:
+ (if (or (mastodon-tl--buffer-type-eq 'notifications)
+ (mastodon-tl--buffer-type-eq 'mentions))
+ mastodon-notifications--images-in-notifs
+ t))
(mastodon-media--get-media-link-rendering ; placeholder: "[img]"
- .preview_url (or .remote_url .url) ; for shr-browse-url
+ .preview_url remote-url ; for shr-browse-url
.type .description sensitive)
;; return URL/caption:
(concat (mastodon-tl--propertize-img-str-or-url
(concat "Media:: " .preview_url) ; string
- .preview_url .remote_url .type .description
+ .preview_url remote-url .type .description
display-str 'shr-link .description sensitive)
"\n")))))
@@ -1214,7 +1351,7 @@ SENSITIVE is a flag from the item's JSON data."
'face face
'mouse-face 'highlight
'mastodon-tab-stop 'image ; for do-link-action-at-point
- 'image-url full-remote-url ; for shr-browse-image
+ 'image-url (or full-remote-url media-url) ; for shr-browse-image
'keymap mastodon-tl--shr-image-map-replacement
'image-description caption
'sensitive sensitive
@@ -1521,7 +1658,7 @@ portion of the byline that takes one variable. By default it is
ACTION-BYLINE is also an optional function for adding an action,
such as boosting favouriting and following to the byline. It also
takes a single function. By default it is
-`mastodon-tl--byline-boosted'.
+`mastodon-tl--byline-boost'.
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
@@ -1532,12 +1669,11 @@ THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle.
UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
NO-BYLINE means just insert toot body, used for folding."
- (let* ((start-pos (point))
- (reply-to-id (alist-get 'in_reply_to_id toot))
+ (let* ((reply-to-id (alist-get 'in_reply_to_id toot))
(after-reply-status-p
(when (and thread reply-to-id)
(mastodon-tl--after-reply-status reply-to-id)))
- (type (alist-get 'type toot))
+ ;; (type (alist-get 'type toot))
(toot-foldable
(and mastodon-tl--fold-toots-at-length
(length> body mastodon-tl--fold-toots-at-length))))
@@ -1547,7 +1683,8 @@ NO-BYLINE means just insert toot body, used for folding."
(propertize ;; body only:
(concat
"\n"
- ;; relpy symbol (broken):
+ (funcall action-byline toot)
+ ;; relpy symbol:
(when (and after-reply-status-p thread)
(concat (mastodon-tl--symbol 'replied)
"\n"))
@@ -1564,9 +1701,10 @@ NO-BYLINE means just insert toot body, used for folding."
'toot-body t) ;; includes newlines etc. for folding
;; byline:
"\n"
- (unless no-byline
- (mastodon-tl--byline toot author-byline action-byline
- detailed-p domain base-toot)))
+ (if no-byline
+ ""
+ (mastodon-tl--byline toot author-byline detailed-p
+ domain base-toot)))
'item-type 'toot
'item-id (or id ; notification's own id
(alist-get 'id toot)) ; toot id
@@ -1578,13 +1716,9 @@ NO-BYLINE means just insert toot body, used for folding."
'item-json toot
'base-toot base-toot
'cursor-face 'mastodon-cursor-highlight-face
- 'notification-type type
'toot-foldable toot-foldable
'toot-folded (and toot-foldable (not unfolded)))
- (if no-byline "" "\n"))
- ;; media:
- (when mastodon-tl--display-media-p
- (mastodon-media--inline-images start-pos (point)))))
+ (if no-byline "" "\n"))))
(defun mastodon-tl--is-reply (toot)
"Check if the TOOT is a reply to another one (and not boosted).
@@ -1654,7 +1788,7 @@ NO-BYLINE means just insert toot body, used for folding."
(mastodon-tl--insert-status
toot
(mastodon-tl--clean-tabs-and-nl spoiler-or-content)
- 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted
+ #'mastodon-tl--byline-author #'mastodon-tl--byline-boost
nil nil detailed-p thread domain unfolded no-byline))))
(defun mastodon-tl--timeline (toots &optional thread domain)
@@ -1662,7 +1796,8 @@ NO-BYLINE means just insert toot body, used for folding."
This function removes replies if user required.
THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle."
- (let ((toots ;; hack to *not* filter replies on profiles:
+ (let ((start-pos (point))
+ (toots ;; hack to *not* filter replies on profiles:
(if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
toots
(if (or ; we were called via --more*:
@@ -1674,6 +1809,9 @@ When DOMAIN, force inclusion of user's domain in their handle."
(mapc (lambda (toot)
(mastodon-tl--toot toot nil thread domain))
toots)
+ ;; media:
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images start-pos (point)))
(goto-char (point-min))))
;;; FOLDING
@@ -1977,7 +2115,9 @@ call this function after it is set or use something else."
((string= "*mastodon-toot-edits*" buffer-name)
'toot-edits)
((string= "*masto-image*" (buffer-name))
- 'mastodon-image))))
+ 'mastodon-image)
+ ((mastodon-tl--endpoint-str-= "timelines/link")
+ 'link-timeline))))
(defun mastodon-tl--buffer-type-eq (type)
"Return t if current buffer type is equal to symbol TYPE."
@@ -2079,16 +2219,28 @@ BACKWARD means move backward (up) the timeline."
(get-text-property (point) prop)))))
(defun mastodon-tl--newest-id ()
- "Return item-id from the top of the buffer."
+ "Return item-id from the top of the buffer.
+If we are in a notifications view, return `notifications-max-id'."
(save-excursion
(goto-char (point-min))
- (mastodon-tl--property 'item-id)))
+ (mastodon-tl--property
+ (if (eq (mastodon-tl--get-buffer-type)
+ (member (mastodon-tl--get-buffer-type)
+ '(mentions notifications)))
+ 'notifications-max-id
+ 'item-id))))
(defun mastodon-tl--oldest-id ()
- "Return item-id from the bottom of the buffer."
+ "Return item-id from the bottom of the buffer.
+If we are in a notifications view, return `notifications-min-id'."
(save-excursion
(goto-char (point-max))
- (mastodon-tl--property 'item-id nil :backward)))
+ (mastodon-tl--property
+ (if (member (mastodon-tl--get-buffer-type)
+ '(mentions notifications))
+ 'notifications-min-id
+ 'item-id)
+ nil :backward)))
(defun mastodon-tl--as-string (numeric)
"Convert NUMERIC to string."
@@ -2128,6 +2280,9 @@ ID is that of the toot to view."
#'mastodon-tl--update-toot)
(mastodon-tl--toot toot :detailed-p)
(goto-char (point-min))
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images (point-min)
+ (point-max)))
(mastodon-tl--goto-next-item :no-refresh)))))
(defun mastodon-tl--update-toot (json)
@@ -2186,6 +2341,11 @@ view all branches of a thread."
(move-marker marker (point))
;; print re-fetched toot:
(mastodon-tl--toot toot :detailed-p :thread)
+ ;; inline images only for the toot
+ ;; (`mastodon-tl--timeline' handles the rest):
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images marker ;start-pos
+ (point)))
(mastodon-tl--timeline (alist-get 'descendants context)
:thread)
;; put point at the toot:
@@ -2236,8 +2396,7 @@ If UNMUTE, unmute it."
(defun mastodon-tl--map-account-id-from-toot (statuses)
"Return a list of the account IDs of the author of each toot in STATUSES."
(mapcar (lambda (status)
- (alist-get 'id
- (alist-get 'account status)))
+ (map-nested-elt status '(account id)))
statuses))
(defun mastodon-tl--user-in-thread-p (id)
@@ -2382,39 +2541,44 @@ LANGS is the accumulated array param alist if we re-run recursively."
"Get the list of user-handles for ACTION from the current toot."
(mastodon-tl--do-if-item
(let ((user-handles
- (cond ((or ; follow suggests / search / foll requests compat:
- (mastodon-tl--buffer-type-eq 'follow-suggestions)
- (mastodon-tl--buffer-type-eq 'search)
- (mastodon-tl--buffer-type-eq 'follow-requests)
- ;; profile follows/followers but not statuses:
- (mastodon-tl--buffer-type-eq 'profile-followers)
- (mastodon-tl--buffer-type-eq 'profile-following))
- ;; fetch 'item-json:
- (list (alist-get 'acct
- (mastodon-tl--property 'item-json :no-move))))
- ;; profile view, point in profile details, poss no toots
- ;; needed for e.g. gup.pe groups which show no toots publically:
- ((and (mastodon-tl--profile-buffer-p)
- (get-text-property (point) 'profile-json))
- (list (alist-get 'acct
- (mastodon-profile--profile-json))))
- (t
- (mastodon-profile--extract-users-handles
- (mastodon-profile--item-json))))))
- ;; return immediately if only 1 handle:
- (if (eq 1 (length user-handles))
- (car user-handles)
- (completing-read (cond ((or ; TODO: make this "enable/disable notifications"
- (string= action "disable")
- (string= action "enable"))
- (format "%s notifications when user posts: " action))
- ((string-suffix-p "boosts" action)
- (format "%s by user: " action))
- (t
- (format "Handle of user to %s: " action)))
- user-handles
- nil ; predicate
- 'confirm)))))
+ (cond
+ ((or ; follow suggests / search / foll requests compat:
+ (member (mastodon-tl--get-buffer-type)
+ '( follow-suggestions search follow-requests
+ ;; profile follows/followers but not statuses:
+ profile-followers profile-following)))
+ ;; fetch 'item-json:
+ (list (alist-get 'acct
+ (mastodon-tl--property 'item-json :no-move))))
+ ;; profile view, point in profile details, poss no toots
+ ;; needed for e.g. gup.pe groups which show no toots publically:
+ ((and (mastodon-tl--profile-buffer-p)
+ (get-text-property (point) 'profile-json))
+ (list (alist-get 'acct
+ (mastodon-profile--profile-json))))
+ ;; (grouped) notifications:
+ ((member (mastodon-tl--get-buffer-type) '(mentions notifications))
+ (append ;; those acting on item:
+ (cl-remove-duplicates
+ (cl-loop for a in (mastodon-tl--property
+ 'notification-accounts :no-move)
+ collect (alist-get 'acct a)))
+ ;; mentions in item:
+ (mastodon-profile--extract-users-handles
+ (mastodon-profile--item-json))))
+ (t
+ (mastodon-profile--extract-users-handles
+ (mastodon-profile--item-json))))))
+ (completing-read
+ (cond ((or ; TODO: make this "enable/disable notifications"
+ (string= action "disable")
+ (string= action "enable"))
+ (format "%s notifications when user posts: " action))
+ ((string-suffix-p "boosts" action)
+ (format "%s by user: " action))
+ (t (format "Handle of user to %s: " action)))
+ user-handles nil ; predicate
+ 'confirm))))
(defun mastodon-tl--get-blocks-or-mutes-list (action)
"Fetch the list of accounts for ACTION from the server.
@@ -2440,20 +2604,31 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'.
LANGS is an array parameters alist of languages to filer user's posts by.
REBLOGS is a boolean string like NOTIFY, enabling or disabling
display of the user's boosts in your timeline."
- (let* ((account (if negp
- ;; unmuting/unblocking, handle from mute/block list
- (mastodon-profile--search-account-by-handle user-handle)
- (mastodon-profile--lookup-account-in-status
- user-handle
- (if (mastodon-tl--profile-buffer-p)
- ;; profile view, use 'profile-json as status:
- (mastodon-profile--profile-json)
- ;; muting/blocking, select from handles in current status
- (mastodon-profile--item-json)))))
+ (let* ((account
+ (cond
+ (negp ;; unmuting/unblocking, use mute/block list
+ (mastodon-profile--search-account-by-handle user-handle))
+ ;; (grouped) notifications:
+ ((member (mastodon-tl--get-buffer-type)
+ '(mentions notifications))
+ (let ((accounts (mastodon-tl--property 'notification-accounts)))
+ (or (cl-some (lambda (x)
+ (when (string= user-handle (alist-get 'acct x))
+ x))
+ accounts)
+ (mastodon-profile--lookup-account-in-status
+ user-handle
+ (mastodon-profile--item-json)))))
+ (t
+ (mastodon-profile--lookup-account-in-status
+ user-handle
+ (if (mastodon-tl--profile-buffer-p)
+ ;; profile view, use 'profile-json as status:
+ (mastodon-profile--profile-json)
+ ;; muting/blocking, select from handles in current status
+ (mastodon-profile--item-json))))))
(user-id (alist-get 'id account))
- (name (if (string-empty-p (alist-get 'display_name account))
- (alist-get 'username account)
- (alist-get 'display_name account)))
+ (name (mastodon-tl--display-or-uname account))
(args (cond (notify `(("notify" . ,notify)))
(langs langs)
(reblogs `(("reblogs" . ,reblogs)))
@@ -2503,8 +2678,7 @@ ARGS is an alist of any parameters to send with the request."
((assoc "languages[]" args #'string=)
(message "User %s filtered by language(s): %s" name
(mapconcat #'cdr args " ")))
- ((and (eq notify nil)
- (eq reblogs nil))
+ ((not (or notify reblogs))
(if (and (string= action "follow")
(eq t (alist-get 'requested json)))
(message "Follow requested for user %s (@%s)!" name user-handle)
@@ -2687,7 +2861,8 @@ the current view."
(args (append args params))
(url (mastodon-http--api
endpoint
- (when (string-suffix-p "search" endpoint)
+ (when (or (string= endpoint "notifications")
+ (string-suffix-p "search" endpoint))
"v2"))))
(apply #'mastodon-http--get-json-async url args callback cbargs)))
@@ -2742,7 +2917,7 @@ Aims to respect any pagination in effect."
((eq type 'mentions)
(mastodon-notifications--get-mentions))
((eq type 'notifications)
- (mastodon-notifications-get nil nil :force max-id))
+ (mastodon-notifications-get nil nil max-id))
((eq type 'profile-statuses-no-boosts)
;; TODO: max-id arg needed here also
(mastodon-profile--open-statuses-no-reblogs))
@@ -3034,12 +3209,13 @@ This location is defined by a non-nil value of
(interactive)
;; FIXME: actually these buffers should just reload by calling their own
;; load function (actually g is mostly mapped as such):
- (if (or (mastodon-tl--buffer-type-eq 'trending-statuses)
- (mastodon-tl--buffer-type-eq 'trending-tags)
- (mastodon-tl--buffer-type-eq 'follow-suggestions)
- (mastodon-tl--buffer-type-eq 'lists)
- (mastodon-tl--buffer-type-eq 'filters)
- (mastodon-tl--buffer-type-eq 'scheduled-statuses)
+ (if (or (member (mastodon-tl--get-buffer-type)
+ '(trending-statuses
+ trending-tags
+ follow-suggestions
+ lists
+ filters
+ scheduled-statuses))
(mastodon-tl--search-buffer-p))
(user-error "Update not available in this view")
;; FIXME: handle update for search and trending buffers
@@ -3047,7 +3223,7 @@ This location is defined by a non-nil value of
(update-function (mastodon-tl--update-function)))
;; update a thread, without calling `mastodon-tl--updated-json':
(if (mastodon-tl--buffer-type-eq 'thread)
- ;; load whole thread whole thread
+ ;; load whole thread:
(let ((thread-id (mastodon-tl--thread-parent-id)))
(funcall update-function thread-id)
(message "Loaded full thread."))
@@ -3061,8 +3237,9 @@ This location is defined by a non-nil value of
(mastodon-tl--set-after-update-marker)
(goto-char (or mastodon-tl--update-point (point-min)))
(funcall update-function json)
- (when mastodon-tl--after-update-marker
- (goto-char mastodon-tl--after-update-marker)))))))))
+ (if mastodon-tl--after-update-marker
+ (goto-char mastodon-tl--after-update-marker)
+ (mastodon-tl--goto-next-item)))))))))
;;; LOADING TIMELINES
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 832d03f..fc5825a 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -1,10 +1,10 @@
;;; mastodon-toot.el --- Minor mode for sending Mastodon toots -*- 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.
@@ -175,9 +175,14 @@ width fonts"))
"A flag indicating whether the toot should be marked as NSFW.")
(defvar mastodon-toot-visibility-list
- '(direct private unlisted public)
+ '(public unlisted private direct)
"A list of the available toot visibility settings.")
+(defvar mastodon-toot-visibility-settings-list
+ '("public" "unlisted" "private")
+ "A list of the available default toot visibility settings.
+Like `mastodon-toot-visibility-list' but without direct.")
+
(defvar-local mastodon-toot--visibility nil
"A string indicating the visibility of the toot being composed.
Valid values are \"direct\", \"private\" (followers-only),
@@ -517,21 +522,34 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement."
(defun mastodon-toot--list-boosters ()
"List the boosters of toot at point."
(interactive)
- (mastodon-toot--list-boosters-or-favers))
+ ;; use grouped notifs data if present:
+ ;; only send accounts as arg if type matches notif type we are acting
+ ;; on, to prevent showing accounts for a boost notif when asking for
+ ;; favers, and vice versa.
+ (let* ((type (mastodon-tl--property 'notification-type :no-move))
+ (accounts (when (string= type "reblog")
+ (mastodon-tl--property 'notification-accounts :no-move))))
+ (mastodon-toot--list-boosters-or-favers nil accounts)))
(defun mastodon-toot--list-favouriters ()
"List the favouriters of toot at point."
(interactive)
- (mastodon-toot--list-boosters-or-favers :favourite))
+ (let* ((type (mastodon-tl--property 'notification-type :no-move))
+ (accounts (when (string= type "favourite")
+ (mastodon-tl--property 'notification-accounts :no-move))))
+ (mastodon-toot--list-boosters-or-favers :favourite accounts)))
-(defun mastodon-toot--list-boosters-or-favers (&optional favourite)
+(defun mastodon-toot--list-boosters-or-favers (&optional favourite accounts)
"List the favouriters or boosters of toot at point.
-With FAVOURITE, list favouriters, else list boosters."
+With FAVOURITE, list favouriters, else list boosters.
+ACCOUNTS is notfications accounts if any."
(mastodon-toot--with-toot-item
- (let* ((endpoint (if favourite "favourited_by" "reblogged_by"))
- (url (mastodon-http--api (format "statuses/%s/%s" id endpoint)))
- (params '(("limit" . "80")))
- (json (mastodon-http--get-json url params)))
+ (let* ((endpoint (unless accounts
+ (if favourite "favourited_by" "reblogged_by")))
+ (url (unless accounts
+ (mastodon-http--api (format "statuses/%s/%s" id endpoint))))
+ (params (unless accounts '(("limit" . "80"))))
+ (json (or accounts (mastodon-http--get-json url params))))
(if (eq (caar json) 'error)
(user-error "%s (Status does not exist or is private)"
(alist-get 'error json))
@@ -1668,7 +1686,7 @@ REPLY-TEXT is the text of the toot being replied to."
'read-only "Edit your message below."
'toot-post-header t))
;; allow us to enter text after read-only header:
- (propertize "\n"
+ (propertize "\n\n"
'rear-nonsticky t))))
(defun mastodon-toot--most-restrictive-visibility (reply-visibility)
@@ -1681,22 +1699,17 @@ The default is given by `mastodon-toot--default-reply-visibility'."
mastodon-toot--default-reply-visibility
reply-visibility))))
-(defun mastodon-toot--fill-buffer ()
- "Mark buffer, call `fill-region'."
- (mark-whole-buffer) ; lisp code should not set mark
- ;; (fill-region (point-min) (point-max)) ; but this doesn't work
- (fill-region (region-beginning) (region-end)))
-
(defun mastodon-toot--render-reply-region-str (str)
"Refill STR and prefix all lines with >, as reply-quote text."
(with-temp-buffer
(insert str)
;; unfill first:
(let ((fill-column (point-max)))
- (mastodon-toot--fill-buffer))
+ (fill-region (point-min) (point-max)))
;; then fill:
- (mastodon-toot--fill-buffer)
+ (fill-region (point-min) (point-max))
;; add our own prefix, pauschal:
+ (goto-char (point-min))
(save-match-data
(while (re-search-forward "^" nil t)
(replace-match " > ")))
diff --git a/lisp/mastodon-transient.el b/lisp/mastodon-transient.el
new file mode 100644
index 0000000..526dfa4
--- /dev/null
+++ b/lisp/mastodon-transient.el
@@ -0,0 +1,230 @@
+;;; mastodon-transient.el --- transient menus for mastodon.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 martian hiatus
+
+;; Author: martian hiatus <mousebot@disroot.org>
+;; Keywords: convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'tp)
+
+;;; UTILS
+
+;; some JSON fields that are returned under the "source" field need to be
+;; sent back in the format source[key], while some others are sent kust as
+;; key:
+(defun mastodon-transient-parse-source-key (key)
+ "Parse mastodon source KEY.
+If KEY needs to be source[key], format like so, else just return
+the inner key part."
+ (let* ((split (split-string key "[][]"))
+ (array-key (cadr split)))
+ (if (or (= 1 (length split)) ;; no split
+ (member array-key '("privacy" "sensitive" "language")))
+ key
+ array-key)))
+
+(defun mastodon-transient-parse-source-keys (alist)
+ "Parse ALIST containing source[key] keys."
+ (cl-loop for a in alist
+ collect (cons (mastodon-transient-parse-source-key (car a))
+ (cdr a))))
+
+(defun mastodon-transient-get-creds ()
+ "Fetch account data."
+ (mastodon-http--get-json
+ (mastodon-http--api "accounts/verify_credentials")
+ nil :silent))
+
+;; fields utils:
+;; to PATCH fields, we just need fields[x][name] and fields[x][value]
+
+(defun mastodon-transient--fields-alist (fields)
+ "Convert fields in FIELDS to numbered conses.
+The keys in the data are not numbered, so we convert the key into
+the format fields.X.keyname."
+ (cl-loop
+ for f in fields
+ for count from 1 to 5
+ collect
+ (cl-loop for x in f
+ collect
+ (cons (concat "fields." (number-to-string count)
+ "." (symbol-name (car x)))
+ (cdr x)))))
+
+(defun mastodon-transient-field-dot-to-array (key)
+ "Convert KEY from tp dot annotation to array[key] annotation."
+ (tp-dot-to-array (symbol-name key) nil "_attributes"))
+
+(defun mastodon-transient-dot-fields-to-arrays (alist)
+ "Parse fields ALIST in dot notation to array notation."
+ (cl-loop for y in alist
+ collect
+ (cons (mastodon-transient-field-dot-to-array (car y))
+ (cdr y))))
+
+;;; TRANSIENTS
+
+;; FIXME: PATCHing source vals as JSON request body doesn't work! existing
+;; `mastodon-profile--update-preference' doesn't use it! it just uses
+;; query params! strange thing is it works for non-source params
+(transient-define-suffix mastodon-user-settings-update (&optional args)
+ "Update current user settings on the server."
+ :transient 'transient--do-exit
+ (interactive (list (transient-args 'mastodon-user-settings)))
+ (let* ((parsed (tp-parse-args-for-send args :strings))
+ (strs (mastodon-transient-parse-source-keys parsed))
+ (url (mastodon-http--api "accounts/update_credentials"))
+ (resp (mastodon-http--patch url strs))) ;; :json fails
+ (mastodon-http--triage
+ resp
+ (lambda (_)
+ (message "Settings updated!\n%s" (pp-to-string strs))))))
+
+(transient-define-prefix mastodon-user-settings ()
+ "A transient for setting current user settings."
+ :value (lambda () (tp-return-data
+ #'mastodon-transient-get-creds))
+ [:description
+ (lambda ()
+ (format "User settings for %s" mastodon-active-user))
+ (:info
+ "Note: use the empty string (\"\") to remove a value from an option.")]
+ ;; strings
+ ["Account info"
+ ("n" "display name" "display_name" :alist-key display_name :class tp-option-str)
+ ("t" "update profile note" mastodon-update-profile-note)
+ ("f" "update profile fields" mastodon-profile-fields)]
+ ;; "choice" booleans (so we can PATCH :json-false explicitly):
+ ["Account options"
+ ("l" "locked" "locked" :alist-key locked :class tp-bool)
+ ("b" "bot" "bot" :alist-key bot :class tp-bool)
+ ("d" "discoverable" "discoverable" :alist-key discoverable :class tp-bool)
+ ("c" "hide follower/following lists" "source.hide_collections"
+ :alist-key source.hide_collections :class tp-bool)
+ ("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)
+ ]
+ ["Tooting options"
+ ("p" "default privacy" "source.privacy" :alist-key source.privacy
+ :class tp-option
+ :choices (lambda () mastodon-toot-visibility-settings-list))
+ ("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool)
+ ("g" "default language" "source.language" :alist-key source.language :class tp-option
+ :choices (lambda () mastodon-iso-639-regional))
+ ]
+ ["Update"
+ ("C-c C-c" "Save settings" mastodon-user-settings-update)
+ ("C-c C-k" :info "Revert all changes")]
+ (interactive)
+ (if (or (not (boundp 'mastodon-active-user))
+ (not mastodon-active-user))
+ (user-error "User not set")
+ (transient-setup 'mastodon-user-settings)))
+
+(transient-define-suffix mastodon-update-profile-note ()
+ "Update current user profile note."
+ :transient 'transient--do-exit
+ (interactive)
+ (mastodon-profile--update-user-profile-note))
+
+(transient-define-suffix mastodon-profile-fields-update (args)
+ "Update current user profile fields."
+ :transient 'transient--do-return
+ (interactive (list (transient-args 'mastodon-profile-fields)))
+ (let* (;; FIXME: maybe only changed also won't work with fields, as
+ ;; perhaps what is PATCHed overwrites whatever is on the server?
+ ;; (only-changed (tp-only-changed-args alist))
+ (arrays (mastodon-transient-dot-fields-to-arrays args))
+ (endpoint "accounts/update_credentials")
+ (url (mastodon-http--api endpoint))
+ (resp (mastodon-http--patch url arrays))) ; :json)))
+ (mastodon-http--triage
+ resp (lambda (_) (message "Fields updated!")))))
+
+(defun mastodon-transient-fetch-fields ()
+ "Fetch profile fields (metadata)."
+ (tp-return-data #'mastodon-transient-get-creds nil 'fields)
+ (setq tp-server-settings
+ (mastodon-transient--fields-alist tp-server-settings)))
+
+(transient-define-prefix mastodon-profile-fields ()
+ "A transient for setting profile fields."
+ :value
+ (lambda () (mastodon-transient-fetch-fields))
+ [:description
+ "Fields"
+ ["Name"
+ ("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field)
+ ("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field)
+ ("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field)
+ ("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)]
+ ["Value"
+ ("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field)
+ ("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field)
+ ("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field)
+ ("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]]
+ ["Update"
+ ("C-c C-c" "Save settings" mastodon-profile-fields-update)
+ ("C-c C-k" :info "Revert all changes")]
+ (interactive)
+ (if (not mastodon-active-user)
+ (user-error "User not set")
+ (transient-setup 'mastodon-profile-fields)))
+
+;;; CLASSES
+
+(defclass mastodon-transient-field (tp-option-str)
+ ((always-read :initarg :always-read :initform t))
+ "An infix option class for our options.
+We always read.")
+
+(cl-defmethod transient-init-value ((obj mastodon-transient-field))
+ "Initialize value of OBJ."
+ (let* ((prefix-val (oref transient--prefix value))
+ (arg (oref obj alist-key)))
+ (oset obj value
+ (tp-get-server-val obj prefix-val))))
+
+(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data)
+ "Return the server value for OBJ from DATA.
+If OBJ's key has dotted notation, drill down into the alist. Currently
+only one level of nesting is supported."
+ ;; TODO: handle nested alist keys
+ (let* ((key (oref obj alist-key))
+ (split (split-string (symbol-name key) "\\."))
+ (num (string-to-number (cadr split))))
+ (alist-get key
+ (nth (1- num) data) nil nil #'string=)))
+
+(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons)
+ "T if value of OBJ is changed from the server value.
+CONS is a cons of the form \"(fields.1.name . val)\"."
+ (let* ((key-split (split-string
+ (symbol-to-string (car cons)) "\\."))
+ (num (1- (string-to-number (nth 1 key-split))))
+ (server-key (symbol-name (car cons)))
+ (server-elt (nth num tp-server-settings)))
+ (not (equal (cdr cons)
+ (alist-get server-key server-elt nil nil #'string=)))))
+
+(provide 'mastodon-transient)
+;;; mastodon-transient.el ends here
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
index ac62b1f..8d356fb 100644
--- a/lisp/mastodon-views.el
+++ b/lisp/mastodon-views.el
@@ -1,8 +1,8 @@
;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020-2022 Marty Hiatt
-;; Author: Marty Hiatt <martianhiatus@riseup.net>
-;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: 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.
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index faeae61..cb5731a 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -4,10 +4,11 @@
;; Copyright (C) 2020-2022 Marty Hiatt
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
;; Author: Johnson Denen <johnson.denen@gmail.com>
-;; Marty Hiatt <martianhiatus@riseup.net>
-;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
-;; Version: 1.0.27
-;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4"))
+;; Marty Hiatt <mousebot@disroot.org>
+;; Maintainer: Marty Hiatt <mousebot@disroot.org>
+;; Version: 1.1.0
+;; Package-Requires: ((emacs "28.1") (request "0.3.0")
+;; (persist "0.4") (tp "0.1"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -38,13 +39,15 @@
;;; Code:
(require 'cl-lib) ; for `cl-some' call in mastodon
(eval-when-compile (require 'subr-x))
-(require 'mastodon-http)
-(require 'mastodon-toot)
-(require 'mastodon-search)
(require 'url)
(require 'thingatpt)
(require 'shr)
+(require 'mastodon-http)
+(require 'mastodon-toot)
+(require 'mastodon-search)
+(require 'mastodon-transient)
+
(declare-function discover-add-context-menu "discover")
(declare-function emojify-mode "emojify")
(declare-function request "request")
@@ -227,6 +230,7 @@ while emojify,el has this feature and mastodon.el implements it.")
(define-key map (kbd "U") #'mastodon-profile--update-user-profile-note)
(define-key map (kbd "V") #'mastodon-profile--view-favourites)
(define-key map (kbd "K") #'mastodon-profile--view-bookmarks)
+ (define-key map (kbd ":") #'mastodon-user-settings)
;; minor views
(define-key map (kbd "R") #'mastodon-views--view-follow-requests)
(define-key map (kbd "S") #'mastodon-views--view-scheduled-toots)
@@ -343,28 +347,25 @@ If REPLY-JSON is the json of the toot being replied to."
(mastodon-toot--compose-buffer user reply-to-id reply-json))
;;;###autoload
-(defun mastodon-notifications-get (&optional type buffer-name force max-id)
+(defun mastodon-notifications-get (&optional type buffer-name max-id)
"Display NOTIFICATIONS in buffer.
Optionally only print notifications of type TYPE, a string.
BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
-FORCE means do not try to update an existing buffer, but fetch
-from the server and load anew."
+MAX-ID is a request parameter for pagination."
(interactive)
(let* ((buffer-name (or buffer-name "notifications"))
(buffer (concat "*mastodon-" buffer-name "*")))
- (if (and (not force) (get-buffer buffer))
- (progn (pop-to-buffer buffer '(display-buffer-same-window))
- (mastodon-tl--update))
- (message "Loading your notifications...")
- (mastodon-tl--init-sync
- buffer-name
- "notifications"
- 'mastodon-notifications--timeline
- type
- (when max-id
- `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))
- (with-current-buffer buffer
- (use-local-map mastodon-notifications--map)))))
+ (message "Loading your notifications...")
+ (mastodon-tl--init-sync
+ buffer-name
+ "notifications"
+ 'mastodon-notifications--timeline
+ type
+ (when max-id
+ `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))
+ nil nil nil "v2")
+ (with-current-buffer (get-buffer-create buffer)
+ (use-local-map mastodon-notifications--map))))
;; URL lookup: should be available even if `mastodon.el' not loaded:
@@ -374,7 +375,8 @@ from the server and load anew."
Does a WebFinger lookup on the server.
URL can be arg QUERY-URL, or URL at point, or provided by the user.
If a status or account is found, load it in `mastodon.el', if
-not, just browse the URL in the normal fashion."
+not, just browse the URL in the normal fashion.
+If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'."
(interactive)
(let* ((query (or query-url
(mastodon-tl--property 'shr-url :no-move)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 04:24:13 +0000