aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authormousebot <mousebot@riseup.net>2021-12-16 14:52:51 +0100
committermousebot <mousebot@riseup.net>2021-12-16 14:52:51 +0100
commita3dd830e4e7b5eddfc21975506fe5461a36c2a89 (patch)
treea7f3dc80903bee7fd7cdff55c6f9e5566b0b9acd /lisp
parent3014e10ec268250a130ac490b5f32b3d263ad21b (diff)
parent7eb4bd98075b70a688701873d8c3488fbedd4c1f (diff)
Merge branch 'develop' into media-type
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-profile.el4
-rw-r--r--lisp/mastodon-tl.el218
-rw-r--r--lisp/mastodon-toot.el18
-rw-r--r--lisp/mastodon.el6
4 files changed, 112 insertions, 134 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 81ab837..7a9edc3 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -68,8 +68,8 @@
;; this way you can update it with C-M-x:
(defvar mastodon-profile-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "O") #'mastodon-profile--open-followers)
- (define-key map (kbd "o") #'mastodon-profile--open-following)
+ (define-key map (kbd "s") #'mastodon-profile--open-followers)
+ (define-key map (kbd "g") #'mastodon-profile--open-following)
(define-key map (kbd "a") #'mastodon-profile--follow-request-accept)
(define-key map (kbd "j") #'mastodon-profile--follow-request-reject)
map)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 9bc7cf2..fbebd69 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -287,13 +287,13 @@ Optionally start from POS."
(propertize (concat "@" handle)
'face 'mastodon-handle-face
'mouse-face 'highlight
- ;; TODO: Replace url browsing with native profile viewing
- 'mastodon-tab-stop 'user-handle
+ ;; TODO: Replace url browsing with native profile viewing
+ 'mastodon-tab-stop 'user-handle
'account account
- 'shr-url profile-url
- 'keymap mastodon-tl--link-keymap
+ 'shr-url profile-url
+ 'keymap mastodon-tl--link-keymap
'mastodon-handle (concat "@" handle)
- 'help-echo (concat "Browse user profile of @" handle))
+ 'help-echo (concat "Browse user profile of @" handle))
")")))
(defun mastodon-tl--byline-boosted (toot)
@@ -696,9 +696,9 @@ message is a link which unhides/hides the main body."
(alist-get 'poll reblog)
(alist-get 'poll toot))))
(concat
+ (mastodon-tl--render-text content toot)
(when poll-p
(mastodon-tl--get-poll toot))
- (mastodon-tl--render-text content toot)
(mastodon-tl--media toot))))
(defun mastodon-tl--insert-status (toot body author-byline action-byline)
@@ -730,16 +730,30 @@ takes a single function. By default it is
"If post TOOT is a poll, return a formatted string of poll."
(let* ((poll (mastodon-tl--field 'poll toot))
(options (mastodon-tl--field 'options poll))
+ (option-titles (mapcar (lambda (x)
+ (alist-get 'title x))
+ options))
+ (longest-option (car (sort option-titles
+ (lambda (x y)
+ (> (length x)
+ (length y))))))
(option-counter 0))
- (concat "Poll: \n\n"
+ (concat "\nPoll: \n\n"
(mapconcat (lambda (option)
(progn
- (format "Option %s: %s, %s votes.\n"
+ (format "Option %s: %s%s [%s votes].\n"
(setq option-counter (1+ option-counter))
(alist-get 'title option)
+ (make-string
+ (1+
+ (- (length longest-option)
+ (length (alist-get 'title
+ option))))
+ ?\ )
(alist-get 'votes_count option))))
options
- "\n") "\n")))
+ "\n")
+ "\n")))
(defun mastodon-tl--poll-vote (option)
"If there is a poll at point, prompt user for OPTION to vote on it."
@@ -941,145 +955,101 @@ webapp"
"Query for USER-HANDLE from current status and follow that user."
(interactive
(list
- (let ((user-handles (mastodon-profile--extract-users-handles
- (mastodon-profile--toot-json))))
- (completing-read "Handle of user to follow: "
- user-handles
- nil ; predicate
- 'confirm))))
- (let* ((account (mastodon-profile--lookup-account-in-status
- user-handle (mastodon-profile--toot-json)))
- (user-id (mastodon-profile--account-field account 'id))
- (name (mastodon-profile--account-field account 'display_name))
- (url (mastodon-http--api (format "accounts/%s/follow" user-id))))
- (if account
- (let ((response (mastodon-http--post url nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (message "User %s (@%s) followed!" name user-handle))))
- (message "Cannot find a user with handle %S" user-handle))))
+ (mastodon-tl--interactive-user-handles-get "follow")))
+ (mastodon-tl--do-user-action-and-response user-handle "follow"))
(defun mastodon-tl--unfollow-user (user-handle)
"Query for USER-HANDLE from current status and unfollow that user."
(interactive
(list
- (let ((user-handles (mastodon-profile--extract-users-handles
- (mastodon-profile--toot-json))))
- (completing-read "Handle of user to unfollow: "
- user-handles
- nil ; predicate
- 'confirm))))
- (let* ((account (mastodon-profile--lookup-account-in-status
- user-handle (mastodon-profile--toot-json)))
- (user-id (mastodon-profile--account-field account 'id))
- (name (mastodon-profile--account-field account 'display_name))
- (url (mastodon-http--api (format "accounts/%s/unfollow" user-id))))
- (if account
- (when (y-or-n-p (format "Unfollow user %s? " name))
- (let ((response (mastodon-http--post url nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (message "User %s (@%s) unfollowed!" name user-handle)))))
- (message "Cannot find a user with handle %S" user-handle))))
+ (mastodon-tl--interactive-user-handles-get "unfollow")))
+ (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))
-(defun mastodon-tl--mute-user (user-handle)
- "Query for USER-HANDLE from current status and mute that user."
+(defun mastodon-tl--block-user (user-handle)
+ "Query for USER-HANDLE from current status and block that user."
(interactive
(list
- (let ((user-handles (mastodon-profile--extract-users-handles
- (mastodon-profile--toot-json))))
- (completing-read "Handle of user to mute: "
- user-handles
- nil ; predicate
- 'confirm))))
- (let* ((account (mastodon-profile--lookup-account-in-status
- user-handle (mastodon-profile--toot-json)))
- (user-id (mastodon-profile--account-field account 'id))
- (name (mastodon-profile--account-field account 'display_name))
- (url (mastodon-http--api (format "accounts/%s/mute" user-id))))
- (if account
- (when (y-or-n-p (format "Mute user %s? " name))
- (let ((response (mastodon-http--post url nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (message "User %s (@%s) muted!" name user-handle)))))
- (message "Cannot find a user with handle %S" user-handle))))
+ (mastodon-tl--interactive-user-handles-get "block")))
+ (mastodon-tl--do-user-action-and-response user-handle "block"))
-(defun mastodon-tl--unmute-user (user-handle)
- "Query for USER-HANDLE from list of muted users and unmute that user."
+(defun mastodon-tl--unblock-user (user-handle)
+ "Query for USER-HANDLE from list of blocked users and unblock that user."
(interactive
(list
- (let* ((mutes-url (mastodon-http--api (format "mutes")))
- (mutes-json (mastodon-http--get-json mutes-url))
- (muted-accts (mapcar (lambda (muted)
- (alist-get 'acct muted))
- mutes-json)))
- (completing-read "Handle of user to unmute: "
- muted-accts
- nil ; predicate
- t))))
- (let* ((account (mastodon-profile--search-account-by-handle
- user-handle))
- (user-id (mastodon-profile--account-field account 'id))
- (name (mastodon-profile--account-field account 'display_name))
- (url (mastodon-http--api (format "accounts/%s/unmute" user-id))))
- (if account
- (when (y-or-n-p (format "Unmute user %s? " name))
- (let ((response (mastodon-http--post url nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (message "User %s (@%s) unmuted!" name user-handle)))))
- (message "Cannot find a user with handle %S" user-handle))))
+ (mastodon-tl--interactive-blocks-or-mutes-list-get "unblock")))
+ (if (not user-handle)
+ (message "Looks like you have no blocks to unblock!")
+ (mastodon-tl--do-user-action-and-response user-handle "unblock" t)))
-(defun mastodon-tl--block-user (user-handle)
- "Query for USER-HANDLE from current status and block that user."
+(defun mastodon-tl--mute-user (user-handle)
+ "Query for USER-HANDLE from current status and mute that user."
(interactive
(list
- (let ((user-handles (mastodon-profile--extract-users-handles
- (mastodon-profile--toot-json))))
- (completing-read "Handle of user to block: "
- user-handles
- nil ; predicate
- 'confirm))))
- (let* ((account (mastodon-profile--lookup-account-in-status
- user-handle (mastodon-profile--toot-json)))
- (user-id (mastodon-profile--account-field account 'id))
- (name (mastodon-profile--account-field account 'display_name))
- (url (mastodon-http--api (format "accounts/%s/block" user-id))))
- (if account
- (when (y-or-n-p (format "Block user %s? " name))
- (let ((response (mastodon-http--post url nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (message "User %s (@%s) blocked!" name user-handle)))))
- (message "Cannot find a user with handle %S" user-handle))))
+ (mastodon-tl--interactive-user-handles-get "mute")))
+ (mastodon-tl--do-user-action-and-response user-handle "mute"))
-(defun mastodon-tl--unblock-user (user-handle)
- "Query for USER-HANDLE from list of blocked users and unblock that user."
+(defun mastodon-tl--unmute-user (user-handle)
+ "Query for USER-HANDLE from list of muted users and unmute that user."
(interactive
(list
- (let* ((blocks-url (mastodon-http--api (format "blocks")))
- (blocks-json (mastodon-http--get-json blocks-url))
- (blocked-accts (mapcar (lambda (blocked)
- (alist-get 'acct blocked))
- blocks-json)))
- (completing-read "Handle of user to unblock: "
- blocked-accts
+ (mastodon-tl--interactive-blocks-or-mutes-list-get "unmute")))
+ (if (not user-handle)
+ (message "Looks like you have no mutes to unmute!")
+ (mastodon-tl--do-user-action-and-response user-handle "unmute" t)))
+
+(defun mastodon-tl--interactive-user-handles-get (action)
+ "Get the list of user-handles for ACTION from the current toot."
+ (let ((user-handles (mastodon-profile--extract-users-handles
+ (mastodon-profile--toot-json))))
+ (completing-read (format "Handle of user to %s: " action)
+ user-handles
+ nil ; predicate
+ 'confirm)))
+
+(defun mastodon-tl--interactive-blocks-or-mutes-list-get (action)
+ "Fetch the list of accounts for ACTION from the server.
+Action must be either \"unblock\" or \"mute\"."
+ (let* ((endpoint (cond ((equal action "unblock")
+ "blocks")
+ ((equal action "unmute")
+ "mutes")))
+ (url (mastodon-http--api endpoint))
+ (json (mastodon-http--get-json url))
+ (accts (mapcar (lambda (user)
+ (alist-get 'acct user))
+ json)))
+ (when accts
+ (completing-read (format "Handle of user to %s: " action)
+ accts
nil ; predicate
t))))
- (let* ((account (mastodon-profile--search-account-by-handle
- user-handle))
+
+(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp)
+ "Do ACTION on user NAME/USER-HANDLE.
+NEGP is whether the action involves un-doing something."
+ (let* ((account (if negp
+ ;; TODO check if both are actually needed
+ (mastodon-profile--search-account-by-handle
+ user-handle)
+ (mastodon-profile--lookup-account-in-status
+ user-handle (mastodon-profile--toot-json))))
(user-id (mastodon-profile--account-field account 'id))
(name (mastodon-profile--account-field account 'display_name))
- (url (mastodon-http--api (format "accounts/%s/unblock" user-id))))
+ (url (mastodon-http--api (format "accounts/%s/%s" user-id action))))
(if account
- (when (y-or-n-p (format "Unblock user %s? " name))
- (let ((response (mastodon-http--post url nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (message "User %s (@%s) unblocked!" name user-handle)))))
+ (if (equal action "follow") ; y-or-n for all but follow
+ (mastodon-tl--do-user-action-function url name user-handle action)
+ (when (y-or-n-p (format "%s user %s? " action name))
+ (mastodon-tl--do-user-action-function url name user-handle action)))
(message "Cannot find a user with handle %S" user-handle))))
+(defun mastodon-tl--do-user-action-function (url name user-handle action)
+ "Post ACTION on user NAME/USER-HANDLE to URL."
+ (let ((response (mastodon-http--post url nil nil)))
+ (mastodon-http--triage response
+ (lambda ()
+ (message "User %s (@%s) %sed!" name user-handle action)))))
+
;; TODO: add this to new posts in some cases, e.g. in thread view.
(defun mastodon-tl--reload-timeline-or-profile ()
"Reload the current timeline or profile page.
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 885db1d..cb3cd44 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -106,6 +106,11 @@ This is only used if company mode is installed."
(const :tag "following only" "following")
(const :tag "all users" "all")))
+(defcustom mastodon-toot--enable-custom-instance-emoji nil
+ "Whether to enable your instance's custom emoji by default."
+ :group 'mastodon-toot
+ :type 'boolean)
+
(defvar-local mastodon-toot--content-warning nil
"A flag whether the toot should be marked with a content warning.")
@@ -519,10 +524,11 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
(defun mastodon-toot--mentions-company-candidates (prefix)
"Given a company PREFIX query, build a list of candidates.
The prefix can match against both user handles and display names."
- (let (res)
+ (let ((prefix (substring prefix 1)) ;remove @ for search
+ (res))
(dolist (item (mastodon-search--search-accounts-query prefix))
- (when (or (string-prefix-p prefix (cadr item))
- (string-prefix-p prefix (car item)))
+ (when (or (string-prefix-p prefix (substring (cadr item) 1) t)
+ (string-prefix-p prefix (car item) t))
(push (mastodon-toot--mentions-company-make-candidate item) res)))
res))
@@ -533,11 +539,11 @@ The prefix can match against both user handles and display names."
(url (caddr candidate)))
(propertize handle 'annot display-name 'meta url)))
-(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored)
+(defun mastodon-toot-mentions (command &optional arg &rest ignored)
"A company completion backend for toot mentions."
(interactive (list 'interactive))
(cl-case command
- (interactive (company-begin-backend 'mastodon-toot--mentions-completion))
+ (interactive (company-begin-backend 'mastodon-toot-mentions))
(prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode
(save-excursion
(forward-whitespace -1)
@@ -856,7 +862,7 @@ REPLY-JSON is the full JSON of the toot being replied to."
(when (require 'company nil :noerror)
(when mastodon-toot--enable-completion-for-mentions
(set (make-local-variable 'company-backends)
- (add-to-list 'company-backends 'mastodon-toot--mentions-completion))
+ (add-to-list 'company-backends 'mastodon-toot-mentions))
(company-mode-on)))
(make-local-variable 'after-change-functions)
(push #'mastodon-toot--update-status-fields after-change-functions)
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 826787a..662b691 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -145,7 +145,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user)
(define-key map (kbd "M") #'mastodon-tl--mute-user)
(define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user)
- (define-key map (kbd "C-S-P") #'mastodon-profile--my-profile)
+ (define-key map (kbd "O") #'mastodon-profile--my-profile)
(define-key map (kbd "S") #'mastodon-search--search-query)
(define-key map (kbd "d") #'mastodon-toot--delete-toot)
(define-key map (kbd "D") #'mastodon-toot--delete-and-redraft-toot)
@@ -223,7 +223,9 @@ If REPLY-JSON is the json of the toot being replied to."
;;;###autoload
(add-hook 'mastodon-mode-hook (lambda ()
(when (require 'emojify nil :noerror)
- (emojify-mode t))))
+ (emojify-mode t)
+ (when mastodon-toot--enable-custom-instance-emoji
+ (mastodon-toot--enable-custom-emoji)))))
(define-derived-mode mastodon-mode special-mode "Mastodon"
"Major mode for Mastodon, the federated microblogging network."