aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authormousebot <mousebot@riseup.net>2021-12-17 14:26:03 +0100
committermousebot <mousebot@riseup.net>2021-12-17 14:26:03 +0100
commitbb9e8ab828cf249ce8fd23a47fe4e75ee9ab61c7 (patch)
tree76be863aeb318606a195a5fe913fd6c15f825ab7 /lisp
parent2d8337af15b2b0c988df13cea4cb31c944b21aac (diff)
parentc65c6231f29929b6e39ebcc9b866d492519ae19b (diff)
Merge branch 'develop'
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-async.el54
-rw-r--r--lisp/mastodon-auth--test.el47
-rw-r--r--lisp/mastodon-auth.el24
-rw-r--r--lisp/mastodon-discover.el17
-rw-r--r--lisp/mastodon-http.el157
-rw-r--r--lisp/mastodon-inspect.el39
-rw-r--r--lisp/mastodon-media.el68
-rw-r--r--lisp/mastodon-notifications.el126
-rw-r--r--lisp/mastodon-profile.el120
-rw-r--r--lisp/mastodon-search.el130
-rw-r--r--lisp/mastodon-tl.el478
-rw-r--r--lisp/mastodon-toot.el595
-rw-r--r--lisp/mastodon.el42
13 files changed, 1186 insertions, 711 deletions
diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el
index 6a421d1..524e13d 100644
--- a/lisp/mastodon-async.el
+++ b/lisp/mastodon-async.el
@@ -30,8 +30,14 @@
;;; Code:
(require 'json)
+(require 'url-http)
+(autoload 'mastodon-auth--access-token "mastodon-auth")
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-notifications--timeline "mastodon-notifications")
+(autoload 'mastodon-tl--timeline "mastodon-tl")
(defgroup mastodon-async nil
"An async module for mastodon streams."
@@ -49,17 +55,14 @@
(defvar mastodon-tl--display-media-p)
(defvar mastodon-tl--buffer-spec)
-(make-variable-buffer-local
- (defvar mastodon-async--queue "" ;;"*mastodon-async-queue*"
- "The intermediate queue buffer name."))
+(defvar-local mastodon-async--queue "" ;;"*mastodon-async-queue*"
+ "The intermediate queue buffer name.")
-(make-variable-buffer-local
- (defvar mastodon-async--buffer "" ;;"*mastodon-async-buffer*"
- "User facing output buffer name."))
+(defvar-local mastodon-async--buffer "" ;;"*mastodon-async-buffer*"
+ "User facing output buffer name.")
-(make-variable-buffer-local
- (defvar mastodon-async--http-buffer "" ;;""
- "Buffer variable bound to http output."))
+(defvar-local mastodon-async--http-buffer "" ;;""
+ "Buffer variable bound to http output.")
(defun mastodon-async--display-http ()
"Display the async HTTP input buffer."
@@ -129,7 +132,9 @@
Then start an async stream at ENDPOINT filtering toots
using FILTER.
TIMELINE is a specific target, such as federated or home.
-NAME is the center portion of the buffer name for *mastodon-async-buffer and *mastodon-async-queue."
+NAME is the center portion of the buffer name for
+*mastodon-async-buffer and *mastodon-async-queue."
+ (ignore timeline) ;; TODO: figure out what this is meant to be used for
(let ((buffer (mastodon-async--start-process
endpoint filter name)))
(with-current-buffer buffer
@@ -172,16 +177,16 @@ is not known when `mastodon-async--setup-buffer' is called."
NAME is used to generate the display buffer and the queue."
(let ((queue-name (concat " *mastodon-async-queue-" name "-"
- mastodon-instance-url "*"))
+ mastodon-instance-url "*"))
(buffer-name (concat "*mastodon-async-display-" name "-"
- mastodon-instance-url "*")))
+ mastodon-instance-url "*")))
(mastodon-async--set-local-variables http-buffer http-buffer
buffer-name queue-name)))
(defun mastodon-async--setup-queue (http-buffer name)
"Sets up the buffer for the async queue."
(let ((queue-name (concat " *mastodon-async-queue-" name "-"
- mastodon-instance-url "*"))
+ mastodon-instance-url "*"))
(buffer-name(concat "*mastodon-async-display-" name "-"
mastodon-instance-url "*")))
(mastodon-async--set-local-variables queue-name http-buffer
@@ -198,11 +203,12 @@ ENPOINT is the endpoint for the stream and timeline."
mastodon-instance-url "*"))
(buffer-name (concat "*mastodon-async-display-" name "-"
mastodon-instance-url "*"))
- ;; if user stream, we need "timelines/home" not "timelines/user"
- ;; if notifs, we need "notifications" not "timelines/notifications"
- (endpoint (if (equal name "notifications") "notifications"
- (if (equal name "home") "timelines/home"
- (format "timelines/%s" endpoint)))))
+ ;; if user stream, we need "timelines/home" not "timelines/user"
+ ;; if notifs, we need "notifications" not "timelines/notifications"
+ (endpoint (cond
+ ((equal name "notifications") "notifications")
+ ((equal name "home") "timelines/home")
+ (t (format "timelines/%s" endpoint)))))
(mastodon-async--set-local-variables buffer-name http-buffer
buffer-name queue-name)
;; Similar to timeline init.
@@ -238,7 +244,9 @@ Filter the toots using FILTER."
(async-buffer (mastodon-async--setup-buffer "" (or name stream) endpoint))
(http-buffer (mastodon-async--get
(mastodon-http--api stream)
- (lambda (status) (message "HTTP SOURCE CLOSED")))))
+ (lambda (status)
+ (ignore status)
+ (message "HTTP SOURCE CLOSED")))))
(mastodon-async--setup-http http-buffer (or name stream))
(mastodon-async--set-http-buffer async-buffer http-buffer)
(mastodon-async--set-http-buffer async-queue http-buffer)
@@ -278,8 +286,8 @@ Filter the toots using FILTER."
;; NB notification events in streams include follow requests
(let* ((split-strings (split-string string "\n" t))
(event-type (replace-regexp-in-string
- "^event: " ""
- (car split-strings)))
+ "^event: " ""
+ (car split-strings)))
(data (replace-regexp-in-string
"^data: " "" (cadr split-strings))))
(when (equal "notification" event-type)
@@ -297,8 +305,8 @@ Filter the toots using FILTER."
(defun mastodon-async--account-local-p (json)
"Test JSON to see if account is local."
(not (string-match-p
- "@"
- (cdr (assoc 'acct (cdr (assoc 'account json)))))))
+ "@"
+ (alist-get 'acct (alist-get 'account json)))))
(defun mastodon-async--output-toot (toot)
"Process TOOT and prepend it to the async user-facing buffer."
diff --git a/lisp/mastodon-auth--test.el b/lisp/mastodon-auth--test.el
deleted file mode 100644
index 9a765b9..0000000
--- a/lisp/mastodon-auth--test.el
+++ /dev/null
@@ -1,47 +0,0 @@
-;;; mastodon-auth--test.el --- Tests for mastodon-auth -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020 Ian Eure
-
-;; Author: Ian Eure <ian@retrospec.tv>
-;; Version: 0.9.1
-;; Homepage: https://github.com/jdenen/mastodon.el
-;; Package-Requires: ((emacs "26.1"))
-
-;; This file is not part of GNU Emacs.
-
-;; This file is part of mastodon.el.
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; mastodon-auth--test.el provides ERT tests for mastodon-auth.el
-
-;;; Code:
-
-(require 'ert)
-
-(ert-deftest mastodon-auth--handle-token-response--good ()
- (should (string= "foo" (mastodon-auth--handle-token-response '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0)))))
-
-(ert-deftest mastodon-auth--handle-token-response--unknown ()
- :expected-result :failed
- (mastodon-auth--handle-token-response '(:herp "derp")))
-
-(ert-deftest mastodon-auth--handle-token-response--failure ()
- :expected-result :failed
- (mastodon-auth--handle-token-response '(:error "invalid_grant" :error_description "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client.")))
-
-(provide 'mastodon-auth--test)
-;;; mastodon-auth--test.el ends here
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index 0b0c703..8d0d7c6 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -63,7 +63,10 @@ if you are happy with unencryped storage use e.g. \"~/authinfo\"."
(defun mastodon-auth--generate-token ()
"Make POST to generate auth token.
-If no auth-sources file, runs `mastodon-auth--generate-token-no-storing-credentials'. If auth-sources file exists, runs `mastodon-auth--generate-token-and-store'."
+If no auth-sources file, runs
+`mastodon-auth--generate-token-no-storing-credentials'. If
+auth-sources file exists, runs
+`mastodon-auth--generate-token-and-store'."
(if (or (null mastodon-auth-source-file)
(string= "" mastodon-auth-source-file))
(mastodon-auth--generate-token-no-storing-credentials)
@@ -124,12 +127,15 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'."
(json-read-from-string json-string))))
(defun mastodon-auth--access-token ()
- "If an access token for `mastodon-instance-url' is in `mastodon-auth--token-alist', return it.
+ "Return exiting or generate new access token.
-Otherwise, generate a token and pass it to `mastodon-auth--handle-token-reponse'."
+If an access token for `mastodon-instance-url' is in
+`mastodon-auth--token-alist', return it.
+
+Otherwise, generate a token and pass it to
+`mastodon-auth--handle-token-reponse'."
(if-let ((token (cdr (assoc mastodon-instance-url mastodon-auth--token-alist))))
token
-
(mastodon-auth--handle-token-response (mastodon-auth--get-token))))
(defun mastodon-auth--handle-token-response (response)
@@ -151,11 +157,11 @@ Handle any errors from the server."
(defun mastodon-auth--get-account-name ()
"Request user credentials and return an account name."
- (cdr (assoc
- 'acct
- (mastodon-http--get-json
- (mastodon-http--api
- "accounts/verify_credentials")))))
+ (alist-get
+ 'acct
+ (mastodon-http--get-json
+ (mastodon-http--api
+ "accounts/verify_credentials"))))
(defun mastodon-auth--user-acct ()
"Return a mastodon user acct name."
diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el
index 8c47fbd..33ce3d5 100644
--- a/lisp/mastodon-discover.el
+++ b/lisp/mastodon-discover.el
@@ -49,7 +49,7 @@
("A" "View profile of author" mastodon-profile--get-toot-author)
("b" "Boost" mastodon-toot--boost)
("f" "Favourite" mastodon-toot--favourite)
- ("c" "Toggle hidden text" mastodon-tl--toggle-spoiler-text-in-toot)
+ ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot)
("n" "Next" mastodon-tl--goto-next-toot)
("p" "Prev" mastodon-tl--goto-prev-toot)
("TAB" "Next link item" mastodon-tl--next-tab-item)
@@ -58,18 +58,22 @@
("r" "Reply" mastodon-toot--reply)
("C" "Copy toot URL" mastodon-toot--copy-toot-url)
("d" "Delete (your) toot" mastodon-toot--delete-toot)
+ ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot)
("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle)
("P" "View user profile" mastodon-profile--show-user)
- ("T" "View thread" mastodon-tl--thread))
+ ("T" "View thread" mastodon-tl--thread)
+ ("v" "Vote on poll" mastodon-tl--poll-vote))
("Timelines"
- ("#" "Tag" mastodon-tl--get-tag-timeline)
+ ("h" "View mode help/keybindings" describe-mode)
+ ("#" "Tag search" mastodon-tl--get-tag-timeline)
("F" "Federated" mastodon-tl--get-federated-timeline)
("H" "Home" mastodon-tl--get-home-timeline)
("L" "Local" mastodon-tl--get-local-timeline)
("N" "Notifications" mastodon-notifications--get)
("u" "Update timeline" mastodon-tl--update)
("S" "Search" mastodon-search--search-query)
- ("C-S-P" "Jump to my profile" mastodon-profile--my-profile))
+ ("C-S-P" "Jump to your profile" mastodon-profile--my-profile)
+ ("K" "View bookmarks" mastodon-profile--view-bookmarks))
("Users"
("W" "Follow" mastodon-tl--follow-user)
("C-S-W" "Unfollow" mastodon-tl--unfollow-user)
@@ -86,10 +90,11 @@
("Profile view"
("o" "Show following" mastodon-profile--open-following)
("O" "Show followers" mastodon-profile--open-followers)
- ("v" "View favourites" mastodon-profile--view-favourites)
+
("R" "View follow requests" mastodon-profile--view-follow-requests)
("a" "Accept follow request" mastodon-profile--follow-request-accept)
- ("r" "Reject follow request" mastodon-profile--follow-request-reject))
+ ("j" "Reject follow request" mastodon-profile--follow-request-reject)
+ ("U" "Update your profile note" mastodon-profile--update-user-profile-note))
("Quit"
("q" "Quit mastodon and bury buffer." kill-this-buffer)
("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window)))))))
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 2d91840..a4f126f 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Version: 0.9.1
-;; Package-Requires: ((emacs "26.1") (request "0.2.0"))
+;; Package-Requires: ((emacs "27.1") (request "0.2.0"))
;; Homepage: https://github.com/jdenen/mastodon.el
;; This file is not part of GNU Emacs.
@@ -46,7 +46,7 @@
"HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.")
(defun mastodon-http--api (endpoint)
- "Return Mastondon API URL for ENDPOINT."
+ "Return Mastodon API URL for ENDPOINT."
(concat mastodon-instance-url "/api/"
mastodon-http--api-version "/" endpoint))
@@ -67,15 +67,15 @@
(string-match "[0-9][0-9][0-9]" status-line)
(match-string 0 status-line)))
-;; (defun mastodon-http--triage (response success)
-;; "Determine if RESPONSE was successful. Call SUCCESS if successful.
+(defun mastodon-http--url-retrieve-synchronously (url)
+ "Retrieve URL asynchronously.
-;; Open RESPONSE buffer if unsuccessful."
-;; (let ((status (with-current-buffer response
-;; (mastodon-http--status))))
-;; (if (string-prefix-p "2" status)
-;; (funcall success)
-;; (switch-to-buffer response))))
+This is a thin abstraction over the system
+`url-retrieve-synchronously`. Depending on which version of this
+is available we will call it with or without a timeout."
+ (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
+ (url-retrieve-synchronously url)
+ (url-retrieve-synchronously url nil nil mastodon-http--timeout)))
(defun mastodon-http--triage (response success)
"Determine if RESPONSE was successful. Call SUCCESS if successful.
@@ -85,10 +85,15 @@ Message status and JSON error from RESPONSE if unsuccessful."
(mastodon-http--status))))
(if (string-prefix-p "2" status)
(funcall success)
- (progn
- (switch-to-buffer response)
- (let ((json-response (mastodon-http--process-json)))
- (message "Error %s: %s" status (cdr (assoc 'error json-response))))))))
+ (switch-to-buffer response)
+ (let ((json-response (mastodon-http--process-json)))
+ (message "Error %s: %s" status (alist-get 'error json-response))))))
+
+(defun mastodon-http--read-file-as-string (filename)
+ "Read a file FILENAME as a string. Used to generate image preview."
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (string-to-unibyte (buffer-string))))
(defun mastodon-http--post (url args headers &optional unauthenticed-p)
"POST synchronously to URL with ARGS and HEADERS.
@@ -109,9 +114,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
`(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))
headers)))
(with-temp-buffer
- (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
- (url-retrieve-synchronously url)
- (url-retrieve-synchronously url nil nil mastodon-http--timeout)))))
+ (mastodon-http--url-retrieve-synchronously url))))
(defun mastodon-http--get (url)
"Make synchronous GET request to URL.
@@ -121,9 +124,7 @@ Pass response buffer to CALLBACK function."
(url-request-extra-headers
`(("Authorization" . ,(concat "Bearer "
(mastodon-auth--access-token))))))
- (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
- (url-retrieve-synchronously url)
- (url-retrieve-synchronously url nil nil mastodon-http--timeout))))
+ (mastodon-http--url-retrieve-synchronously url)))
(defun mastodon-http--get-json (url)
"Make synchronous GET request to URL. Return JSON response."
@@ -139,8 +140,8 @@ Pass response buffer to CALLBACK function."
(buffer-substring-no-properties (point) (point-max))
'utf-8)))
(kill-buffer)
- (unless (or (string= "" json-string) (equal nil json-string)))
- (json-read-from-string json-string)))
+ (unless (or (string-equal "" json-string) (null json-string))
+ (json-read-from-string json-string))))
(defun mastodon-http--delete (url)
"Make DELETE request to URL."
@@ -149,7 +150,7 @@ Pass response buffer to CALLBACK function."
`(("Authorization" . ,(concat "Bearer "
(mastodon-auth--access-token))))))
(with-temp-buffer
- (url-retrieve-synchronously url))))
+ (mastodon-http--url-retrieve-synchronously url))))
;; search functions:
(defun mastodon-http--process-json-search ()
@@ -163,24 +164,25 @@ Pass response buffer to CALLBACK function."
(kill-buffer)
(json-read-from-string json-string)))
-(defun mastodon-http--get-search-json (url query)
- "Make GET request to URL, searching for QUERY and return JSON response."
- (let ((buffer (mastodon-http--get-search url query)))
+(defun mastodon-http--get-search-json (url query &optional param)
+ "Make GET request to URL, searching for QUERY and return JSON response.
+PARAM is any extra parameters to send with the request."
+ (let ((buffer (mastodon-http--get-search url query param)))
(with-current-buffer buffer
(mastodon-http--process-json-search))))
-(defun mastodon-http--get-search (base-url query)
+(defun mastodon-http--get-search (base-url query &optional param)
"Make GET request to BASE-URL, searching for QUERY.
-
-Pass response buffer to CALLBACK function."
+Pass response buffer to CALLBACK function.
+PARAM is a formatted request parameter, eg 'following=true'."
(let ((url-request-method "GET")
- (url (concat base-url "?q=" (url-hexify-string query)))
+ (url (if param
+ (concat base-url "?" param "&q=" (url-hexify-string query))
+ (concat base-url "?q=" (url-hexify-string query))))
(url-request-extra-headers
`(("Authorization" . ,(concat "Bearer "
(mastodon-auth--access-token))))))
- (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
- (url-retrieve-synchronously url)
- (url-retrieve-synchronously url nil nil mastodon-http--timeout))))
+ (mastodon-http--url-retrieve-synchronously url)))
;; profile update functions
@@ -201,9 +203,7 @@ Pass response buffer to CALLBACK function."
(url-request-extra-headers
`(("Authorization" . ,(concat "Bearer "
(mastodon-auth--access-token))))))
- (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
- (url-retrieve-synchronously url)
- (url-retrieve-synchronously url nil nil mastodon-http--timeout))))
+ (mastodon-http--url-retrieve-synchronously url)))
;; Asynchronous functions
@@ -214,7 +214,7 @@ Pass response buffer to CALLBACK function with args CBARGS."
(url-request-extra-headers
`(("Authorization" . ,(concat "Bearer "
(mastodon-auth--access-token))))))
- (url-retrieve url callback cbargs mastodon-http--timeout)))
+ (url-retrieve url callback cbargs)))
(defun mastodon-http--get-json-async (url &optional callback &rest args)
"Make GET request to URL. Call CALLBACK with json-vector and ARGS."
@@ -239,52 +239,57 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
args
"&")))
(url-request-extra-headers
- (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))
- headers)))
+ (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))
+ headers)))
(with-temp-buffer
- (url-retrieve url callback cbargs mastodon-http--timeout))))
+ (url-retrieve url callback cbargs))))
;; TODO: test for curl first?
(defun mastodon-http--post-media-attachment (url filename caption)
"Make POST request to upload FILENAME with CAPTION to the server's media URL.
-The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, and `mastodon-toot--update-status-fields' is run."
+The upload is asynchronous. On succeeding,
+`mastodon-toot--media-attachment-ids' is set to the id(s) of the
+item uploaded, and `mastodon-toot--update-status-fields' is run."
(let* ((file (file-name-nondirectory filename))
(request-backend 'curl))
- ;; (response
- (request
- url
- :type "POST"
- :params `(("description" . ,caption))
- :files `(("file" . (,file :file ,filename
- :mime-type "multipart/form-data")))
- :parser 'json-read
- :headers `(("Authorization" . ,(concat "Bearer "
- (mastodon-auth--access-token))))
- :sync nil
- :success (cl-function
- (lambda (&key data &allow-other-keys)
- (when data
- (progn
- (push (cdr (assoc 'id data))
- mastodon-toot--media-attachment-ids) ; add ID to list
- (push file mastodon-toot--media-attachment-filenames)
- (message "%s file %s with id %S and caption '%s' uploaded!"
- (capitalize (cdr (assoc 'type data)))
- file
- (cdr (assoc 'id data))
- (cdr (assoc 'description data)))
- (mastodon-toot--update-status-fields)))))
- :error (cl-function
- (lambda (&key error-thrown &allow-other-keys)
- (message "%s" (car (last error-thrown)))
- (message "%s" (type-of (car (last error-thrown))))
- (cond ((= (car (last error-thrown)) 401)
- (message "Got error: %s Unauthorized: The access token is invalid" error-thrown))
- ((= (car (last error-thrown)) 422)
- (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown))
- (t
- (message "Got error: %s Shit went south"
- error-thrown))))))))
+ (request
+ url
+ :type "POST"
+ :params `(("description" . ,caption))
+ :files `(("file" . (,file :file ,filename
+ :mime-type "multipart/form-data")))
+ :parser 'json-read
+ :headers `(("Authorization" . ,(concat "Bearer "
+ (mastodon-auth--access-token))))
+ :sync nil
+ :success (cl-function
+ (lambda (&key data &allow-other-keys)
+ (when data
+ (push (alist-get 'id data)
+ mastodon-toot--media-attachment-ids) ; add ID to list
+ (message "%s file %s with id %S and caption '%s' uploaded!"
+ (capitalize (alist-get 'type data))
+ file
+ (alist-get 'id data)
+ (alist-get 'description data))
+ (mastodon-toot--update-status-fields))))
+ :error (cl-function
+ (lambda (&key error-thrown &allow-other-keys)
+ (cond
+ ;; handle curl errors first (eg 26, can't read file/path)
+ ;; because the '=' test below fails for them
+ ;; they have the form (error . error message 24)
+ ((not (proper-list-p error-thrown)) ; not dotted list
+ (message "Got error: %s. Shit went south." (cdr error-thrown)))
+ ;; handle mastodon api errors
+ ;; they have the form (error http 401)
+ ((= (car (last error-thrown)) 401)
+ (message "Got error: %s Unauthorized: The access token is invalid" error-thrown))
+ ((= (car (last error-thrown)) 422)
+ (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown))
+ (t
+ (message "Got error: %s Shit went south"
+ error-thrown))))))))
(provide 'mastodon-http)
;;; mastodon-http.el ends here
diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el
index 9559b21..57240f3 100644
--- a/lisp/mastodon-inspect.el
+++ b/lisp/mastodon-inspect.el
@@ -30,12 +30,15 @@
;;; Code:
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--get-search-json "mastodon-http")
(autoload 'mastodon-media--inline-images "mastodon-media")
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-tl--as-string "mastodon-tl")
(autoload 'mastodon-tl--property "mastodon-tl")
(autoload 'mastodon-tl--toot "mastodon-tl")
+(defvar mastodon-instance-url)
+
(defgroup mastodon-inspect nil
"Tools to help inspect toots."
:prefix "mastodon-inspect-"
@@ -59,7 +62,7 @@
(concat "*mastodon-inspect-toot-"
(mastodon-tl--as-string (mastodon-tl--property 'toot-id))
"*")
- (mastodon-tl--property 'toot-json)))
+ (mastodon-tl--property 'toot-json)))
(defun mastodon-inspect--download-single-toot (toot-id)
"Download the toot/status represented by TOOT-ID."
@@ -69,7 +72,7 @@
(defun mastodon-inspect--view-single-toot (toot-id)
"View the toot/status represented by TOOT-ID."
(interactive "s Toot ID: ")
- (let ((buffer (get-buffer-create(concat "*mastodon-status-" toot-id "*"))))
+ (let ((buffer (get-buffer-create (concat "*mastodon-status-" toot-id "*"))))
(with-current-buffer buffer
(let ((toot (mastodon-inspect--download-single-toot toot-id )))
(mastodon-tl--toot toot)
@@ -87,5 +90,37 @@
(concat "*mastodon-status-raw-" toot-id "*")
(mastodon-inspect--download-single-toot toot-id)))
+
+(defvar mastodon-inspect--search-query-accounts-result)
+(defvar mastodon-inspect--single-account-json)
+
+(defvar mastodon-inspect--search-query-full-result)
+(defvar mastodon-inspect--search-result-tags)
+
+(defun mastodon-inspect--get-search-result (query)
+ (interactive)
+ (setq mastodon-inspect--search-query-full-result
+ (append ; convert vector to list
+ (mastodon-http--get-search-json
+ (format "%s/api/v2/search" mastodon-instance-url)
+ query)
+ nil))
+ (setq mastodon-inspect--search-result-tags
+ (append (cdr
+ (caddr mastodon-inspect--search-query-full-result))
+ nil)))
+
+(defun mastodon-inspect--get-search-account (query)
+ (interactive)
+ (setq mastodon-inspect--search-query-accounts-result
+ (append ; convert vector to list
+ (mastodon-http--get-search-json
+ (format "%s/api/v1/accounts/search" mastodon-instance-url)
+ query)
+ nil))
+ (setq mastodon-inspect--single-account-json
+ (car mastodon-inspect--search-query-accounts-result)))
+
+
(provide 'mastodon-inspect)
;;; mastodon-inspect.el ends here
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index b58eab6..457628f 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -32,6 +32,8 @@
;; required by the server and client.
;;; Code:
+(require 'url-cache)
+
(defvar url-show-status)
(defvar mastodon-tl--shr-image-map-replacement)
@@ -47,10 +49,15 @@
:type 'integer)
(defcustom mastodon-media--preview-max-height 250
- "Max height of any media attachment preview to be shown."
+ "Max height of any media attachment preview to be shown in timelines."
:group 'mastodon-media
:type 'integer)
+(defcustom mastodon-media--enable-image-caching nil
+ "Whether images should be cached."
+ :group 'mastodon-media
+ :type 'boolean)
+
(defvar mastodon-media--generic-avatar-data
(base64-decode-string
"iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
@@ -130,13 +137,14 @@ fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=")
"The PNG data for a generic 200x200 'broken image' view.")
(defun mastodon-media--process-image-response
- (status-plist marker image-options region-length)
+ (status-plist marker image-options region-length url)
"Callback function processing the url retrieve response for URL.
STATUS-PLIST is the usual plist of status events as per `url-retrieve'.
IMAGE-OPTIONS are the precomputed options to apply to the image.
MARKER is the marker to where the response should be visible.
-REGION-LENGTH is the length of the region that should be replaced with the image."
+REGION-LENGTH is the length of the region that should be replaced
+with the image."
(when (marker-buffer marker) ; only if the buffer hasn't been kill in the meantime
(let ((url-buffer (current-buffer))
(is-error-response-p (eq :error (car status-plist))))
@@ -151,6 +159,9 @@ REGION-LENGTH is the length of the region that should be replaced with the image
(when image-options 'imagemagick)
nil) ; inbuilt scaling in 27.1
t image-options))))
+ (when mastodon-media--enable-image-caching
+ (unless (url-is-cached url) ; cache if not already cached
+ (url-store-in-cache url-buffer)))
(with-current-buffer (marker-buffer marker)
;; Save narrowing in our buffer
(let ((inhibit-read-only t))
@@ -189,9 +200,18 @@ REGION-LENGTH is the range from start to propertize."
(condition-case nil
;; catch any errors in url-retrieve so as to not abort
;; whatever called us
- (url-retrieve url
- #'mastodon-media--process-image-response
- (list marker image-options region-length))
+ (if (and mastodon-media--enable-image-caching
+ (url-is-cached url))
+ ;; if image url is cached, decompress and use it
+ (with-current-buffer (url-fetch-from-cache url)
+ (set-buffer-multibyte nil)
+ (goto-char (point-min))
+ (zlib-decompress-region (goto-char (search-forward "\n\n")) (point-max))
+ (mastodon-media--process-image-response nil marker image-options region-length url))
+ ;; else fetch as usual and process-image-response will cache it
+ (url-retrieve url
+ #'mastodon-media--process-image-response
+ (list marker image-options region-length url)))
(error (with-current-buffer buffer
;; TODO: Consider adding retries
(put-text-property marker
@@ -219,7 +239,7 @@ found."
;; Avatars are just one character in the buffer
((eq media-type 'avatar)
(list next-pos (+ next-pos 1) 'avatar))
- ;; Media links are 5 character ("[img]")
+ ;; Media links are 5 character ("[img]")
((eq media-type 'media-link)
(list next-pos (+ next-pos 5) 'media-link)))))))
@@ -272,21 +292,27 @@ Replace them with the referenced image."
t image-options))
" ")))
-(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url)
+(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type)
"Return the string to be written that renders the image at MEDIA-URL.
-FULL-REMOTE-URL is used for `shr-browse-image'."
- (concat
- (propertize "[img]"
- 'media-url media-url
- 'media-state 'needs-loading
- 'media-type 'media-link
- 'display (create-image mastodon-media--generic-broken-image-data nil t)
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'image ; for do-link-action-at-point
- 'image-url full-remote-url ; for shr-browse-image
- 'keymap mastodon-tl--shr-image-map-replacement
- 'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview"))
- " "))
+FULL-REMOTE-URL is used for `shr-browse-image'.
+TYPE is the attachment's type field on the server."
+ (let ((help-echo
+ "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview"))
+ (concat
+ (propertize "[img]"
+ 'media-url media-url
+ 'media-state 'needs-loading
+ 'media-type 'media-link
+ 'mastodon-media-type type
+ 'display (create-image mastodon-media--generic-broken-image-data nil t)
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'image ; for do-link-action-at-point
+ 'image-url full-remote-url ; for shr-browse-image
+ 'keymap mastodon-tl--shr-image-map-replacement
+ 'help-echo (if (string= type "image")
+ help-echo
+ (concat help-echo "\ntype: " type)))
+ " ")))
(provide 'mastodon-media)
;;; mastodon-media.el ends here
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index c917124..15633be 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -29,22 +29,23 @@
;;; Code:
+(autoload 'mastodon-http--api "mastodon-http.el")
+(autoload 'mastodon-http--post "mastodon-http.el")
+(autoload 'mastodon-http--triage "mastodon-http.el")
(autoload 'mastodon-media--inline-images "mastodon-media.el")
+(autoload 'mastodon-tl--byline "mastodon-tl.el")
(autoload 'mastodon-tl--byline-author "mastodon-tl.el")
(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl.el")
(autoload 'mastodon-tl--content "mastodon-tl.el")
-(autoload 'mastodon-tl--byline "mastodon-tl.el")
-(autoload 'mastodon-tl--toot-id "mastodon-tl.el")
(autoload 'mastodon-tl--field "mastodon-tl.el")
+(autoload 'mastodon-tl--find-property-range "mastodon-tl.el")
(autoload 'mastodon-tl--has-spoiler "mastodon-tl.el")
(autoload 'mastodon-tl--init "mastodon-tl.el")
+(autoload 'mastodon-tl--init-sync "mastodon-tl.el")
(autoload 'mastodon-tl--insert-status "mastodon-tl.el")
-(autoload 'mastodon-tl--spoiler "mastodon-tl.el")
(autoload 'mastodon-tl--property "mastodon-tl.el")
-(autoload 'mastodon-tl--find-property-range "mastodon-tl.el")
-(autoload 'mastodon-http--triage "mastodon-http.el")
-(autoload 'mastodon-http--post "mastodon-http.el")
-(autoload 'mastodon-http--api "mastodon-http.el")
+(autoload 'mastodon-tl--spoiler "mastodon-tl.el")
+(autoload 'mastodon-tl--toot-id "mastodon-tl.el")
(defvar mastodon-tl--display-media-p)
@@ -53,7 +54,8 @@
("follow" . mastodon-notifications--follow)
("favourite" . mastodon-notifications--favourite)
("reblog" . mastodon-notifications--reblog)
- ("follow_request" . mastodon-notifications--follow-request))
+ ("follow_request" . mastodon-notifications--follow-request)
+ ("status" . mastodon-notifications--status))
"Alist of notification types and their corresponding function.")
(defvar mastodon-notifications--response-alist
@@ -61,7 +63,8 @@
("Followed" . "you")
("Favourited" . "your status from")
("Boosted" . "your status from")
- ("Requested to follow" . "you"))
+ ("Requested to follow" . "you")
+ ("Posted" . "a post"))
"Alist of subjects for notification types.")
(defun mastodon-notifications--byline-concat (message)
@@ -72,31 +75,30 @@
" "
(cdr (assoc message mastodon-notifications--response-alist))))
-
(defun mastodon-notifications--follow-request-accept-notifs ()
"Accept the follow request of user at point, in notifications view."
(interactive)
(when (mastodon-tl--find-property-range 'toot-json (point))
(let* ((toot-json (mastodon-tl--property 'toot-json))
- (f-req-p (string= "follow_request" (cdr (assoc 'type toot-json)))))
+ (f-req-p (string= "follow_request" (alist-get 'type toot-json))))
(if f-req-p
- (let* ((account (cdr (assoc 'account toot-json)))
- (id (cdr (assoc 'id account)))
- (handle (cdr (assoc 'acct account)))
- (name (cdr (assoc 'username account))))
- (if id
- (let ((response
- (mastodon-http--post
- (concat
- (mastodon-http--api "follow_requests")
- (format "/%s/authorize" id))
- nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (mastodon-notifications--get)
- (message "Follow request of %s (@%s) accepted!"
- name handle))))
- (message "No account result at point?")))
+ (let* ((account (alist-get 'account toot-json))
+ (id (alist-get 'id account))
+ (handle (alist-get 'acct account))
+ (name (alist-get 'username account)))
+ (if id
+ (let ((response
+ (mastodon-http--post
+ (concat
+ (mastodon-http--api "follow_requests")
+ (format "/%s/authorize" id))
+ nil nil)))
+ (mastodon-http--triage response
+ (lambda ()
+ (mastodon-notifications--get)
+ (message "Follow request of %s (@%s) accepted!"
+ name handle))))
+ (message "No account result at point?")))
(message "No follow request at point?")))))
(defun mastodon-notifications--follow-request-reject-notifs ()
@@ -104,30 +106,30 @@
(interactive)
(when (mastodon-tl--find-property-range 'toot-json (point))
(let* ((toot-json (mastodon-tl--property 'toot-json))
- (f-req-p (string= "follow_request" (cdr (assoc 'type toot-json)))))
+ (f-req-p (string= "follow_request" (alist-get 'type toot-json))))
(if f-req-p
- (let* ((account (cdr (assoc 'account toot-json)))
- (id (cdr (assoc 'id account)))
- (handle (cdr (assoc 'acct account)))
- (name (cdr (assoc 'username account))))
- (if id
- (let ((response
- (mastodon-http--post
- (concat
- (mastodon-http--api "follow_requests")
- (format "/%s/reject" id))
- nil nil)))
- (mastodon-http--triage response
- (lambda ()
- (mastodon-notifications--get)
- (message "Follow request of %s (@%s) rejected!"
- name handle))))
- (message "No account result at point?")))
+ (let* ((account (alist-get 'account toot-json))
+ (id (alist-get 'id account))
+ (handle (alist-get 'acct account))
+ (name (alist-get 'username account)))
+ (if id
+ (let ((response
+ (mastodon-http--post
+ (concat
+ (mastodon-http--api "follow_requests")
+ (format "/%s/reject" id))
+ nil nil)))
+ (mastodon-http--triage response
+ (lambda ()
+ (mastodon-notifications--get)
+ (message "Follow request of %s (@%s) rejected!"
+ name handle))))
+ (message "No account result at point?")))
(message "No follow request at point?")))))
(defun mastodon-notifications--mention (note)
"Format for a `mention' NOTE."
- (let ((id (cdr (assoc 'id note)))
+ (let ((id (alist-get 'id note))
(status (mastodon-tl--field 'status note)))
(mastodon-notifications--insert-status
status
@@ -156,8 +158,8 @@
(defun mastodon-notifications--follow-request (note)
"Format for a `follow-request' NOTE."
- (let ((id (cdr (assoc 'id note)))
- (follower (cdr (assoc 'username (cdr (assoc 'account note))))))
+ (let ((id (alist-get 'id note))
+ (follower (alist-get 'username (alist-get 'account note))))
(mastodon-notifications--insert-status
(cons '(reblog (id . nil)) note)
(propertize (format "You have a follow request from... %s" follower)
@@ -170,7 +172,7 @@
(defun mastodon-notifications--favourite (note)
"Format for a `favourite' NOTE."
- (let ((id (cdr (assoc 'id note)))
+ (let ((id (alist-get 'id note))
(status (mastodon-tl--field 'status note)))
(mastodon-notifications--insert-status
status
@@ -188,7 +190,7 @@
(defun mastodon-notifications--reblog (note)
"Format for a `boost' NOTE."
- (let ((id (cdr (assoc 'id note)))
+ (let ((id (alist-get 'id note))
(status (mastodon-tl--field 'status note)))
(mastodon-notifications--insert-status
status
@@ -204,6 +206,26 @@
"Boosted"))
id)))
+(defun mastodon-notifications--status (note)
+ "Format for a `status' NOTE.
+Status notifications are given when
+`mastodon-tl--notify-user-posts' has been set."
+ (let ((id (cdr (assoc 'id note)))
+ (status (mastodon-tl--field 'status note)))
+ (mastodon-notifications--insert-status
+ status
+ (mastodon-tl--clean-tabs-and-nl
+ (if (mastodon-tl--has-spoiler status)
+ (mastodon-tl--spoiler status)
+ (mastodon-tl--content status)))
+ (lambda (_status)
+ (mastodon-tl--byline-author
+ note))
+ (lambda (_status)
+ (mastodon-notifications--byline-concat
+ "Posted"))
+ id)))
+
(defun mastodon-notifications--insert-status (toot body author-byline action-byline &optional id)
"Display the content and byline of timeline element TOOT.
@@ -252,7 +274,7 @@ ID is the notification's own id, which is attached as a property."
"Display NOTIFICATIONS in buffer."
(interactive)
(message "Loading your notifications...")
- (mastodon-tl--init
+ (mastodon-tl--init-sync
"notifications"
"notifications"
'mastodon-notifications--timeline))
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 2c364da..7a9edc3 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Version: 0.9.1
-;; Package-Requires: ((emacs "26.1") (seq "1.8"))
+;; Package-Requires: ((emacs "26.1") (seq "1.0"))
;; Homepage: https://github.com/jdenen/mastodon.el
;; This file is not part of GNU Emacs.
@@ -62,15 +62,14 @@
(defvar mastodon-tl--update-point)
-(defvar mastodon-profile--account nil
+(defvar-local mastodon-profile--account nil
"The data for the account being described in the current profile buffer.")
-(make-variable-buffer-local 'mastodon-profile--account)
;; 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)
@@ -143,6 +142,14 @@ extra keybindings."
"favourites"
'mastodon-tl--timeline))
+(defun mastodon-profile--view-bookmarks ()
+ "Open a new buffer displaying the user's bookmarks."
+ (interactive)
+ (message "Loading your bookmarked toots...")
+ (mastodon-tl--init "bookmarks"
+ "bookmarks"
+ 'mastodon-tl--timeline))
+
(defun mastodon-profile--view-follow-requests ()
"Open a new buffer displaying the user's follow requests."
(interactive)
@@ -156,9 +163,9 @@ extra keybindings."
(interactive)
(if (mastodon-tl--find-property-range 'toot-json (point))
(let* ((acct-json (mastodon-profile--toot-json))
- (id (cdr (assoc 'id acct-json)))
- (handle (cdr (assoc 'acct acct-json)))
- (name (cdr (assoc 'username acct-json))))
+ (id (alist-get 'id acct-json))
+ (handle (alist-get 'acct acct-json))
+ (name (alist-get 'username acct-json)))
(if id
(let ((response
(mastodon-http--post
@@ -178,9 +185,9 @@ extra keybindings."
(interactive)
(if (mastodon-tl--find-property-range 'toot-json (point))
(let* ((acct-json (mastodon-profile--toot-json))
- (id (cdr (assoc 'id acct-json)))
- (handle (cdr (assoc 'acct acct-json)))
- (name (cdr (assoc 'username acct-json))))
+ (id (alist-get 'id acct-json))
+ (handle (alist-get 'acct acct-json))
+ (name (alist-get 'username acct-json)))
(if id
(let ((response
(mastodon-http--post
@@ -202,8 +209,8 @@ extra keybindings."
"/api/v1/accounts/update_credentials"))
;; (buffer (mastodon-http--patch url))
(json (mastodon-http--patch-json url))
- (source (cdr (assoc 'source json)))
- (note (cdr (assoc 'note source)))
+ (source (alist-get 'source json))
+ (note (alist-get 'note source))
(buffer (get-buffer-create "*mastodon-update-profile*"))
(inhibit-read-only t))
(switch-to-buffer-other-window buffer)
@@ -240,8 +247,8 @@ Returns a list of lists."
(mapcar
(lambda (el)
(list
- (cdr (assoc 'name el))
- (cdr (assoc 'value el))))
+ (alist-get 'name el)
+ (alist-get 'value el)))
fields))))
(defun mastodon-profile--fields-insert (fields)
@@ -249,20 +256,20 @@ Returns a list of lists."
(let* ((car-fields (mapcar 'car fields))
;; (cdr-fields (mapcar 'cadr fields))
;; (cdr-fields-rendered
- ;; (list
- ;; (mapcar (lambda (x)
- ;; (mastodon-tl--render-text x nil))
- ;; cdr-fields)))
+ ;; (list
+ ;; (mapcar (lambda (x)
+ ;; (mastodon-tl--render-text x nil))
+ ;; cdr-fields)))
(left-width (car (sort (mapcar 'length car-fields) '>))))
- ;; (right-width (car (sort (mapcar 'length cdr-fields) '>))))
+ ;; (right-width (car (sort (mapcar 'length cdr-fields) '>))))
(mapconcat (lambda (field)
(mastodon-tl--render-text
(concat
(format "_ %s " (car field))
(make-string (- (+ 1 left-width) (length (car field))) ?_)
(format " :: %s" (cadr field)))
- ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_)
- ;; " |")
+ ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_)
+ ;; " |")
field)) ; nil)) ; hack to make links tabstops
fields "")))
@@ -288,6 +295,7 @@ Returns a list of lists."
(buffer (concat "*mastodon-" acct "-" endpoint-type "*"))
(note (mastodon-profile--account-field account 'note))
(json (mastodon-http--get-json url))
+ (locked (mastodon-profile--account-field account 'locked))
(followers-count (mastodon-tl--as-string
(mastodon-profile--account-field
account 'followers_count)))
@@ -298,10 +306,10 @@ Returns a list of lists."
(mastodon-profile--account-field
account 'statuses_count)))
(relationships (mastodon-profile--relationships-get id))
- (followed-by-you (cdr (assoc 'following
- (aref relationships 0))))
- (follows-you (cdr (assoc 'followed_by
- (aref relationships 0))))
+ (followed-by-you (alist-get 'following
+ (aref relationships 0)))
+ (follows-you (alist-get 'followed_by
+ (aref relationships 0)))
(followsp (or (equal follows-you 't) (equal followed-by-you 't)))
(fields (mastodon-profile--fields-get account))
(pinned (mastodon-profile--get-statuses-pinned account)))
@@ -319,9 +327,9 @@ Returns a list of lists."
(is-followers (string= endpoint-type "followers"))
(is-following (string= endpoint-type "following"))
(endpoint-name (cond
- (is-statuses " TOOTS ")
- (is-followers " FOLLOWERS ")
- (is-following " FOLLOWING "))))
+ (is-statuses " TOOTS ")
+ (is-followers " FOLLOWERS ")
+ (is-following " FOLLOWING "))))
(insert
"\n"
(mastodon-profile--image-from-account account)
@@ -330,18 +338,22 @@ Returns a list of lists."
account 'display_name)
'face 'mastodon-display-name-face)
"\n"
- (propertize acct
+ (propertize (concat "@" acct)
'face 'default)
+ (if (equal locked t)
+ (if (fontp (char-displayable-p #10r9993))
+ " 🔒"
+ " [locked]")
+ "")
"\n ------------\n"
(mastodon-tl--render-text note account)
;; account here to enable tab-stops in profile note
(if fields
- (progn
- (concat "\n"
- (mastodon-tl--set-face
- (mastodon-profile--fields-insert fields)
- 'success)
- "\n"))
+ (concat "\n"
+ (mastodon-tl--set-face
+ (mastodon-profile--fields-insert fields)
+ 'success)
+ "\n")
"")
;; insert counts
(mastodon-tl--set-face
@@ -369,7 +381,7 @@ Returns a list of lists."
'success))
(setq mastodon-tl--update-point (point))
(mastodon-media--inline-images (point-min) (point))
- ;; insert pinned toots first
+ ;; insert pinned toots first
(when (and pinned (equal endpoint-type "statuses"))
(mastodon-profile--insert-statuses-pinned pinned)
(setq mastodon-tl--update-point (point))) ;updates to follow pinned toots
@@ -383,11 +395,11 @@ Returns a list of lists."
If toot is a boost, opens the profile of the booster."
(interactive)
(mastodon-profile--make-author-buffer
- (cdr (assoc 'account (mastodon-profile--toot-json)))))
+ (alist-get 'account (mastodon-profile--toot-json))))
(defun mastodon-profile--image-from-account (status)
"Generate an image from a STATUS."
- (let ((url (cdr (assoc 'avatar_static status))))
+ (let ((url (alist-get 'avatar_static status)))
(unless (equal url "/avatars/original/missing.png")
(mastodon-media--get-media-link-rendering url))))
@@ -430,12 +442,12 @@ FIELD is used to identify regions under 'account"
(propertize
(mastodon-tl--byline-author `((account . ,toot)))
'byline 't
- 'toot-id (cdr (assoc 'id toot))
+ 'toot-id (alist-get 'id toot)
'base-toot-id (mastodon-tl--toot-id toot)
'toot-json toot))
(mastodon-media--inline-images start-pos (point))
(insert "\n"
- (mastodon-tl--render-text (cdr (assoc 'note toot)) nil)
+ (mastodon-tl--render-text (alist-get 'note toot) nil)
"\n")))
tootv)))
@@ -448,7 +460,7 @@ If the handle does not match a search return then retun NIL."
handle))
(matching-account
(seq-remove
- (lambda(x) (not (string= (cdr (assoc 'acct x)) handle)))
+ (lambda(x) (not (string= (alist-get 'acct x) handle)))
(mastodon-http--get-json
(mastodon-http--api (format "accounts/search?q=%s" handle))))))
(when (equal 1 (length matching-account))
@@ -464,35 +476,35 @@ If the handle does not match a search return then retun NIL."
These include the author, author of reblogged entries and any user mentioned."
(when status
- (let ((this-account (cdr (assoc 'account status)))
- (mentions (cdr (assoc 'mentions status)))
- (reblog (cdr (assoc 'reblog status))))
+ (let ((this-account (alist-get 'account status))
+ (mentions (alist-get 'mentions status))
+ (reblog (alist-get 'reblog status)))
(seq-filter
'stringp
(seq-uniq
(seq-concatenate
'list
- (list (cdr (assoc 'acct this-account)))
+ (list (alist-get 'acct this-account))
(mastodon-profile--extract-users-handles reblog)
(mapcar (lambda (mention)
- (cdr (assoc 'acct mention)))
+ (alist-get 'acct mention))
mentions)))))))
(defun mastodon-profile--lookup-account-in-status (handle status)
"Return account for HANDLE using hints in STATUS if possible."
- (let* ((this-account (cdr (assoc 'account status)))
- (reblog-account (cdr (assoc 'account (cdr (assoc 'reblog status)))))
+ (let* ((this-account (alist-get 'account status))
+ (reblog-account (alist-get 'account (alist-get 'reblog status)))
(mention-id (seq-some
(lambda (mention)
(when (string= handle
- (cdr (assoc 'acct mention)))
- (cdr (assoc 'id mention))))
- (cdr (assoc 'mentions status)))))
+ (alist-get 'acct mention))
+ (alist-get 'id mention)))
+ (alist-get 'mentions status))))
(cond ((string= handle
- (cdr (assoc 'acct this-account)))
+ (alist-get 'acct this-account))
this-account)
((string= handle
- (cdr (assoc 'acct reblog-account)))
+ (alist-get 'acct reblog-account))
reblog-account)
(mention-id
(mastodon-profile--account-from-id mention-id))
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 537a746..fcfaec9 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -42,6 +42,29 @@
(defvar mastodon-instance-url)
(defvar mastodon-tl--link-keymap)
(defvar mastodon-http--timeout)
+(defvar mastodon-toot--enable-completion-for-mentions)
+
+;; functions for company completion of mentions in mastodon-toot
+
+(defun mastodon-search--get-user-info-@ (account)
+ "Get user handle, display name and account URL from ACCOUNT."
+ (list (cdr (assoc 'display_name account))
+ (concat "@" (cdr (assoc 'acct account)))
+ (cdr (assoc 'url account))))
+
+(defun mastodon-search--search-accounts-query (query)
+ "Prompt for a search QUERY and return accounts synchronously.
+Returns a nested list containing user handle, display name, and URL."
+ (interactive "sSearch mastodon for: ")
+ (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url))
+ ;; (buffer (format "*mastodon-search-%s*" query))
+ (response (if (equal mastodon-toot--enable-completion-for-mentions "following")
+ (mastodon-http--get-search-json url query "following=true")
+ (mastodon-http--get-search-json url query))))
+ (mapcar #'mastodon-search--get-user-info-@
+ response)))
+
+;; functions for mastodon search
(defun mastodon-search--search-query (query)
"Prompt for a search QUERY and return accounts, statuses, and hashtags."
@@ -49,15 +72,15 @@
(let* ((url (format "%s/api/v2/search" mastodon-instance-url))
(buffer (format "*mastodon-search-%s*" query))
(response (mastodon-http--get-search-json url query))
- (accts (cdr (assoc 'accounts response)))
- (tags (cdr (assoc 'hashtags response)))
- (statuses (cdr (assoc 'statuses response)))
+ (accts (alist-get 'accounts response))
+ (tags (alist-get 'hashtags response))
+ (statuses (alist-get 'statuses response))
(user-ids (mapcar #'mastodon-search--get-user-info
accts)) ; returns a list of three-item lists
(tags-list (mapcar #'mastodon-search--get-hashtag-info
tags))
;; (status-list (mapcar #'mastodon-search--get-status-info
- ;; statuses))
+ ;; statuses))
(status-ids-list (mapcar 'mastodon-search--get-id-from-status
statuses))
(toots-list-json (mapcar #'mastodon-search--fetch-full-status-from-id
@@ -74,73 +97,74 @@
" ------------\n\n")
'success))
(mapc (lambda (el)
- (insert (propertize (car el) 'face 'mastodon-display-name-face)
- " : \n : "
- (propertize (concat "@" (car (cdr el)))
- 'face 'mastodon-handle-face
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'user-handle
- 'keymap mastodon-tl--link-keymap
- 'mastodon-handle (concat "@" (car (cdr el)))
- 'help-echo (concat "Browse user profile of @" (car (cdr el))))
- " : \n"
- "\n"))
- user-ids)
- ;; hashtag results:
- (insert (mastodon-tl--set-face
- (concat "\n ------------\n"
- " HASHTAGS\n"
- " ------------\n\n")
- 'success))
- (mapc (lambda (el)
- (insert " : #"
- (propertize (car el)
- 'mouse-face 'highlight
- 'mastodon-tag (car el)
- 'mastodon-tab-stop 'hashtag
- 'help-echo (concat "Browse tag #" (car el))
- 'keymap mastodon-tl--link-keymap)
- " : \n\n"))
- tags-list)
- ;; status results:
- (insert (mastodon-tl--set-face
- (concat "\n ------------\n"
- " STATUSES\n"
- " ------------\n")
- 'success))
- (mapc 'mastodon-tl--toot toots-list-json)
- (goto-char (point-min))))))
+ (insert (propertize (car el) 'face 'mastodon-display-name-face)
+ " : \n : "
+ (propertize (concat "@" (car (cdr el)))
+ 'face 'mastodon-handle-face
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'keymap mastodon-tl--link-keymap
+ 'mastodon-handle (concat "@" (car (cdr el)))
+ 'help-echo (concat "Browse user profile of @" (car (cdr el))))
+ " : \n"
+ "\n"))
+ user-ids)
+ ;; hashtag results:
+ (insert (mastodon-tl--set-face
+ (concat "\n ------------\n"
+ " HASHTAGS\n"
+ " ------------\n\n")
+ 'success))
+ (mapc (lambda (el)
+ (insert " : #"
+ (propertize (car el)
+ 'mouse-face 'highlight
+ 'mastodon-tag (car el)
+ 'mastodon-tab-stop 'hashtag
+ 'help-echo (concat "Browse tag #" (car el))
+ 'keymap mastodon-tl--link-keymap)
+ " : \n\n"))
+ tags-list)
+ ;; status results:
+ (insert (mastodon-tl--set-face
+ (concat "\n ------------\n"
+ " STATUSES\n"
+ " ------------\n")
+ 'success))
+ (mapc 'mastodon-tl--toot toots-list-json)
+ (goto-char (point-min))))))
(defun mastodon-search--get-user-info (account)
"Get user handle, display name and account URL from ACCOUNT."
- (list (cdr (assoc 'display_name account))
- (cdr (assoc 'acct account))
- (cdr (assoc 'url account))))
+ (list (alist-get 'display_name account)
+ (alist-get 'acct account)
+ (alist-get 'url account)))
(defun mastodon-search--get-hashtag-info (tag)
"Get hashtag name and URL from TAG."
- (list (cdr (assoc 'name tag))
- (cdr (assoc 'url tag))))
+ (list (alist-get 'name tag)
+ (alist-get 'url tag)))
(defun mastodon-search--get-status-info (status)
"Get ID, timestamp, content, and spoiler from STATUS."
- (list (cdr (assoc 'id status))
- (cdr (assoc 'created_at status))
- (cdr (assoc 'spoiler_text status))
- (cdr (assoc 'content status))))
+ (list (alist-get 'id status)
+ (alist-get 'created_at status)
+ (alist-get 'spoiler_text status)
+ (alist-get 'content status)))
(defun mastodon-search--get-id-from-status (status)
- "Fetch the id from a STATUS returned by a search call to the server.
+ "Fetch the id from a STATUS returned by a search call to the server.
We use this to fetch the complete status from the server."
- (cdr (assoc 'id status)))
+ (alist-get 'id status))
(defun mastodon-search--fetch-full-status-from-id (id)
"Fetch the full status with id ID from the server.
-This allows us to access the full account etc. details and to render them properly."
+This allows us to access the full account etc. details and to
+render them properly."
(let* ((url (concat mastodon-instance-url "/api/v1/statuses/" (mastodon-tl--as-string id)))
- (json (mastodon-http--get-json url)))
+ (json (mastodon-http--get-json url)))
json))
(provide 'mastodon-search)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 48237d9..67ce4eb 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -67,7 +67,7 @@
:group 'mastodon)
(defcustom mastodon-tl--enable-relative-timestamps t
- "Nonnil to enable showing relative (to the current time) timestamps.
+ "Whether to show relative (to the current time) timestamps.
This will require periodic updates of a timeline buffer to
keep the timestamps current as time progresses."
@@ -82,9 +82,8 @@ By default fixed width fonts are used."
:type '(boolean :tag "Enable using proportional rather than fixed \
width fonts when rendering HTML text"))
-(defvar mastodon-tl--buffer-spec nil
+(defvar-local mastodon-tl--buffer-spec nil
"A unique identifier and functions for each Mastodon buffer.")
-(make-variable-buffer-local 'mastodon-tl--buffer-spec)
(defcustom mastodon-tl--show-avatars nil
"Whether to enable display of user avatars in timelines."
@@ -92,27 +91,24 @@ width fonts when rendering HTML text"))
:type '(boolean :tag "Whether to display user avatars in timelines"))
;; (defvar mastodon-tl--show-avatars nil
- ;; (if (version< emacs-version "27.1")
- ;; (image-type-available-p 'imagemagick)
- ;; (image-transforms-p))
- ;; "A boolean value stating whether to show avatars in timelines.")
+;; (if (version< emacs-version "27.1")
+;; (image-type-available-p 'imagemagick)
+;; (image-transforms-p))
+;; "A boolean value stating whether to show avatars in timelines.")
-(defvar mastodon-tl--update-point nil
+(defvar-local mastodon-tl--update-point nil
"When updating a mastodon buffer this is where new toots will be inserted.
If nil `(point-min)' is used instead.")
-(make-variable-buffer-local 'mastodon-tl--update-point)
(defvar mastodon-tl--display-media-p t
"A boolean value stating whether to show media in timelines.")
-(defvar mastodon-tl--timestamp-next-update nil
+(defvar-local mastodon-tl--timestamp-next-update nil
"The timestamp when the buffer should next be scanned to update the timestamps.")
-(make-variable-buffer-local 'mastodon-tl--timestamp-next-update)
-(defvar mastodon-tl--timestamp-update-timer nil
+(defvar-local mastodon-tl--timestamp-update-timer nil
"The timer that, when set will scan the buffer to update the timestamps.")
-(make-variable-buffer-local 'mastodon-tl--timestamp-update-timer)
(defvar mastodon-tl--link-keymap
(let ((map (make-sparse-keymap)))
@@ -149,6 +145,11 @@ types of mastodon links and not just shr.el-generated ones.")
;; browse-url loads the preview only, we want browse-image
;; on RET to browse full sized image URL
(define-key map [remap shr-browse-url] 'shr-browse-image)
+ ;; remove shr's u binding, as it the maybe-probe-and-copy-url
+ ;; is already bound to w also
+ (define-key map (kbd "u") 'mastodon-tl--update)
+ ;; keep new my-profile binding; shr 'O' doesn't work here anyway
+ (define-key map (kbd "O") 'mastodon-profile--my-profile)
(keymap-canonicalize map))
"The keymap to be set for shr.el generated image links.
@@ -267,13 +268,13 @@ Optionally start from POS."
(defun mastodon-tl--byline-author (toot)
"Propertize author of TOOT."
- (let* ((account (cdr (assoc 'account toot)))
- (handle (cdr (assoc 'acct account)))
- (name (if (not (string= "" (cdr (assoc 'display_name account))))
- (cdr (assoc 'display_name account))
- (cdr (assoc 'username account))))
- (profile-url (cdr (assoc 'url account)))
- (avatar-url (cdr (assoc 'avatar account))))
+ (let* ((account (alist-get 'account toot))
+ (handle (alist-get 'acct account))
+ (name (if (not (string= "" (alist-get 'display_name account)))
+ (alist-get 'display_name account)
+ (alist-get 'username account)))
+ (profile-url (alist-get 'url account))
+ (avatar-url (alist-get 'avatar account)))
;; TODO: Once we have a view for a user (e.g. their posts
;; timeline) make this a tab-stop and attach an action
(concat
@@ -283,23 +284,33 @@ Optionally start from POS."
(image-type-available-p 'imagemagick)
(image-transforms-p)))
(mastodon-media--get-avatar-rendering avatar-url))
- (propertize name 'face 'mastodon-display-name-face)
+ (propertize name
+ 'face 'mastodon-display-name-face
+ 'help-echo
+ ;; echo faves count when point on post author name:
+ ;; which is where --goto-next-toot puts point.
+ ;; prefer the reblog toot if present:
+ (let ((toot-to-use (or (alist-get 'reblog toot) toot)))
+ (format "%s faves | %s boosts | %s replies"
+ (alist-get 'favourites_count toot-to-use)
+ (alist-get 'reblogs_count toot-to-use)
+ (alist-get 'replies_count toot-to-use))))
" ("
(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)
"Add byline for boosted data from TOOT."
- (let ((reblog (cdr (assoc 'reblog toot))))
+ (let ((reblog (alist-get 'reblog toot)))
(when reblog
(concat
"\n "
@@ -311,8 +322,8 @@ Optionally start from POS."
"Return FIELD from TOOT.
Return value from boosted content if available."
- (or (cdr (assoc field (cdr (assoc 'reblog toot))))
- (cdr (assoc field toot))))
+ (or (alist-get field (alist-get 'reblog toot))
+ (alist-get field toot)))
(defun mastodon-tl--relative-time-details (timestamp &optional current-time)
"Return cons of (descriptive string . next change) for the TIMESTAMP.
@@ -389,7 +400,8 @@ favouriting and following to the byline. It also takes a single function.
By default it is `mastodon-tl--byline-boosted'"
(let ((parsed-time (date-to-time (mastodon-tl--field 'created_at toot)))
(faved (equal 't (mastodon-tl--field 'favourited toot)))
- (boosted (equal 't (mastodon-tl--field 'reblogged toot))))
+ (boosted (equal 't (mastodon-tl--field 'reblogged toot)))
+ (visibility (mastodon-tl--field 'visibility toot)))
(concat
;; (propertize "\n | " 'face 'default)
(propertize
@@ -400,6 +412,14 @@ By default it is `mastodon-tl--byline-boosted'"
(format "(%s) "
(propertize "F" 'face 'mastodon-boost-fave-face)))
(funcall author-byline toot)
+ (cond ((equal visibility "direct")
+ (if (fontp (char-displayable-p #10r128274))
+ " ✉"
+ " [direct]"))
+ ((equal visibility "private")
+ (if (fontp (char-displayable-p #10r9993))
+ " 🔒"
+ " [followers]")))
(funcall action-byline toot)
" "
;; TODO: Once we have a view for toot (responses etc.) make
@@ -455,7 +475,7 @@ START and END are the boundaries of the link in the toot."
(url-instance (concat "https://"
(url-host (url-generic-parse-url url))))
(maybe-userhandle (if (string= mastodon-instance-url url-instance)
- ; if handle is local, then no instance suffix:
+ ; if handle is local, then no instance suffix:
(buffer-substring-no-properties start end)
(mastodon-tl--extract-userhandle-from-url
url (buffer-substring-no-properties start end)))))
@@ -494,14 +514,14 @@ START and END are the boundaries of the link in the toot."
(defun mastodon-tl--extract-userid-toot (toot acct)
"Extract a user id for an ACCT from mentions in a TOOT."
- (let* ((mentions (append (cdr (assoc 'mentions toot)) nil))
+ (let* ((mentions (append (alist-get 'mentions toot) nil))
(mention (pop mentions))
(short-acct (substring acct 1 (length acct)))
return)
(while mention
- (when (string= (cdr (assoc 'acct mention))
+ (when (string= (alist-get 'acct mention)
short-acct)
- (setq return (cdr (assoc 'id mention))))
+ (setq return (alist-get 'id mention)))
(setq mention (pop mentions)))
return))
@@ -618,7 +638,10 @@ Used for a mouse-click EVENT on a link."
(mastodon-tl--do-link-action-at-point (posn-point (event-end event))))
(defun mastodon-tl--has-spoiler (toot)
- "Check if the given TOOT has a spoiler text that should initially be shown only while the main content should be hidden."
+ "Check if the given TOOT has a spoiler text.
+
+Spoiler text should initially be shown only while the main
+content should be hidden."
(let ((spoiler (mastodon-tl--field 'spoiler_text toot)))
(and spoiler (> (length spoiler) 0))))
@@ -641,12 +664,12 @@ message is a link which unhides/hides the main body."
(mastodon-tl--render-text spoiler toot))
'default))
(message (concat ;"\n"
- " ---------------\n"
- " " (mastodon-tl--make-link
- (concat "CW: " string)
- 'content-warning)
- "\n"
- " ---------------\n"))
+ " ---------------\n"
+ " " (mastodon-tl--make-link
+ (concat "CW: " string)
+ 'content-warning)
+ "\n"
+ " ---------------\n"))
(cw (mastodon-tl--set-face message 'mastodon-cw-face)))
(concat
cw
@@ -660,15 +683,16 @@ message is a link which unhides/hides the main body."
(media-string (mapconcat
(lambda (media-attachement)
(let ((preview-url
- (cdr (assoc 'preview_url media-attachement)))
+ (alist-get 'preview_url media-attachement))
(remote-url
- (if (cdr (assoc 'remote_url media-attachement))
- (cdr (assoc 'remote_url media-attachement))
+ (if (alist-get 'remote_url media-attachement)
+ (alist-get 'remote_url media-attachement)
;; fallback b/c notifications don't have remote_url
- (cdr (assoc 'url media-attachement)))))
+ (alist-get 'url media-attachement)))
+ (type (alist-get 'type media-attachement)))
(if mastodon-tl--display-media-p
(mastodon-media--get-media-link-rendering
- preview-url remote-url) ; 2nd arg for shr-browse-url
+ preview-url remote-url type) ; 2nd arg for shr-browse-url
(concat "Media::" preview-url "\n"))))
media-attachements "")))
(if (not (and mastodon-tl--display-media-p
@@ -677,17 +701,30 @@ message is a link which unhides/hides the main body."
"")))
(defun mastodon-tl--content (toot)
- "Retrieve text content from TOOT."
+ "Retrieve text content from TOOT.
+If we are in thread view, the toot content is propertized with
+faves/boosts/replies counts."
(let* ((content (mastodon-tl--field 'content toot))
- (reblog (cdr (assoc 'reblog toot)))
+ (reblog (alist-get 'reblog toot))
(poll-p (if reblog
- (cdr (assoc 'poll reblog))
- (cdr (assoc 'poll toot)))))
+ (alist-get 'poll reblog)
+ (alist-get 'poll toot))))
(concat
- (when poll-p
- (mastodon-tl--get-poll toot))
+ (propertize
(mastodon-tl--render-text content toot)
- (mastodon-tl--media toot))))
+ 'help-echo (when (and mastodon-tl--buffer-spec
+ (string-match-p
+ "context" ; only when thread view
+ (plist-get mastodon-tl--buffer-spec 'endpoint)))
+ ;; prefer the reblog toot if present:
+ (let ((toot-to-use (or (alist-get 'reblog toot) toot)))
+ (format "%s faves | %s boosts | %s replies"
+ (alist-get 'favourites_count toot-to-use)
+ (alist-get 'reblogs_count toot-to-use)
+ (alist-get 'replies_count toot-to-use)))))
+ (when poll-p
+ (mastodon-tl--get-poll toot))
+ (mastodon-tl--media toot))))
(defun mastodon-tl--insert-status (toot body author-byline action-byline)
"Display the content and byline of timeline element TOOT.
@@ -707,7 +744,7 @@ takes a single function. By default it is
body
" \n"
(mastodon-tl--byline toot author-byline action-byline))
- 'toot-id (cdr (assoc 'id toot))
+ 'toot-id (alist-get 'id toot)
'base-toot-id (mastodon-tl--toot-id toot)
'toot-json toot)
"\n")
@@ -718,29 +755,43 @@ 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"
- (setq option-counter (1+ option-counter))
- (cdr (assoc 'title option))
- (cdr (assoc 'votes_count option)))))
+ (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."
(interactive
(list
(let* ((toot (mastodon-tl--property 'toot-json))
- (reblog (cdr (assoc 'reblog toot)))
- (poll (or (cdr (assoc 'poll reblog))
+ (reblog (alist-get 'reblog toot))
+ (poll (or (alist-get 'poll reblog)
(mastodon-tl--field 'poll toot)))
(options (mastodon-tl--field 'options poll))
(options-titles (mapcar (lambda (x)
- (cdr (assoc 'title x)))
- options))
+ (alist-get 'title x))
+ options))
(options-number-seq (number-sequence 1 (length options)))
(options-numbers (mapcar (lambda(x)
(number-to-string x))
@@ -750,22 +801,22 @@ takes a single function. By default it is
;; but also store both as cons cell as cdr, as we need it below
(candidates (mapcar (lambda (cell)
(cons (format "%s | %s" (car cell) (cdr cell))
- cell))
+ cell))
options-alist)))
(if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json)))
(message "No poll here.")
;; var "option" = just the cdr, a cons of option number and desc
(cdr (assoc
(completing-read "Poll option to vote for: "
- candidates
- nil ; (predicate)
- t) ; require match
+ candidates
+ nil ; (predicate)
+ t) ; require match
candidates))))))
(if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json)))
(message "No poll here.")
(let* ((toot (mastodon-tl--property 'toot-json))
(poll (mastodon-tl--field 'poll toot))
- (poll-id (cdr (assoc 'id poll)))
+ (poll-id (alist-get 'id poll))
(url (mastodon-http--api (format "polls/%s/votes" poll-id)))
;; need to zero-index our option:
(option-as-arg (number-to-string (1- (string-to-number (car option)))))
@@ -891,31 +942,24 @@ If the toot has been boosted use the id found in the
reblog portion of the toot. Otherwise, use the body of
the toot. This is the same behaviour as the mastodon.social
webapp"
- (let ((id (cdr (assoc 'id json)))
- (reblog (cdr (assoc 'reblog json))))
- (if reblog (cdr (assoc 'id reblog)) id)))
+ (let ((id (alist-get 'id json))
+ (reblog (alist-get 'reblog json)))
+ (if reblog (alist-get 'id reblog) id)))
+
(defun mastodon-tl--thread ()
- "Open thread buffer for toot under `point' asynchronously."
+ "Open thread buffer for toot under `point'."
(interactive)
(let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id
(mastodon-tl--property 'toot-json))))
- (toot (mastodon-tl--property 'toot-json))
+ (url (mastodon-http--api (format "statuses/%s/context" id)))
(buffer (format "*mastodon-thread-%s*" id))
- (url (mastodon-http--api (format "statuses/%s/context" id))))
- (mastodon-http--get-json-async url
- 'mastodon-tl--thread* id toot buffer)))
-
-(defun mastodon-tl--thread* (context id toot buffer)
- "Callback for async `mastodon-tl--thread'.
-
-Open thread buffer for TOOT with id ID under `point'asynchronously,
-in new BUFFER.
-CONTEXT is the previous and subsequent toots in the thread."
- (when (member (cdr (assoc 'type toot)) '("reblog" "favourite"))
- (setq toot (cdr (assoc 'status toot))))
- (if (> (+ (length (cdr (assoc 'ancestors context)))
- (length (cdr (assoc 'descendants context))))
+ (toot (mastodon-tl--property 'toot-json))
+ (context (mastodon-http--get-json url)))
+ (when (member (alist-get 'type toot) '("reblog" "favourite"))
+ (setq toot (alist-get 'status toot)))
+ (if (> (+ (length (alist-get 'ancestors context))
+ (length (alist-get 'descendants context)))
0)
(with-output-to-temp-buffer buffer
(switch-to-buffer buffer)
@@ -927,154 +971,143 @@ CONTEXT is the previous and subsequent toots in the thread."
(lambda(toot) (message "END of thread."))))
(let ((inhibit-read-only t))
(mastodon-tl--timeline (vconcat
- (cdr (assoc 'ancestors context))
+ (alist-get 'ancestors context)
`(,toot)
- (cdr (assoc 'descendants context))))))
- (message "No Thread!")));)
-
-(defun mastodon-tl--follow-user (user-handle)
- "Query for USER-HANDLE from current status and follow that user."
+ (alist-get 'descendants context)))))
+ (message "No Thread!"))))
+
+(defun mastodon-tl--follow-user (user-handle &optional notify)
+ "Query for USER-HANDLE from current status and follow that user.
+If NOTIFY is \"true\", enable notifications when that user posts.
+If NOTIFY is \"false\", disable notifications when that user posts.
+This can be called to toggle NOTIFY on users already being followed."
(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" nil notify))
-(defun mastodon-tl--unfollow-user (user-handle)
- "Query for USER-HANDLE from current status and unfollow that user."
+(defun mastodon-tl--enable-notify-user-posts (user-handle)
+ "Query for USER-HANDLE and enable notifications when they post."
(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 "enable")))
+ (mastodon-tl--follow-user user-handle "true"))
-(defun mastodon-tl--mute-user (user-handle)
- "Query for USER-HANDLE from current status and mute that user."
+(defun mastodon-tl--disable-notify-user-posts (user-handle)
+ "Query for USER-HANDLE and disable notifications when they post."
(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 "disable")))
+ (mastodon-tl--follow-user user-handle "false"))
-(defun mastodon-tl--unmute-user (user-handle)
- "Query for USER-HANDLE from list of muted users and unmute that user."
+(defun mastodon-tl--unfollow-user (user-handle)
+ "Query for USER-HANDLE from current status and unfollow 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)
- (cdr (assoc '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-user-handles-get "unfollow")))
+ (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))
(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 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 "block")))
+ (mastodon-tl--do-user-action-and-response user-handle "block"))
(defun mastodon-tl--unblock-user (user-handle)
"Query for USER-HANDLE from list of blocked users and unblock 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)
- (cdr (assoc 'acct blocked)))
- blocks-json)))
- (completing-read "Handle of user to unblock: "
- blocked-accts
+ (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--mute-user (user-handle)
+ "Query for USER-HANDLE from current status and mute that user."
+ (interactive
+ (list
+ (mastodon-tl--interactive-user-handles-get "mute")))
+ (mastodon-tl--do-user-action-and-response user-handle "mute"))
+
+(defun mastodon-tl--unmute-user (user-handle)
+ "Query for USER-HANDLE from list of muted users and unmute that user."
+ (interactive
+ (list
+ (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 (if (or (equal action "disable")
+ (equal action "enable"))
+ (format "%s notifications when user posts: " action)
+ (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 notify)
+ "Do ACTION on user NAME/USER-HANDLE.
+NEGP is whether the action involves un-doing something.
+If NOTIFY is \"true\", enable notifications when that user posts.
+If NOTIFY is \"false\", disable notifications when that user posts.
+NOTIFY is only non-nil when called by `mastodon-tl--follow-user'."
+ (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
+ (if notify
+ (format "accounts/%s/%s?notify=%s" user-id action notify)
+ (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 notify)
+ (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 &optional notify)
+ "Post ACTION on user NAME/USER-HANDLE to URL."
+ (let ((response (mastodon-http--post url nil nil)))
+ (mastodon-http--triage response
+ (lambda ()
+ (cond ((string-equal notify "true")
+ (message "Receiving notifications for user %s (@%s)!"
+ name user-handle))
+ ((string-equal notify "false")
+ (message "Not receiving notifications for user %s (@%s)!"
+ name user-handle))
+ ((eq notify nil)
+ (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.
@@ -1302,5 +1335,36 @@ JSON is the data returned from the server."
(current-buffer)
nil)))))
+(defun mastodon-tl--init-sync (buffer-name endpoint update-function)
+ "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
+
+UPDATE-FUNCTION is used to receive more toots.
+Runs synchronously."
+ (let* ((url (mastodon-http--api endpoint))
+ (buffer (concat "*mastodon-" buffer-name "*"))
+ (json (mastodon-http--get-json url)))
+ (with-output-to-temp-buffer buffer
+ (switch-to-buffer buffer)
+ (setq
+ ;; Initialize with a minimal interval; we re-scan at least once
+ ;; every 5 minutes to catch any timestamps we may have missed
+ mastodon-tl--timestamp-next-update (time-add (current-time)
+ (seconds-to-time 300)))
+ (funcall update-function json))
+ (mastodon-mode)
+ (with-current-buffer buffer
+ (setq mastodon-tl--buffer-spec
+ `(buffer-name ,buffer-name
+ endpoint ,endpoint update-function
+ ,update-function)
+ mastodon-tl--timestamp-update-timer
+ (when mastodon-tl--enable-relative-timestamps
+ (run-at-time mastodon-tl--timestamp-next-update
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer)
+ nil))))
+ buffer))
+
(provide 'mastodon-tl)
;;; mastodon-tl.el ends here
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index f8e0f70..2ff7f83 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -29,28 +29,43 @@
;;; Code:
-(defvar mastodon-instance-url)
(when (require 'emojify nil :noerror)
- (declare-function emojify-insert-emoji "emojify"))
+ (declare-function emojify-insert-emoji "emojify")
+ (declare-function emojify-set-emoji-data "emojify")
+ (defvar emojify-emojis-dir)
+ (defvar emojify-user-emojis))
+
+(require 'cl-lib)
+(when (require 'company nil :noerror)
+ (declare-function company-mode-on "company")
+ (declare-function company-begin-backend "company")
+ (declare-function company-grab-symbol "company")
+ (defvar company-backends))
+
+(defvar mastodon-instance-url)
(autoload 'mastodon-auth--user-acct "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
-(autoload 'mastodon-http--post "mastodon-http")
-(autoload 'mastodon-http--triage "mastodon-http")
(autoload 'mastodon-http--delete "mastodon-http")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--get-json-async "mastodon-htpp")
+(autoload 'mastodon-http--post "mastodon-http")
+(autoload 'mastodon-http--post-media-attachment "mastodon-http")
(autoload 'mastodon-http--process-json "mastodon-http")
+(autoload 'mastodon-http--read-file-as-string "mastodon-http")
+(autoload 'mastodon-http--triage "mastodon-http")
+(autoload 'mastodon-search--search-accounts-query "mastodon-search")
(autoload 'mastodon-tl--as-string "mastodon-tl")
(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl")
(autoload 'mastodon-tl--field "mastodon-tl")
(autoload 'mastodon-tl--find-property-range "mastodon-tl")
+(autoload 'mastodon-tl--find-property-range "mastodon-tl")
(autoload 'mastodon-tl--goto-next-toot "mastodon-tl")
(autoload 'mastodon-tl--property "mastodon-tl")
-(autoload 'mastodon-tl--find-property-range "mastodon-tl")
-(autoload 'mastodon-toot "mastodon")
-(autoload 'mastodon-http--post-media-attachment "mastodon-http")
-(autoload 'mastodon-tl--toot-id "mastodon-tl")
(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl")
+(autoload 'mastodon-tl--toot-id "mastodon-tl")
+(autoload 'mastodon-toot "mastodon")
(defgroup mastodon-toot nil
"Tooting in Mastodon."
@@ -60,7 +75,8 @@
(defcustom mastodon-toot--default-visibility "public"
"The default visibility for new toots.
-Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \"direct\"."
+Must be one of \"public\", \"unlisted\", \"private\" (for
+followers-only), or \"direct\"."
:group 'mastodon-toot
:type '(choice
(const :tag "public" "public")
@@ -73,35 +89,53 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \"
:group 'mastodon-toot
:type 'string)
-(defvar mastodon-toot--content-warning nil
+(defcustom mastodon-toot--attachment-height 80
+ "Height of the attached images preview in the toot draft buffer."
+ :group 'mastodon-toot
+ :type 'integer)
+
+(defcustom mastodon-toot--enable-completion-for-mentions (if (require 'company nil :noerror) "following" "off")
+ "Whether to enable company completion for mentions.
+
+Used for completion in toot compose buffer.
+
+This is only used if company mode is installed."
+ :group 'mastodon-toot
+ :type '(choice
+ (const :tag "off" nil)
+ (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.")
-(make-variable-buffer-local 'mastodon-toot--content-warning)
-(defvar mastodon-toot--content-nsfw nil
+(defvar-local mastodon-toot--content-warning-from-reply-or-redraft nil
+ "The content warning of the toot being replied to.")
+
+(defvar-local mastodon-toot--content-nsfw nil
"A flag indicating whether the toot should be marked as NSFW.")
-(make-variable-buffer-local 'mastodon-toot--content-nsfw)
-(defvar mastodon-toot--visibility "public"
+(defvar-local mastodon-toot--visibility "public"
"A string indicating the visibility of the toot being composed.
Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\".")
-(make-variable-buffer-local 'mastodon-toot--visibility)
-(defvar mastodon-toot--media-attachments nil
- "A flag indicating if the toot being composed has media attachments.")
-(make-variable-buffer-local 'mastodon-toot--media-attachments)
+(defvar-local mastodon-toot--media-attachments nil
+ "A list of the media attachments of the toot being composed.")
-(defvar mastodon-toot--media-attachment-ids nil
+(defvar-local mastodon-toot--media-attachment-ids nil
"A list of any media attachment ids of the toot being composed.")
-(make-variable-buffer-local 'mastodon-toot--media-attachment-ids)
-(defvar mastodon-toot--media-attachment-filenames nil
- "A list of any media attachment filenames of the toot being composed.")
-(make-variable-buffer-local 'mastodon-toot--media-attachment-filenames)
-
-(defvar mastodon-toot--reply-to-id nil
+(defvar-local mastodon-toot--reply-to-id nil
"Buffer-local variable to hold the id of the toot being replied to.")
-(make-variable-buffer-local 'mastodon-toot--reply-to-id)
+
+(defvar mastodon-toot--max-toot-chars nil
+ "The maximum allowed characters count for a single toot.")
(defvar mastodon-toot-mode-map
(let ((map (make-sparse-keymap)))
@@ -110,12 +144,26 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p
(define-key map (kbd "C-c C-w") #'mastodon-toot--toggle-warning)
(define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw)
(define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility)
- (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment)
(when (require 'emojify nil :noerror)
(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)
map)
"Keymap for `mastodon-toot'.")
+(defun mastodon-toot--get-max-toot-chars ()
+ "Fetch max_toot_chars from `mastodon-instance-url' asynchronously."
+ (mastodon-http--get-json-async
+ (mastodon-http--api "instance") 'mastodon-toot--get-max-toot-chars-callback))
+
+(defun mastodon-toot--get-max-toot-chars-callback (json-response)
+ "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer."
+ (setq mastodon-toot--max-toot-chars
+ (number-to-string
+ (alist-get 'max_toot_chars json-response)))
+ (with-current-buffer "*new toot*"
+ (mastodon-toot--update-status-fields)))
+
(defun mastodon-toot--action-success (marker byline-region remove)
"Insert/remove the text MARKER with 'success face in byline.
@@ -141,9 +189,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
"Take ACTION on toot at point, then execute CALLBACK."
(let* ((id (mastodon-tl--property 'base-toot-id))
(url (mastodon-http--api (concat "statuses/"
- (mastodon-tl--as-string id)
- "/"
- action))))
+ (mastodon-tl--as-string id)
+ "/"
+ action))))
(let ((response (mastodon-http--post url nil nil)))
(mastodon-http--triage response callback))))
@@ -203,11 +251,11 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
(interactive)
(let* ((toot (mastodon-tl--property 'toot-json))
(pinnable-p (and
- (not (cdr (assoc 'reblog toot)))
- (equal (cdr (assoc 'acct
- (cdr (assoc 'account toot))))
+ (not (alist-get 'reblog toot))
+ (equal (alist-get 'acct
+ (alist-get 'account toot))
(mastodon-auth--user-acct))))
- (pinned-p (equal (cdr (assoc 'pinned toot)) t))
+ (pinned-p (equal (alist-get 'pinned toot) t))
(action (if pinned-p "unpin" "pin"))
(msg (if pinned-p "unpinned" "pinned"))
(msg-y-or-n (if pinned-p "Unpin" "Pin")))
@@ -223,8 +271,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
(interactive)
(let* ((toot (mastodon-tl--property 'toot-json))
(url (if (mastodon-tl--field 'reblog toot)
- (cdr (assoc 'url (cdr (assoc 'reblog toot))))
- (cdr (assoc 'url toot)))))
+ (alist-get 'url (alist-get 'reblog toot))
+ (alist-get 'url toot))))
(kill-new url)
(message "Toot URL copied to the clipboard.")))
@@ -234,9 +282,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
(let* ((toot (mastodon-tl--property 'toot-json))
(id (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
(url (mastodon-http--api (format "statuses/%s" id))))
- (if (or (cdr (assoc 'reblog toot))
- (not (equal (cdr (assoc 'acct
- (cdr (assoc 'account toot))))
+ (if (or (alist-get 'reblog toot)
+ (not (equal (alist-get 'acct
+ (alist-get 'account toot))
(mastodon-auth--user-acct))))
(message "You can only delete your own toots.")
(if (y-or-n-p (format "Delete this toot? "))
@@ -252,10 +300,13 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
(interactive)
(let* ((toot (mastodon-tl--property 'toot-json))
(id (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
- (url (mastodon-http--api (format "statuses/%s" id))))
- (if (or (cdr (assoc 'reblog toot))
- (not (equal (cdr (assoc 'acct
- (cdr (assoc 'account toot))))
+ (url (mastodon-http--api (format "statuses/%s" id)))
+ (toot-cw (alist-get 'spoiler_text toot))
+ (toot-visibility (alist-get 'visibility toot))
+ (reply-id (alist-get 'in_reply_to_id toot)))
+ (if (or (alist-get 'reblog toot)
+ (not (equal (alist-get 'acct
+ (alist-get 'account toot))
(mastodon-auth--user-acct))))
(message "You can only delete and redraft your own toots.")
(if (y-or-n-p (format "Delete and redraft this toot? "))
@@ -265,11 +316,40 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
(lambda ()
(with-current-buffer response
(let* ((json-response (mastodon-http--process-json))
- (content (cdr (assoc 'text json-response))))
- ;; (media (cdr (assoc 'media_attachments json-response))))
+ (content (alist-get 'text json-response)))
+ ;; (media (alist-get 'media_attachments json-response)))
(mastodon-toot--compose-buffer nil nil)
(goto-char (point-max))
- (insert content))))))))))
+ (insert content)
+ ;; adopt reply-to-id, visibility and CW from deleted toot:
+ (when reply-id
+ (setq mastodon-toot--reply-to-id reply-id))
+ (setq mastodon-toot--visibility toot-visibility)
+ (when (not (equal toot-cw ""))
+ (setq mastodon-toot--content-warning t)
+ (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw))
+ (mastodon-toot--update-status-fields))))))))))
+
+(defun mastodon-toot--bookmark-toot-toggle ()
+ "Bookmark or unbookmark toot at point synchronously."
+ (interactive)
+ (let* ((toot (mastodon-tl--property 'toot-json))
+ (id (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
+ (bookmarked (alist-get 'bookmarked toot))
+ (url (mastodon-http--api (if (equal bookmarked t)
+ (format "statuses/%s/unbookmark" id)
+ (format "statuses/%s/bookmark" id))))
+ (prompt (if (equal bookmarked t)
+ (format "Toot already bookmarked. Remove? ")
+ (format "Bookmark this toot? ")))
+ (message (if (equal bookmarked t)
+ "Bookmark removed!"
+ "Toot bookmarked!")))
+ (when (y-or-n-p prompt)
+ (let ((response (mastodon-http--post url nil nil)))
+ (mastodon-http--triage response
+ (lambda ()
+ (message message)))))))
(defun mastodon-toot--kill ()
"Kill `mastodon-toot-mode' buffer and window."
@@ -284,6 +364,75 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
'emojify-insert-emoji
"Prompt to insert an emoji.")
+(defun mastodon-toot--download-custom-emoji ()
+ "Download `mastodon-instance-url's custom emoji.
+Emoji images are stored in a subdir of `emojify-emojis-dir'.
+To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'."
+ (interactive)
+ (let ((custom-emoji (mastodon-http--get-json
+ (mastodon-http--api "custom_emojis")))
+ (mastodon-custom-emoji-dir (file-name-as-directory
+ (concat (file-name-as-directory
+ (expand-file-name
+ emojify-emojis-dir))
+ "mastodon-custom-emojis"))))
+ (if (not (file-directory-p emojify-emojis-dir))
+ (message "Looks like you need to set up emojify first.")
+ (unless (file-directory-p mastodon-custom-emoji-dir)
+ (make-directory mastodon-custom-emoji-dir nil)) ; no add parent
+ (mapc (lambda (x)
+ (url-copy-file (alist-get 'url x)
+ (concat
+ mastodon-custom-emoji-dir
+ (alist-get 'shortcode x)
+ "."
+ (file-name-extension (alist-get 'url x)))
+ t))
+ custom-emoji)
+ (message "Custom emoji for %s downloaded to %s"
+ mastodon-instance-url
+ mastodon-custom-emoji-dir))))
+
+(defun mastodon-toot--collect-custom-emoji ()
+ "Return a list of `mastodon-instance-url's custom emoji.
+The list is formatted for `emojify-user-emojis', which see."
+ (let* ((mastodon-custom-emojis-dir (concat (expand-file-name
+ emojify-emojis-dir)
+ "/mastodon-custom-emojis/"))
+ (custom-emoji-files (directory-files mastodon-custom-emojis-dir
+ nil ; not full path
+ "^[^.]")) ; no dot files
+ (mastodon-emojify-user-emojis))
+ (mapc (lambda (x)
+ (push
+ `(,(concat ":"
+ (file-name-base x)
+ ":") . (("name" . ,(file-name-base x))
+ ("image" . ,(concat mastodon-custom-emojis-dir x))
+ ("style" . "github")))
+ mastodon-emojify-user-emojis))
+ custom-emoji-files)
+ (reverse mastodon-emojify-user-emojis)))
+
+(defun mastodon-toot--enable-custom-emoji ()
+ "Add `mastodon-instance-url's custom emoji to `emojify'.
+Custom emoji must first be downloaded with
+`mastodon-toot--download-custom-emoji'. Custom emoji are appended
+to `emojify-user-emojis', and the emoji data is updated."
+ (interactive)
+ (unless (file-exists-p (concat (expand-file-name
+ emojify-emojis-dir)
+ "/mastodon-custom-emojis/"))
+ (when (y-or-n-p "Looks like you haven't downloaded your instance's custom emoji yet. Download now? ")
+ (mastodon-toot--download-custom-emoji)))
+ (setq emojify-user-emojis
+ (append (mastodon-toot--collect-custom-emoji)
+ emojify-user-emojis))
+ ;; if already loaded, reload
+ (when (featurep 'emojify)
+ (emojify-set-emoji-data)))
+
+
(defun mastodon-toot--remove-docs ()
"Get the body of a toot from the current compose buffer."
(let ((header-region (mastodon-tl--find-property-range 'toot-post-header
@@ -300,23 +449,10 @@ Remove MARKER if REMOVE is non-nil, otherwise add it."
(setq mastodon-toot--visibility visibility)
(message "Visibility set to %s" visibility))
-(defun mastodon-toot--add-media-attachment ()
- "Prompt the user for a file and POST it to the media endpoint on the server.
-
-Set `mastodon-toot--media-attachment-ids' to the item's id so it can be attached to the toot."
- (interactive)
- (let* ((filename (read-file-name "Choose file to attach to this toot: "
- mastodon-toot--default-media-directory))
- (caption (read-string "Enter a caption: "))
- (url (concat mastodon-instance-url "/api/v1/media")))
- (message "Uploading %s..." (file-name-nondirectory filename))
- (mastodon-http--post-media-attachment url filename caption)
- (setq mastodon-toot--media-attachments t)))
-
(defun mastodon-toot--send ()
- "Kill new-toot buffer/window and POST contents to the Mastodon instance.
-
-If media items have been uploaded with `mastodon-toot--add-media-attachment', attach them to the toot."
+ "POST contents of new-toot buffer to Mastodon instance and kill buffer.
+If media items have been attached and uploaded with
+`mastodon-toot--attach-media', they are attached to the toot."
(interactive)
(let* ((toot (mastodon-toot--remove-docs))
(empty-toot-p (and (not mastodon-toot--media-attachments)
@@ -324,30 +460,35 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at
(endpoint (mastodon-http--api "statuses"))
(spoiler (when (and (not empty-toot-p)
mastodon-toot--content-warning)
- (read-string "Warning: ")))
+ (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft)))
(args-no-media `(("status" . ,toot)
("in_reply_to_id" . ,mastodon-toot--reply-to-id)
("visibility" . ,mastodon-toot--visibility)
("sensitive" . ,(when mastodon-toot--content-nsfw
(symbol-name t)))
("spoiler_text" . ,spoiler)))
- (args-media
- (when mastodon-toot--media-attachment-ids
- (mapcar
- (lambda (id)
- (cons "media_ids[]" id))
- mastodon-toot--media-attachment-ids)))
- (args (append args-no-media args-media)))
- (if (and mastodon-toot--media-attachments
- (equal mastodon-toot--media-attachment-ids nil))
- (message "Looks like your uploads are not yet ready...")
- (if empty-toot-p
- (message "Empty toot. Cowardly refusing to post this.")
- (let ((response (mastodon-http--post endpoint args nil)))
- (mastodon-http--triage response
- (lambda ()
- (mastodon-toot--kill)
- (message "Toot toot!"))))))))
+ (args-media (when mastodon-toot--media-attachments
+ (mapcar (lambda (id)
+ (cons "media_ids[]" id))
+ mastodon-toot--media-attachment-ids)))
+ (args (append args-media args-no-media)))
+ (cond ((and mastodon-toot--media-attachments
+ ;; make sure we have media args
+ ;; and the same num of ids as attachments
+ (or (not args-media)
+ (not (= (length mastodon-toot--media-attachments)
+ (length mastodon-toot--media-attachment-ids)))))
+ (message "Something is wrong with your uploads. Wait for them to complete or try again."))
+ ((> (length toot) (string-to-number mastodon-toot--max-toot-chars))
+ (message "Looks like your toot is longer than that maximum allowed length."))
+ (empty-toot-p
+ (message "Empty toot. Cowardly refusing to post this."))
+ (t
+ (let ((response (mastodon-http--post endpoint args nil)))
+ (mastodon-http--triage response
+ (lambda ()
+ (mastodon-toot--kill)
+ (message "Toot toot!"))))))))
(defun mastodon-toot--process-local (acct)
"Add domain to local ACCT and replace the curent user name with \"\".
@@ -366,28 +507,71 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
"Extract mentions from STATUS and process them into a string."
(interactive)
(let* ((boosted (mastodon-tl--field 'reblog status))
- (mentions
- (if boosted
- (cdr (assoc 'mentions (cdr (assoc 'reblog status))))
- (cdr (assoc 'mentions status)))))
+ (mentions
+ (if boosted
+ (alist-get 'mentions (alist-get 'reblog status))
+ (alist-get 'mentions status))))
(mapconcat (lambda(x) (mastodon-toot--process-local
- (cdr (assoc 'acct x))))
+ (alist-get 'acct x)))
;; reverse does not work on vectors in 24.5
(reverse (append mentions nil))
"")))
+(defun mastodon-toot--mentions-company-meta (candidate)
+ "Format company completion CANDIDATE's meta field."
+ (format " %s"
+ (get-text-property 0 'meta candidate)))
+
+(defun mastodon-toot--mentions-company-annotation (candidate)
+ "Format company completion CANDIDATE's annotation."
+ (format " %s" (get-text-property 0 'annot candidate)))
+
+(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 ((prefix (substring prefix 1)) ;remove @ for search
+ (res))
+ (dolist (item (mastodon-search--search-accounts-query prefix))
+ (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))
+
+(defun mastodon-toot--mentions-company-make-candidate (candidate)
+ "Construct a company completion CANDIDATE for display."
+ (let ((display-name (car candidate))
+ (handle (cadr candidate))
+ (url (caddr candidate)))
+ (propertize handle 'annot display-name 'meta url)))
+
+(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))
+ (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode
+ (save-excursion
+ (forward-whitespace -1)
+ (forward-whitespace 1)
+ (looking-at "@")))
+ ;; @ + thing before point
+ (concat "@" (company-grab-symbol))))
+ (candidates (mastodon-toot--mentions-company-candidates arg))
+ (annotation (mastodon-toot--mentions-company-annotation arg))
+ (meta (mastodon-toot--mentions-company-meta arg))))
+
(defun mastodon-toot--reply ()
"Reply to toot at `point'."
(interactive)
(let* ((toot (mastodon-tl--property 'toot-json))
(id (mastodon-tl--as-string (mastodon-tl--field 'id toot)))
(account (mastodon-tl--field 'account toot))
- (user (cdr (assoc 'acct account)))
+ (user (alist-get 'acct account))
(mentions (mastodon-toot--mentions toot))
(boosted (mastodon-tl--field 'reblog toot))
(booster (when boosted
- (cdr (assoc 'acct
- (cdr (assoc 'account toot)))))))
+ (alist-get 'acct
+ (alist-get 'account toot)))))
(mastodon-toot (when user
(if booster
(if (and
@@ -400,7 +584,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
mentions))
(concat (mastodon-toot--process-local user)
mentions)))
- id)))
+ id toot)))
(defun mastodon-toot--toggle-warning ()
"Toggle `mastodon-toot--content-warning'."
@@ -414,6 +598,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
(interactive)
(setq mastodon-toot--content-nsfw
(not mastodon-toot--content-nsfw))
+ (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off"))
(mastodon-toot--update-status-fields))
(defun mastodon-toot--change-visibility ()
@@ -430,6 +615,79 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
"public")))
(mastodon-toot--update-status-fields))
+(defun mastodon-toot--clear-all-attachments ()
+ "Remove all attachments from a toot draft."
+ (interactive)
+ (setq mastodon-toot--media-attachments nil)
+ (setq mastodon-toot--media-attachment-ids nil)
+ (mastodon-toot--refresh-attachments-display)
+ (mastodon-toot--update-status-fields))
+
+(defun mastodon-toot--attach-media (file content-type description)
+ "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION.
+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: \nsContent type: \nsDescription: ")
+ (when (>= (length mastodon-toot--media-attachments) 4)
+ ;; Only a max. of 4 attachments are allowed, so pop the oldest one.
+ (pop mastodon-toot--media-attachments))
+ (if (file-directory-p file)
+ (message "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))
+ (:content-type . ,content-type)
+ (: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--upload-attached-media (attachment)
+ "Upload a single attachment using `mastodon-http--post-media-attachment'.
+The item's id is added to `mastodon-toot--media-attachment-ids',
+which is used to attach it to a toot when posting."
+ (let* ((filename (expand-file-name
+ (alist-get :filename attachment)))
+ (caption (alist-get :description attachment))
+ (url (concat mastodon-instance-url "/api/v2/media")))
+ (message "Uploading %s..." (file-name-nondirectory filename))
+ (mastodon-http--post-media-attachment url filename caption)))
+
+(defun mastodon-toot--refresh-attachments-display ()
+ "Update the display attachment previews in toot draft buffer."
+ (let ((inhibit-read-only t)
+ (attachments-region (mastodon-tl--find-property-range
+ 'toot-attachments (point-min)))
+ (display-specs (mastodon-toot--format-attachments)))
+ (dotimes (i (- (cdr attachments-region) (car attachments-region)))
+ (add-text-properties (+ (car attachments-region) i)
+ (+ (car attachments-region) i 1)
+ (list 'display (or (nth i display-specs) ""))))))
+
+(defun mastodon-toot--format-attachments ()
+ "Format the attachment previews for display in toot draft buffer."
+ (or (let ((counter 0)
+ (image-options (when (or (image-type-available-p 'imagemagick)
+ (image-transforms-p))
+ `(:height ,mastodon-toot--attachment-height))))
+ (mapcan (lambda (attachment)
+ (let* ((data (alist-get :contents attachment))
+ (image (apply #'create-image data
+ (if (version< emacs-version "27.1")
+ (when image-options 'imagemagick)
+ nil) ; inbuilt scaling in 27.1
+ t image-options))
+ (type (alist-get :content-type attachment))
+ (description (alist-get :description attachment)))
+ (setq counter (1+ counter))
+ (list (format "\n %d: " counter)
+ image
+ (format " \"%s\" (%s)" description type))))
+ mastodon-toot--media-attachments))
+ (list "None")))
+
;; we'll need to revisit this if the binds get
;; more diverse than two-chord bindings
(defun mastodon-toot--get-mode-kbinds ()
@@ -457,19 +715,50 @@ e.g. mastodon-toot--send -> Send."
"Format a single keybinding, KBIND, for display in documentation."
(let ((key (help-key-description (car kbind) nil))
(command (mastodon-toot--format-kbind-command (cdr kbind))))
- (format "\t%s - %s" key command)))
+ (format " %s - %s" key command)))
(defun mastodon-toot--format-kbinds (kbinds)
"Format a list of keybindings, KBINDS, for display in documentation."
- (mapconcat 'identity (cons "" (mapcar #'mastodon-toot--format-kbind kbinds))
- "\n"))
+ (mapcar #'mastodon-toot--format-kbind kbinds))
+
+(defvar-local mastodon-toot--kbinds-pairs nil
+ "Contains a list of paired toot compose buffer keybindings for inserting.")
+
+(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest)
+ "Return a list of strings each containing two formatted kbinds.
+KBINDS-LIST is the list of formatted bindings to pair.
+LONGEST is the length of the longest binding."
+ (when kbinds-list
+ (push (concat "\n"
+ (car kbinds-list)
+ (make-string (- (1+ longest) (length (car kbinds-list)))
+ ?\ )
+ (cadr kbinds-list))
+ mastodon-toot--kbinds-pairs)
+ (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest))
+ (reverse mastodon-toot--kbinds-pairs))
+
+(defun mastodon-toot--formatted-kbinds-longest (kbinds-list)
+ "Return the length of the longest item in KBINDS-LIST."
+ (let ((lengths (mapcar (lambda (x)
+ (length x))
+ kbinds-list)))
+ (car (sort lengths #'>))))
(defun mastodon-toot--make-mode-docs ()
"Create formatted documentation text for the mastodon-toot-mode."
- (let ((kbinds (mastodon-toot--get-mode-kbinds)))
+ (let* ((kbinds (mastodon-toot--get-mode-kbinds))
+ (longest-kbind
+ (mastodon-toot--formatted-kbinds-longest
+ (mastodon-toot--format-kbinds kbinds))))
(concat
" Compose a new toot here. The following keybindings are available:"
- (mastodon-toot--format-kbinds kbinds))))
+ ;; (mastodon-toot--format-kbinds kbinds))))
+ (mapconcat 'identity
+ (mastodon-toot--formatted-kbinds-pairs
+ (mastodon-toot--format-kbinds kbinds)
+ longest-kbind)
+ nil))))
(defun mastodon-toot--display-docs-and-status-fields ()
"Insert propertized text with documentation about `mastodon-toot-mode'.
@@ -482,6 +771,8 @@ on the status of NSFW, content warning flags, media attachments, etc."
(concat
divider "\n"
(mastodon-toot--make-mode-docs) "\n"
+ ;; divider "\n"
+ ;; "\n"
divider "\n"
" "
(propertize "Count"
@@ -490,15 +781,15 @@ on the status of NSFW, content warning flags, media attachments, etc."
(propertize "Visibility"
'toot-post-visibility t)
" ⋅ "
- (propertize "Attachment"
- 'toot-attachment t)
- " ⋅ "
(propertize "CW"
'toot-post-cw-flag t)
" "
(propertize "NSFW"
'toot-post-nsfw-flag t)
"\n"
+ " Attachments: "
+ (propertize "None " 'toot-attachments t)
+ "\n"
divider
(propertize "\n"
'rear-nonsticky t))
@@ -506,67 +797,83 @@ on the status of NSFW, content warning flags, media attachments, etc."
'read-only "Edit your message below."
'toot-post-header t))))
-(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id)
+(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 the MASTODON-TOOT--REPLY-TO-ID var."
- (when reply-to-user
- (insert (format "%s " reply-to-user))
- (setq mastodon-toot--reply-to-id reply-to-id)))
-
-(defun mastodon-toot--update-status-fields (&rest args)
+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))
+ (reply-cw (alist-get 'spoiler_text reply-json)))
+ (when reply-to-user
+ (insert (format "%s " reply-to-user))
+ (setq mastodon-toot--reply-to-id reply-to-id)
+ (if (not (equal mastodon-toot--visibility
+ reply-visibility))
+ (setq mastodon-toot--visibility reply-visibility))
+ (when (not (equal reply-cw ""))
+ (setq mastodon-toot--content-warning t)
+ (setq mastodon-toot--content-warning-from-reply-or-redraft reply-cw)))))
+
+(defun mastodon-toot--update-status-fields (&rest _args)
"Update the status fields in the header based on the current state."
- (let ((inhibit-read-only t)
- (header-region (mastodon-tl--find-property-range 'toot-post-header
+ (ignore-errors ;; called from after-change-functions so let's not leak errors
+ (let ((inhibit-read-only t)
+ (header-region (mastodon-tl--find-property-range 'toot-post-header
+ (point-min)))
+ (count-region (mastodon-tl--find-property-range 'toot-post-counter
+ (point-min)))
+ (visibility-region (mastodon-tl--find-property-range
+ 'toot-post-visibility (point-min)))
+ (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag
(point-min)))
- (count-region (mastodon-tl--find-property-range 'toot-post-counter
- (point-min)))
- (visibility-region (mastodon-tl--find-property-range
- 'toot-post-visibility (point-min)))
- (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag
- (point-min)))
- (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
- (point-min)))
- (attachment-region (mastodon-tl--find-property-range
- 'toot-attachment (point-min))))
- (add-text-properties (car count-region) (cdr count-region)
- (list 'display
- (format "%s characters"
- (- (point-max) (cdr header-region)))))
- (add-text-properties (car visibility-region) (cdr visibility-region)
- (list 'display
- (format "Visibility: %s"
- (if (equal
- mastodon-toot--visibility
- "private")
- "followers-only"
- mastodon-toot--visibility))))
- (add-text-properties (car attachment-region) (cdr attachment-region)
- (list 'display
- (format "Attached: %s"
- (mapconcat 'identity
- mastodon-toot--media-attachment-filenames
- ", "))))
- (add-text-properties (car nsfw-region) (cdr nsfw-region)
- (list 'invisible (not mastodon-toot--content-nsfw)
- 'face 'mastodon-cw-face))
- (add-text-properties (car cw-region) (cdr cw-region)
- (list 'invisible (not mastodon-toot--content-warning)
- 'face 'mastodon-cw-face))))
-
-(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id)
+ (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
+ (point-min))))
+ (add-text-properties (car count-region) (cdr count-region)
+ (list 'display
+ (format "%s/%s characters"
+ (- (point-max) (cdr header-region))
+ mastodon-toot--max-toot-chars)))
+ (add-text-properties (car visibility-region) (cdr visibility-region)
+ (list 'display
+ (format "Visibility: %s"
+ (if (equal
+ mastodon-toot--visibility
+ "private")
+ "followers-only"
+ mastodon-toot--visibility))))
+ (add-text-properties (car nsfw-region) (cdr nsfw-region)
+ (list 'display (if mastodon-toot--content-nsfw
+ (if mastodon-toot--media-attachments
+ "NSFW" "NSFW (no effect until attachments added)")
+ "")
+ 'face 'mastodon-cw-face))
+ (add-text-properties (car cw-region) (cdr cw-region)
+ (list 'invisible (not mastodon-toot--content-warning)
+ 'face 'mastodon-cw-face)))))
+
+(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id &optional reply-json)
"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."
+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."
(let* ((buffer-exists (get-buffer "*new toot*"))
(buffer (or buffer-exists (get-buffer-create "*new toot*")))
(inhibit-read-only t))
(switch-to-buffer-other-window buffer)
+ (mastodon-toot-mode t)
(when (not buffer-exists)
(mastodon-toot--display-docs-and-status-fields)
- (mastodon-toot--setup-as-reply reply-to-user reply-to-id))
+ (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json))
(mastodon-toot-mode t)
+ (unless mastodon-toot--max-toot-chars
+ (mastodon-toot--get-max-toot-chars))
+ (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))
+ (company-mode-on)))
(make-local-variable 'after-change-functions)
(push #'mastodon-toot--update-status-fields after-change-functions)
+ (mastodon-toot--refresh-attachments-display)
(mastodon-toot--update-status-fields)))
(define-minor-mode mastodon-toot-mode
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index a06b18d..662b691 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Version: 0.9.1
-;; Package-Requires: ((emacs "26.1") (request "0.2.0") (seq "1.8"))
+;; Package-Requires: ((emacs "26.1") (request "0.3.2") (seq "1.0"))
;; Homepage: https://github.com/jdenen/mastodon.el
;; This file is not part of GNU Emacs.
@@ -31,6 +31,7 @@
;;; Code:
(require 'cl-lib) ; for `cl-some' call in mastodon
+(require 'mastodon-toot) ; hack to make mastodon-toot customs visible
(declare-function discover-add-context-menu "discover")
(declare-function emojify-mode "emojify")
@@ -51,10 +52,10 @@
(autoload 'mastodon-profile--get-toot-author "mastodon-profile")
(autoload 'mastodon-profile--make-author-buffer "mastodon-profile")
(autoload 'mastodon-profile--show-user "mastodon-profile")
-(autoload 'mastodon-toot--compose-buffer "mastodon-toot")
-(autoload 'mastodon-toot--reply "mastodon-toot")
-(autoload 'mastodon-toot--toggle-boost "mastodon-toot")
-(autoload 'mastodon-toot--toggle-favourite "mastodon-toot")
+;; (autoload 'mastodon-toot--compose-buffer "mastodon-toot")
+;; (autoload 'mastodon-toot--reply "mastodon-toot")
+;; (autoload 'mastodon-toot--toggle-boost "mastodon-toot")
+;; (autoload 'mastodon-toot--toggle-favourite "mastodon-toot")
(autoload 'mastodon-discover "mastodon-discover")
(autoload 'mastodon-tl--block-user "mastodon-tl")
@@ -69,18 +70,21 @@
(autoload 'mastodon-notifications--follow-request-accept-notifs "mastodon-profile")
(autoload 'mastodon-notifications--follow-request-reject-notifs "mastodon-profile")
(autoload 'mastodon-search--search-query "mastodon-search")
-(autoload 'mastodon-toot--delete-toot "mastodon-toot")
-(autoload 'mastodon-toot--copy-toot-url "mastodon-toot")
-(autoload 'mastodon-toot--pin-toot-toggle "mastodon-toot")
+;; (autoload 'mastodon-toot--delete-toot "mastodon-toot")
+;; (autoload 'mastodon-toot--copy-toot-url "mastodon-toot")
+;; (autoload 'mastodon-toot--pin-toot-toggle "mastodon-toot")
(autoload 'mastodon-auth--get-account-name "mastodon-auth")
;; (autoload 'mastodon-async--stream-federated "mastodon-async")
;; (autoload 'mastodon-async--stream-local "mastodon-async")
;; (autoload 'mastodon-async--stream-home "mastodon-async")
;; (autoload 'mastodon-async--stream-notifications "mastodon-async")
+;; (autoload 'mastodon-async-mode "mastodon-async")
(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile")
(autoload 'mastodon-auth--user-acct "mastodon-auth")
(autoload 'mastodon-tl--poll-vote "mastodon-http")
-(autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot")
+;; (autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot")
+(autoload 'mastodon-profile--view-bookmarks "mastodon-profile")
+;; (autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot")
(defgroup mastodon nil
"Interface with Mastodon."
@@ -141,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)
@@ -157,6 +161,8 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "a") #'mastodon-notifications--follow-request-accept-notifs)
(define-key map (kbd "j") #'mastodon-notifications--follow-request-reject-notifs)
(define-key map (kbd "v") #'mastodon-tl--poll-vote)
+ (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle)
+ (define-key map (kbd "K") #'mastodon-profile--view-bookmarks)
map)
"Keymap for `mastodon-mode'.")
@@ -198,26 +204,28 @@ Use. e.g. \"%c\" for your locale's date and time format."
"favourites"
"search"))
(buffer (cl-some (lambda (el)
- (get-buffer (concat "*mastodon-" el "*")))
- tls))) ; return first buff that exists
+ (get-buffer (concat "*mastodon-" el "*")))
+ tls))) ; return first buff that exists
(if buffer
(switch-to-buffer buffer)
(mastodon-tl--get-home-timeline)
(message "Loading Mastodon account %s on %s..." (mastodon-auth--user-acct) mastodon-instance-url))))
;;;###autoload
-(defun mastodon-toot (&optional user reply-to-id)
+(defun mastodon-toot (&optional user reply-to-id reply-json)
"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-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))
+ (mastodon-toot--compose-buffer user reply-to-id reply-json))
;;;###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."
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 01:41:37 +0000