diff options
Diffstat (limited to 'lisp/mastodon-toot.el')
| -rw-r--r-- | lisp/mastodon-toot.el | 137 |
1 files changed, 103 insertions, 34 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index cbcc4f3..2625695 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -41,7 +41,6 @@ (require 'cl-lib) (require 'persist) - (require 'mastodon-iso) (defvar mastodon-instance-url) @@ -77,13 +76,15 @@ (autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") (autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-tl--symbol "mastodon-tl") (autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl") (autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot") (autoload 'org-read-date "org") (autoload 'iso8601-parse "iso8601") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -113,7 +114,6 @@ Used for completion in toot compose buffer." (defcustom mastodon-toot--use-company-for-completion nil "Whether to enable company for completion. - When non-nil, `company-mode' is enabled in the toot compose buffer, and mastodon completion backends are added to `company-capf'. @@ -140,6 +140,16 @@ You need to install company yourself to use this." :group 'mastodon-toot :type 'integer) +(defcustom mastodon-toot--default-reply-visibility "public" + "Default visibility settings when replying. +If the original toot visibility is different we use the more restricted one." + :group 'mastodon-toot + :type '(choice + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) + (defcustom mastodon-toot--enable-custom-instance-emoji nil "Whether to enable your instance's custom emoji by default." :group 'mastodon-toot @@ -160,7 +170,6 @@ You need to install company yourself to use this." (defvar-local mastodon-toot--visibility nil "A string indicating the visibility of the toot being composed. - Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\". @@ -279,13 +288,13 @@ NO-TOOT means we are not calling from a toot buffer." (defun mastodon-toot--action-success (marker byline-region remove) "Insert/remove the text MARKER with 'success face in byline. - BYLINE-REGION is a cons of start and end pos of the byline to be modified. Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((inhibit-read-only t) (bol (car byline-region)) - (eol (cdr byline-region))) + (eol (cdr byline-region)) + (at-byline-p (eq (get-text-property (point) 'byline) t))) (save-excursion (when remove (goto-char bol) @@ -297,9 +306,14 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (goto-char bol) (insert (format "(%s) " (propertize marker 'face 'success))))) - ;; leave point after the marker: - (unless remove - (mastodon-tl--goto-next-toot)))) + (when at-byline-p + ;; leave point after the marker: + (unless remove + ;; if point is inside the byline, back up first so + ;; we don't move to the following toot: + (beginning-of-line) + (forward-line -1) + (mastodon-tl--goto-next-toot))))) (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. @@ -333,7 +347,9 @@ TYPE is a symbol, either 'favourite or 'boost." (msg (if boosted "unboosted" "boosted")) (action-string (if boost-p "boost" "favourite")) (remove (if boost-p (when boosted t) (when faved t))) - (toot-type (alist-get 'type (mastodon-tl--property 'toot-json)))) + (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) + (visibility (mastodon-tl--field 'visibility + (mastodon-tl--property 'toot-json)))) (if byline-region (cond ;; actually there's nothing wrong with faving/boosting own toots! ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) @@ -341,11 +357,14 @@ TYPE is a symbol, either 'favourite or 'boost." ;; & nothing wrong with faving/boosting own toots from notifs: ;; this boosts/faves the base toot, not the notif status ((and (equal "reblog" toot-type) - (not (string= (mastodon-tl--get-endpoint) "notifications"))) + (not (mastodon-tl--buffer-type-eq 'notifications))) (error "You can't %s boosts" action-string)) ((and (equal "favourite" toot-type) - (not (string= (mastodon-tl--get-endpoint) "notifications"))) - (error "Your can't %s favourites" action-string)) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (error "You can't %s favourites" action-string)) + ((and (equal "private" visibility) + (equal type 'boost)) + (error "You can't boost private toots")) (t (mastodon-toot--action action @@ -409,6 +428,40 @@ TYPE is a symbol, either 'favourite or 'boost." (message (format "%s #%s" message id))))) (message (format "Nothing to %s here?!?" action))))) +(defun mastodon-toot--list-toot-boosters () + "List the boosters of toot at point." + (interactive) + (mastodon-toot--list-toot-boosters-or-favers)) + +(defun mastodon-toot--list-toot-favouriters () + "List the favouriters of toot at point." + (interactive) + (mastodon-toot--list-toot-boosters-or-favers :favourite)) + +(defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) + "List the favouriters or boosters of toot at point. +With FAVOURITE, list favouriters, else list boosters." + (let* ((base-toot (mastodon-tl--property 'base-toot-id)) + (endpoint (if favourite "favourited_by" "reblogged_by")) + (url (mastodon-http--api + (format "statuses/%s/%s" base-toot endpoint))) + (params '(("limit" . "80"))) + (json (mastodon-http--get-json url params))) + (if (eq (caar json) 'error) + (error "%s (Status does not exist or is private)" + (alist-get 'error json)) + (let ((handles (mapcar (lambda (x) (alist-get 'acct x)) json)) + (type-string (if favourite "Favouriters" "Boosters"))) + (if (not handles) + (error "Looks like this toot has no %s" type-string) + (let ((choice + (completing-read + (format "%s (enter to view profile): " type-string) + handles + nil + t))) + (mastodon-profile--show-user choice))))))) + (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point. If the toot is a fave/boost notification, copy the URLof the @@ -701,12 +754,11 @@ If media items have been attached and uploaded with If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to instance to edit a toot." (interactive) - (let* ((edit-p (if mastodon-toot--edit-toot-id t nil)) - (toot (mastodon-toot--remove-docs)) + (let* ((toot (mastodon-toot--remove-docs)) (scheduled mastodon-toot--scheduled-for) (scheduled-id mastodon-toot--scheduled-id) (endpoint - (if edit-p + (if mastodon-toot--edit-toot-id ;; we are sending an edit: (mastodon-http--api (format "statuses/%s" mastodon-toot--edit-toot-id)) @@ -722,8 +774,8 @@ instance to edit a toot." (symbol-name t))) ("spoiler_text" . ,spoiler) ("language" . ,mastodon-toot--language)) - ; Pleroma instances can't handle null-valued - ; scheduled_at args, so only add if non-nil + ;; Pleroma instances can't handle null-valued + ;; scheduled_at args, so only add if non-nil (when scheduled `(("scheduled_at" . ,scheduled))))) (args-media (when mastodon-toot--media-attachments (mastodon-http--build-array-params-alist @@ -751,7 +803,7 @@ instance to edit a toot." ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (if edit-p + (let ((response (if mastodon-toot--edit-toot-id ;; we are sending an edit: (mastodon-http--put endpoint args) (mastodon-http--post endpoint args)))) @@ -785,9 +837,9 @@ instance to edit a toot." (toot-language (alist-get 'language toot)) (reply-id (alist-get 'in_reply_to_id toot))) (when (y-or-n-p "Edit this toot? ") - (mastodon-toot--compose-buffer) + (mastodon-toot--compose-buffer nil reply-id nil content :edit) (goto-char (point-max)) - (insert content) + ;; (insert content) ;; adopt reply-to-id, visibility, CW, and language: (mastodon-toot--set-toot-properties reply-id toot-visibility source-cw toot-language) @@ -807,7 +859,8 @@ instance to edit a toot." (defun mastodon-toot--view-toot-edits () "View editing history of the toot at point in a popup buffer." (interactive) - (let ((history (mastodon-tl--property 'edit-history))) + (let ((id (mastodon-tl--property 'base-toot-id)) + (history (mastodon-tl--property 'edit-history))) (with-current-buffer (get-buffer-create "*mastodon-toot-edits*") (let ((inhibit-read-only t)) (special-mode) @@ -828,7 +881,10 @@ instance to edit a toot." (format "Edits to toot by %s:" (alist-get 'username (alist-get 'account (car history)))) - 'face font-lock-comment-face)))))) + 'face font-lock-comment-face)) + (mastodon-tl--set-buffer-spec (buffer-name (current-buffer)) + (format "statuses/%s/history" id) + nil))))) (defun mastodon-toot--insert-toot-iter (it) "Insert iteration IT of toot." @@ -844,16 +900,15 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." (goto-char (cadr config))) (defun mastodon-toot--mentions-to-string (mentions) - "Applies mastodon-toot--process-local function to each mention, -removes empty string (self) from result and joins the sequence with whitespace \" \"." - (mapconcat (lambda(mention) mention) - (remove "" (mapcar (lambda(x) (mastodon-toot--process-local x)) + "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. +Remove empty string (self) from result and joins the sequence with whitespace." + (mapconcat (lambda (mention) mention) + (remove "" (mapcar (lambda (x) (mastodon-toot--process-local x)) mentions)) " ")) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". - Mastodon requires the full @user@domain, even in the case of local accts. eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the mastodon-instance-url). @@ -1348,11 +1403,22 @@ REPLY-TEXT is the text of the toot being replied to." 'read-only "Edit your message below." 'toot-post-header t)))) +(defun mastodon-toot--most-restrictive-visibility (reply-visibility) + "Return REPLY-VISIBILITY or default visibility, whichever is more restrictive. +The default is given by `mastodon-toot--default-reply-visibility'." + (unless (null reply-visibility) + (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) + mastodon-toot-visibility-list))) + (if (member (intern reply-visibility) less-restrictive) + mastodon-toot--default-reply-visibility reply-visibility)))) + (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. REPLY-JSON is the full JSON of the toot being replied to." - (let ((reply-visibility (alist-get 'visibility reply-json)) + (let ((reply-visibility + (mastodon-toot--most-restrictive-visibility + (alist-get 'visibility reply-json))) (reply-cw (alist-get 'spoiler_text reply-json))) (when reply-to-user (insert (format "%s " reply-to-user)) @@ -1516,20 +1582,23 @@ Added to `after-change-functions'." (defun mastodon-toot--compose-buffer-p () "Return t if compose buffer is current." - (equal (buffer-name (current-buffer)) "*new toot*")) + (mastodon-tl--buffer-type-eq 'new-toot)) ;; NB: now that we have toot drafts, to ensure offline composing remains ;; possible, avoid any direct requests here: (defun mastodon-toot--compose-buffer (&optional reply-to-user - reply-to-id reply-json initial-text) + reply-to-id reply-json initial-text + edit) "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." - (let* ((buffer-exists (get-buffer "*new toot*")) - (buffer (or buffer-exists (get-buffer-create "*new toot*"))) +a draft into the buffer. +EDIT means we are editing an existing toot, not composing a new one." + (let* ((buffer-name (if edit "*edit toot*" "*new toot*")) + (buffer-exists (get-buffer buffer-name)) + (buffer (or buffer-exists (get-buffer-create buffer-name))) (inhibit-read-only t) (reply-text (alist-get 'content reply-json)) (previous-window-config (list (current-window-configuration) |