From fdd71200cd63b2bd5a60e15010781ce7c816cce2 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Sun, 26 Apr 2026 19:59:04 +0200 Subject: [PATCH] update mastodon --- elpa/mastodon-20260406.856/README-elpa | 5 + .../dir | 0 .../mastodon-async.el | 0 .../mastodon-auth.el | 0 .../mastodon-autoloads.el | 40 +- .../mastodon-client.el | 0 .../mastodon-discover.el | 0 .../mastodon-http.el | 24 +- .../mastodon-inspect.el | 8 +- .../mastodon-iso.el | 0 .../mastodon-media.el | 0 .../mastodon-notifications.el | 167 ++++++- .../mastodon-pkg.el | 10 +- .../mastodon-profile.el | 337 ++++++++++---- .../mastodon-search.el | 0 .../mastodon-tl.el | 429 +++++++++++++----- .../mastodon-toot.el | 349 ++++++++++---- .../mastodon-transient.el | 20 +- .../mastodon-views.el | 14 +- .../mastodon-widget.el | 0 .../mastodon.el | 89 +++- .../mastodon.info | 0 22 files changed, 1144 insertions(+), 348 deletions(-) create mode 100644 elpa/mastodon-20260406.856/README-elpa rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/dir (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-async.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-auth.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-autoloads.el (80%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-client.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-discover.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-http.el (96%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-inspect.el (97%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-iso.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-media.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-notifications.el (83%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-pkg.el (68%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-profile.el (79%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-search.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-tl.el (92%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-toot.el (87%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-transient.el (96%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-views.el (99%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon-widget.el (100%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon.el (87%) rename elpa/{mastodon-20251201.1553 => mastodon-20260406.856}/mastodon.info (100%) diff --git a/elpa/mastodon-20260406.856/README-elpa b/elpa/mastodon-20260406.856/README-elpa new file mode 100644 index 00000000..2e50bcf0 --- /dev/null +++ b/elpa/mastodon-20260406.856/README-elpa @@ -0,0 +1,5 @@ +mastodon.el is a client for fediverse services that implement the Mastodon +API. See . + +For set up and usage details, see the Info documentation, or the readme +file at . diff --git a/elpa/mastodon-20251201.1553/dir b/elpa/mastodon-20260406.856/dir similarity index 100% rename from elpa/mastodon-20251201.1553/dir rename to elpa/mastodon-20260406.856/dir diff --git a/elpa/mastodon-20251201.1553/mastodon-async.el b/elpa/mastodon-20260406.856/mastodon-async.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-async.el rename to elpa/mastodon-20260406.856/mastodon-async.el diff --git a/elpa/mastodon-20251201.1553/mastodon-auth.el b/elpa/mastodon-20260406.856/mastodon-auth.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-auth.el rename to elpa/mastodon-20260406.856/mastodon-auth.el diff --git a/elpa/mastodon-20251201.1553/mastodon-autoloads.el b/elpa/mastodon-20260406.856/mastodon-autoloads.el similarity index 80% rename from elpa/mastodon-20251201.1553/mastodon-autoloads.el rename to elpa/mastodon-20260406.856/mastodon-autoloads.el index d94babd3..f005e35b 100644 --- a/elpa/mastodon-20251201.1553/mastodon-autoloads.el +++ b/elpa/mastodon-20260406.856/mastodon-autoloads.el @@ -11,29 +11,33 @@ ;;; Generated autoloads from mastodon.el -(autoload 'mastodon-forget-all-logins "mastodon" "\ -Delete `mastodon-client--token-file'. +(autoload 'mastodon-forget-all-logins "mastodon" +"Delete `mastodon-client--token-file'. Also nil `mastodon-auth--token-alist'." t) -(autoload 'mastodon "mastodon" "\ -Connect client to `mastodon-instance-url' instance. +(autoload 'mastodon "mastodon" +"Connect client to `mastodon-instance-url' instance. If there are any open mastodon.el buffers, switch to one instead. Prority in switching is given to timeline views." t) -(autoload 'mastodon-toot "mastodon" "\ -Update instance with new toot. Content is captured in a new buffer. +(autoload 'mastodon-toot "mastodon" +"Update instance with new toot. Content is captured in a new buffer. If USER is non-nil, insert after @ symbol to begin new toot. If REPLY-TO-ID is non-nil, attach new toot to a conversation. If REPLY-JSON is the json of the toot being replied to. +QUOTE-ID is the id of a toot being quoted, QUOTE-JSON is its data. +VISIBILITY is the visibility of the toot. -(fn &optional USER REPLY-TO-ID REPLY-JSON)" t) -(autoload 'mastodon-notifications-get "mastodon" "\ -Display NOTIFICATIONS in buffer. +(fn &optional USER REPLY-TO-ID REPLY-JSON QUOTE-ID QUOTE-JSON VISIBILITY)" t) +(autoload 'mastodon-notifications-get "mastodon" +"Display NOTIFICATIONS in buffer. Optionally only print notifications of type TYPE, a string. BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. MAX-ID is a request parameter for pagination. (fn &optional TYPE BUFFER-NAME MAX-ID)" t) -(autoload 'mastodon-url-lookup "mastodon" "\ -If a URL resembles a fediverse link, try to load in `mastodon.el'. +(autoload 'mastodon-notifications-check "mastodon" +"Check for the number of unread notifications." t) +(autoload 'mastodon-url-lookup "mastodon" +"If a URL resembles a fediverse link, try to load in `mastodon.el'. 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 @@ -47,8 +51,8 @@ If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'. ;;; Generated autoloads from mastodon-async.el -(autoload 'mastodon-async-mode "mastodon-async" "\ -Async Mastodon. +(autoload 'mastodon-async-mode "mastodon-async" +"Async Mastodon. This is a minor mode. If called interactively, toggle the `Mastodon-Async mode' mode. If the prefix argument is positive, enable @@ -110,7 +114,7 @@ disabled. ;;; Generated autoloads from mastodon-profile.el -(register-definition-prefixes "mastodon-profile" '("mastodon-profile-")) +(register-definition-prefixes "mastodon-profile" '("mastodon-profile")) ;;; Generated autoloads from mastodon-search.el @@ -136,10 +140,10 @@ disabled. ;;; Generated autoloads from mastodon-views.el -(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" "\ -Show the user's scheduled toots in a new buffer." t) -(autoload 'mastodon-views-view-filters "mastodon-views" "\ -View the user's filters in a new buffer." t) +(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" +"Show the user's scheduled toots in a new buffer." t) +(autoload 'mastodon-views-view-filters "mastodon-views" +"View the user's filters in a new buffer." t) (register-definition-prefixes "mastodon-views" '("mastodon-views-")) diff --git a/elpa/mastodon-20251201.1553/mastodon-client.el b/elpa/mastodon-20260406.856/mastodon-client.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-client.el rename to elpa/mastodon-20260406.856/mastodon-client.el diff --git a/elpa/mastodon-20251201.1553/mastodon-discover.el b/elpa/mastodon-20260406.856/mastodon-discover.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-discover.el rename to elpa/mastodon-20260406.856/mastodon-discover.el diff --git a/elpa/mastodon-20251201.1553/mastodon-http.el b/elpa/mastodon-20260406.856/mastodon-http.el similarity index 96% rename from elpa/mastodon-20251201.1553/mastodon-http.el rename to elpa/mastodon-20260406.856/mastodon-http.el index fc456925..16c9d787 100644 --- a/elpa/mastodon-20251201.1553/mastodon-http.el +++ b/elpa/mastodon-20260406.856/mastodon-http.el @@ -323,30 +323,36 @@ JSON means send params as JSON data." ;; Asynchronous functions -(defun mastodon-http--get-async (url &optional params callback &rest cbargs) +(defun mastodon-http--get-async (url &optional params silent + callback &rest cbargs) "Make GET request to URL. Pass response buffer to CALLBACK function with args CBARGS. -PARAMS is an alist of any extra parameters to send with the request." +PARAMS is an alist of any extra parameters to send with the request. +Optionally make the request SILENT." (let ((url (mastodon-http--concat-params-to-url url params))) (mastodon-http--authorized-request "GET" - (url-retrieve url callback cbargs)))) + (url-retrieve url callback cbargs silent)))) -(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) +(defun mastodon-http--get-response-async (url &optional params silent + callback &rest cbargs) "Make GET request to URL. Call CALLBACK with http response and CBARGS. -PARAMS is an alist of any extra parameters to send with the request." +PARAMS is an alist of any extra parameters to send with the request. +Optionally make the request SILENT." (mastodon-http--get-async url - params + params silent (lambda (status) (when status ; for flakey servers (apply callback (mastodon-http--process-response) cbargs))))) -(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) +(defun mastodon-http--get-json-async (url &optional params silent + callback &rest cbargs) "Make GET request to URL. Call CALLBACK with json-list and CBARGS. -PARAMS is an alist of any extra parameters to send with the request." +PARAMS is an alist of any extra parameters to send with the request. +Optionally make the request SILENT." (mastodon-http--get-async url - params + params silent (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-json) cbargs))))) diff --git a/elpa/mastodon-20251201.1553/mastodon-inspect.el b/elpa/mastodon-20260406.856/mastodon-inspect.el similarity index 97% rename from elpa/mastodon-20251201.1553/mastodon-inspect.el rename to elpa/mastodon-20260406.856/mastodon-inspect.el index 4981943f..77959898 100644 --- a/elpa/mastodon-20251201.1553/mastodon-inspect.el +++ b/elpa/mastodon-20260406.856/mastodon-inspect.el @@ -51,10 +51,10 @@ (erase-buffer) (let ((print-level nil) (print-length nil)) - (insert (pp json t))) - (goto-char (point-min)) - (emacs-lisp-mode) - (message "success")) + (pp json (current-buffer)) + (goto-char (point-min)) + (emacs-lisp-mode) + (message "success"))) (defun mastodon-inspect--toot () "Find next toot and dump its meta data into new buffer." diff --git a/elpa/mastodon-20251201.1553/mastodon-iso.el b/elpa/mastodon-20260406.856/mastodon-iso.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-iso.el rename to elpa/mastodon-20260406.856/mastodon-iso.el diff --git a/elpa/mastodon-20251201.1553/mastodon-media.el b/elpa/mastodon-20260406.856/mastodon-media.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-media.el rename to elpa/mastodon-20260406.856/mastodon-media.el diff --git a/elpa/mastodon-20251201.1553/mastodon-notifications.el b/elpa/mastodon-20260406.856/mastodon-notifications.el similarity index 83% rename from elpa/mastodon-20251201.1553/mastodon-notifications.el rename to elpa/mastodon-20260406.856/mastodon-notifications.el index 113f3a59..5db7114e 100644 --- a/elpa/mastodon-20251201.1553/mastodon-notifications.el +++ b/elpa/mastodon-20260406.856/mastodon-notifications.el @@ -35,11 +35,16 @@ (require 'mastodon-widget) (require 'map) +(declare-function alert-add-rule "alert") +(declare-function alert "alert") + (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-params-async-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--triage "mastodon-http") (autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--byline "mastodon-tl") (autoload 'mastodon-tl--byline-author "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") @@ -71,6 +76,10 @@ (autoload 'mastodon-views--minor-view "mastodon-views") (autoload 'mastodon-tl--goto-first-item "mastodon-tl") (autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-live-buffers "mastodon") +(autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-tl--insert-quoted "mastodon-tl") ;; notifications defcustoms moved into mastodon.el ;; as some need to be available without loading this file @@ -90,6 +99,9 @@ (defvar mastodon-notifications-grouped-names-count) (defvar mastodon-tl--link-keymap) (defvar mastodon-tl--update-point) +(defvar mastodon-notifications-alerts-interval) +(defvar mastodon-notifications-alert-style) +(defvar mastodon-notifications-alerts) ;;; VARIABLES (defvar mastodon-notifications--map @@ -471,7 +483,7 @@ TYPE is notification type, used for non-group notifs." "\n" ;; display quoted post: (when (alist-get 'quote toot) - (mastodon-tl--insert-quoted (alist-get 'quote toot))) + (mastodon-tl--insert-quoted (alist-get 'quote toot) toot)) ;; actual byline: (if (member type '("severed_relationships" "moderation_warning")) (propertize @@ -657,6 +669,7 @@ UPDATE means we are updating, so skip some things." ;; set update point: (setq mastodon-tl--update-point (point)) ;; render: + (setq mastodon-tl--update-point (point)) (mastodon-notifications--render json (not mastodon-group-notifications)) (goto-char (point-min)) @@ -809,7 +822,7 @@ Status notifications are created when you call (resp (mastodon-http--get-json endpoint params))) (map-nested-elt resp '(notifications last_read_id)))) -(defun mastodon-notifications-get-single-notif () +(defun mastodon-notifications--get-single-notif () "Return a single notification JSON for v2 notifs." (interactive) (let* ((id ;; grouped (should work for ungrouped items): @@ -825,9 +838,46 @@ Status notifications are created when you call (let* ((endpoint "notifications/unread_count") (url (mastodon-http--api endpoint (when mastodon-group-notifications "v2"))) - (resp (mastodon-http--get-json url))) + ;; NB: sync request!: + (resp (mastodon-http--get-json url nil :silent))) (alist-get 'count resp))) +(when (and mastodon-notifications-alerts + (require 'alert nil :noerror)) + (alert-add-rule :mode 'mastodon-mode + :status '(buried visible idle selected) + :persistent + #'(lambda (info) + ;; If the buffer is buried, or the user has been idle + ;; for `alert-reveal-idle-time' seconds, make this + ;; alert persistent. Normally, alerts become + ;; persistent after `alert-persist-idle-time' seconds. + (memq (plist-get info :status) '(buried idle))) + ;; FIXME: if user configures this variable, we need to + ;; remove this rule and re-add it! or they need to restart + ;; emacs?: + :style mastodon-notifications-alert-style + :continue t)) + +;;; REVOKE QUOTED STATUS +;; POST /api/v1/statuses/:id/quotes/:quoting_status_id/revoke. +(defun mastodon-notifications-revoke-post-quote () + "Revoke the quote of a post from a quote notification." + (interactive) + ;; SCOPE required: check quote notif type, which will have user post in + ;; the "status" attribute: + (let* ((notif (mastodon-tl--property 'item-json :no-move)) + (id (map-nested-elt notif '(quote quoted_status id))) + (quote-id (alist-get 'id notif)) + (url (mastodon-http--api (format "statuses/%s/quotes/%s/revoke" + id quote-id)))) + (when (y-or-n-p "Revoke quote of post at point?") + (let ((resp (mastodon-http--post url))) + (mastodon-http--triage + resp + (lambda (_resp) + (message "Quote of post revoked!"))))))) + ;;; NOTIFICATION REQUESTS / FILTERING / POLICY (defvar mastodon-notifications--requests-map @@ -971,5 +1021,116 @@ NOTE means to include a profile note." "\n") 'item-json req))) + +;;; UPDATES TIMER + +(defvar mastodon-notifications-notify-shown) + +(defvar mastodon-notifications-timer nil + "Timer to update the notifs buffer.") + +(defun mastodon-notifications-cancel-timer () + "Cancel `mastodon-notifications-timer'. +Also nil the variable." + (when (timerp mastodon-notifications-timer) + (cancel-timer mastodon-notifications-timer)) + (setq mastodon-notifications-timer nil)) + +(defun mastodon-notifications-notify (&optional count force) + "Send a desktop notification when we have COUNT unread notifications. +If COUNT is nil, fetch again from server (synchronously). +Uses `alert.el'. +When FORCE, skip all checks and show an alert (for debugging)." + (let ((count (or count (mastodon-notifications--get-unread-count)))) + (when (or force + (and (> count 0) + (not mastodon-notifications-notify-shown))) + (if (not (require 'alert nil :noerror)) + (message "mastodon.el: new notifications %s" count) + (alert (format "New notifications: %s" count) + :title "mastodon.el" + ;; adding an alert.el rule as per above doesn't always work + ;; if a non-mastodon.el buffer is active (despite the 'buried + ;; status setting), so let's just give it a masto buffer: + :buffer (car (mastodon-live-buffers)))) + (unless force + ;; we nil this in `mastodon-notifications-get': + (setq mastodon-notifications-notify-shown t))))) + +(defun mastodon-notifications--update-with-timer () + "Run a timer to update notifications. Added to `mastodon-mode-hook'." + (cond + ;; if no buffers: cancel our timer and do nothing else: + ((and (not (mastodon-live-buffers)) + ;; if we are loading a first mastodon.el buffer, the previous + ;; check fails, as `mastodon-mode-hook' necessariliy runs + ;; before we have buf-spec, which + ;; `mastodon-tl--get-buffer-type' relies on, and if we set + ;; buf-spec earlier, enabling the mode wipes it. So + ;; let's also check if the current buffer prefix is *mastodon-, + ;; which it will be when first calling `mastodon' at least + ;; (though not necessarily when loading other first mastodon.el + ;; buffers, such as new toot): + (not (string-prefix-p "*mastodon-" (buffer-name)))) + ;; if not masto buffers: cancel everything: + (mastodon-notifications-cancel-timer)) + ;; if a timer has already run but somehow + ;; `mastodon-notifications-timer' has not been nilled, assume it is a + ;; leftover and cancel it, otherwise our unless check below will always + ;; fail and no new timer will be created. + ;; NB: this gets called: + ;; - on creating a new mastodon.el buffer, + ;; - if an existing timer is run. + ;; in both cases, `timerp' should fail, but sometimes we have a + ;; zombie one somehow: + ((and (timerp mastodon-notifications-timer) + (timer--triggered mastodon-notifications-timer)) + (mastodon-notifications-cancel-timer)) + ;; maybe we can remove this unless check, and just always cancel and + ;; restart? that would have the effect of making the timer always + ;; run `mastodon-notifications-alerts-interval' seconds after opening + ;; a new mastodon.el buffer, or effectively only showing an alert if + ;; the user stops opening buffers: + (t + (unless mastodon-notifications-timer + ;; set new timer if we don't have one: + (setq mastodon-notifications-timer + (run-at-time mastodon-notifications-alerts-interval + nil #'mastodon-notifications--update-check)))))) + +(defun mastodon-notifications--update-check () + "Get unread notifications count from the server, asynchronously. +Called by `mastodon-notifications--update-with-timer'. +Callback is `mastodon-notifications--update-check-cb'." + (let* ((endpoint "notifications/unread_count") + (url (mastodon-http--api endpoint + (when mastodon-group-notifications "v2")))) + (mastodon-http--get-json-async + url nil :silent #'mastodon-notifications--update-check-cb))) + +(defun mastodon-notifications--update-check-cb (resp) + "Callback functions for handling unread notifs count response RESP." + (let ((count (alist-get 'count resp))) + (when (> count 0) + ;; (message "%s" (current-buffer)) ;; => *mastodon-home* / *messages* + + ;; FIXME: unsure how to check if notifications buffer is active + ;; here, as (current-buffer) returns different things if this is + ;; triggered with notifs buffer active! so let's skip it for now, + ;; and only ever notify, not update the notifs buffer. + + ;; (if ;;(not (mastodon-tl--buffer-type-eq 'notifications)) + ;; (not mastodon-notifications-update-when-unread) + (mastodon-notifications-notify count) + ;; run updates if in notifs buffer: + ;; (message "Updating mastodon.el notifications...") + ;; (undo-boundary) + ;; (mastodon-tl-update) + ;; (undo-boundary) + ;; (message "Updating mastodon.el notifications... Done."))) + ;; cancel and set new timer: + (mastodon-notifications-cancel-timer) + (mastodon-notifications--update-with-timer)))) + (provide 'mastodon-notifications) ;;; mastodon-notifications.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-pkg.el b/elpa/mastodon-20260406.856/mastodon-pkg.el similarity index 68% rename from elpa/mastodon-20251201.1553/mastodon-pkg.el rename to elpa/mastodon-20260406.856/mastodon-pkg.el index 3b988614..cd3630ad 100644 --- a/elpa/mastodon-20251201.1553/mastodon-pkg.el +++ b/elpa/mastodon-20260406.856/mastodon-pkg.el @@ -1,12 +1,12 @@ ;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "mastodon" "20251201.1553" +(define-package "mastodon" "20260406.856" "Client for fediverse services using the Mastodon API." - '((emacs "28.1") + '((emacs "29.1") (persist "0.8") - (tp "0.7")) + (tp "0.8")) :url "https://codeberg.org/martianh/mastodon.el" - :commit "3c00418bfbb13f450551c28a97f8870e8ce3fef9" - :revdesc "3c00418bfbb1" + :commit "5bba23045efda9f63c36ac431bec8f318a55e76a" + :revdesc "5bba23045efd" :authors '(("Johnson Denen" . "johnson.denen@gmail.com") ("Marty Hiatt" . "mousebot@disroot.org")) :maintainers '(("Marty Hiatt" . "mousebot@disroot.org"))) diff --git a/elpa/mastodon-20251201.1553/mastodon-profile.el b/elpa/mastodon-20260406.856/mastodon-profile.el similarity index 79% rename from elpa/mastodon-20251201.1553/mastodon-profile.el rename to elpa/mastodon-20260406.856/mastodon-profile.el index 8c947334..677df5f4 100644 --- a/elpa/mastodon-20251201.1553/mastodon-profile.el +++ b/elpa/mastodon-20260406.856/mastodon-profile.el @@ -41,12 +41,12 @@ (eval-when-compile (require 'mastodon-tl)) (require 'mastodon-widget) +(require 'table) (autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-auth--get-account-name "mastodon-auth.el") (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") -(autoload 'mastodon-http--get-json-async "mastodon-http.el") (autoload 'mastodon-http--get-response "mastodon-http") (autoload 'mastodon-http--patch "mastodon-http") (autoload 'mastodon-http--patch-json "mastodon-http") @@ -86,6 +86,9 @@ (autoload 'mastodon-tl--field-status "mastodon-tl") (autoload 'mastodon-toot--with-toot-item "mastodon-toot" nil nil 'macro) (autoload 'mastodon-tl--toot-or-base "mastodon-tl") +(autoload 'mastodon-views--end-of-table "mastodon-views") +(autoload 'mastodon-tl--buttonify-link "mastodon-tl") +(autoload 'mastodon-tl-read-handle-annotated "mastodon-tl") (defvar mastodon-active-user) (defvar mastodon-tl--horiz-bar) @@ -94,6 +97,7 @@ (defvar mastodon-toot--visibility) (defvar mastodon-toot--content-nsfw) (defvar mastodon-tl--timeline-posts-count) +(defvar mastodon-group-notifications) (defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") @@ -151,16 +155,18 @@ This variable is set from data in (mastodon-tl--property 'item-json)) (defun mastodon-profile--make-author-buffer - (account &optional no-reblogs no-replies only-media tag max-id) + (account &optional no-reblogs no-replies only-media tag max-id + skip-pinned) "Take an ACCOUNT json and insert a user account into a new buffer. NO-REBLOGS means do not display boosts in statuses. NO-REPLIES means to exlude replies. ONLY-MEDIA means show only posts containing attachments. TAG is a hashtag to restrict posts to. -MAX-ID is a flag to include the max_id pagination parameter." +MAX-ID is a flag to include the max_id pagination parameter. +SKIP-PINNED means don't display pinned toots." (mastodon-profile--make-profile-buffer-for account "statuses" #'mastodon-tl--timeline no-reblogs nil - no-replies only-media tag max-id)) + no-replies only-media tag max-id skip-pinned)) ;;; PROFILE VIEW COMMANDS @@ -229,16 +235,15 @@ If a PREFIX argument is provided, prompt for a view type and load." (interactive) (if mastodon-profile--account (mastodon-profile--make-author-buffer - mastodon-profile--account nil nil :only-media) + mastodon-profile--account nil nil :only-media nil nil :skip-pinned) (user-error "Not in a mastodon profile"))) -(defun mastodon-profile-open-statuses-tagged () - "Prompt for a hashtag and display a profile with only statuses containing it." +(defun mastodon-profile-open-statuses-tagged (&optional tag) + "Prompt for a TAG and display a profile with statuses containing it." (interactive) - (let ((tag (read-string "Statuses containing tag: "))) + (let ((tag (or tag (read-string "Statuses containing tag: ")))) (if mastodon-profile--account - (mastodon-profile--make-author-buffer - mastodon-profile--account nil nil nil tag) + (mastodon-profile--make-author-buffer mastodon-profile--account nil nil nil tag nil :skip-pinned) (user-error "Not in a mastodon profile")))) (defun mastodon-profile-open-following () @@ -572,6 +577,24 @@ The endpoint only holds a few preferences. For others, see "\n\n")) (goto-char (point-min))))) +(defvar mastodon-profiles-quote-policy-types + '(public followers nobody)) + +(defun mastodon-profile-set-quote-policy () + "Prompt for a quote policy and set it in the user's preferences." + (interactive) + (let* ((prefs + ;; this fetches from a local var, we want to fetch from server, + ;; else we need this var to update when we change this setting: + ;; (mastodon-profile--get-source-values)) + ;; so we fetch from preferences instead: + (mastodon-http--get-json (mastodon-http--api "preferences"))) + (current (alist-get 'posting:default:quote_policy prefs)) + (choice (completing-read + (format "Set default quote policy [current: %s]: " current) + mastodon-profiles-quote-policy-types nil :match))) + (mastodon-profile--update-preference "quote_policy" choice 'source))) + ;;; PROFILE VIEW DETAILS @@ -590,18 +613,94 @@ FIELDS means provide a fields vector fetched by other means." (when fields (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) -(defun mastodon-profile--fields-insert (fields) - "Format and insert field pairs (a.k.a profile metadata) in FIELDS." - (let* ((car-fields (mapcar #'car fields)) - (left-width (apply #'max (mapcar #'length car-fields)))) - (mapconcat (lambda (field) - (mastodon-tl--render-text - (concat - (format "_ %s " (car field)) - (make-string (- (+ 1 left-width) (length (car field))) ?_) - (format " :: %s" (cdr field))) - field)) ; hack to make links tabstops - fields ""))) +(defun mastodon-profile--format-fields (fields) + "Format field pairs (a.k.a profile metadata) in FIELDS." + ;; prevent `mastodon-tl--render-text' from adding any newlines: + (let* ((mastodon-tl--no-fill-on-render t) + ;; render sans variable pitch: + ;; (mastodon-tl--enable-proportional-fonts nil) + ;; to set cell witdth right, we have to render any html first: + (rendered (mapcar (lambda (x) + (cons + (mastodon-tl--render-text (car x) x) + (mastodon-tl--render-text (cdr x) x))) + fields)) + (left-longest (apply #'max (mapcar #'length + (mapcar #'car rendered)))) + (left-width (min 30 left-longest)) + (right-longest (apply #'max (mapcar #'length + (mapcar #'cdr rendered)))) + ;; some people have very long URLs in their entries, so we set a + ;; max of (- window-width left-width). that way, long cells will + ;; run over onto multiple lines when we enable + ;; `table-fixed-width-mode': + (right-width (min + (if (> (frame-width) left-width) + (- (frame-width) (+ 10 left-width)) + ;; bizarre fallback: + (/ (frame-width) 3)) ;; 30) + right-longest))) + (mastodon-profile--pretty-table + #'mastodon-profile--insert-fields + `(,(+ 2 left-width) ,(+ 2 right-width)) rendered))) + +(defun mastodon-profile--pretty-table (insert-fun &optional min-cell-width + &rest insert-args) + "Insert some data and make a pretty table of it with table.el. +Call INSERT-FUN with INSERT-ARGS. +MIN-CELL-WIDTH is for `table-capture'. +Note that it can be a list of values, one for each column." + (let* ((mastodon-tl--no-fill-on-render t) + (table-cell-horizontal-chars + (if (char-displayable-p ?–) "–" "-")) + (mastodon-tl--enable-proportional-fonts nil) + (beg (point))) + ;; remove crazy table-cell face: + (face-remap-add-relative 'table-cell 'default) + (apply insert-fun insert-args) + (table-capture beg (point) "|" "\n" nil min-cell-width) + ;; center our content by col: + (let* ((cols (nth 4 (table-query-dimension)))) + (dotimes (_x cols) + (table-justify-column 'center) + (table-forward-cell))) + ;; (table-release) ;; removes frame, but fixes links + (mastodon-views--end-of-table) + (table-fixed-width-mode 1) + ;; unfuck `table-fixed-width-mode' disastrous face handling: + (set-face-attribute 'table-cell nil :inverse-video nil) + (add-text-properties beg (point) '(face 'success)))) + +(defun mastodon-profile-table-cell-hook-fun () + "Hook function for `table-cell-map-hook'. +We ensure we have our tab/click/RET bindings active for links." + (define-key table-cell-map + [remap table-forward-cell] #'mastodon-tl-next-tab-item) + (define-key table-cell-map + [remap table-backward-cell] #'mastodon-tl-previous-tab-item) + (define-key table-cell-map + [remap *table--cell-newline] #'mastodon-tl-do-link-action-at-point) + (define-key table-cell-map [mouse-2] #'mastodon-tl-do-link-action) + (define-key table-cell-map [follow-link] 'mouse-face)) + +(defun mastodon-profile--insert-fields (fields) + "Insert profile metadata FIELDS, an alist. +Format them so we can create a pretty table." + (insert + (mapconcat + (lambda (field) + (concat + (mastodon-profile--sane-field-str (car field)) + " | " + (mastodon-profile--sane-field-str (cdr field)))) + fields "\n"))) + +(defun mastodon-profile--sane-field-str (str) + "In STR, replace | with / and trim spaces/newlines. +We replace | because it is our pretty table's column delimiter." + (string-trim + (replace-regexp-in-string "|" "/" str) + "[ \n]")) (defun mastodon-profile--get-statuses-pinned (account) "Fetch the pinned toots for ACCOUNT." @@ -652,16 +751,76 @@ DATA is an account data from a moved field in profile data." 'help-echo (concat "Browse user profile of " handle)) "\n\n")))) +(defun mastodon-profile--insert-counts (toots followers following) + "Insert counts as a pretty table. +TOOTS FOLLOWERS and FOLLOWING are each integers." + (let ((table-cell-horizontal-chars (if (char-displayable-p ?–) + "–" + "-")) + (toot-cell (concat " TOOTS: " (mastodon-tl--as-string toots))) + (followers-cell (concat "FOLLOWERS: " + (mastodon-tl--as-string followers))) + (following-cell (concat "FOLLOWING: " + (mastodon-tl--as-string following)))) + (mastodon-profile--pretty-table + (lambda () + (insert + (concat toot-cell " | " followers-cell " | " following-cell + "\n"))) + `(,(+ 2 (length toot-cell)) ,(+ 2 (length followers-cell)) + ,(+ 2 (length following-cell)))))) + +(defun mastodon-profile--insert-joined (joined) + "Insert JOINED data as a pretty table." + (let ((join-str "Joined: ") + (date-str (mastodon-profile--format-joined-date-string joined))) + (mastodon-profile--pretty-table + (lambda () (insert join-str "|" date-str)) + `(,(+ 2 (length join-str)) ,(+ 2 (length date-str)))))) + +(defun mastodon-profile--insert-relationships (relationships) + "Insert RELATIONSHIPS data." + (let-alist relationships + ;; (sharkey has no relationships endpoint, returns 500. + ;; or poss it has a different endpoint?:) + (when .id + (let* ((followsp + (mastodon-profile--follows-p + (list .requested_by .following .followed_by .blocked_by))) + (rels (mastodon-profile--relationships-get .id)) + (langs-filtered (when-let* ((langs (alist-get 'languages rels))) + (concat " (" + (mapconcat #'identity langs " ") + ")"))) + (fold-str (concat "FOLLOWED BY YOU |" langs-filtered)) + (fols-str "FOLLOWS YOU |") + (req-str "REQUESTED TO FOLLOW YOU |") + (block-str "BLOCKS YOU |") + (str-list (cl-remove + nil (list (when (eq .following t) fold-str) + (when (eq .followed_by t) fols-str) + (when (eq .requested_by t) req-str) + (when (eq .blocked_by t) block-str))))) + (when followsp + (mastodon-profile--pretty-table + (lambda () + (insert + (apply #'concat str-list))) + (cl-loop for x in str-list + collect (+ 2 (length x))))))))) + (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function - &optional no-reblogs headers no-replies only-media tag max-id) + &optional no-reblogs headers no-replies only-media tag max-id + skip-pinned) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. NO-REBLOGS means do not display boosts in statuses. HEADERS means also fetch link headers for pagination. NO-REPLIES means to exlude replies. ONLY-MEDIA means show only posts containing attachments. TAG is a hashtag to restrict posts to. -MAX-ID is a flag to include the max_id pagination parameter." +MAX-ID is a flag to include the max_id pagination parameter. +SKIP-PINNED means don't display pinned toots." (let-alist account (let* ((max-id-str (when max-id (mastodon-tl--buffer-property 'max-id))) @@ -727,53 +886,18 @@ MAX-ID is a flag to include the max_id pagination parameter." (mastodon-profile--render-moved .moved)) ;; profile note: (mastodon-tl--render-text .note account) ; account = tab-stops in profile - ;; meta fields: - (when fields - (concat "\n" (mastodon-tl--set-face - (mastodon-profile--fields-insert fields) - 'success))) - "\n" - ;; Joined date: - (propertize - (mastodon-profile--format-joined-date-string .created_at) - 'face 'success) - "\n\n") - 'profile-json account) - ;; insert counts - (mastodon-tl--set-face - (concat " " mastodon-tl--horiz-bar "\n" - " TOOTS: " (mastodon-tl--as-string .statuses_count) " | " - "FOLLOWERS: " (mastodon-tl--as-string .followers_count) " | " - "FOLLOWING: " (mastodon-tl--as-string .following_count) "\n" - " " mastodon-tl--horiz-bar "\n\n") - 'success) - ;; insert relationship (follows) - (let-alist relationships - (if (not .id) - ;; sharkey has no relationships endpoint, returns 500. - ;; or poss it has a different endpoint - "" - (let* ((followsp (mastodon-profile--follows-p - (list .requested_by .following .followed_by .blocked_by))) - (rels (mastodon-profile--relationships-get .id)) - (langs-filtered (if-let* ((langs (alist-get 'languages rels))) - (concat " (" - (mapconcat #'identity langs " ") - ")") - ""))) - (if followsp - (mastodon-tl--set-face - (concat (when (eq .following t) - (format " | FOLLOWED BY YOU%s" langs-filtered)) - (when (eq .followed_by t) - " | FOLLOWS YOU") - (when (eq .requested_by t) - " | REQUESTED TO FOLLOW YOU") - (when (eq .blocked_by t) - " | BLOCKS YOU") - "\n\n") - 'success) - ""))))) ; for insert call + "\n") + 'profile-json account)) + ;; Joined date: + (mastodon-profile--insert-joined .created_at) + ;; meta fields: + (when fields + (mastodon-profile--format-fields fields)) + ;; insert counts + (mastodon-profile--insert-counts .statuses_count + .followers_count .following_count) + ;; insert relationship (follows) + (mastodon-profile--insert-relationships relationships) (mastodon-media--inline-images (point-min) (point)) ;; widget items description (mastodon-widget--create @@ -792,7 +916,9 @@ MAX-ID is a flag to include the max_id pagination parameter." (with-current-buffer buffer (let* ((inhibit-read-only t)) ;; insert pinned toots first - (when (and pinned (string= endpoint-type "statuses")) + (when (and (not skip-pinned) + pinned + (string= endpoint-type "statuses")) (let ((beg (point))) (mastodon-profile--insert-statuses-pinned pinned) (setq mastodon-tl--update-point (point)) @@ -822,7 +948,7 @@ NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG." "Format a human-readable Joined string from timestamp JOINED. JOINED is the `created_at' field in profile account JSON, and of the format \"2000-01-31T00:00:00.000Z\"." - (format-time-string "Joined: %d %B %Y" + (format-time-string "%d %B %Y" (parse-iso8601-time-string joined))) (defun mastodon-profile-get-toot-author (&optional max-id) @@ -851,12 +977,9 @@ IMG-TYPE is the JSON key from the account data." (if (and (not (mastodon-tl--profile-buffer-p)) (not (mastodon-tl--property 'item-json :no-move))) (user-error "Looks like there's no toot or user at point?") - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--item-json)))) - (completing-read "View profile of user [choose or enter any handle]: " - user-handles - nil ; predicate - 'confirm))))) + (mastodon-tl-read-handle-annotated + (mastodon-profile--extract-users-handles (mastodon-profile--item-json)) + "View profile of user [choose or enter any handle]: ")))) (if (not (or ; own profile has no need for item-json test: (string= user-handle (mastodon-auth--get-account-name)) (mastodon-tl--profile-buffer-p) @@ -929,10 +1052,18 @@ If the handle does not match a search return then retun NIL." "Return all user handles found in STATUS. These include the author, author of reblogged entries and any user mentioned." (when status - (let ((this-account (or (alist-get 'account status) ; status is a toot + (let ((this-account (or (alist-get 'account status) ; status is a toot/notif status)) ; status is a user listing (mentions (mastodon-tl--field-status 'mentions status)) - (reblog (mastodon-tl--field-status 'reblog status))) + (reblog (mastodon-tl--field-status 'reblog status)) + (grouped (when mastodon-group-notifications + ;; NB: looks like this only contains the grouped + ;; notifs for the current notif, which is not + ;; necessariliy all favers/boosters for a given item: + (let ((accounts (mastodon-tl--property 'notification-accounts + :nomove))) + (cl-loop for x in accounts + collect (alist-get 'acct x)))))) (seq-remove (lambda (x) (string= x mastodon-active-user)) (seq-filter #'stringp @@ -940,7 +1071,8 @@ These include the author, author of reblogged entries and any user mentioned." (seq-concatenate 'list (list (alist-get 'acct this-account)) - (mastodon-profile--extract-users-handles reblog) + grouped + (when reblog (mastodon-profile--extract-users-handles reblog)) (mastodon-tl--map-alist 'acct mentions)))))))) (defun mastodon-profile--lookup-account-in-status (handle status) @@ -1106,5 +1238,46 @@ the given account." (let ((choice (completing-read "Show profile of user: " handles))) (mastodon-profile-show-user choice))))) +;;; FEATURED TAGS + +(defun mastodon-profile-feature-tag () + "Feature a tag on your profile." + (interactive) + (let* ((tag (read-string "Feature tag on your profile: ")) + (endpoint (mastodon-http--api + (format "/tags/%s/feature" tag))) + (resp (mastodon-http--post endpoint))) + (mastodon-http--triage + resp (lambda (_resp) + (message "Tag #%s featured!" tag))))) + +(defun mastodon-profile--get-featured-tags (id) + "Get featured tags for user ID." + (let ((endpoint (mastodon-http--api + (format "/accounts/%s/featured_tags" id)))) + (mastodon-http--get-json endpoint))) + +(defun mastodon-profile-load-featured-tag () + "Prompt for a featured tag, and load posts containing it. +Only works when viewing a user's profile." + (interactive) + (let* ((data (mastodon-profile--profile-json)) + (id (alist-get 'id data)) + (tags (mastodon-profile--get-featured-tags id)) + (choice (completing-read "View user's featured tag: " + (mastodon-tl--map-alist 'name tags)))) + (mastodon-profile-open-statuses-tagged choice))) + +(defun mastodon-profile-own-featured-tags () + "Display your own featured tags. +Load a timeline of your own featured tags with +`mastodon-profile-load-featured-tag'when viewing your profile." + (interactive) + ;; GET /api/v1/featured_tags + (let* ((endpoint (mastodon-http--api "featured_tags")) + (tags (mastodon-http--get-json endpoint))) + (message "%S" + (mastodon-tl--map-alist 'name tags)))) + (provide 'mastodon-profile) ;;; mastodon-profile.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-search.el b/elpa/mastodon-20260406.856/mastodon-search.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-search.el rename to elpa/mastodon-20260406.856/mastodon-search.el diff --git a/elpa/mastodon-20251201.1553/mastodon-tl.el b/elpa/mastodon-20260406.856/mastodon-tl.el similarity index 92% rename from elpa/mastodon-20251201.1553/mastodon-tl.el rename to elpa/mastodon-20260406.856/mastodon-tl.el index 87b6f5a5..b331bcd2 100644 --- a/elpa/mastodon-20251201.1553/mastodon-tl.el +++ b/elpa/mastodon-20260406.856/mastodon-tl.el @@ -97,12 +97,14 @@ (autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications") (autoload 'mastodon-search--print-tags "mastodon-search") (autoload 'mastodon-profile-show-user "mastodon-profile") +(autoload 'mastodon-toot--own-toot-p "mastodon-toot") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) (defvar mastodon-active-user) (defvar mastodon-images-in-notifs) (defvar mastodon-group-notifications) +(defvar mastodon-profiles-quote-policy-types) (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -180,6 +182,7 @@ nil." (follow_request . ("👤" . "+")) (severed_relationships . ("🔗" . "//")) (moderation_warning . ("⚠" . "!!")) + (bot . ("🤖" . "[bot]")) (quote . (,(propertize "“" 'face '(t :inherit success :weight bold :height 1.8)))) @@ -470,7 +473,7 @@ found." (interactive) (condition-case nil (mastodon-tl--goto-item-pos 'next-single-property-change - (unless no-refresh 'mastodon-tl--more)) + (unless no-refresh 'mastodon-tl--more)) (t (error "No more items")))) (defun mastodon-tl-goto-prev-item (&optional no-refresh) @@ -481,7 +484,7 @@ found." (interactive) (condition-case nil (mastodon-tl--goto-item-pos 'previous-single-property-change - (unless no-refresh 'mastodon-tl-update)) + (unless no-refresh 'mastodon-tl-update)) (t (error "No more items")))) (defun mastodon-tl--goto-first-item () @@ -490,7 +493,7 @@ Used on initializing a timeline or thread." (goto-char (point-min)) (condition-case nil (mastodon-tl--goto-item-pos 'next-single-property-change - 'next-line) + 'next-line) (t (error "No item")))) @@ -512,9 +515,9 @@ With a double PREFIX arg, only show posts with media." `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) (message "Loading federated timeline...") (mastodon-tl--init (if local "local" "federated") - "timelines/public" 'mastodon-tl--timeline nil - params - (when (eq prefix 4) t)))) + "timelines/public" 'mastodon-tl--timeline nil + params + (when (eq prefix 4) t)))) (defun mastodon-tl-get-home-timeline (&optional arg max-id) "Open home timeline. @@ -527,8 +530,8 @@ MAX-ID is a flag to add the max_id pagination parameter." `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) (message "Loading home timeline...") (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil - params - (when (eq arg 4) t)))) + params + (when (eq arg 4) t)))) (defun mastodon-tl-get-remote-local-timeline (&optional endpoint) "Prompt for an instance domain and try to display its local timeline. @@ -556,9 +559,9 @@ Optionally, provide API ENDPOINT." (y-or-n-p "Domain appears unknown to your instance. Proceed?")) (mastodon-tl--init buf - (or endpoint "timelines/public") - 'mastodon-tl--timeline nil - params nil domain)))) + (or endpoint "timelines/public") + 'mastodon-tl--timeline nil + params nil domain)))) (defun mastodon-tl-remote-tag-timeline (&optional tag) "Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline." @@ -622,14 +625,14 @@ With a double PREFIX arg, limit results to your own instance." "Load a link timeline, displaying posts containing URL." (let ((params `(("url" . ,url)))) (mastodon-tl--init "links" "timelines/link" - 'mastodon-tl--timeline nil - params))) + 'mastodon-tl--timeline nil + params))) (defun mastodon-tl-announcements () "Display announcements from your instance." (interactive) (mastodon-tl--init "announcements" "announcements" - 'mastodon-tl--timeline nil nil nil nil :no-byline)) + 'mastodon-tl--timeline nil nil nil nil :no-byline)) ;;; BYLINES, etc. @@ -806,9 +809,9 @@ The result is added as an attachments property to author-byline." (defun mastodon-tl--top-byline (toot) "Format a boost or reply top (action) byline for TOOT. -If it is a self-reply, return 'continued thread'. -If it is a non-self-reply, return 'in reply to $username'. -If it is a boost, return '$username boosted'." +If it is a self-reply, return \\='continued thread'. +If it is a non-self-reply, return \\='in reply to $username'. +If it is a boost, return \\='$username boosted'." (let ((reblog (alist-get 'reblog toot)) (reply-acc-id (alist-get 'in_reply_to_account_id toot))) (cond @@ -859,6 +862,7 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." (propertize letter 'face 'mastodon-boost-fave-face ;; emojify breaks this for 🔖: 'help-echo (format "You have %s this status." + ;; FIXME: this is often nil help-string))))) (defun mastodon-tl--image-trans-check () @@ -868,10 +872,8 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." (image-transforms-p))) (defun mastodon-tl--byline (toot &optional detailed-p - domain base-toot group ts) + domain base-toot group ts) "Generate (bottom) byline for TOOT. -AUTHOR-BYLINE is a function for adding the author portion of -the byline that takes one variable. 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. @@ -885,7 +887,7 @@ TS is a timestamp from the server, if any." ;; bosts, faves, edits, polls in notifs view use base item ;; timestamp: (mastodon-tl--field 'created_at - (mastodon-tl--field 'status toot)) + (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))) @@ -899,6 +901,7 @@ TS is a timestamp from the server, if any." (bookmarked (eq t (mastodon-tl--field 'bookmarked base-maybe))) (visibility (mastodon-tl--field 'visibility base-maybe)) (account (alist-get 'account base-maybe)) + (botp (eq t (map-nested-elt base-maybe '(account bot)))) (avatar-url (alist-get 'avatar account)) (edited-time (alist-get 'edited_at base-maybe)) (edited-parsed (when edited-time (date-to-time edited-time)))) @@ -918,7 +921,9 @@ TS is a timestamp from the server, if any." (mastodon-tl--symbol 'favourite))) (when bookmarked (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'bookmark)))) + (mastodon-tl--symbol 'bookmark))) + (when botp + (concat (mastodon-tl--symbol 'bot) " "))) ;; 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 @@ -933,7 +938,7 @@ TS is a timestamp from the server, if any." ;; we use base-toot if poss for fave/boost notifs that need to show ;; base item in author byline (mastodon-tl--byline-author (or base-toot toot) - nil domain :base) + nil domain :base) ;; visibility: (cond ((string= visibility "direct") (propertize (concat " " (mastodon-tl--symbol 'direct)) @@ -1053,8 +1058,8 @@ links in the text. If TOOT is nil no parsing occurs." (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)) + (car region) (cdr region) + (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))) @@ -1284,17 +1289,21 @@ LINK-TYPE is the type of link to produce." (t (error "Unknown link type %s" link-type))))) (mastodon-tl--buttonify-link string - 'mastodon-tab-stop link-type - 'help-echo help-text))) + 'mastodon-tab-stop link-type + 'help-echo help-text))) (defun mastodon-tl-do-link-action-at-point (pos) "Do the action of the link at POS. Used for hitting RET on a given link." (interactive "d") (let ((link-type (get-text-property pos 'mastodon-tab-stop)) - (cont-thread (mastodon-tl--property 'continued-thread :nomove))) + (cont-thread (mastodon-tl--property 'continued-thread :nomove)) + (quote-toot (mastodon-tl--property 'quote-url :nomove))) (cond (cont-thread (mastodon-tl-continued-thread-load)) + (quote-toot + (let ((url (mastodon-tl--property 'quote-url :nomove))) + (mastodon-url-lookup url))) ((eq link-type 'content-warning) (mastodon-tl--toggle-spoiler-text pos)) ((eq link-type 'hashtag) @@ -1426,23 +1435,28 @@ FILTER is a string to use as a filter warning spoiler instead." cw (propertize (mastodon-tl--content toot) - 'invisible - (or filter ;; filters = invis - (let ((cust mastodon-tl--expand-content-warnings)) - (if (not (eq 'server cust)) - (not cust) ;; opp to setting - ;; respect server setting: - ;; If something goes wrong reading prefs, - ;; just return t so CWs fold by default. - (condition-case nil - (if (eq :json-false - (mastodon-profile--get-preferences-pref - 'reading:expand:spoilers)) - t - nil) - (error t))))) + 'invisible (mastodon-tl--spoiler-invisible-maybe filter) 'mastodon-content-warning-body t)))) +(defun mastodon-tl--spoiler-invisible-maybe (&optional filter) + "Set the invisible property for a post with a spoiler. +Also used to set invisibility for quoted posts. +We respect `mastodon-tl--expand-content-warnings'. +If it is server, we check the user's preference. +FILTER means we go invisible." + (or filter ;; filters = invis + (let ((cust mastodon-tl--expand-content-warnings)) + (if (not (eq 'server cust)) + (not cust) ;; opp to setting + ;; respect server setting: + ;; If something goes wrong reading prefs, + ;; just return t so CWs fold by default. + (condition-case nil + (eq :json-false + (mastodon-profile--get-preferences-pref + 'reading:expand:spoilers)) + (error t)))))) + ;;; MEDIA @@ -1509,6 +1523,7 @@ SENSITIVE is a flag from the item's JSON data." 'image-url (or full-remote-url media-url) ; for shr-browse-image 'keymap mastodon-tl--shr-image-map-replacement 'image-description caption + 'shr-alt caption ; for shr-show-alt-text 'sensitive sensitive 'help-echo (if (or (string= type "image") (string= type nil) @@ -1530,7 +1545,7 @@ SENSITIVE is a flag from the item's JSON data." ;; patch `shr-browse-image' to accept url arg: (defun mastodon-tl-shr-browse-image (&optional arg) "Browse the image under point. -With a prefix argument, copy the URL of the image instead. +With prefix argument ARG, copy the URL of the image instead. If URL is a string, use it rather than the image-url property at point." (interactive "P") (let ((prop (get-text-property (point) 'image-url))) @@ -1610,14 +1625,14 @@ returns the match and the list of which it is the car." (interactive) (let* ((next-url (mastodon-tl--get-next-image-url))) (mastodon-tl--view-image-url next-url - (cdr mastodon-media--attachments)))) + (cdr mastodon-media--attachments)))) (defun mastodon-tl-prev-full-image () "From full image view buffer, load the toot's prev image." (interactive) (let* ((prev-url (mastodon-tl--get-prev-image-url))) (mastodon-tl--view-image-url prev-url - (cdr mastodon-media--attachments)))) + (cdr mastodon-media--attachments)))) (defun mastodon-tl-toggle-sensitive-image () "Toggle dislay of sensitive image at point." @@ -1870,9 +1885,18 @@ in which case play first video or gif from current toot." "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." (let* ((content (mastodon-tl--field 'content toot)) + (quote-p (mastodon-tl--field 'quote toot)) + (rendered (mastodon-tl--render-text content toot)) + (stripped-maybe (if (not quote-p) + rendered + (with-temp-buffer ;; strip quoted toot URL: + (insert rendered) + (goto-char (point-min)) + (kill-line 2) + (buffer-string)))) (poll-p (mastodon-tl--field 'poll toot)) (media-p (mastodon-tl--field 'media_attachments toot))) - (concat (mastodon-tl--render-text content toot) + (concat stripped-maybe (when poll-p (mastodon-tl--format-poll (mastodon-tl--field 'poll toot))) ;; toot or reblog @@ -1912,26 +1936,107 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (goto-char (prop-match-end prop))))) list)) -(defun mastodon-tl--insert-quoted (data) - "Propertize quoted status DATA for insertion." - (let ((bar (concat " " (mastodon-tl--symbol 'reply-bar))) - (content (map-nested-elt data '(quoted_status content))) - ;; quote symbol hack: - (quotemark (propertize "“" 'face - '(t :inherit success :weight bold - :height 1.8)))) - (propertize - (concat quotemark "\n" - ;; author byline without horiz bar and toot stats: - (mastodon-tl--byline-author - (alist-get 'quoted_status data) nil :domain :base) - "\n" - ;; quoted text: - (mastodon-tl--render-text content - (alist-get 'quoted_status data))) - 'line-prefix bar - 'wrap-prefix bar - 'mastodon-quote data))) +(defvar mastodon-tl--quote-states + '(pending accepted rejected revoked deleted + unauthorized blocked_account blocked_domain muted_account) + "A list of possible values for a quote state attribute. +See https://docs.joinmastodon.org/entities/Quote/#state for details.") + +(defun mastodon-tl--quote-symbol-str () + "Return a propertized quote symbol, \"." + ;; quote symbol hack: + (propertize "“" 'face + '( :inherit success :weight bold + :height 1.8))) + +(defun mastodon-tl--insert-quoted (data toot) + "Propertize quoted status DATA for insertion. +TOOT is the data for the quoting toot." + (let* ((bar (concat " " (mastodon-tl--symbol 'reply-bar))) + (state (alist-get 'state data)) + ;; CW status of quoting toot: + (cw (not (string-empty-p + (mastodon-tl--field 'spoiler_text toot)))) + (quoted (alist-get 'quoted_status data))) + (let-alist quoted + (let ((filters (when .filtered + (mastodon-tl--current-filters .filtered)))) + ;; TODO: tailor non-disply of quote based on quote 'state' + ;; `mastodon-tl--quote-states': + (propertize + (cond + ((or (assoc "warn" filters) + (assoc "hide" filters)) + ;; FIXME: "warn" should result in CW, but it should be + ;; a CW independent of post CW: + (mastodon-tl--format-quote-non-display + "Quote hidden due to one of your filters")) + ;; FIXME: muted account should result in a folded quote + ;; (unfoldable): + ((string= state "muted_account") + (mastodon-tl--format-quote-non-display + "Quote hidden, account muted")) + ((member state '("rejected" "revoked" "deleted")) + (mastodon-tl--format-quote-non-display + (format "Quote %s" state))) + ((member state '("blocked_account" "blocked_domain")) + (mastodon-tl--format-quote-non-display + (format "Quote hidden, %s" state))) + ((string= state "pending") + (mastodon-tl--format-quote-non-display "quote pending")) + (t + (concat + "\n" (mastodon-tl--quote-symbol-str) "\n" + ;; author byline without horiz bar/stats: + (concat + (mastodon-tl--byline-author quoted nil nil :base) + "\n" + (propertize ;; buttonize quoted toot body + ;; quoted text: + (mastodon-tl--content quoted) + 'button t + 'keymap mastodon-tl--link-keymap + 'help-echo "Load quoted toot" + 'mouse-face '(:inherit (highlight link) :underline nil)))))) + 'line-prefix bar + 'wrap-prefix bar + 'quote-url .url + 'mastodon-content-warning-body (when cw t) + ;; TODO: respect filtering of quoted toot: + 'invisible (when cw (mastodon-tl--spoiler-invisible-maybe)) + 'mastodon-quote data))))) + +(defun mastodon-tl--format-quote-non-display (str) + "Return a non-displaying quote string for STR." + (concat "\n\n" (mastodon-tl--quote-symbol-str) "\n[" str "]")) + +;; PUT /api/v1/statuses/:id/interaction_policy +(defun mastodon-tl--change-post-quote-policy () + "Change the quote policy of the toot at point. +Toot must be on you own." + (interactive) + ;; SCOPE: with own toot: + (let ((toot (mastodon-tl--property 'item-json :no-move))) + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only set quote policy for your own posts") + (let* ((id (mastodon-tl--property 'item-id)) + (current (car (map-nested-elt toot + '(quote_approval automatic)))) + (choice (completing-read (format "Set quote policy [%s]: " current) + mastodon-profiles-quote-policy-types + nil :match)) + (url (mastodon-http--api (format "statuses/%s/interaction_policy" + id))) + (resp (mastodon-http--put + url `(("quote_approval_policy" . ,choice))))) + (mastodon-http--triage + resp + (lambda (resp) + (let* ((json (with-current-buffer resp + (mastodon-http--process-json))) + (set (or (car (map-nested-elt json '(quote_approval automatic))) + "nobody"))) ;; nil on the server = nobody + (message "Quote policy for post updated to: %s!" set)))))))) (defun mastodon-tl--insert-status (toot body &optional detailed-p thread domain unfolded no-byline @@ -1953,9 +2058,8 @@ CW-EXPANDED means treat content warnings as unfolded." (toot-foldable (and mastodon-tl--fold-toots-at-length (length> body mastodon-tl--fold-toots-at-length))) - (cw-p (not - (string-empty-p - (alist-get 'spoiler_text toot)))) + (cw-p (not (string-empty-p + (alist-get 'spoiler_text toot)))) (body-tags (mastodon-tl--body-tags body)) (quote (mastodon-tl--field 'quote toot))) (insert @@ -1982,9 +2086,7 @@ CW-EXPANDED means treat content warnings as unfolded." body) ;; insert quote maybe: (when quote - (concat "\n\n" - (mastodon-tl--insert-quoted quote) - )))) + (mastodon-tl--insert-quoted quote toot)))) (if (and toot-foldable unfolded cw-expanded) (mastodon-tl--read-more-or-less "LESS" cw-p (not cw-expanded)) @@ -2035,12 +2137,15 @@ title, and context." (defun mastodon-tl--filters-context () "Return a string of the current buffer's filter context. Returns a member of `mastodon-views--filter-types'." + ;; FIXME: filters for bookmarks? = home? (let ((buf (mastodon-tl--get-buffer-type))) (cond ((or (eq buf 'local) (eq buf 'federated)) "public") ((mastodon-tl--profile-buffer-p) "profile") - ((eq buf 'list-timeline) + ( + ;; (eq buf 'list-timeline) + (or (eq buf 'list-timeline) (eq buf 'bookmarks)) "home") ;; lists are "home" filter (t ;; thread, notifs, home: (symbol-name buf))))) @@ -2054,7 +2159,7 @@ title, and context." (mastodon-tl--filter-by-context context filters-no-context))) (defun mastodon-tl--toot (toot &optional detailed-p thread domain - unfolded no-byline cw-expanded) + unfolded no-byline cw-expanded) "Format TOOT and insert it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client. @@ -2073,9 +2178,16 @@ CW-EXPANDED means treat content warnings as unfolded." (if (mastodon-tl--has-spoiler toot) (mastodon-tl--spoiler toot) (mastodon-tl--content toot))))) - ;; If any filters are "hide", then we hide, - ;; even though item may also have a "warn" filter: - (unless (and filtered (assoc "hide" filters)) ;; no insert + (unless (or + ;; If any filters are "hide", then we hide, + ;; even though item may also have a "warn" filter: + (and filtered (assoc "hide" filters)) ;; no insert + ;; if account suspended, no-op: + ;; https://codeberg.org/martianh/mastodon.el/issues/753 + ;; a user found post in bookmarks from a suspended user, + ;; breaking loading of bookmarks, even though I suspect the + ;; server should not even send us such data: + (map-nested-elt toot '(account suspended))) (mastodon-tl--insert-status toot (mastodon-tl--clean-tabs-and-nl spoiler-or-content) detailed-p thread domain unfolded no-byline cw-expanded)))) @@ -2132,6 +2244,21 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (propertize display 'read-more body))) +(defun mastodon-tl--load-images-fold () + "Check for unloaded images on (un)fold and load if found." + (when mastodon-tl--display-media-p + (let ((prev-point + (save-excursion + (let ((pb (point))) + (mastodon-tl-goto-prev-item :norefresh) + ;; our prev-item implementation is awful, so we just check + ;; if we moved, if we didn't, assume we are first item, so + ;; return point-min and use it: + (if (eq (point) pb) + (point-min) + (point)))))) + (mastodon-media--inline-images prev-point (point))))) + (defun mastodon-tl-unfold-post (&optional fold) "Unfold the toot at point if it is folded (read-more). FOLD means to fold it instead." @@ -2144,7 +2271,7 @@ FOLD means to fold it instead." (user-error "No foldable item at point?") (let* ((inhibit-read-only t) (body-range (mastodon-tl--find-property-range 'toot-body - (point) :backward)) + (point) :backward)) (cw-range (mastodon-tl--find-property-range 'mastodon-content-warning-body (point) :backward)) @@ -2166,14 +2293,16 @@ FOLD means to fold it instead." (delete-char 1) ;; prevent newlines accumulating ;; insert toot body: (mastodon-tl--toot toot nil nil nil (not fold) :no-byline - (unless cw-invis :cw-expanded)) ;; respect CW state + (unless cw-invis :cw-expanded)) ;; respect CW state ;; set toot-folded prop on entire toot (not just body): (let ((toot-range ;; post fold action range: (mastodon-tl--find-property-range 'item-json - (point) :backward))) + (point) :backward))) (add-text-properties (car toot-range) (cdr toot-range) `(toot-folded ,fold))) + ;; load unfolded images maybe: + (mastodon-tl--load-images-fold) ;; try to leave point somewhere sane: (cond ((or at-byline (and fold point-after-fold)) ;; point was in area now folded @@ -2200,6 +2329,7 @@ FOLD means to fold it instead." ;; calqued off mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) + ;; FIXME: just use `mastodon-tl-toot-or-base'? "Return the TOOT on which we want to extract stats. If no TOOT is given, the one at point is considered." (let* ((original-toot (or toot (get-text-property (point) 'item-json))) @@ -2227,6 +2357,12 @@ To disable showing the stats, customize (faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite))) (boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost))) (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) + (quotes (when .quotes_count + (format "%s %s" + (propertize (number-to-string .quotes_count) + 'face 'mastodon-toot-docs-face) + (propertize (mastodon-tl--symbol 'quote) + 'face '(:inherit success :box t))))) (stats (concat (propertize faves 'favourited-p (eq t .favourited) @@ -2244,7 +2380,15 @@ To disable showing the stats, customize 'replies-field t 'replies-count .replies_count 'help-echo (format "%s replies" .replies_count) - 'face 'mastodon-toot-docs-face))) + 'face 'mastodon-toot-docs-face) + (propertize " | " 'face 'mastodon-toot-docs-face) + (when .quotes_count + (propertize quotes + 'quotes-field t + 'quotes-count .quotes_count + 'help-echo (format "%s quotes" .quotes_count) + ;; 'face 'mastodon-toot-docs-face + )))) (right-spacing (propertize " " 'display @@ -2613,9 +2757,9 @@ ID is that of the toot to view." (user-error "Error: %s" (cdar toot)) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) - #'mastodon-tl--update-toot - ;; id for reload on reply: - nil nil nil nil id) + #'mastodon-tl--update-toot + ;; id for reload on reply: + nil nil nil nil id) (mastodon-tl--toot toot :detailed-p) (goto-char (point-min)) (when mastodon-tl--display-media-p @@ -2674,9 +2818,9 @@ programmatically and not crash into mastodon-group-notifications) (mastodon-tl--property 'notification-type) (mastodon-tl--field 'type - (mastodon-tl--property 'item-json :no-move)))) + (mastodon-tl--property 'item-json :no-move)))) (unfolded-state (mastodon-tl--buffer-property 'thread-unfolded - (current-buffer) :noerror)) + (current-buffer) :noerror)) (mastodon-tl--expand-content-warnings ;; if reloading and thread was explicitly (un)folded, respect it: (or (pcase unfolded-state @@ -2705,8 +2849,8 @@ programmatically and not crash into (with-mastodon-buffer buffer #'mastodon-mode nil (let ((marker (make-marker))) (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread-do - nil nil nil nil id) + #'mastodon-tl--thread-do + nil nil nil nil id) (when unfolded-state (plist-put mastodon-tl--buffer-spec 'thread-unfolded unfolded-state)) @@ -2791,7 +2935,7 @@ ID is that of the post the context is currently displayed for." ;;; FOLLOW/BLOCK/MUTE, ETC (defun mastodon-tl-follow-user (user-handle - &optional notify langs reblogs json) + &optional notify langs reblogs json) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. @@ -2828,7 +2972,7 @@ USER-HANDLE can also be a URL to a user profile page." (url (mastodon-http--api (format "accounts/%s/%s" user-id "follow")))) (if account (mastodon-tl--do-user-action-function url name - (substring user-handle 1) "follow") + (substring user-handle 1) "follow") (user-error "Cannot find a user with handle %S" user-handle)))) ;; TODO: make this action "enable/disable notifications" @@ -2938,6 +3082,42 @@ LANGS is the accumulated array param alist if we re-run recursively." (setq mastodon-toot--visibility "direct") (mastodon-toot--update-status-fields))) +(defun mastodon-tl-read-handle-annotated (user-handles prompt) + "Read a handle from data USER-HANDLES with PROMPT. +Annotate the candidates with display name or user name." + (let* ((item-json (mastodon-profile--item-json)) + (notif-accts (mastodon-tl--property 'notification-accounts :nomove)) + (completion-extra-properties + `(:annotation-function + ,(lambda (cand) + (let ((user + (or + ;; mentions: + (mastodon-tl--find-user cand + (alist-get 'mentions + (mastodon-tl--toot-or-base item-json))) + ;; notifs: + (mastodon-tl--find-user cand notif-accts) + ;; booster/faver: + (when (string= cand + (map-nested-elt item-json + '(account acct))) + (alist-get 'account item-json)) + ;; author: + (let ((data (mastodon-tl--toot-or-base item-json))) + (when (string= cand + (map-nested-elt data + '(account acct))) + (alist-get 'account data)))))) + (when user + (concat + (propertize " " + 'display '(space :align-to 40)) + (propertize (or (alist-get 'display_name user) + (alist-get 'username user)) + 'face 'mastodon-display-name-face)))))))) + (completing-read prompt user-handles nil 'confirm))) + (defun mastodon-tl--user-handles-get (action) "Get the list of user-handles for ACTION from the current toot." (mastodon-tl--do-if-item @@ -2970,16 +3150,22 @@ LANGS is the accumulated array param alist if we re-run recursively." (t (mastodon-profile--extract-users-handles (mastodon-profile--item-json)))))) - (completing-read + (mastodon-tl-read-handle-annotated + user-handles (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)))) + (t (format "Handle of user to %s: " action))))))) + +(defun mastodon-tl--find-user (handle data) + "Find user with HANDLE in DATA." + (cl-find-if + (lambda (entry) + (string= handle (alist-get 'acct entry))) + data)) (defun mastodon-tl--get-blocks-or-mutes-list (action) "Fetch the list of accounts for ACTION from the server. @@ -3261,7 +3447,7 @@ ACCOUNT and TOOT are the data to use." (mastodon-tl--read-rules-ids))) (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other")))) (mastodon-tl--report-build-params account-id comment item-id - forward-p cat rules))) + forward-p cat rules))) (defun mastodon-tl--report-build-params (account-id comment item-id forward-p cat &optional rules) @@ -3334,11 +3520,12 @@ report the account for spam." (mastodon-http--get-json url args))) (defun mastodon-tl--more-json-async - (endpoint id &optional params callback &rest cbargs) + (endpoint id &optional params silent callback &rest cbargs) "Return JSON for timeline ENDPOINT before ID. Then run CALLBACK with arguments CBARGS. PARAMS is used to send any parameters needed to correctly update -the current view." +the current view. +Optionally make the request SILENT." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) (args (append args params)) (url (mastodon-http--api @@ -3347,10 +3534,10 @@ the current view." (string= endpoint "notifications")) (string-suffix-p "search" endpoint)) "v2")))) - (apply #'mastodon-http--get-json-async url args callback cbargs))) + (apply #'mastodon-http--get-json-async url args silent callback cbargs))) -(defun mastodon-tl--more-json-async-offset (endpoint &optional params - callback &rest cbargs) +(defun mastodon-tl--more-json-async-offset (endpoint &optional params silent + callback &rest cbargs) "Return JSON for ENDPOINT, using the \"offset\" query param. This is used for pagination with endpoints that implement the \"offset\" parameter, rather than using link-headers or @@ -3358,7 +3545,8 @@ This is used for pagination with endpoints that implement the PARAMS are the update parameters, see `mastodon-tl--update-params'. These (\"limit\" and \"offset\") must be set in `mastodon-tl--buffer-spec' for pagination to work. -Then run CALLBACK with arguments CBARGS." +Then run CALLBACK with arguments CBARGS. +Optionally make the request SILENT." (let* ((params (or params (mastodon-tl--update-params))) (limit (string-to-number (alist-get "limit" params nil nil #'string=))) @@ -3372,16 +3560,20 @@ Then run CALLBACK with arguments CBARGS." "v2")))) ;; increment: (setf (alist-get "offset" params nil nil #'string=) offset) - (apply #'mastodon-http--get-json-async url params callback cbargs))) + (apply #'mastodon-http--get-json-async url params silent callback cbargs))) -(defun mastodon-tl--updated-json (endpoint id &optional params version) +(defun mastodon-tl--updated-json (endpoint id &optional params) "Return JSON for timeline ENDPOINT since ID. PARAMS is used to send any parameters needed to correctly update the current view. VERSION is the API version to use, as grouped notifs use v2." (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) (args (append args params)) - (url (mastodon-http--api endpoint version))) + (url (mastodon-http--api + endpoint + (when (and mastodon-group-notifications + (string= endpoint "notifications")) + "v2")))) (mastodon-http--get-json url args))) ;; TODO: add this to new posts in some cases, e.g. in thread view. @@ -3461,7 +3653,7 @@ and profile pages when showing followers or accounts followed." ;;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) (mastodon-http--get-response-async - url nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) + url nil nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) (cond (;; no paginate (or (mastodon-tl--buffer-type-eq 'follow-suggestions) (mastodon-tl--buffer-type-eq 'filters) @@ -3472,14 +3664,14 @@ and profile pages when showing followers or accounts followed." (mastodon-tl--search-buffer-p)) (mastodon-tl--more-json-async-offset (mastodon-tl--endpoint) - (mastodon-tl--update-params) + (mastodon-tl--update-params) nil 'mastodon-tl--more* (current-buffer) (point))) (t ;; max_id paginate (timelines, items with ids/timestamps): (let ((max-id (mastodon-tl--oldest-id)) (params (mastodon-tl--update-params))) (mastodon-tl--more-json-async (mastodon-tl--endpoint) - max-id params + max-id params nil 'mastodon-tl--more* (current-buffer) (point) nil max-id)))))) @@ -3542,7 +3734,7 @@ UPDATE-PARAMS is from prev buffer spec, added to the new one." (message "Loading... done."))))))) (defun mastodon-tl--find-property-range (property start-point - &optional search-backwards) + &optional search-backwards) "Return nil if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. @@ -3647,12 +3839,12 @@ from the start if it is nil." (set-marker previous-marker nil) ;; Otherwise this is a rew run, so let's initialize the next-run time. (setq mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300)) + (seconds-to-time 300)) mastodon-tl--timestamp-update-timer nil)) (while (and (< iteration 5) (setq next-timestamp-range (mastodon-tl--find-property-range 'timestamp - previous-timestamp))) + previous-timestamp))) (let* ((start (car next-timestamp-range)) (end (cdr next-timestamp-range)) (timestamp (get-text-property start 'timestamp)) @@ -3734,9 +3926,7 @@ This location is defined by a non-nil value of (notifs-p (eq update-fun 'mastodon-notifications--timeline)) (json (mastodon-tl--updated-json - endpoint id params - (when (and notifs-p mastodon-group-notifications) - "v2")))) + endpoint id params))) (if (mastodon-tl--no-json json) (user-error "Nothing to update") (let ((inhibit-read-only t)) @@ -3772,7 +3962,8 @@ NO-BYLINE means just insert toot body, used for announcements." (if headers #'mastodon-http--get-response-async #'mastodon-http--get-json-async) - url params 'mastodon-tl--init* + url params nil ;; not silent + 'mastodon-tl--init* buffer endpoint update-function headers params hide-replies instance no-byline))) @@ -3845,7 +4036,7 @@ ENDPOINT-VERSION is a string, format Vx, e.g. V2." (insert (substitute-command-keys (mastodon-tl--set-face (concat "[" binding-str "]\n\n") - 'mastodon-toot-docs-face)))) + 'mastodon-toot-docs-face)))) (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header params nil @@ -3870,7 +4061,7 @@ TYPE is a notification type." ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) + (seconds-to-time 300))) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds @@ -3886,7 +4077,7 @@ TYPE is a notification type." ;;; NODEINFO (defun mastodon-tl--get-nodeinfo (instance &optional version) - "Return Nodeinfo data for INSTANCE, optionally for version." + "Return Nodeinfo data for INSTANCE, optionally for VERSION." ;; NB: not in the API: (let ((url (format "https://%s/nodeinfo/%s" instance (or version "2.0")))) (mastodon-http--get-json url))) @@ -3908,7 +4099,7 @@ https://nodeinfo.diaspora.software." (mastodon-tl--render-nodeinfo data))))) (defun mastodon-tl--render-nodeinfo (data) - "Render Nodeinfo DADA as message." + "Render Nodeinfo DATA as message." (let-alist data (message "%s" diff --git a/elpa/mastodon-20251201.1553/mastodon-toot.el b/elpa/mastodon-20260406.856/mastodon-toot.el similarity index 87% rename from elpa/mastodon-20251201.1553/mastodon-toot.el rename to elpa/mastodon-20260406.856/mastodon-toot.el index 463abe34..3e1f5ae4 100644 --- a/elpa/mastodon-20251201.1553/mastodon-toot.el +++ b/elpa/mastodon-20260406.856/mastodon-toot.el @@ -31,7 +31,6 @@ ;;; Code: (eval-when-compile (require 'subr-x)) - (defvar mastodon-use-emojify) (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify") @@ -56,6 +55,7 @@ (defvar mastodon-tl--enable-proportional-fonts) (defvar mastodon-profile-account-settings) (defvar mastodon-profile-acccount-preferences-data) +(defvar mastodon-profiles-quote-policy-types) (autoload 'iso8601-parse "iso8601") (autoload 'ht-get "ht") @@ -107,6 +107,7 @@ (autoload 'mastodon-instance-data "mastodon") (autoload 'mastodon-create-poll "mastodon-transient") (autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl") +(autoload 'mastodon-tl--thread-do "mastodon-tl") ;; for mastodon-toot-translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -241,6 +242,11 @@ Takes its form from `window-configuration-to-register'.") (defvar mastodon-toot-current-toot-text nil "The text of the toot being composed.") +(defvar-local mastodon-toot-quote-policy nil + "The quote policy for the current toot.") + +(defvar-local mastodon-toot-quote-id nil) + (persist-defvar mastodon-toot-draft-toots-list nil "A list of toots that have been saved as drafts. For the moment we just put all composed toots in here, as we want @@ -331,8 +337,9 @@ property, and call BODY-FUN on them." (define-key map (kbd "C-c C-v") #'mastodon-toot-change-visibility) (define-key map (kbd "C-c C-e") #'mastodon-toot-insert-emoji) (define-key map (kbd "C-c C-a") #'mastodon-toot-attach-media) - (define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments) + (define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments) (define-key map (kbd "C-c C-p") #'mastodon-toot-create-poll) + (define-key map (kbd "C-c C-u") #'mastodon-toot-set-quote-policy) (define-key map (kbd "C-c C-o") #'mastodon-toot-clear-poll) (define-key map (kbd "C-c C-l") #'mastodon-toot-set-toot-language) (define-key map (kbd "C-c C-s") #'mastodon-toot-schedule-toot) @@ -352,7 +359,7 @@ property, and call BODY-FUN on them." NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") - nil + nil :silent 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response @@ -445,10 +452,10 @@ ACTION is a symbol, either `favourite' or `boost.'" (get-text-property (car byline-region) 'favourited-p))) (str-api (if boost-p "reblog" action-str)) (action-str-api (mastodon-toot--str-negify str-api faved boosted - action)) + action)) (action-pp (concat (mastodon-toot--str-negify action-str faved boosted - action) + action) (if boost-p "ed" "d"))) (remove-p (if boost-p boosted faved))) (mastodon-toot--action @@ -537,7 +544,7 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (cdr byline-region) (list 'bookmarked-p (not bookmarked-p))) (mastodon-toot--action-success bookmark-str - byline-region bookmarked-p item-json) + byline-region bookmarked-p item-json) (message "%s #%s" message id)))))))))) (defun mastodon-toot-list-boosters () @@ -594,6 +601,8 @@ base toot." (defun mastodon-toot-browse-toot-url () "Browse URL of toot at point. +Note that this loads the version of the toot on the remote server, not +your own. Calls `browse-url'." (interactive) (browse-url @@ -672,29 +681,35 @@ Uses `lingva.el'." "Delete and redraft user's toot at point synchronously. NO-REDRAFT means delete toot only." (interactive) - (let* ((toot (mastodon-toot--base-toot-or-item-json)) - (id (mastodon-tl--as-string (mastodon-tl--item-id toot))) - (url (mastodon-http--api (format "statuses/%s" id))) - (pos (point))) - (let-alist toot - (if (not (mastodon-toot--own-toot-p toot)) - (user-error "You can only delete (and redraft) your own toots") - (when (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda (_) - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile pos)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - .in_reply_to_id - .visibility - .spoiler_text)))))))))) + (mastodon-toot--with-toot-item + (let* ((toot (mastodon-toot--base-toot-or-item-json)) + (url (mastodon-http--api (format "statuses/%s" id))) + (attachmentsp (mastodon-tl--field 'media_attachments toot)) + (pos (point))) + (let-alist toot + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only delete (and redraft) your own toots") + (when (y-or-n-p (if no-redraft + "Delete this toot? " + "Delete and redraft this toot? ")) + (let* ((params + (when (and attachmentsp + no-redraft + (y-or-n-p "Also delete toot's attachments?")) + `(("delete_media" . "true")))) + (response (mastodon-http--delete url params))) + (mastodon-http--triage + response + (lambda (_) + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile pos)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + .in_reply_to_id + .visibility + .spoiler_text))))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -734,7 +749,8 @@ MEDIA is the media_attachments data for a status from the server." media)) (defun mastodon-toot--set-toot-properties - (reply-id visibility cw lang &optional scheduled scheduled-id media poll) + (reply-id visibility cw lang + &optional scheduled scheduled-id media poll quote-id) "Set the toot properties for the current redrafted or edited toot. REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set. MEDIA is the media_attachments data for a status from the server." @@ -751,6 +767,7 @@ MEDIA is the media_attachments data for a status from the server." (mastodon-toot--set-toot-media-attachments media)) (when poll (mastodon-toot--server-poll-to-local poll)) + (setq mastodon-toot-quote-id quote-id) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields))) @@ -932,7 +949,9 @@ instance to edit a toot." ("sensitive" . ,(when mastodon-toot--content-nsfw (symbol-name t))) ("spoiler_text" . ,mastodon-toot--content-warning) - ("language" . ,mastodon-toot--language)) + ("quote_approval_policy" . ,mastodon-toot-quote-policy) + ("language" . ,mastodon-toot--language) + ("quoted_status_id" . ,mastodon-toot-quote-id)) ;; Pleroma instances can't handle null-valued ;; scheduled_at args, so only add if non-nil (when scheduled `(("scheduled_at" . ,scheduled))))) @@ -1006,17 +1025,19 @@ instance to edit a toot." (user-error "You can only edit your own toots") (let* ((source (mastodon-toot--get-toot-source id)) (content (alist-get 'text source)) - (source-cw (alist-get 'spoiler_text source))) + (source-cw (alist-get 'spoiler_text source)) + (quote (alist-get 'quote toot))) (let-alist toot (when (y-or-n-p "Edit this toot? ") (mastodon-toot--compose-buffer nil .in_reply_to_id nil content :edit) (goto-char (point-max)) ;; adopt reply-to-id, visibility, CW, language, and media: - (mastodon-toot--set-toot-properties .in_reply_to_id .visibility - source-cw .language nil nil - ;; maintain media order: - (reverse .media_attachments) .poll) + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility source-cw .language nil nil + ;; maintain media order: + (reverse .media_attachments) .poll + (map-nested-elt quote '(quoted_status id))) (setq mastodon-toot--edit-item-id id)))))))) (defun mastodon-toot--get-toot-source (id) @@ -1296,14 +1317,45 @@ Return its two letter ISO 639 1 code." (message "Language set to %s" choice) (mastodon-toot--update-status-fields))) +(defun mastodon-toot-set-quote-policy () + "Set quote policy for the current toot." + (interactive) + (let* ((default (alist-get 'posting:default:quote_policy + (mastodon-http--get-json + (mastodon-http--api "preferences")))) + (choice (completing-read + (format "Quote policy for this toot [default: %s]" + default) + mastodon-profiles-quote-policy-types))) + (setq mastodon-toot-quote-policy choice) + (message (concat "Quote policy for this toot: " choice)) + (mastodon-toot--update-status-fields))) + ;;; ATTACHMENTS +(defun mastodon-toot--delete-attachments () + "Delete each attachment on the server. +Makes a DELETE request for each item in +`mastodon-toot--media-attachment-ids'." + (while mastodon-toot--media-attachment-ids + (let* ((id (pop mastodon-toot--media-attachment-ids)) + (url (mastodon-http--api + (format "media/%s" + id))) + (resp (mastodon-http--delete url))) + (mastodon-http--triage resp + (lambda (_resp) + (message "File %s deleted!" id)))))) + (defun mastodon-toot-clear-all-attachments () - "Remove all attachments from a toot draft." + "Remove all attachments from a toot draft. +If user so chooses, also delete the files on the server." (interactive) (setq mastodon-toot--media-attachments nil) - (setq mastodon-toot--media-attachment-ids nil) + (if (not (y-or-n-p "Also delete attachments on the server?")) + (setq mastodon-toot--media-attachment-ids nil) + (mastodon-toot--delete-attachments)) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields)) @@ -1320,31 +1372,35 @@ If that fails, return 4 as a fallback" (alist-get 'max_media_attachments config)) 4)) ; mastodon default as fallback -(defun mastodon-toot-attach-media (file description) - "Prompt for an attachment FILE with DESCRIPTION. +(defun mastodon-toot-attach-media () + "Prompt for an attachment file. A preview is displayed in the new toot buffer, and the file is uploaded asynchronously using `mastodon-toot--upload-attached-media'. File is actually attached to the toot upon posting." - (interactive "fFilename: \nsDescription: ") - (let ((max-attachments (mastodon-toot--get-instance-max-attachments))) - (when (>= (length mastodon-toot--media-attachments) - max-attachments) - ;; warn + pop the oldest one: - (when (y-or-n-p - (format "Maximum attachments (%s) reached: remove first one?" - max-attachments)) - (pop mastodon-toot--media-attachments))) - (if (file-directory-p file) - (user-error "Looks like you chose a directory not a file") - (setq mastodon-toot--media-attachments - (nconc mastodon-toot--media-attachments - `(((:contents . ,(mastodon-http--read-file-as-string file)) - (:description . ,description) - (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display) - ;; upload only most recent attachment: - (mastodon-toot--upload-attached-media - (car (last mastodon-toot--media-attachments)))))) + (interactive) + (if mastodon-toot-quote-id + (user-error "You can't add attachments to quote toots") + (let ((file (read-file-name "Filename: ")) + (description (read-string "Description: ")) + (max-attachments (mastodon-toot--get-instance-max-attachments))) + (when (>= (length mastodon-toot--media-attachments) + max-attachments) + ;; warn + pop the oldest one: + (when (y-or-n-p + (format "Maximum attachments (%s) reached: remove first one?" + max-attachments)) + (pop mastodon-toot--media-attachments))) + (if (file-directory-p file) + (user-error "Looks like you chose a directory not a file") + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:description . ,description) + (:filename . ,file))))) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media + (car (last mastodon-toot--media-attachments))))))) (defun mastodon-toot--attachment-descriptions () "Return a list of image descriptions for current attachments." @@ -1444,9 +1500,11 @@ MAX is the maximum number set by their instance." (defun mastodon-toot-create-poll () "Prompt for new poll options and return as a list." (interactive) - (if mastodon-toot-poll-use-transient - (call-interactively #'mastodon-create-poll) - (mastodon-toot--read-poll))) + (cond (mastodon-toot-quote-id + (user-error "You can't add a poll to a quote toot")) + (mastodon-toot-poll-use-transient + (call-interactively #'mastodon-create-poll)) + (t (mastodon-toot--read-poll)))) (defun mastodon-toot--read-poll () "Read poll options." @@ -1548,6 +1606,87 @@ If TRANSIENT, we are called from a transient, so nil `( :options ,options :expiry-readable ,expiry-human :expiry ,expiry-str :multi ,multiple)))))) +;;; QUOTE + +(defvar mastodon-toot-quote-approval-user + '("automatic" "manual" "denied" "unknown")) + +(defvar mastodon-toot-quote-approval-auto-or-manual + '("public" "followers" "following" "unsupported_policy")) + +(defun mastodon-toot-quote () + "Compose a toot quoting the toot at point." + (interactive) + ;; boosted toot or toot: + (let* ((quote-id (mastodon-tl--property 'base-item-id)) + (json (mastodon-tl--property 'item-json)) + (policy (alist-get 'quote_approval json)) + (user-policy (alist-get 'current_user policy)) + ;; Respect visibility when quoting a toot: + ;; According to web UI settings (preferences/posting defaults): + + ;; - quoting an unlisted ("quiet public") post, means quoting post also unlisted + ;; "When people quote you, their post will also be hidden from trending timelines." + + ;; - private ("followers only") means no quoting allowed + ;; "Followers-only posts authored on Mastodon can't be quoted by others." + ;; BUT: we don't need to enforce this, as user-policy will be "denied" + ;; if toot is "private" + + ;; "Quoting a private post will restrict the quoting post’s + ;; visibility to private or direct (if the given visibility is + ;; public or unlisted, private will be used instead)." + + ;; + + ;; for now all we do is hand on quoted toot's visibility: + (visibility (mastodon-tl--field 'visibility json))) + (if (string= user-policy "denied") + (user-error "You don't have permission to quote this toot") + (when (or (not (string= user-policy "unknown")) + (y-or-n-p "Quote permission unknown. Proceed?")) + (mastodon-toot--compose-buffer nil nil nil nil nil + quote-id json visibility))))) + +(defun mastodon-toot-jump-to-quoting () + "Prompt for a toot quoting the toot at point and load it." + (interactive) + (mastodon-toot--with-toot-item + (let* ((json (mastodon-tl--toot-or-base + (mastodon-tl--property 'item-json))) + (quotes (alist-get 'quotes_count json))) + (if (= 0 quotes) + (user-error "Item has no quotes?") + ;; with-toot-item fetches base id: + (let* ((data (mastodon-toot--get-quoting id)) + (users (cl-loop for x in data + collect (map-nested-elt x '(account acct)))) + (completion-extra-properties + `(:annotation-function + ,(lambda (cand) + (let ((user (cl-find-if + (lambda (entry) + (string= cand + (map-nested-elt entry '(account acct)))) + data))) + (concat " " + (map-nested-elt user '(account username))))))) + (choice (completing-read "Load quoting toot by:" users)) + (choice-item (cl-find-if + (lambda (x) + (string= choice + (map-nested-elt x '(account acct)))) + data))) + (mastodon-tl--thread-do (alist-get 'id choice-item))))))) + +(defun mastodon-toot--get-quoting (id) + "Get statuses that quote item with ID." + ;; link header for paginating + ;; limit param default 20 max 40 + (let ((endpoint (mastodon-http--api + (format "statuses/%s/quotes" id)))) + (mastodon-http--get-json endpoint))) + ;;; SCHEDULE @@ -1690,26 +1829,29 @@ LONGEST is the length of the longest binding." (mastodon-toot--formatted-kbinds-pairs formatted longest-kbind) nil)))) -(defun mastodon-toot--format-reply-in-compose (reply-text) - "Format a REPLY-TEXT for display in compose buffer docs." - (let* ((rendered (mastodon-tl--render-text reply-text)) +(defun mastodon-toot--format-reply-in-compose (reply-text &optional quote-text) + "Format a REPLY-TEXT for display in compose buffer docs. +Optionally format QUOTE-TEXT." + (let* ((rendered (mastodon-tl--render-text (or quote-text reply-text))) (no-props (substring-no-properties rendered)) ;; FIXME: this replaces \n at end of every post, so we have to trim: (no-newlines (string-trim (replace-regexp-in-string "[\n]+" " " no-props))) - (reply-to (concat " Reply to: \"" no-newlines "\"")) - (crop (truncate-string-to-width reply-to - mastodon-toot-orig-in-reply-length))) + (prompt (concat (if quote-text " Quoting: \"" " Reply to: \"") + no-newlines "\"")) + (crop (truncate-string-to-width + prompt mastodon-toot-orig-in-reply-length))) (if (> (length no-newlines) (length crop)) ; we cropped: (concat crop "\n") - (concat reply-to "\n")))) + (concat prompt "\n")))) -(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text) +(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text quote-text) "Insert propertized text with documentation about `mastodon-toot-mode'. Also includes and the status fields which will get updated based on the status of NSFW, content warning flags, media attachments, etc. -REPLY-TEXT is the text of the toot being replied to." +REPLY-TEXT is the text of the toot being replied to. +QUOTE-TEXT is that of the toot being quoted if so." (let ((divider "|=================================================================|")) (insert @@ -1739,15 +1881,23 @@ REPLY-TEXT is the text of the toot being replied to." " " (propertize "NSFW" 'toot-post-nsfw-flag t) + " " + (propertize "Quoting" + 'toot-quote-policy t) "\n" " Attachments: " (propertize "None " 'toot-attachments t) "\n" - (when reply-text - (propertize - (mastodon-toot--format-reply-in-compose reply-text) - 'toot-reply t)) + (cond (reply-text + (propertize + (mastodon-toot--format-reply-in-compose reply-text) + 'toot-reply t)) + (quote-text + (let ((text (mastodon-toot--format-reply-in-compose + nil quote-text))) + (propertize text + 'toot-quote text)))) divider) 'face 'mastodon-toot-docs-face 'read-only "Edit your message below." @@ -1823,8 +1973,16 @@ REPLY-REGION is a string to be injected into the buffer." (point-min))) (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag (point-min))) + (quote-pol-region (mastodon-tl--find-property-range 'toot-quote-policy + (point-min))) (toot-string (buffer-substring-no-properties (cdr header-region) - (point-max)))) + (point-max))) + (toot-quote (mastodon-tl--find-property-range 'toot-quote + (point-min))) + (quote-text (when toot-quote + (save-excursion + (goto-char (car toot-quote)) + (mastodon-tl--property 'toot-quote :nomove))))) (mastodon-toot--apply-fields-props count-region (format "%s/%s chars" @@ -1869,7 +2027,15 @@ REPLY-REGION is a string to be injected into the buffer." (not (string= "" mastodon-toot--content-warning))) (format "CW: %s" mastodon-toot--content-warning) " ") ;; hold the blank space - 'mastodon-cw-face)))) + 'mastodon-cw-face) + (mastodon-toot--apply-fields-props + quote-pol-region + (if mastodon-toot-quote-policy + (format "Quoting: %s" mastodon-toot-quote-policy) + "") + 'mastodon-cw-face) + (mastodon-toot--apply-fields-props + toot-quote quote-text 'mastodon-cw-face)))) (defun mastodon-toot--apply-fields-props (region display &optional face help-echo) "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end." @@ -1999,14 +2165,18 @@ Added to `after-change-functions'." ;;; COMPOSE BUFFER FUNCTION (defun mastodon-toot--compose-buffer - (&optional reply-to-user reply-to-id reply-json initial-text edit) + (&optional reply-to-user reply-to-id reply-json initial-text edit + quote-id quote-json visibility) "Create a new buffer to capture text for a new toot. If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var. REPLY-JSON is the full JSON of the toot being replied to. INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add a draft into the buffer. -EDIT means we are editing an existing toot, not composing a new one." +EDIT means we are editing an existing toot, not composing a new one. +QUOTE-ID is the id of the post being quoted if there is one. +QUOTE-JSON is its data. +VISIBILITY is the toot's visibility." (let* ((buffer-name (if edit "*edit toot*" "*new toot*")) (buffer-exists (get-buffer buffer-name)) (buffer (if (not buffer-exists) @@ -2027,9 +2197,13 @@ EDIT means we are editing an existing toot, not composing a new one." (switch-to-buffer-other-window buffer) (text-mode) (mastodon-toot-mode t) + ;; set quote id: + (when quote-id + (setq mastodon-toot-quote-id quote-id)) ;; set visibility: (setq mastodon-toot--visibility - (or (plist-get mastodon-profile-account-settings 'privacy) + (or visibility ;; quoting a toot + (plist-get mastodon-profile-account-settings 'privacy) ;; use toot visibility setting from the server: (mastodon-profile--get-source-value 'privacy) "public")) ; fallback @@ -2040,11 +2214,14 @@ EDIT means we are editing an existing toot, not composing a new one." (setq mastodon-toot--language (mastodon-profile--get-preferences-pref 'posting:default:language)) ;; display original toot: - (if mastodon-toot-display-orig-in-reply-buffer - (progn - (mastodon-toot--display-docs-and-status-fields reply-text) - (mastodon-toot--fill-reply-in-compose)) - (mastodon-toot--display-docs-and-status-fields)) + (cond (quote-id + (mastodon-toot--display-docs-and-status-fields + nil (mastodon-tl--field 'content quote-json)) + (mastodon-toot--fill-reply-in-compose)) + (mastodon-toot-display-orig-in-reply-buffer + (mastodon-toot--display-docs-and-status-fields reply-text) + (mastodon-toot--fill-reply-in-compose)) + (t (mastodon-toot--display-docs-and-status-fields))) ;; `reply-to-user' (alone) is also used by `mastodon-tl-dm-user', so ;; perhaps we should not always call --setup-as-reply, or make its ;; workings conditional on reply-to-id. currently it only checks for diff --git a/elpa/mastodon-20251201.1553/mastodon-transient.el b/elpa/mastodon-20260406.856/mastodon-transient.el similarity index 96% rename from elpa/mastodon-20251201.1553/mastodon-transient.el rename to elpa/mastodon-20260406.856/mastodon-transient.el index 3c8b369e..dbfb182e 100644 --- a/elpa/mastodon-20251201.1553/mastodon-transient.el +++ b/elpa/mastodon-20260406.856/mastodon-transient.el @@ -73,7 +73,8 @@ 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"))) + (member array-key + '("quote_policy" "privacy" "sensitive" "language"))) key array-key))) @@ -163,7 +164,10 @@ the format fields.X.keyname." :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))] + :choices (lambda () mastodon-iso-639-regional)) + ("q" "quote policy" "source.quote_policy" :alist-key source.quote_policy + :class tp-option + :choices (lambda () mastodon-profiles-quote-policy-types))] ["Update" ("C-c C-c" "Save settings" mastodon-user-settings-update) ("C-x C-k" :info "Revert all changes")] @@ -376,7 +380,9 @@ Do not add more than the server's maximum setting." (defun mastodon-notifications-requests-count () "Format a string for pending requests." - (let ((val (oref transient--prefix value))) + (let ((val ;; (oref transient--prefix value))) ;; deprecated + ;; (transient-get-value)) ;; broken + tp-transient-settings)) ;; dubious (format "Pending requests: %d" (or (map-nested-elt val @@ -385,7 +391,9 @@ Do not add more than the server's maximum setting." (defun mastodon-notifications-filtered-count () "Format a string for pending notifications." - (let ((val (oref transient--prefix value))) + (let ((val ;; (oref transient--prefix value))) ;; deprecated + ;; (transient-get-value)) ;; broken + tp-transient-settings)) ;; dubious (format "Pending notifications: %d" (or (map-nested-elt val @@ -417,7 +425,9 @@ We always read.") (cl-defmethod transient-init-value ((obj mastodon-transient-field)) "Initialize value of OBJ." - (let* ((prefix-val (oref transient--prefix value))) + (let* ((prefix-val ;; (oref transient--prefix value))) ;; deprecated + ;; (transient-get-value)) ;; broken + tp-transient-settings)) ;; dubious ;; (arg (oref obj alist-key))) (oset obj value (tp-get-server-val obj prefix-val)))) diff --git a/elpa/mastodon-20251201.1553/mastodon-views.el b/elpa/mastodon-20260406.856/mastodon-views.el similarity index 99% rename from elpa/mastodon-20251201.1553/mastodon-views.el rename to elpa/mastodon-20260406.856/mastodon-views.el index ab4ccaac..53d5a4db 100644 --- a/elpa/mastodon-20251201.1553/mastodon-views.el +++ b/elpa/mastodon-20260406.856/mastodon-views.el @@ -632,11 +632,15 @@ JSON is the filters data." (table-justify-column 'center) (table-forward-cell) ;; col 2 (table-justify-column 'center) - (while (re-search-forward ;; goto end of table: - (concat table-cell-horizontal-chars - (make-string 1 table-cell-intersection-char) - "\n") - nil :no-error)))) + (mastodon-views--end-of-table))) + +(defun mastodon-views--end-of-table () + "" + (while (re-search-forward ;; goto end of table: + (concat table-cell-horizontal-chars + (make-string 1 table-cell-intersection-char) + "\n") + nil :no-error))) (defun mastodon-views--insert-filter (filter) "Insert a single FILTER." diff --git a/elpa/mastodon-20251201.1553/mastodon-widget.el b/elpa/mastodon-20260406.856/mastodon-widget.el similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon-widget.el rename to elpa/mastodon-20260406.856/mastodon-widget.el diff --git a/elpa/mastodon-20251201.1553/mastodon.el b/elpa/mastodon-20260406.856/mastodon.el similarity index 87% rename from elpa/mastodon-20251201.1553/mastodon.el rename to elpa/mastodon-20260406.856/mastodon.el index c58e0466..8fa5837a 100644 --- a/elpa/mastodon-20251201.1553/mastodon.el +++ b/elpa/mastodon-20260406.856/mastodon.el @@ -6,9 +6,9 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Package-Version: 20251201.1553 -;; Package-Revision: 3c00418bfbb1 -;; Package-Requires: ((emacs "28.1") (persist "0.8") (tp "0.7")) +;; Package-Version: 20260406.856 +;; Package-Revision: 5bba23045efd +;; Package-Requires: ((emacs "29.1") (persist "0.8") (tp "0.8")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -51,7 +51,6 @@ (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") -(declare-function request "request") (autoload 'mastodon-auth--get-account-name "mastodon-auth") (autoload 'mastodon-auth--user-acct "mastodon-auth") @@ -76,6 +75,8 @@ (autoload 'mastodon-toot--view-toot-history "mastodon-tl") (autoload 'mastodon-tl-return "mastodon-tl") (autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl") +(autoload 'mastodon-notifications--update-with-timer "mastodon-notifications") +(autoload 'mastodon-profile-table-cell-hook-fun "mastodon-profile") ;; for M-x visibility ;; (views.el uses `mastodon-mode-map', so we can't easily require it) @@ -105,16 +106,24 @@ nil :interactive) (autoload 'special-mode "simple") +(autoload 'mastodon-tl--thread-do "mastodon-tl") +(autoload 'mastodon-notifications--get-unread-count "mastodon-notifications") (defvar mastodon-tl--highlight-current-toot) (defvar mastodon-notifications--map) (defvar mastodon-client--token-file) +(defvar alert-default-style) +(defvar alert-styles) + (defvar mastodon-notifications-grouped-types '("reblog" "favourite") ;; TODO: implement follow! "List of notification types for which grouping is implemented. Used in `mastodon-notifications-get'") +(defvar mastodon-notifications-notify-shown nil + "Whether recent notifications have been seen by the user or not.") + (defgroup mastodon nil "Interface with Mastodon." :prefix "mastodon-" @@ -194,6 +203,39 @@ A count of 2 for example means to display like so: \"Bob, Jenny and X others...\"." :type '(integer)) +(defcustom mastodon-notifications-alerts-interval 60 + "How often to check for new notifications, in seconds." + :type '(integer)) + +(defcustom mastodon-notifications-alerts t + "Whether to enable alert.el unread-notification alerts. +If this is enabled and alert.el is installed, an alert.el notification +will be shown using `mastodon-notifications-alert-style' as its alert +style. If this is enabled but alert.el is not installed, alerts will be +shown using `message'. +Alerts are only checked for when at least 1 mastodon.el buffer is open." + :type '(boolean)) + +(defcustom mastodon-notifications-alert-style + (when (require 'alert nil :noerror) alert-default-style) + "The type of alert.el style to use for mastodon.el notification alerts. +Currently, if you customize this variable, you need to restart Emacs for +it to take effect, or if you don't have any other alert.el rules set up, +you can nil `alert-internal-configuration' and reload mastodon.el. This +only applies to alert.el alerts, if you don't use alert.el, you should +not set this variable and mastodon.el will message for notification +alerts." + :type + `(choice + ,@(if (not (require 'alert nil :noerror)) + '(const nil) + (append + '((const :tag "alert.el default" + :value alert-default-style)) + (cl-loop for x in alert-styles + collect (list 'const :tag (plist-get (cdr x) :title) + :value (car x))))))) + (defun mastodon-kill-window () "Quit window and delete helper." (interactive) @@ -230,10 +272,11 @@ Also nil `mastodon-auth--token-alist'." (define-key map (kbd "l") #'recenter-top-bottom) ;; navigation between timelines (define-key map (kbd "#") #'mastodon-tl-get-tag-timeline) - (define-key map (kbd "\"") #'mastodon-tl-list-followed-tags) - (define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag) + (define-key map (kbd "C-#") #'mastodon-tl-list-followed-tags) + ;; (define-key map (kbd "\"") #'mastodon-tl-list-followed-tags) + (define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag) (define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline) - (define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline) + (define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline) (define-key map (kbd "A") #'mastodon-profile-get-toot-author) (define-key map (kbd "F") #'mastodon-tl-get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl-get-home-timeline) @@ -255,6 +298,7 @@ Also nil `mastodon-auth--token-alist'." (define-key map (kbd "f") #'mastodon-toot-toggle-favourite) (define-key map (kbd "k") #'mastodon-toot-toggle-bookmark) (define-key map (kbd "r") #'mastodon-toot-reply) + (define-key map (kbd "\"") #'mastodon-toot-quote) (define-key map (kbd "C") #'mastodon-toot-copy-toot-url) (define-key map (kbd "o") #'mastodon-toot-browse-toot-url) (define-key map (kbd "v") #'mastodon-tl-poll-vote) @@ -267,6 +311,7 @@ Also nil `mastodon-auth--token-alist'." (define-key map (kbd "a") #'mastodon-toot-translate-toot-text)) (define-key map (kbd ",") #'mastodon-toot-list-favouriters) (define-key map (kbd ".") #'mastodon-toot-list-boosters) + (define-key map (kbd "C-,") #'mastodon-toot-jump-to-quoting) (define-key map (kbd ";") #'mastodon-views-view-instance-description) (define-key map (kbd "M-;") #'mastodon-tl-nodeinfo-for-toot) ;; override special mode binding @@ -415,13 +460,17 @@ FORCE means to fetch from the server in any case and update (alist-get 'version (mastodon-instance-data))) ;;;###autoload -(defun mastodon-toot (&optional user reply-to-id reply-json) +(defun mastodon-toot (&optional user reply-to-id reply-json + quote-id quote-json visibility) "Update instance with new toot. Content is captured in a new buffer. If USER is non-nil, insert after @ symbol to begin new toot. If REPLY-TO-ID is non-nil, attach new toot to a conversation. -If REPLY-JSON is the json of the toot being replied to." +If REPLY-JSON is the json of the toot being replied to. +QUOTE-ID is the id of a toot being quoted, QUOTE-JSON is its data. +VISIBILITY is the visibility of the toot." (interactive) - (mastodon-toot--compose-buffer user reply-to-id reply-json)) + (mastodon-toot--compose-buffer user reply-to-id reply-json + nil nil quote-id quote-json visibility)) ;;;###autoload (defun mastodon-notifications-get (&optional type buffer-name max-id) @@ -451,9 +500,18 @@ MAX-ID is a request parameter for pagination." "v1" "v2")) (with-current-buffer (get-buffer-create buffer) - (use-local-map mastodon-notifications--map)) + (use-local-map mastodon-notifications--map) + (when mastodon-notifications-notify-shown + (setq mastodon-notifications-notify-shown nil))) (message "Loading your notifications... Done"))) +;;;###autoload +(defun mastodon-notifications-check () + "Check for the number of unread notifications." + (interactive) + (let ((count (mastodon-notifications--get-unread-count))) + (message "Unread notifications: %s" count))) + ;; URL lookup: should be available even if `mastodon.el' not loaded: ;;;###autoload @@ -574,7 +632,14 @@ Calls `mastodon-tl--get-buffer-type', which see." ;; make `thing-at-point' functions work: (setq-local thing-at-point-provider-alist (append thing-at-point-provider-alist - '((url . mastodon--url-at-point))))) + '((url . mastodon--url-at-point)))) + ;; notifs timer + (when mastodon-notifications-alerts + (mastodon-notifications--update-with-timer)) + ;; pretty table override bindings: + (add-hook 'table-cell-map-hook + #'mastodon-profile-table-cell-hook-fun + nil :local)) ;;;###autoload (add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun) diff --git a/elpa/mastodon-20251201.1553/mastodon.info b/elpa/mastodon-20260406.856/mastodon.info similarity index 100% rename from elpa/mastodon-20251201.1553/mastodon.info rename to elpa/mastodon-20260406.856/mastodon.info -- 2.47.3