branch: elpa/mastodon
commit 3eebd4d41b41f8ac948de9948b524fcce1a11ab1
Merge: 317c218eab 319e1d11ed
Author: marty hiatt <[email protected]>
Commit: marty hiatt <[email protected]>
Merge branch 'quote-post' into develop
---
lisp/mastodon-notifications.el | 21 +++-
lisp/mastodon-profile.el | 18 ++++
lisp/mastodon-tl.el | 179 ++++++++++++++++++++++++----------
lisp/mastodon-toot.el | 213 +++++++++++++++++++++++++++++++----------
lisp/mastodon.el | 14 ++-
mastodon-index.org | 8 +-
6 files changed, 345 insertions(+), 108 deletions(-)
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index 58fbf009f3..f5c706d8c3 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -481,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
@@ -862,6 +862,25 @@ Uses `alert.el'."
;; we nil this in `mastodon-notifications-get':
(setq mastodon-notifications-notify-shown 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
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index f95908dc0b..a1fe54a800 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -571,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 6b6b064440..14043e683c 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
@@ -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,89 @@ 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--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))))
+ ;; quote symbol hack:
+ (quotemark (propertize "โ" 'face
+ '( :inherit success :weight bold
+ :height 1.8)))
+ (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':
+ (when (or (string= "pending" state)
+ (string= "accepted" state))
+ (propertize
+ (if-let* ((match (or (assoc "warn" filters)
+ (assoc "hide" filters))))
+ ;; FIXME: "warn" should result in CW, but it should be
+ ;; a CW independent of post CW:
+ (concat "\n\n" quotemark "\n"
+ "Quote hidden due to one of your filters")
+ (concat
+ "\n" quotemark "\n"
+ ;; author byline without horiz bar/stats:
+ (if (string= state "pending")
+ "[quote pending]"
+ (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))))))
+
+;; 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 +2037,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
@@ -1981,11 +2064,8 @@ CW-EXPANDED means treat content warnings as unfolded."
'wrap-prefix bar)
body)
;; insert quote maybe:
- (when (and quote
- (not (string= "deleted" (alist-get 'state quote))))
- (concat "\n\n"
- (mastodon-tl--insert-quoted quote)
- ))))
+ (when 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))
@@ -2036,12 +2116,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)))))
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 68163d3736..9a9a7870cb 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -241,6 +241,9 @@ 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.")
+
(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 +334,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)
@@ -734,7 +738,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 +756,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 +938,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 +1014,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 +1306,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 "Quote policy for this toot: " choice)
+ (mastodon-toot--update-status-fields)))
+
;;; ATTACHMENTS
@@ -1320,31 +1344,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 +1472,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 +1578,50 @@ 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"))
+
+(defvar-local mastodon-toot-quote-id nil)
+
+(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,22 +1764,23 @@ 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)
+(defun mastodon-toot--format-reply-in-compose (reply-text &optional quote-text)
"Format a REPLY-TEXT for display in compose buffer docs."
- (let* ((rendered (mastodon-tl--render-text reply-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.
@@ -1739,15 +1814,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 +1906,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 +1960,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,7 +2098,8 @@ 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.
@@ -2027,9 +2127,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 +2144,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.el b/lisp/mastodon.el
index 42fac384c4..10bcbba54f 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -258,10 +258,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)
@@ -283,6 +284,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)
@@ -443,13 +445,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)
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'. |
