branch: elpa/mastodon
commit 07b3b2249b3e0838eccdc2860cbd5b2f94199481
Merge: 3c00418bfb 5b966671bf
Author: marty hiatt <[email protected]>
Commit: marty hiatt <[email protected]>
Merge branch 'develop'
---
lisp/mastodon-http.el | 24 ++--
lisp/mastodon-inspect.el | 8 +-
lisp/mastodon-notifications.el | 164 +++++++++++++++++++++++-
lisp/mastodon-profile.el | 19 ++-
lisp/mastodon-tl.el | 265 +++++++++++++++++++++++++++++----------
lisp/mastodon-toot.el | 274 +++++++++++++++++++++++++++++------------
lisp/mastodon-transient.el | 20 ++-
lisp/mastodon.el | 67 ++++++++--
mastodon-index.org | 8 +-
test/mastodon-auth-tests.el | 3 +
test/mastodon-client-tests.el | 117 +++++++++---------
11 files changed, 732 insertions(+), 237 deletions(-)
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index fc456925e5..16c9d787a7 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/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/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el
index 4981943f2b..779598984a 100644
--- a/lisp/mastodon-inspect.el
+++ b/lisp/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/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index 113f3a5908..8ea7397e17 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -40,6 +40,8 @@
(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 +73,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 +96,10 @@
(defvar mastodon-notifications-grouped-names-count)
(defvar mastodon-tl--link-keymap)
(defvar mastodon-tl--update-point)
+(defvar mastodon-notifications-updates-interval)
+(defvar mastodon-notifications-check-for-updates)
+(defvar mastodon-notifications-alert-style)
+(defvar mastodon-notifications-alerts)
;;; VARIABLES
(defvar mastodon-notifications--map
@@ -471,7 +481,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 +667,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 +820,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 +836,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 +1019,115 @@ 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 :noerror))
+ (message "mastodon.el: new notifications %s" count)
+ (alert (format "New notifications: <b>%s</b>" 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'."
+ ;; if no buffers: cancel our timer and do nothing else:
+ (if (and (not (mastodon-live-buffers))
+ ;; if we are loading a first mastodon buffer, the previous
+ ;; check fails, as `mastodon-mode-hook' necessariliy runs
+ ;; before we have buf-spec, which
+ ;; `mastodon-tl--get-buffer-type' depends on, and if we set
+ ;; buf-spec before enabling the mode, buf-spec is lost. 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)
+ (when mastodon-notifications-check-for-updates
+ ;; if a timer has already run but somehow the variable 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:
+ (when (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-updates-interval seconds after opening
+ ;; a new mastodon.el buffer, or effectively only showing an alert if
+ ;; the user stops opening buffers:
+ (unless mastodon-notifications-timer
+ ;; set new timer if we don't have one:
+ (setq mastodon-notifications-timer
+ (run-at-time mastodon-notifications-updates-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.
+
+ ;; (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/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 8c947334cd..a1fe54a800 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -46,7 +46,6 @@
(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")
@@ -572,6 +571,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
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 87b6f5a5bb..2ee37e8c53 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/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"))
@@ -807,8 +809,8 @@ 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 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 +861,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 ()
@@ -1292,9 +1295,13 @@ LINK-TYPE is the type of link to produce."
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 +1433,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
@@ -1530,7 +1542,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)))
@@ -1870,9 +1882,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 +1933,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 :domain :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 +2055,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 +2083,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 +2134,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)))))
@@ -2073,9 +2175,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 +2241,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."
@@ -2174,6 +2298,8 @@ FOLD means to fold it instead."
(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
@@ -3334,11 +3460,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,9 +3474,9 @@ 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
+(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
@@ -3358,7 +3485,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 +3500,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 +3593,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 +3604,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))))))
@@ -3734,9 +3866,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 +3902,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)))
@@ -3886,7 +4017,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 +4039,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/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 463abe3496..34bdccb5c1 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/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")
@@ -241,6 +241,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 +336,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 +358,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
@@ -672,29 +678,29 @@ 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)))
+ (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)))))))))))
(defun mastodon-toot--set-cw (&optional cw)
"Set content warning to CW if it is non-nil."
@@ -734,7 +740,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 +758,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 +940,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 +1016,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,6 +1308,20 @@ 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
@@ -1320,31 +1346,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 +1474,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 +1580,48 @@ 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)."
+
+ ;;
<https://docs.joinmastodon.org/methods/statuses/#form-data-parameters>
+
+ ;; 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)))))
+
;;; SCHEDULE
@@ -1690,26 +1764,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 +1816,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 +1908,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 +1962,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 +2100,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 +2132,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 +2149,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/lisp/mastodon-transient.el b/lisp/mastodon-transient.el
index 3c8b369e16..dbfb182e3b 100644
--- a/lisp/mastodon-transient.el
+++ b/lisp/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/lisp/mastodon.el b/lisp/mastodon.el
index 9ec106889f..90b8afc624 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -6,8 +6,8 @@
;; Author: Johnson Denen <[email protected]>
;; Marty Hiatt <[email protected]>
;; Maintainer: Marty Hiatt <[email protected]>
-;; Version: 2.0.8
-;; Package-Requires: ((emacs "28.1") (persist "0.8") (tp "0.7"))
+;; Version: 2.0.9
+;; 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.
@@ -40,6 +40,7 @@
(eval-when-compile (require 'subr-x))
(require 'url)
(require 'thingatpt)
+(require 'alert)
(require 'shr)
(require 'mastodon-http)
@@ -75,6 +76,7 @@
(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")
;; for M-x visibility
;; (views.el uses `mastodon-mode-map', so we can't easily require it)
@@ -104,6 +106,8 @@
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)
@@ -114,6 +118,9 @@
"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-"
@@ -193,6 +200,32 @@ A count of 2 for example means to display like so: \"Bob,
Jenny
and X others...\"."
:type '(integer))
+(defcustom mastodon-notifications-check-for-updates t
+ "Whether to regularly check for new notifications."
+ :type '(boolean))
+
+(defcustom mastodon-notifications-updates-interval 60
+ "How often to check for new notifications, in seconds."
+ :type '(integer))
+
+(defcustom mastodon-notifications-alerts nil
+ "Whether to enable alert.el alerts."
+ :type '(boolean))
+
+(defcustom mastodon-notifications-alert-style 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"
+ :type
+ `(choice
+ ,@(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)
@@ -229,10 +262,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)
@@ -254,6 +288,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)
@@ -414,13 +449,15 @@ 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."
(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)
@@ -450,9 +487,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
@@ -573,7 +619,10 @@ 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)))
;;;###autoload
(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
diff --git a/mastodon-index.org b/mastodon-index.org
index 8d41afdcde..1f5fca03b3 100644
--- a/mastodon-index.org
+++ b/mastodon-index.org
@@ -98,6 +98,7 @@
| | mastodon-notifications-request-accept | Accept a
notification request for a user. |
| | mastodon-notifications-request-reject | Reject a
notification request for a user. |
| C-S-n | mastodon-notifications-requests | Open a new
buffer displaying the user's notification requests. |
+| | mastodon-notifications-revoke-post-quote | Revoke the
quote of a post from a quote notification. |
| | mastodon-profile-account-bot-toggle | Toggle the
bot status of your account. |
| | mastodon-profile-account-discoverable-toggle | Toggle the
discoverable status of your account. |
| | mastodon-profile-account-locked-toggle | Toggle the
locked status of your account. |
@@ -121,6 +122,7 @@
| | mastodon-profile-remove-from-followers-at-point | Prompt for a
user in the item at point and remove from followers. |
| | mastodon-profile-remove-from-followers-list | Select a
user from your followers and remove from followers. |
| | mastodon-profile-remove-user-from-followers | Remove a
user from your followers. |
+| | mastodon-profile-set-quote-policy | Prompt for a
quote policy and set it in the user's preferences. |
| | mastodon-profile-show-familiar-followers | Show a list
of familiar followers. |
| P | mastodon-profile-show-user | Query for
USER-HANDLE from current status and show that user's profile. |
| | mastodon-profile-update-display-name | Update
display name for your account. |
@@ -142,10 +144,12 @@
| | mastodon-search-trending-statuses | Display a
list of statuses trending on your instance. |
| | mastodon-search-trending-tags | Display a
list of tags trending on your instance. |
| / | mastodon-switch-to-buffer | Switch to a
live mastodon buffer. |
+| | mastodon-tl--change-post-quote-policy | Change the
quote policy of the toot at point. |
| | mastodon-tl-announcements | Display
announcements from your instance. |
| | mastodon-tl-block-domain | Read a
domain and block it. |
| B | mastodon-tl-block-user | Query for
USER-HANDLE from current status and block that user. |
| <mouse-2> | mastodon-tl-click-image-or-video | Click to
play video with `mpv.el'. |
+| | mastodon-tl-continued-thread-load | Load thread
based on prop item-id. |
| C | mastodon-tl-copy-image-caption | Copy the
caption of the image at point. |
| | mastodon-tl-disable-notify-user-posts | Query for
USER-HANDLE and disable notifications when they post. |
| m | mastodon-tl-dm-user | Query for
USER-HANDLE from current status and compose a message to that user. |
@@ -207,7 +211,7 @@
| | mastodon-tl-view-single-toot | View toot at
point in a separate buffer. |
| | mastodon-tl-view-whole-thread | From a
thread view, view entire thread. |
| C-c m t, t | mastodon-toot | Update
instance with new toot. Content is captured in a new buffer. |
-| C-c C-a | mastodon-toot-attach-media | Prompt for
an attachment FILE with DESCRIPTION. |
+| C-c C-a | mastodon-toot-attach-media | Prompt for
an attachment file. |
| o | mastodon-toot-browse-toot-url | Browse URL
of toot at point. |
| C-c C-k | mastodon-toot-cancel | Kill
new-toot buffer/window. Does not POST content. |
| C-c C-v | mastodon-toot-change-visibility | Change the
current visibility to the next valid value. |
@@ -230,12 +234,14 @@
| | mastodon-toot-mode | Minor mode
for composing toots. |
| | mastodon-toot-open-draft-toot | Prompt for a
draft and compose a toot with it. |
| i | mastodon-toot-pin-toot-toggle | Pin or unpin
user's toot at point. |
+| " | mastodon-toot-quote | Compose a
toot quoting the toot at point. |
| r | mastodon-toot-reply | Reply to
toot at `point'. |
| | mastodon-toot-save-draft | Save the
current compose toot text as a draft. |
| C-c C-s | mastodon-toot-schedule-toot | Read a date
(+ time) in the minibuffer and schedule the current toot. |
| C-c C-c | mastodon-toot-send | POST
contents of new-toot buffer to fediverse instance and kill buffer. |
| C-c C-w | mastodon-toot-set-content-warning | Set a
content warning for the current toot. |
| | mastodon-toot-set-default-visibility | Set the
default visibility for toots on the server. |
+| C-c C-u | mastodon-toot-set-quote-policy | Set quote
policy for the current toot. |
| C-c C-l | mastodon-toot-set-toot-language | Prompt for a
language and set `mastodon-toot--language'. |
| k | mastodon-toot-toggle-bookmark | Bookmark or
unbookmark toot at point. |
| b | mastodon-toot-toggle-boost |
Boost/unboost toot at `point'. |
diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el
index 5ce9910534..a9b400464a 100644
--- a/test/mastodon-auth-tests.el
+++ b/test/mastodon-auth-tests.el
@@ -4,6 +4,9 @@
(require 'mastodon)
(require 'mastodon-auth)
+;; NB: since switching to encrypted (client) plstore, some tests fail if
+;; `plistore-encrypt-to' is not set to a working gpg key
+
(ert-deftest mastodon-auth--handle-token-response--good ()
"Should extract the access token from a good response."
(should
diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el
index 83dc106d48..97ac11ce5b 100644
--- a/test/mastodon-client-tests.el
+++ b/test/mastodon-client-tests.el
@@ -4,6 +4,9 @@
(require 'mastodon-client)
(require 'mastodon-http)
+;; NB: since switching to encrypted (client) plstore, some tests fail if
+;; `plistore-encrypt-to' is not set to a working gpg key
+
(ert-deftest mastodon-client--register ()
"Should POST to /apps."
(with-mock
@@ -21,10 +24,10 @@
"Should return client registration JSON."
(with-temp-buffer
(with-mock
- (mock (mastodon-client--register) => (progn
- (insert "\n\n{\"foo\":\"bar\"}")
- (current-buffer)))
- (should (equal (mastodon-client--fetch) '(:foo "bar"))))))
+ (mock (mastodon-client--register) => (progn
+ (insert "\n\n{\"foo\":\"bar\"}")
+ (current-buffer)))
+ (should (equal (mastodon-client--fetch) '(:foo "bar"))))))
;; FIXME: broken by new encrypted plstore flow
;; (asks for gpg passphrase)
@@ -34,9 +37,9 @@
(let ((mastodon-instance-url "http://mastodon.example";)
(plist '(:client_id "id" :client_secret "secret")))
(with-mock
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (mock (mastodon-client--fetch) => plist)
- (should (equal (mastodon-client--store) plist)))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (mock (mastodon-client--fetch) => plist)
+ (should (equal (mastodon-client--store) plist)))
(let* ((plstore (plstore-open "stubfile.plstore"))
(client (mastodon-client--remove-key-from-plstore
(plstore-get plstore "mastodon-http://mastodon.example";))))
@@ -49,43 +52,43 @@
"Should return mastodon client from `mastodon-token-file' if it exists."
(let ((mastodon-instance-url "http://mastodon.example";))
(with-mock
- (mock (mastodon-client--token-file) => "fixture/client.plstore")
- (should (equal (mastodon-client--read)
- '(:client_id "id2" :client_secret "secret2"))))))
+ (mock (mastodon-client--token-file) => "fixture/client.plstore")
+ (should (equal (mastodon-client--read)
+ '(:client_id "id2" :client_secret "secret2"))))))
(ert-deftest mastodon-client--general-read-finds-match ()
(with-mock
- (mock (mastodon-client--token-file) => "fixture/client.plstore")
- (should (equal (mastodon-client--general-read
"[email protected]")
- '(:username "[email protected]"
- :instance "http://mastodon.example";
- :client_id "id2" :client_secret "secret2"
- :access_token "token2")))))
+ (mock (mastodon-client--token-file) => "fixture/client.plstore")
+ (should (equal (mastodon-client--general-read
"[email protected]")
+ '(:username "[email protected]"
+ :instance "http://mastodon.example";
+ :client_id "id2" :client_secret "secret2"
+ :access_token "token2")))))
(ert-deftest mastodon-client--general-read-finds-no-match ()
(with-mock
- (mock (mastodon-client--token-file) => "fixture/client.plstore")
- (should (equal (mastodon-client--general-read "nonexistant-key")
- nil))))
+ (mock (mastodon-client--token-file) => "fixture/client.plstore")
+ (should (equal (mastodon-client--general-read "nonexistant-key")
+ nil))))
(ert-deftest mastodon-client--general-read-empty-store ()
(with-mock
- (mock (mastodon-client--token-file) => "fixture/empty.plstore")
- (should (equal (mastodon-client--general-read "something")
- nil))))
+ (mock (mastodon-client--token-file) => "fixture/empty.plstore")
+ (should (equal (mastodon-client--general-read "something")
+ nil))))
(ert-deftest mastodon-client--read-finds-no-match ()
"Should return mastodon client from `mastodon-token-file' if it exists."
(let ((mastodon-instance-url "http://mastodon.social";))
(with-mock
- (mock (mastodon-client--token-file) => "fixture/client.plstore")
- (should (equal (mastodon-client--read) nil)))))
+ (mock (mastodon-client--token-file) => "fixture/client.plstore")
+ (should (equal (mastodon-client--read) nil)))))
(ert-deftest mastodon-client--read-empty-store ()
"Should return nil if mastodon client is not present in the plstore."
(with-mock
- (mock (mastodon-client--token-file) => "fixture/empty.plstore")
- (should (equal (mastodon-client--read) nil))))
+ (mock (mastodon-client--token-file) => "fixture/empty.plstore")
+ (should (equal (mastodon-client--read) nil))))
(ert-deftest mastodon-client--client-set-and-matching ()
"Should return `mastondon-client' if `mastodon-client--client-details-alist'
is non-nil and instance url is included."
@@ -99,32 +102,32 @@
(let ((mastodon-instance-url "http://mastodon.example";)
(mastodon-client--client-details-alist '(("http://other.example";
:wrong))))
(with-mock
- (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar"))
- (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
- (should (equal mastodon-client--client-details-alist
- '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")
- ("http://other.example"; :wrong)))))))
+ (mock (mastodon-client--read) => '(:client_id "foo" :client_secret
"bar"))
+ (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
+ (should (equal mastodon-client--client-details-alist
+ '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")
+ ("http://other.example"; :wrong)))))))
(ert-deftest mastodon-client--client-unset ()
"Should read from `mastodon-token-file' if available."
(let ((mastodon-instance-url "http://mastodon.example";)
(mastodon-client--client-details-alist nil))
(with-mock
- (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar"))
- (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
- (should (equal mastodon-client--client-details-alist
- '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")))))))
+ (mock (mastodon-client--read) => '(:client_id "foo" :client_secret
"bar"))
+ (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
+ (should (equal mastodon-client--client-details-alist
+ '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")))))))
(ert-deftest mastodon-client--client-unset-and-not-in-storage ()
"Should store client data in plstore if it can't be read."
(let ((mastodon-instance-url "http://mastodon.example";)
(mastodon-client--client-details-alist nil))
(with-mock
- (mock (mastodon-client--read))
- (mock (mastodon-client--store) => '(:client_id "foo" :client_secret
"baz"))
- (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"baz")))
- (should (equal mastodon-client--client-details-alist
- '(("http://mastodon.example"; :client_id "foo"
:client_secret "baz")))))))
+ (mock (mastodon-client--read))
+ (mock (mastodon-client--store) => '(:client_id "foo" :client_secret
"baz"))
+ (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"baz")))
+ (should (equal mastodon-client--client-details-alist
+ '(("http://mastodon.example"; :client_id "foo"
:client_secret "baz")))))))
(ert-deftest mastodon-client--form-user-from-vars ()
(let ((mastodon-active-user "test9000")
@@ -138,13 +141,13 @@
(mastodon-instance-url "https://mastodon.example";))
;; when the current user /is/ the active user
(with-mock
- (mock (mastodon-client--general-read "active-user") => '(:username
"[email protected]" :client_id "id1"))
- (should (equal (mastodon-client--current-user-active-p)
- '(:username "[email protected]" :client_id
"id1"))))
+ (mock (mastodon-client--general-read "active-user") => '(:username
"[email protected]" :client_id "id1"))
+ (should (equal (mastodon-client--current-user-active-p)
+ '(:username "[email protected]" :client_id
"id1"))))
;; when the current user is /not/ the active user
(with-mock
- (mock (mastodon-client--general-read "active-user") => '(:username
"[email protected]" :client_id "id1"))
- (should (null (mastodon-client--current-user-active-p))))))
+ (mock (mastodon-client--general-read "active-user") => '(:username
"[email protected]" :client_id "id1"))
+ (should (null (mastodon-client--current-user-active-p))))))
;; FIXME: broken by new encrypted plstore flow
;; (asks for gpg passphrase)
@@ -161,16 +164,16 @@
;; test if mastodon-client--store-access-token /returns/ right
;; value
(with-mock
- (mock (mastodon-client) => '(:client_id "id" :client_secret "secret"))
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (should (equal (mastodon-client--store-access-token "token")
- user-details)))
+ (mock (mastodon-client) => '(:client_id "id" :client_secret "secret"))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (should (equal (mastodon-client--store-access-token "token")
+ user-details)))
;; test if mastodon-client--store-access-token /stores/ right value
(with-mock
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (should (equal (mastodon-client--general-read
- "[email protected]")
- user-details)))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (should (equal (mastodon-client--general-read
+ "[email protected]")
+ user-details)))
(delete-file "stubfile.plstore")))
;; FIXME: broken by new encrypted plstore flow
@@ -184,8 +187,8 @@
:username "[email protected]"))
(mastodon-auth-use-auth-source nil)) ;; FIXME: test auth source
(with-mock
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (mastodon-client--make-user-active user-details)
- (should (equal (mastodon-client--general-read "active-user")
- user-details)))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (mastodon-client--make-user-active user-details)
+ (should (equal (mastodon-client--general-read "active-user")
+ user-details)))
(delete-file "stubfile.plstore")))
