aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-11-21 10:20:59 +0100
committermarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-11-21 10:20:59 +0100
commitabbdef12e38c97e571ae8f664596fcf931cb4292 (patch)
treea75751f73d085f8130ac4c5b181ae8c5cc8a31e5 /lisp
parent583dad59590bd6423138053b67961cf39fe81d02 (diff)
parent6e75db20584272ee4a9954129359f5e19d737d75 (diff)
Merge branch 'develop'
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-auth.el8
-rw-r--r--lisp/mastodon-discover.el2
-rw-r--r--lisp/mastodon-http.el44
-rw-r--r--lisp/mastodon-notifications.el101
-rw-r--r--lisp/mastodon-profile.el48
-rw-r--r--lisp/mastodon-search.el48
-rw-r--r--lisp/mastodon-tl.el584
-rw-r--r--lisp/mastodon-toot.el199
-rw-r--r--lisp/mastodon.el24
9 files changed, 838 insertions, 220 deletions
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index 02799bf..263ece2 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -222,6 +222,14 @@ Handle any errors from the server."
(mastodon-http--api
"accounts/verify_credentials"))))
+(defun mastodon-auth--get-account-id ()
+ "Request user credentials and return an account name."
+ (alist-get
+ 'id
+ (mastodon-http--get-json
+ (mastodon-http--api
+ "accounts/verify_credentials"))))
+
(defun mastodon-auth--user-acct ()
"Return a mastodon user acct name."
(or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist))
diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el
index 0ef64e2..5d1a86e 100644
--- a/lisp/mastodon-discover.el
+++ b/lisp/mastodon-discover.el
@@ -100,7 +100,7 @@
("-" "zoom out" 'image-decrease-size)
("u" "copy URL" 'shr-maybe-probe-and-copy-url))
("Profile view"
- ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle))
+ ("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle))
("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 66707b7..6e7bfb3 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -89,8 +89,11 @@ Message status and JSON error from RESPONSE if unsuccessful."
(if (string-prefix-p "2" status)
(funcall success)
(switch-to-buffer response)
- (let ((json-response (mastodon-http--process-json)))
- (message "Error %s: %s" status (alist-get 'error json-response))))))
+ ;; 404 returns http response not JSON:
+ (if (string-prefix-p "404" status)
+ (message "Error %s: page not found" status)
+ (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."
@@ -121,8 +124,14 @@ Unless UNAUTHENTICATED-P is non-nil."
args
"&"))
-(defun mastodon-http--post (url args headers &optional unauthenticated-p)
- "POST synchronously to URL with ARGS and HEADERS.
+(defun mastodon-http--build-array-args-alist (param-str array)
+ "Return parameters alist using PARAM-STR and ARRAY param values.
+Used for API form data parameters that take an array."
+ (cl-loop for x in array
+ collect (cons param-str x)))
+
+(defun mastodon-http--post (url &optional args headers unauthenticated-p)
+ "POST synchronously to URL, optionally with ARGS and HEADERS.
Authorization header is included by default unless UNAUTHENTICATED-P is non-nil."
(mastodon-http--authorized-request
@@ -203,12 +212,31 @@ Callback to `mastodon-http--get-response-async', usually
(cons (car list) (cadr list))))
head-list)))
-(defun mastodon-http--delete (url)
+(defun mastodon-http--delete (url &optional args)
"Make DELETE request to URL."
+ (let ((url-request-data
+ (when args
+ (mastodon-http--build-query-string args))))
+ (mastodon-http--authorized-request
+ "DELETE"
+ (with-temp-buffer
+ (mastodon-http--url-retrieve-synchronously url)))))
+
+(defun mastodon-http--put (url &optional args headers)
+ "Make PUT request to URL."
(mastodon-http--authorized-request
- "DELETE"
- (with-temp-buffer
- (mastodon-http--url-retrieve-synchronously url))))
+ "PUT"
+ (let ((url-request-data
+ (when args
+ (mastodon-http--build-query-string args)))
+ (url-request-extra-headers
+ (append url-request-extra-headers ; auth set in macro
+ ;; pleroma compat:
+ (unless (assoc "Content-Type" headers)
+ '(("Content-Type" . "application/x-www-form-urlencoded")))
+ headers)))
+ (with-temp-buffer
+ (mastodon-http--url-retrieve-synchronously url)))))
(defun mastodon-http--append-query-string (url params)
"Append PARAMS to URL as query strings and return it.
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index 7c5d40b..62cdfe7 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -52,27 +52,40 @@
(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl")
(defvar mastodon-tl--buffer-spec)
(defvar mastodon-tl--display-media-p)
+(defvar mastodon-mode-map)
(defvar mastodon-notifications--types-alist
- '(("mention" . mastodon-notifications--mention)
- ("follow" . mastodon-notifications--follow)
+ '(("follow" . mastodon-notifications--follow)
("favourite" . mastodon-notifications--favourite)
("reblog" . mastodon-notifications--reblog)
+ ("mention" . mastodon-notifications--mention)
+ ("poll" . mastodon-notifications--poll)
("follow_request" . mastodon-notifications--follow-request)
("status" . mastodon-notifications--status)
- ("poll" . mastodon-notifications--poll))
+ ("update" . mastodon-notifications--edit))
"Alist of notification types and their corresponding function.")
(defvar mastodon-notifications--response-alist
- '(("Mentioned" . "you")
- ("Followed" . "you")
+ '(("Followed" . "you")
("Favourited" . "your status from")
("Boosted" . "your status from")
+ ("Mentioned" . "you")
+ ("Posted a poll" . "that has now ended")
("Requested to follow" . "you")
("Posted" . "a post")
- ("Posted a poll" . "that has now ended"))
+ ("Edited" . "a post"))
"Alist of subjects for notification types.")
+(defvar mastodon-notifications--map
+ (let ((map
+ (copy-keymap mastodon-mode-map)))
+ (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept)
+ (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject)
+ (define-key map (kbd "c") #'mastodon-notifications--clear-current)
+ (define-key map (kbd "g") #'mastodon-notifications--get)
+ (keymap-canonicalize map))
+ "Keymap for viewing notifications.")
+
(defun mastodon-notifications--byline-concat (message)
"Add byline for TOOT with MESSAGE."
(concat
@@ -106,8 +119,7 @@ follow-requests view."
(mastodon-http--api "follow_requests")
(format "/%s/%s" id (if reject
"reject"
- "authorize")))
- nil nil)))
+ "authorize"))))))
(mastodon-http--triage response
(lambda ()
(if f-reqs-view-p
@@ -130,7 +142,7 @@ Can be called in notifications view or in follow-requests view."
"Reject a follow request.
Can be called in notifications view or in follow-requests view."
(interactive)
- (mastodon-notifications--follow-request-process t))
+ (mastodon-notifications--follow-request-process :reject))
(defun mastodon-notifications--mention (note)
"Format for a `mention' NOTE."
@@ -162,6 +174,10 @@ Status notifications are given when
"Format for a `poll' NOTE."
(mastodon-notifications--format-note note 'poll))
+(defun mastodon-notifications--edit (note)
+ "Format for an `edit' NOTE."
+ (mastodon-notifications--format-note note 'edit))
+
(defun mastodon-notifications--format-note (note type)
"Format for a NOTE of TYPE."
(let ((id (alist-get 'id note))
@@ -186,7 +202,7 @@ Status notifications are given when
"Congratulations, you have a new follower!"
(format "You have a follow request from... %s"
follower))
- 'face 'default)
+ 'face 'default)
(mastodon-tl--clean-tabs-and-nl
(if (mastodon-tl--has-spoiler status)
(mastodon-tl--spoiler status)
@@ -213,7 +229,9 @@ Status notifications are given when
((equal type 'status)
"Posted")
((equal type 'poll)
- "Posted a poll"))))
+ "Posted a poll")
+ ((equal type 'edit)
+ "Edited"))))
id
(when (or (equal type 'favourite)
(equal type 'boost))
@@ -258,22 +276,62 @@ of the toot responded to."
(mapc #'mastodon-notifications--by-type json)
(goto-char (point-min))))
-(defun mastodon-notifications--get ()
- "Display NOTIFICATIONS in buffer."
+(defun mastodon-notifications--get (&optional type buffer-name)
+ "Display NOTIFICATIONS in buffer.
+Optionally only print notifications of type TYPE, a string."
+ (interactive)
+ (let ((buffer (or (concat "*mastodon-" buffer-name)
+ "*mastodon-notifications*")))
+ (if (get-buffer buffer)
+ (progn (switch-to-buffer buffer)
+ (mastodon-tl--update))
+ (message "Loading your notifications...")
+ (mastodon-tl--init-sync
+ (or buffer-name "notifications")
+ "notifications"
+ 'mastodon-notifications--timeline
+ type)
+ (use-local-map mastodon-notifications--map))))
+
+(defun mastodon-notifications--get-mentions ()
+ "Display mention notifications in buffer."
+ (interactive)
+ (mastodon-notifications--get "mention" "mentions"))
+
+(defun mastodon-notifications--get-favourites ()
+ "Display favourite notifications in buffer."
+ (interactive)
+ (mastodon-notifications--get "favourite" "favourites"))
+
+(defun mastodon-notifications--get-boosts ()
+ "Display boost notifications in buffer."
+ (interactive)
+ (mastodon-notifications--get "reblog" "boosts"))
+
+(defun mastodon-notifications--get-polls ()
+ "Display poll notifications in buffer."
(interactive)
- (message "Loading your notifications...")
- (mastodon-tl--init-sync
- "notifications"
- "notifications"
- 'mastodon-notifications--timeline))
+ (mastodon-notifications--get "poll" "polls"))
+
+(defun mastodon-notifications--get-statuses ()
+ "Display status notifications in buffer.
+Status notifications are created when you call
+`mastodon-tl--enable-notify-user-posts'."
+ (interactive)
+ (mastodon-notifications--get "status" "statuses"))
+
+(defun mastodon-notifications--filter-types-list (type)
+ "Return a list of notification types with TYPE removed."
+ (let ((types
+ (mapcar #'car mastodon-notifications--types-alist)))
+ (remove type types)))
(defun mastodon-notifications--clear-all ()
"Clear all notifications."
(interactive)
(when (y-or-n-p "Clear all notifications?")
(let ((response
- (mastodon-http--post (mastodon-http--api "notifications/clear")
- nil nil)))
+ (mastodon-http--post (mastodon-http--api "notifications/clear"))))
(mastodon-http--triage
response (lambda ()
(when mastodon-tl--buffer-spec
@@ -288,8 +346,7 @@ of the toot responded to."
(mastodon-tl--property 'toot-json))))
(response
(mastodon-http--post (mastodon-http--api
- (format "notifications/%s/dismiss" id))
- nil nil)))
+ (format "notifications/%s/dismiss" id)))))
(mastodon-http--triage
response (lambda ()
(when mastodon-tl--buffer-spec
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 63c062b..f81441e 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -87,7 +87,7 @@
;; maybe we can retire both of these awful bindings
;; (define-key map (kbd "s") #'mastodon-profile--open-followers)
;; (define-key map (kbd "g") #'mastodon-profile--open-following)
- (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle)
+ (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle)
map)
"Keymap for `mastodon-profile-mode'.")
@@ -156,7 +156,7 @@ contains")
account "statuses" #'mastodon-tl--timeline))
;; TODO: we shd just load all views' data then switch coz this is slow af:
-(defun mastodon-profile-account-view-cycle ()
+(defun mastodon-profile--account-view-cycle ()
"Cycle through profile view: toots, followers, and following."
(interactive)
(let ((endpoint (plist-get mastodon-tl--buffer-spec 'endpoint)))
@@ -203,7 +203,8 @@ contains")
(message "Loading your bookmarked toots...")
(mastodon-tl--init "bookmarks"
"bookmarks"
- 'mastodon-tl--timeline))
+ 'mastodon-tl--timeline
+ :headers))
(defun mastodon-profile--view-follow-requests ()
"Open a new buffer displaying the user's follow requests."
@@ -295,25 +296,25 @@ SOURCE means that the preference is in the 'source' part of the account JSON."
(response (mastodon-http--patch url `((,pref-formatted . ,val)))))
(mastodon-http--triage response
(lambda ()
- (mastodon-profile-fetch-server-account-settings)
+ (mastodon-profile--fetch-server-account-settings)
(message "Account setting %s updated to %s!" pref val)))))
(defun mastodon-profile--get-pref (pref)
"Return PREF from `mastodon-profile-account-settings'."
(plist-get mastodon-profile-account-settings pref))
-(defun mastodon-profile-update-preference-plist (pref val)
+(defun mastodon-profile--update-preference-plist (pref val)
"Set local account preference plist preference PREF to VAL.
This is done after changing the setting on the server."
(setq mastodon-profile-account-settings
(plist-put mastodon-profile-account-settings pref val)))
-(defun mastodon-profile-fetch-server-account-settings-maybe ()
+(defun mastodon-profile--fetch-server-account-settings-maybe ()
"Fetch account settings from the server.
Only do so if `mastodon-profile-account-settings' is nil."
- (mastodon-profile-fetch-server-account-settings :no-force))
+ (mastodon-profile--fetch-server-account-settings :no-force))
-(defun mastodon-profile-fetch-server-account-settings (&optional no-force)
+(defun mastodon-profile--fetch-server-account-settings (&optional no-force)
"Fetch basic account settings from the server.
Store the values in `mastodon-profile-account-settings'.
Run in `mastodon-mode-hook'.
@@ -324,42 +325,42 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
(let ((keys '(locked discoverable display_name bot))
(source-keys '(privacy sensitive language)))
(mapc (lambda (k)
- (mastodon-profile-update-preference-plist
+ (mastodon-profile--update-preference-plist
k
(mastodon-profile--get-json-value k)))
keys)
(mapc (lambda (sk)
- (mastodon-profile-update-preference-plist
+ (mastodon-profile--update-preference-plist
sk
(mastodon-profile--get-source-value sk)))
source-keys)
;; hack for max toot chars:
(mastodon-toot--get-max-toot-chars :no-toot)
- (mastodon-profile-update-preference-plist 'max_toot_chars
- mastodon-toot--max-toot-chars)
+ (mastodon-profile--update-preference-plist 'max_toot_chars
+ mastodon-toot--max-toot-chars)
;; TODO: remove now redundant vars, replace with fetchers from the plist
(setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy)
mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive))
mastodon-profile-account-settings)))
-(defun mastodon-profile-account-locked-toggle ()
+(defun mastodon-profile--account-locked-toggle ()
"Toggle the locked status of your account.
Locked means follow requests have to be approved."
(interactive)
(mastodon-profile--toggle-account-key 'locked))
-(defun mastodon-profile-account-discoverable-toggle ()
+(defun mastodon-profile--account-discoverable-toggle ()
"Toggle the discoverable status of your account.
Discoverable means the account is listed in the server directory."
(interactive)
(mastodon-profile--toggle-account-key 'discoverable))
-(defun mastodon-profile-account-bot-toggle ()
+(defun mastodon-profile--account-bot-toggle ()
"Toggle the bot status of your account."
(interactive)
(mastodon-profile--toggle-account-key 'bot))
-(defun mastodon-profile-account-sensitive-toggle ()
+(defun mastodon-profile--account-sensitive-toggle ()
"Toggle the sensitive status of your account.
When enabled, statuses are marked as sensitive by default."
(interactive)
@@ -387,7 +388,7 @@ Current settings are fetched from the server."
val)))
(mastodon-profile--update-preference (symbol-name key) new-val)))
-(defun mastodon-profile-update-display-name ()
+(defun mastodon-profile--update-display-name ()
"Update display name for your account."
(interactive)
(mastodon-profile--edit-string-value 'display_name))
@@ -396,8 +397,8 @@ Current settings are fetched from the server."
"Construct a parameter query string from metadata alist FIELDS.
Returns an alist."
(let ((keys (cl-loop for count from 1 to 5
- collect (cons (format "fields_attributes[%s][name]" count)
- (format "fields_attributes[%s][value]" count)))))
+ collect (cons (format "fields_attributes[%s][name]" count)
+ (format "fields_attributes[%s][value]" count)))))
(cl-loop for a-pair in keys
for b-pair in fields
append (list (cons (car a-pair)
@@ -405,7 +406,7 @@ Returns an alist."
(cons (cdr a-pair)
(cdr b-pair))))))
-(defun mastodon-profile-update-meta-fields ()
+(defun mastodon-profile--update-meta-fields ()
"Prompt for new metadata fields information and PATCH the server."
(interactive)
(let* ((url (mastodon-http--api "accounts/update_credentials"))
@@ -414,7 +415,7 @@ Returns an alist."
(response (mastodon-http--patch url params)))
(mastodon-http--triage response
(lambda ()
- (mastodon-profile-fetch-server-account-settings)
+ (mastodon-profile--fetch-server-account-settings)
(message "Account setting %s updated to %s!"
"metadata fields" fields-updated)))))
@@ -458,7 +459,7 @@ This endpoint only holds a few preferences. For others, see
(mastodon-http--get-json
(mastodon-http--api "preferences"))))
-(defun mastodon-profile-view-preferences ()
+(defun mastodon-profile--view-preferences ()
"View user preferences in another window."
(interactive)
(let* ((url (mastodon-http--api "preferences"))
@@ -707,7 +708,8 @@ Used to view a user's followers and those they're following."
(let ((start-pos (point)))
(insert "\n"
(propertize
- (mastodon-tl--byline-author `((account . ,toot)))
+ (mastodon-tl--byline-author `((account . ,toot))
+ :avatar)
'byline 't
'toot-id (alist-get 'id toot)
'base-toot-id (mastodon-tl--toot-id toot)
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index d161544..31fcae3 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -162,34 +162,38 @@ QUERY is the string to search."
(defun mastodon-search--insert-users-propertized (json &optional note)
"Insert users list into the buffer.
-JSON is the data from the server.. If NOTE is non-nil, include
+JSON is the data from the server. If NOTE is non-nil, include
user's profile note. This is also called by
`mastodon-tl--get-follow-suggestions' and
`mastodon-profile--insert-follow-requests'."
(mapc (lambda (acct)
- (let ((user (mastodon-search--get-user-info acct)))
- (insert
- (propertize
- (concat (propertize (car user)
- 'face 'mastodon-display-name-face
- 'byline t
- 'toot-id "0")
- " : \n : "
- (propertize (concat "@" (cadr user))
- 'face 'mastodon-handle-face
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'user-handle
- 'keymap mastodon-tl--link-keymap
- 'mastodon-handle (concat "@" (cadr user))
- 'help-echo (concat "Browse user profile of @" (cadr user)))
- " : \n"
- (if note
- (mastodon-tl--render-text (cadddr user) nil)
- "")
- "\n")
- 'toot-json acct)))) ; so named for compat w other processing functions
+ (insert (mastodon-search--propertize-user acct note)))
json))
+(defun mastodon-search--propertize-user (acct &optional note)
+ "Propertize display string for ACCT, optionally including profile
+NOTE."
+ (let ((user (mastodon-search--get-user-info acct)))
+ (propertize
+ (concat (propertize (car user)
+ 'face 'mastodon-display-name-face
+ 'byline t
+ 'toot-id "0")
+ " : \n : "
+ (propertize (concat "@" (cadr user))
+ 'face 'mastodon-handle-face
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'keymap mastodon-tl--link-keymap
+ 'mastodon-handle (concat "@" (cadr user))
+ 'help-echo (concat "Browse user profile of @" (cadr user)))
+ " : \n"
+ (if note
+ (mastodon-tl--render-text (cadddr user) nil)
+ "")
+ "\n")
+ 'toot-json acct))) ; so named for compat w other processing functions
+
(defun mastodon-search--print-tags-list (tags)
"Insert a propertized list of TAGS."
(mapc (lambda (el)
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 86a7b56..34048e7 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -63,6 +63,7 @@
;; make notifications--get available via M-x and outside our keymap:
(autoload 'mastodon-notifications--get "mastodon-notifications"
"Display NOTIFICATIONS in buffer." t) ; interactive
+(autoload 'mastodon-search--propertize-user "mastodon-search")
(autoload 'mastodon-search--insert-users-propertized "mastodon-search")
(autoload 'mastodon-search--get-user-info "mastodon-search")
(autoload 'mastodon-http--delete "mastodon-http")
@@ -70,6 +71,13 @@
(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
(autoload 'mastodon-http--get-response-async "mastodon-http")
(autoload 'mastodon-url-lookup "mastodon")
+(autoload 'mastodon-auth--get-account-id "mastodon-auth")
+(autoload 'mastodon-http--put "mastodon-http")
+(autoload 'mastodon-http--process-json "mastodon-http")
+(autoload 'mastodon-http--build-array-args-alist "mastodon-http")
+(autoload 'mastodon-http--build-query-string "mastodon-http")
+(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications")
+
(when (require 'mpv nil :no-error)
(declare-function mpv-start "mpv"))
(defvar mastodon-instance-url)
@@ -120,6 +128,12 @@ If nil `(point-min)' is used instead.")
(defvar-local mastodon-tl--timestamp-update-timer nil
"The timer that, when set will scan the buffer to update the timestamps.")
+(defvar mastodon-tl--link-header-buffers
+ '("*mastodon-favourites*" "*mastodon-bookmarks*")
+ "A list of buffers that use link headers for pagination.")
+
+;; KEYMAPS
+
(defvar mastodon-tl--link-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'mastodon-tl--do-link-action-at-point)
@@ -171,7 +185,7 @@ We need to override the keymap so tabbing will navigate to all
types of mastodon links and not just shr.el-generated ones.")
(defvar mastodon-tl--view-filters-keymap
- (let ((map ;(make-sparse-keymap)))
+ (let ((map
(copy-keymap mastodon-mode-map)))
(define-key map (kbd "d") 'mastodon-tl--delete-filter)
(define-key map (kbd "c") 'mastodon-tl--create-filter)
@@ -183,7 +197,7 @@ types of mastodon links and not just shr.el-generated ones.")
"Keymap for viewing filters.")
(defvar mastodon-tl--follow-suggestions-map
- (let ((map ;(make-sparse-keymap)))
+ (let ((map
(copy-keymap mastodon-mode-map)))
(define-key map (kbd "n") 'mastodon-tl--goto-next-item)
(define-key map (kbd "p") 'mastodon-tl--goto-prev-item)
@@ -191,6 +205,30 @@ types of mastodon links and not just shr.el-generated ones.")
(keymap-canonicalize map))
"Keymap for viewing follow suggestions.")
+(defvar mastodon-tl--view-lists-keymap
+ (let ((map ;(make-sparse-keymap)))
+ (copy-keymap mastodon-mode-map)))
+ (define-key map (kbd "D") 'mastodon-tl--delete-list)
+ (define-key map (kbd "C") 'mastodon-tl--create-list)
+ (define-key map (kbd "A") 'mastodon-tl--add-account-to-list)
+ (define-key map (kbd "R") 'mastodon-tl--remove-account-from-list)
+ (define-key map (kbd "E") 'mastodon-tl--edit-list)
+ (define-key map (kbd "n") 'mastodon-tl--goto-next-item)
+ (define-key map (kbd "p") 'mastodon-tl--goto-prev-item)
+ (define-key map (kbd "g") 'mastodon-tl--view-lists)
+ (keymap-canonicalize map))
+ "Keymap for viewing lists.")
+
+(defvar mastodon-tl--list-name-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<return>") 'mastodon-tl--view-timeline-list-at-point)
+ (define-key map (kbd "d") 'mastodon-tl--delete-list-at-point)
+ (define-key map (kbd "a") 'mastodon-tl--add-account-to-list-at-point)
+ (define-key map (kbd "r") 'mastodon-tl--remove-account-from-list-at-point)
+ (define-key map (kbd "e") 'mastodon-tl--edit-list-at-point)
+ (keymap-canonicalize map))
+ "Keymap for when point is on list name.")
+
(defvar mastodon-tl--byline-link-keymap
(when (require 'mpv nil :no-error)
(let ((map (make-sparse-keymap)))
@@ -200,6 +238,8 @@ types of mastodon links and not just shr.el-generated ones.")
"The keymap to be set for the author byline.
It is active where point is placed by `mastodon-tl--goto-next-toot.'")
+;; NAV
+
(defun mastodon-tl--next-tab-item ()
"Move to the next interesting item.
@@ -242,52 +282,6 @@ text, i.e. hidden spoiler text."
(goto-char (car next-range))
(message "%s" (get-text-property (point) 'help-echo)))))
-(defun mastodon-tl--get-federated-timeline ()
- "Opens federated timeline."
- (interactive)
- (message "Loading federated timeline...")
- (mastodon-tl--init
- "federated" "timelines/public" 'mastodon-tl--timeline))
-
-(defun mastodon-tl--get-home-timeline ()
- "Opens home timeline."
- (interactive)
- (message "Loading home timeline...")
- (mastodon-tl--init
- "home" "timelines/home" 'mastodon-tl--timeline))
-
-(defun mastodon-tl--get-local-timeline ()
- "Opens local timeline."
- (interactive)
- (message "Loading local timeline...")
- (mastodon-tl--init
- "local" "timelines/public?local=true" 'mastodon-tl--timeline))
-
-(defun mastodon-tl--get-tag-timeline ()
- "Prompt for tag and opens its timeline."
- (interactive)
- (let* ((word (or (word-at-point) ""))
- (input (read-string (format "Load timeline for tag (%s): " word)))
- (tag (if (string-empty-p input) word input)))
- (message "Loading timeline for #%s..." tag)
- (mastodon-tl--show-tag-timeline tag)))
-
-(defun mastodon-tl--show-tag-timeline (tag)
- "Opens a new buffer showing the timeline of posts with hastag TAG."
- (mastodon-tl--init
- (concat "tag-" tag) (concat "timelines/tag/" tag) 'mastodon-tl--timeline))
-
-(defun mastodon-tl--message-help-echo ()
- "Call message on 'help-echo property at point.
-Do so if type of status at poins is not follow_request/follow."
- (let ((type (alist-get
- 'type
- (get-text-property (point) 'toot-json)))
- (echo (get-text-property (point) 'help-echo)))
- (when echo ; not for followers/following in profile
- (unless (or (string= type "follow_request")
- (string= type "follow")) ; no counts for these
- (message "%s" (get-text-property (point) 'help-echo))))))
(defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos)
"Search for toot with FIND-POS.
@@ -339,14 +333,64 @@ Used on initializing a timeline or thread."
(mastodon-tl--goto-toot-pos 'previous-single-property-change
'previous-line))
+;; TIMELINES
+
+(defun mastodon-tl--get-federated-timeline ()
+ "Opens federated timeline."
+ (interactive)
+ (message "Loading federated timeline...")
+ (mastodon-tl--init
+ "federated" "timelines/public" 'mastodon-tl--timeline))
+
+(defun mastodon-tl--get-home-timeline ()
+ "Opens home timeline."
+ (interactive)
+ (message "Loading home timeline...")
+ (mastodon-tl--init
+ "home" "timelines/home" 'mastodon-tl--timeline))
+
+(defun mastodon-tl--get-local-timeline ()
+ "Opens local timeline."
+ (interactive)
+ (message "Loading local timeline...")
+ (mastodon-tl--init
+ "local" "timelines/public?local=true" 'mastodon-tl--timeline))
+
+(defun mastodon-tl--get-tag-timeline ()
+ "Prompt for tag and opens its timeline."
+ (interactive)
+ (let* ((word (or (word-at-point) ""))
+ (input (read-string (format "Load timeline for tag (%s): " word)))
+ (tag (if (string-empty-p input) word input)))
+ (message "Loading timeline for #%s..." tag)
+ (mastodon-tl--show-tag-timeline tag)))
+
+(defun mastodon-tl--show-tag-timeline (tag)
+ "Opens a new buffer showing the timeline of posts with hastag TAG."
+ (mastodon-tl--init
+ (concat "tag-" tag) (concat "timelines/tag/" tag) 'mastodon-tl--timeline))
+
+(defun mastodon-tl--message-help-echo ()
+ "Call message on 'help-echo property at point.
+Do so if type of status at poins is not follow_request/follow."
+ (let ((type (alist-get
+ 'type
+ (get-text-property (point) 'toot-json)))
+ (echo (get-text-property (point) 'help-echo)))
+ (when echo ; not for followers/following in profile
+ (unless (or (string= type "follow_request")
+ (string= type "follow")) ; no counts for these
+ (message "%s" (get-text-property (point) 'help-echo))))))
+
(defun mastodon-tl--remove-html (toot)
"Remove unrendered tags from TOOT."
(let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot))
(t2 (replace-regexp-in-string "<\/?span>" "" t1)))
(replace-regexp-in-string "<span class=\"h-card\">" "" t2)))
-(defun mastodon-tl--byline-author (toot)
- "Propertize author of TOOT."
+(defun mastodon-tl--byline-author (toot &optional avatar)
+ "Propertize author of TOOT.
+With arg AVATAR, include the account's avatar image."
(let* ((account (alist-get 'account toot))
(handle (alist-get 'acct account))
(name (if (not (string-empty-p (alist-get 'display_name account)))
@@ -357,7 +401,11 @@ Used on initializing a timeline or thread."
;; TODO: Once we have a view for a user (e.g. their posts
;; timeline) make this a tab-stop and attach an action
(concat
- (when (and mastodon-tl--show-avatars
+ ;; avatar insertion moved up to `mastodon-tl--byline' by default in order
+ ;; to be outside of text prop 'byline t. arg avatar is used by
+ ;; `mastodon-profile--add-author-bylines'
+ (when (and avatar
+ mastodon-tl--show-avatars
mastodon-tl--display-media-p
(if (version< emacs-version "27.1")
(image-type-available-p 'imagemagick)
@@ -554,7 +602,11 @@ this just means displaying toot client."
(bookmark-str (if (fontp (char-displayable-p #10r128278))
"🔖"
"K"))
- (visibility (mastodon-tl--field 'visibility toot)))
+ (visibility (mastodon-tl--field 'visibility toot))
+ (account (alist-get 'account toot))
+ (avatar-url (alist-get 'avatar account))
+ (edited-time (alist-get 'edited_at toot))
+ (edited-parsed (when edited-time (date-to-time edited-time))))
(concat
;; Boosted/favourited markers are not technically part of the byline, so
;; we don't propertize them with 'byline t', as per the rest. This
@@ -569,11 +621,20 @@ this just means displaying toot client."
(mastodon-tl--format-faved-or-boosted-byline "F"))
(when bookmarked
(mastodon-tl--format-faved-or-boosted-byline bookmark-str)))
+ ;; we remove avatars from the byline also, so that they also do not mess
+ ;; with `mastodon-tl--goto-next-toot':
+ (when (and mastodon-tl--show-avatars
+ mastodon-tl--display-media-p
+ (if (version< emacs-version "27.1")
+ (image-type-available-p 'imagemagick)
+ (image-transforms-p)))
+ (mastodon-media--get-avatar-rendering avatar-url))
(propertize
(concat
;; we propertize help-echo format faves for author name
;; in `mastodon-tl--byline-author'
(funcall author-byline toot)
+ ;; visibility:
(cond ((equal visibility "direct")
(if (fontp (char-displayable-p #10r9993))
" ✉"
@@ -582,6 +643,7 @@ this just means displaying toot client."
(if (fontp (char-displayable-p #10r128274))
" 🔒"
" [followers]")))
+ ;; action:
(funcall action-byline toot)
" "
;; TODO: Once we have a view for toot (responses etc.) make
@@ -607,12 +669,44 @@ this just means displaying toot client."
'shr-url app-url
'help-echo app-url
'keymap mastodon-tl--shr-map-replacement)))))
+ (when edited-time
+ (concat
+ (if (fontp (char-displayable-p #10r128274))
+ " ✍ "
+ " [edited] ")
+ (propertize
+ (format-time-string mastodon-toot-timestamp-format
+ edited-parsed)
+ 'face 'font-lock-comment-face
+ 'timestamp edited-parsed
+ 'display (if mastodon-tl--enable-relative-timestamps
+ (mastodon-tl--relative-time-description edited-parsed)
+ edited-parsed))))
(propertize "\n ------------\n" 'face 'default))
'favourited-p faved
'boosted-p boosted
'bookmarked-p bookmarked
+ 'edited edited-time
+ 'edit-history (when edited-time
+ (mastodon-toot--get-toot-edits (alist-get 'id toot)))
'byline t))))
+(defun mastodon-tl--format-edit-timestamp (timestamp)
+ "Convert edit TIMESTAMP into a descriptive string."
+ (let ((parsed (ts-human-duration
+ (ts-diff (ts-now) (ts-parse timestamp)))))
+ (cond ((> (plist-get parsed :days) 0)
+ (format "%s days ago" (plist-get parsed :days) (plist-get parsed :hours)))
+ ((> (plist-get parsed :hours) 0)
+ (format "%s hours ago" (plist-get parsed :hours) (plist-get parsed :minutes)))
+ ((> (plist-get parsed :minutes) 0)
+ (format "%s minutes ago" (plist-get parsed :minutes)))
+ (t ;; we failed to guess:
+ (format "%s days, %s hours, %s minutes ago"
+ (plist-get parsed :days)
+ (plist-get parsed :hours)
+ (plist-get parsed :minutes))))))
+
(defun mastodon-tl--format-faved-or-boosted-byline (letter)
"Format the byline marker for a boosted or favourited status.
LETTER is a string, F for favourited, B for boosted, or K for bookmarked."
@@ -993,7 +1087,8 @@ this just means displaying toot client."
(expiry (mastodon-tl--field 'expires_at poll))
(expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t))
(multi (mastodon-tl--field 'multiple poll))
- (vote-count (mastodon-tl--field 'voters_count poll))
+ (voters-count (mastodon-tl--field 'voters_count poll))
+ (vote-count (mastodon-tl--field 'votes_count poll))
(options (mastodon-tl--field 'options poll))
(option-titles (mapcar (lambda (x)
(alist-get 'title x))
@@ -1022,10 +1117,16 @@ this just means displaying toot client."
options
"\n")
"\n"
- (propertize (if (= vote-count 1)
- (format "%s person | " vote-count)
- (format "%s people | " vote-count))
- 'face 'font-lock-comment-face)
+ (propertize
+ (cond (voters-count ; sometimes it is nil
+ (if (= voters-count 1)
+ (format "%s person | " voters-count)
+ (format "%s people | " voters-count)))
+ (vote-count
+ (format "%s votes | " vote-count))
+ (t
+ ""))
+ 'face 'font-lock-comment-face)
(let ((str (if expired-p
"Poll expired."
(mastodon-tl--format-poll-expiry expiry))))
@@ -1091,7 +1192,7 @@ this just means displaying toot client."
;; need to zero-index our option:
(option-as-arg (number-to-string (1- (string-to-number (car option)))))
(arg `(("choices[]" . ,option-as-arg)))
- (response (mastodon-http--post url arg nil)))
+ (response (mastodon-http--post url arg)))
(mastodon-http--triage response
(lambda ()
(message "You voted for option %s: %s!"
@@ -1178,7 +1279,7 @@ Optionally get it for BUFFER."
(mastodon-tl--get-buffer-property 'buffer-name buffer))
(defun mastodon-tl--link-header (&optional buffer)
- "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'.
+ "Get the LINK HEADER stored in `mastodon-tl--buffer-spec'.
Optionally get it for BUFFER."
(mastodon-tl--get-buffer-property 'link-header buffer))
@@ -1348,6 +1449,263 @@ ID is that of the toot to view."
;; else just print the lone toot:
(mastodon-tl--single-toot id)))))))
+;;; LISTS
+
+(defun mastodon-tl--get-users-lists ()
+ "Get the list of the user's lists from the server."
+ (let ((url (mastodon-http--api "lists")))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl--get-lists-names ()
+ "Return a list of the user's lists' names."
+ (let ((lists (mastodon-tl--get-users-lists)))
+ (mapcar (lambda (x)
+ (alist-get 'title x))
+ lists)))
+
+(defun mastodon-tl--get-list-by-name (name)
+ "Return the list data for list with NAME."
+ (let* ((lists (mastodon-tl--get-users-lists)))
+ (cl-loop for list in lists
+ if (string= (alist-get 'title list) name)
+ return list)))
+
+(defun mastodon-tl--get-list-id (name)
+ "Return id for list with NAME."
+ (let ((list (mastodon-tl--get-list-by-name name)))
+ (alist-get 'id list)))
+
+(defun mastodon-tl--get-list-name (id)
+ "Return name of list with ID."
+ (let* ((url (mastodon-http--api (format "lists/%s" id)))
+ (response (mastodon-http--get-json url)))
+ (alist-get 'title response)))
+
+(defun mastodon-tl--edit-list-at-point ()
+ "Edit list at point."
+ (interactive)
+ (let ((id (get-text-property (point) 'list-id)))
+ (mastodon-tl--edit-list id)))
+
+(defun mastodon-tl--edit-list (&optional id)
+ "Prompt for a list and edit the name and replies policy.
+If ID is provided, use that list."
+ (interactive)
+ (let* ((list-names (unless id (mastodon-tl--get-lists-names)))
+ (name-old (if id
+ (get-text-property (point) 'list-id)
+ (completing-read "Edit list: "
+ list-names)))
+ (id (or id (mastodon-tl--get-list-id name-old)))
+ (name-choice (read-string "List name: " name-old))
+ (replies-policy (completing-read "Replies policy: " ; give this a proper name
+ '("followed" "list" "none")
+ nil t nil nil "list"))
+ (url (mastodon-http--api (format "lists/%s" id)))
+ (response (mastodon-http--put url
+ `(("title" . ,name-choice)
+ ("replies_policy" . ,replies-policy)))))
+ (mastodon-http--triage response
+ (lambda ()
+ (with-current-buffer response
+ (let* ((json (mastodon-http--process-json))
+ (name-new (alist-get 'title json)))
+ (message "list %s edited to %s!" name-old name-new)))
+ (when (equal (buffer-name (current-buffer))
+ "*mastodon-lists*")
+ (mastodon-tl--view-lists))))))
+
+(defun mastodon-tl--view-timeline-list-at-point ()
+ "View timeline of list at point."
+ (interactive)
+ (let ((list-id (get-text-property (point) 'list-id)))
+ (mastodon-tl--view-list-timeline list-id)))
+
+(defun mastodon-tl--view-list-timeline (&optional id)
+ "Prompt for a list and view its timeline.
+If ID is provided, use that list."
+ (interactive)
+ (let* ((list-names (unless id (mastodon-tl--get-lists-names)))
+ (list-name (unless id (completing-read "View list: " list-names)))
+ (id (or id (mastodon-tl--get-list-id list-name)))
+ (endpoint (format "timelines/list/%s" id))
+ (name (mastodon-tl--get-list-name id))
+ (buffer-name (format "list-%s" name)))
+ (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline)))
+
+(defun mastodon-tl--create-list ()
+ "Create a new list.
+Prompt for name and replies policy."
+ (interactive)
+ (let* ((title (read-string "New list name: "))
+ (replies-policy (completing-read "Replies policy: " ; give this a proper name
+ '("followed" "list" "none")
+ nil t nil nil "list")) ; default
+ (response (mastodon-http--post (mastodon-http--api "lists")
+ `(("title" . ,title)
+ ("replies_policy" . ,replies-policy))
+ nil)))
+ (mastodon-tl--list-action-triage response
+ (message "list %s created!" title))))
+
+(defun mastodon-tl--delete-list-at-point ()
+ "Delete list at point."
+ (interactive)
+ (let ((id (get-text-property (point) 'list-id)))
+ (mastodon-tl--delete-list id)))
+
+(defun mastodon-tl--delete-list (&optional id)
+ "Prompt for a list and delete it.
+If ID is provided, delete that list."
+ (interactive)
+ (let* ((list-names (unless id (mastodon-tl--get-lists-names)))
+ (name (if id
+ (mastodon-tl--get-list-name id)
+ (completing-read "Delete list: "
+ list-names)))
+ (id (or id (mastodon-tl--get-list-id name)))
+ (url (mastodon-http--api (format "lists/%s" id))))
+ (when (y-or-n-p (format "Delete list %s?" name))
+ (let ((response (mastodon-http--delete url)))
+ (mastodon-tl--list-action-triage response
+ (message "list %s deleted!" name))))))
+
+(defun mastodon-tl--view-lists ()
+ "Show the user's lists in a new buffer."
+ (interactive)
+ (mastodon-tl--init-sync "lists"
+ "lists"
+ 'mastodon-tl--insert-lists)
+ (use-local-map mastodon-tl--view-lists-keymap))
+
+(defun mastodon-tl--insert-lists (_json)
+ "Insert the user's lists from JSON."
+ ;; TODO: for now we don't use the JSON, we get it ourself again
+ (let* ((lists-names (mastodon-tl--get-lists-names)))
+ (erase-buffer)
+ (insert (mastodon-tl--set-face
+ (concat "\n ------------\n"
+ " YOUR LISTS\n"
+ " ------------\n\n")
+ 'success)
+ (mastodon-tl--set-face
+ "[C - create a list\n D - delete a list\
+\n A/R - add/remove account from a list\
+\n E - edit a list\n n/p - go to next/prev item]\n\n"
+ 'font-lock-comment-face))
+ (mapc (lambda (x)
+ (mastodon-tl--print-list-accounts x))
+ lists-names)
+ (goto-char (point-min))))
+;; (mastodon-tl--goto-next-item))) ; causes another request!
+
+(defun mastodon-tl--print-list-accounts (list-name)
+ "Insert the accounts in list named LIST-NAME."
+ (let* ((id (mastodon-tl--get-list-id list-name))
+ (accounts (mastodon-tl--accounts-in-list id)))
+ (insert
+ (propertize list-name
+ 'byline t ; so we nav here
+ 'toot-id "0" ; so we nav here
+ 'help-echo "RET: view list timeline, d: delete this list, \
+a: add account to this list, r: remove account from this list"
+ 'face 'link) ; '((:underline t :inherit success)))
+ "\n\n"
+ (propertize
+ (mapconcat #'mastodon-search--propertize-user accounts
+ " ")
+ ;; (mastodon-search--insert-users-propertized accounts)
+ 'list t
+ 'keymap mastodon-tl--list-name-keymap
+ 'list-name list-name
+ 'list-id id))))
+
+(defun mastodon-tl--get-users-followings ()
+ "Return the list of followers of the logged in account."
+ (let* ((id (mastodon-auth--get-account-id))
+ (url (mastodon-http--api (format "accounts/%s/following" id))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl--add-account-to-list-at-point ()
+ "Prompt for account and add to list at point."
+ (interactive)
+ (let ((id (get-text-property (point) 'list-id)))
+ (mastodon-tl--add-account-to-list id)))
+
+(defun mastodon-tl--add-account-to-list (&optional id)
+ "Prompt for a list and for an account, add account to list.
+If ID is provided, use that list."
+ (interactive)
+ (let* ((list-name (if id
+ (get-text-property (point) 'list-id)
+ (completing-read "Add account to list: "
+ (mastodon-tl--get-lists-names) nil t)))
+ (list-id (or id (mastodon-tl--get-list-id list-name)))
+ (followings (mastodon-tl--get-users-followings))
+ (handles (mapcar (lambda (x)
+ (cons (alist-get 'acct x)
+ (alist-get 'id x)))
+ followings))
+ (account (completing-read "Account to add: "
+ handles nil t))
+ (account-id (alist-get account handles nil nil 'equal))
+ (url (mastodon-http--api (format "lists/%s/accounts" list-id)))
+ (response (mastodon-http--post url
+ `(("account_ids[]" . ,account-id)))))
+ (mastodon-tl--list-action-triage
+ response
+ (message "%s added to list %s!" account list-name))))
+
+(defun mastodon-tl--remove-account-from-list-at-point ()
+ "Prompt for account and remove from list at point."
+ (interactive)
+ (let ((id (get-text-property (point) 'list-id)))
+ (mastodon-tl--remove-account-from-list id)))
+
+(defun mastodon-tl--remove-account-from-list (&optional id)
+ "Prompt for a list, select an account and remove from list.
+If ID is provided, use that list."
+ (interactive)
+ (let* ((list-name (if id
+ (get-text-property (point) 'list-id)
+ (completing-read "Remove account from list: "
+ (mastodon-tl--get-lists-names) nil t)))
+ (list-id (or id (mastodon-tl--get-list-id list-name)))
+ (accounts (mastodon-tl--accounts-in-list list-id))
+ (handles (mapcar (lambda (x)
+ (cons (alist-get 'acct x)
+ (alist-get 'id x)))
+ accounts))
+ (account (completing-read "Account to remove: "
+ handles nil t))
+ (account-id (alist-get account handles nil nil 'equal))
+ ;; letting --delete handle the params doesn't work
+ ;; so we do it here for now:
+ (base-url (mastodon-http--api (format "lists/%s/accounts" list-id)))
+ (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id)))
+ (query-str (mastodon-http--build-query-string args))
+ (url (concat base-url "?" query-str))
+ (response (mastodon-http--delete url)))
+ (mastodon-tl--list-action-triage
+ response
+ (message "%s removed from list %s!" account list-name))))
+
+(defun mastodon-tl--list-action-triage (response message)
+ "Call `mastodon-http--triage' on RESPONSE and display MESSAGE."
+ (mastodon-http--triage response
+ (lambda ()
+ (when (equal (buffer-name (current-buffer))
+ "*mastodon-lists*")
+ (mastodon-tl--view-lists))
+ message)))
+
+(defun mastodon-tl--accounts-in-list (list-id)
+ "Return the JSON of the accounts in list with LIST-ID."
+ (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id))))
+ (mastodon-http--get-json url)))
+
+;;; FILTERS
+
(defun mastodon-tl--create-filter ()
"Create a filter for a word.
Prompt for a context, must be a list containting at least one of \"home\",
@@ -1361,7 +1719,7 @@ Prompt for a context, must be a list containting at least one of \"home\",
(if (string-empty-p word)
(error "You must select at least one word for a filter")
(completing-read-multiple
- "Contexts to filter [TAB for options]:"
+ "Contexts to filter [TAB for options]: "
'("home" "notifications" "public" "thread")
nil ; no predicate
t))) ; require-match, as context is mandatory
@@ -1373,8 +1731,7 @@ Prompt for a context, must be a list containting at least one of \"home\",
contexts)))
(response (mastodon-http--post url (push
`("phrase" . ,word)
- contexts-processed)
- nil)))
+ contexts-processed))))
(mastodon-http--triage response
(lambda ()
(message "Filter created for %s!" word)
@@ -1443,6 +1800,8 @@ JSON is what is returned by by the server."
(mastodon-tl--view-filters)
(message "Filter for \"%s\" deleted!" phrase)))))))
+;;; FOLLOW SUGGESTIONS
+
(defun mastodon-tl--get-follow-suggestions ()
"Display a buffer of suggested accounts to follow."
(interactive)
@@ -1470,23 +1829,25 @@ RESPONSE is the JSON returned by the server."
(message "Looks like there's no toot or user at point?")
,@body))
-(defun mastodon-tl-view-own-instance (&optional brief)
+;;;; INSTANCES
+
+(defun mastodon-tl--view-own-instance (&optional brief)
"View details of your own instance.
BRIEF means show fewer details."
(interactive)
- (mastodon-tl-view-instance-description :user brief))
+ (mastodon-tl--view-instance-description :user brief))
-(defun mastodon-tl-view-own-instance-brief ()
+(defun mastodon-tl--view-own-instance-brief ()
"View brief details of your own instance."
(interactive)
- (mastodon-tl-view-instance-description :user :brief))
+ (mastodon-tl--view-instance-description :user :brief))
-(defun mastodon-tl-view-instance-description-brief ()
+(defun mastodon-tl--view-instance-description-brief ()
"View brief details of the instance the current post's author is on."
(interactive)
- (mastodon-tl-view-instance-description nil :brief))
+ (mastodon-tl--view-instance-description nil :brief))
-(defun mastodon-tl-view-instance-description (&optional user brief instance)
+(defun mastodon-tl--view-instance-description (&optional user brief instance)
"View the details of the instance the current post's author is on.
USER means to show the instance details for the logged in user.
BRIEF means to show fewer details.
@@ -1645,6 +2006,8 @@ IND is the optional indentation level to print at."
"\n"
"")))
+;;; FOLLOW/BLOCK/MUTE, ETC
+
(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.
@@ -1747,7 +2110,7 @@ Can be called to toggle NOTIFY on users already being followed."
(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\"."
+Action must be either \"unblock\" or \"unmute\"."
(let* ((endpoint (cond ((equal action "unblock")
"blocks")
((equal action "unmute")
@@ -1799,7 +2162,7 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'."
"Post ACTION on user NAME/USER-HANDLE to URL.
NOTIFY is either \"true\" or \"false\", and used when we have been called
by `mastodon-tl--follow-user' to enable or disable notifications."
- (let ((response (mastodon-http--post url nil nil)))
+ (let ((response (mastodon-http--post url)))
(mastodon-http--triage response
(lambda ()
(cond ((string-equal notify "true")
@@ -1814,6 +2177,56 @@ by `mastodon-tl--follow-user' to enable or disable notifications."
((eq notify nil)
(message "User %s (@%s) %sed!" name user-handle action)))))))
+;; FOLLOW TAGS
+
+(defun mastodon-tl--get-tag-json (tag)
+ "Return JSON data about TAG."
+ (let ((url (mastodon-http--api (format "tags/%s" tag))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl--follow-tag (&optional tag)
+ "Prompt for a tag and follow it.
+If TAG provided, follow it."
+ (interactive)
+ (let* ((tag (or tag (read-string "Tag to follow: ")))
+ (url (mastodon-http--api (format "tags/%s/follow" tag)))
+ (response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda ()
+ (message "tag #%s followed!" tag)))))
+
+(defun mastodon-tl--followed-tags ()
+ "Return JSON of tags followed."
+ (let ((url (mastodon-http--api (format "followed_tags"))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl--unfollow-tag (&optional tag)
+ "Prompt for a followed tag, and unfollow it.
+If TAG if provided, unfollow it."
+ (interactive)
+ (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags)))
+ (tags (unless tag (mapcar (lambda (x)
+ (alist-get 'name x))
+ followed-tags-json)))
+ (tag (or tag (completing-read "Unfollow tag: "
+ tags)))
+ (url (mastodon-http--api (format "tags/%s/unfollow" tag)))
+ (response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda ()
+ (message "tag #%s unfollowed!" tag)))))
+
+(defun mastodon-tl--list-followed-tags ()
+ "List tags followed. If user choses one, display its JSON."
+ (interactive)
+ (let* ((followed-tags-json (mastodon-tl--followed-tags))
+ (tags (mapcar (lambda (x)
+ (alist-get 'name x))
+ followed-tags-json))
+ (tag (completing-read "Tag: " tags)))
+ (message (prin1-to-string
+ (mastodon-tl--get-tag-json tag)))))
+
;; 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.
@@ -1847,10 +2260,10 @@ For use after e.g. deleting a toot."
"Append older toots to timeline, asynchronously."
(interactive)
(message "Loading older toots...")
- (if (string= (buffer-name (current-buffer)) "*mastodon-favourites*")
+ (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers)
;; link-header: can't build a URL with --more-json-async, endpoint/id:
(let* ((next (car (mastodon-tl--link-header)))
- (prev (cadr (mastodon-tl--link-header)))
+ ;(prev (cadr (mastodon-tl--link-header)))
(url (mastodon-tl--build-link-header-url next)))
(mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer)
(point) :headers))
@@ -2033,10 +2446,11 @@ from the start if it is nil."
(update-function (mastodon-tl--get-update-function))
(id (mastodon-tl--newest-id))
(json (mastodon-tl--updated-json endpoint id)))
- (when json
- (let ((inhibit-read-only t))
- (goto-char (or mastodon-tl--update-point (point-min)))
- (funcall update-function json)))))
+ (if json
+ (let ((inhibit-read-only t))
+ (goto-char (or mastodon-tl--update-point (point-min)))
+ (funcall update-function json))
+ (message "nothing to update"))))
(defun mastodon-tl--get-link-header-from-response (headers)
"Get http Link header from list of http HEADERS."
@@ -2100,12 +2514,22 @@ headers."
;; for everything save profiles
(mastodon-tl--goto-first-item)))))
-(defun mastodon-tl--init-sync (buffer-name endpoint update-function)
+(defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
UPDATE-FUNCTION is used to receive more toots.
-Runs synchronously."
- (let* ((url (mastodon-http--api endpoint))
+Runs synchronously.
+Optional arg NOTE-TYPE means only get that type of note."
+ (let* ((exclude-types (when note-type
+ (mastodon-notifications--filter-types-list note-type)))
+ (args (when note-type (mastodon-http--build-array-args-alist
+ "exclude_types[]" exclude-types)))
+ (query-string (when note-type
+ (mastodon-http--build-query-string args)))
+ ;; add note-type exclusions to endpoint so it works in `mastodon-tl--buffer-spec'
+ ;; that way `mastodon-tl--more' works seamlessly too:
+ (endpoint (if note-type (concat endpoint "?" query-string) endpoint))
+ (url (mastodon-http--api endpoint))
(buffer (concat "*mastodon-" buffer-name "*"))
(json (mastodon-http--get-json url)))
(with-output-to-temp-buffer buffer
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 138602a..9f46cb6 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -76,9 +76,12 @@
(autoload 'mastodon-toot "mastodon")
(autoload 'mastodon-profile--get-source-pref "mastodon-profile")
(autoload 'mastodon-profile--update-preference "mastodon-profile")
-(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile")
+(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile")
(autoload 'mastodon-tl--render-text "mastodon-tl")
-(autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile")
+(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile")
+(autoload 'mastodon-http--build-array-args-alist "mastodon-http")
+(autoload 'mastodon-tl--get-endpoint "mastodon-tl")
+(autoload 'mastodon-http--put "mastodon-http")
;; for mastodon-toot--translate-toot-text
(autoload 'mastodon-tl--content "mastodon-tl")
@@ -155,7 +158,7 @@ Valid values are \"direct\", \"private\" (followers-only),
This is determined by the account setting on the server. To
change the setting on the server, see
-`mastodon-toot-set-default-visibility'.")
+`mastodon-toot--set-default-visibility'.")
(defvar-local mastodon-toot--media-attachments nil
"A list of the media attachments of the toot being composed.")
@@ -169,6 +172,8 @@ change the setting on the server, see
(defvar-local mastodon-toot--reply-to-id nil
"Buffer-local variable to hold the id of the toot being replied to.")
+(defvar-local mastodon-toot--edit-toot-id nil
+ "The id of the toot being edited.")
(defvar-local mastodon-toot-previous-window-config nil
"A list of window configuration prior to composing a toot.
@@ -186,7 +191,7 @@ For the moment we just put all composed toots in here, as we want
to also capture toots that are 'sent' but that don't successfully
send.")
-(defvar mastodon-handle-regex
+(defvar mastodon-toot-handle-regex
(concat
;; preceding space or bol [boundary doesn't work with @]
"\\([\n\t ]\\|^\\)"
@@ -209,7 +214,7 @@ send.")
map)
"Keymap for `mastodon-toot'.")
-(defun mastodon-toot-set-default-visibility ()
+(defun mastodon-toot--set-default-visibility ()
"Set the default visibility for toots on the server."
(interactive)
(let ((vis (completing-read "Set default visibility to:"
@@ -274,7 +279,7 @@ boosting, or bookmarking toots."
(mastodon-tl--as-string id)
"/"
action))))
- (let ((response (mastodon-http--post url nil nil)))
+ (let ((response (mastodon-http--post url)))
(mastodon-http--triage response callback))))
(defun mastodon-toot--toggle-boost-or-favourite (type)
@@ -416,7 +421,8 @@ Uses `lingva.el'."
(defun mastodon-toot--pin-toot-toggle ()
"Pin or unpin user's toot at point."
(interactive)
- (let* ((toot (mastodon-tl--property 'toot-json))
+ (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs
+ (mastodon-tl--property 'toot-json)))
(pinnable-p (mastodon-toot--own-toot-p toot))
(pinned-p (equal (alist-get 'pinned toot) t))
(action (if pinned-p "unpin" "pin"))
@@ -441,7 +447,8 @@ Uses `lingva.el'."
"Delete and redraft user's toot at point synchronously.
NO-REDRAFT means delete toot only."
(interactive)
- (let* ((toot (mastodon-tl--property 'toot-json))
+ (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs
+ (mastodon-tl--property 'toot-json)))
(id (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
(url (mastodon-http--api (format "statuses/%s" id)))
(toot-cw (alist-get 'spoiler_text toot))
@@ -466,7 +473,7 @@ NO-REDRAFT means delete toot only."
toot-visibility
toot-cw)))))))))
-(defun mastodon-toot-set-cw (&optional cw)
+(defun mastodon-toot--set-cw (&optional cw)
"Set content warning to CW if it is non-nil."
(unless (string-empty-p cw)
(setq mastodon-toot--content-warning t)
@@ -485,7 +492,7 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
(when reply-id
(setq mastodon-toot--reply-to-id reply-id))
(setq mastodon-toot--visibility toot-visibility)
- (mastodon-toot-set-cw toot-cw)
+ (mastodon-toot--set-cw toot-cw)
(mastodon-toot--update-status-fields))))
(defun mastodon-toot--kill (&optional cancel)
@@ -505,13 +512,13 @@ CANCEL means the toot was not sent, so we save the toot text as a draft."
"Kill new-toot buffer/window. Does not POST content to Mastodon.
If toot is not empty, prompt to save text as a draft."
(interactive)
- (if (mastodon-toot-empty-p)
+ (if (mastodon-toot--empty-p)
(mastodon-toot--kill)
(when (y-or-n-p "Save draft toot?")
- (mastodon-toot-save-draft))
+ (mastodon-toot--save-draft))
(mastodon-toot--kill)))
-(defun mastodon-toot-save-draft ()
+(defun mastodon-toot--save-draft ()
"Save the current compose toot text as a draft.
Pushes `mastodon-toot-current-toot-text' to
`mastodon-toot-draft-toots-list'."
@@ -521,9 +528,9 @@ Pushes `mastodon-toot-current-toot-text' to
mastodon-toot-draft-toots-list :test 'equal)
(message "Draft saved!")))
-(defun mastodon-toot-empty-p (&optional text-only)
- "Return t if no text, attachments, or polls have been added to the compose buffer.
-TEXT-ONLY means don't check for attachments."
+(defun mastodon-toot--empty-p (&optional text-only)
+ "Return t if toot has no text, attachments, or polls.
+TEXT-ONLY means don't check for attachments or polls."
(and (if text-only
t
(not mastodon-toot--media-attachments)
@@ -623,7 +630,8 @@ to `emojify-user-emojis', and the emoji data is updated."
(defun mastodon-toot--build-poll-params ()
"Return an alist of parameters for POSTing a poll status."
(append
- (mastodon-toot--make-poll-options-params
+ (mastodon-http--build-array-args-alist
+ "poll[options][]"
(plist-get mastodon-toot-poll :options))
`(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry)))
`(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
@@ -632,13 +640,22 @@ to `emojify-user-emojis', and the emoji data is updated."
(defun mastodon-toot--send ()
"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."
+`mastodon-toot--attach-media', they are attached to the toot.
+If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to
+instance to edit a toot."
(interactive)
- (let* ((toot (mastodon-toot--remove-docs))
- (endpoint (mastodon-http--api "statuses"))
- (spoiler (when (and (not (mastodon-toot-empty-p))
+ (let* ((edit-p (if mastodon-toot--edit-toot-id t nil))
+ (toot (mastodon-toot--remove-docs))
+ (endpoint
+ (if edit-p
+ ;; we are sending an edit:
+ (mastodon-http--api (format "statuses/%s"
+ mastodon-toot--edit-toot-id))
+ (mastodon-http--api "statuses")))
+ (spoiler (when (and (not (mastodon-toot--empty-p))
mastodon-toot--content-warning)
- (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft)))
+ (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)
@@ -646,9 +663,9 @@ If media items have been attached and uploaded with
(symbol-name t)))
("spoiler_text" . ,spoiler)))
(args-media (when mastodon-toot--media-attachments
- (mapcar (lambda (id)
- (cons "media_ids[]" id))
- mastodon-toot--media-attachment-ids)))
+ (mastodon-http--build-array-args-alist
+ "media_ids[]"
+ mastodon-toot--media-attachment-ids)))
(args-poll (when mastodon-toot-poll
(mastodon-toot--build-poll-params)))
;; media || polls:
@@ -668,16 +685,89 @@ If media items have been attached and uploaded with
((and mastodon-toot--max-toot-chars
(> (length toot) mastodon-toot--max-toot-chars))
(message "Looks like your toot is longer than that maximum allowed length."))
- ((mastodon-toot-empty-p)
+ ((mastodon-toot--empty-p)
(message "Empty toot. Cowardly refusing to post this."))
(t
- (let ((response (mastodon-http--post endpoint args nil)))
+ (let ((response (if edit-p
+ ;; we are sending an edit:
+ (mastodon-http--put endpoint args)
+ (mastodon-http--post endpoint args))))
(mastodon-http--triage response
(lambda ()
(mastodon-toot--kill)
(message "Toot toot!")
(mastodon-toot--restore-previous-window-config prev-window-config))))))))
+;; EDITING TOOTS:
+
+(defun mastodon-toot--edit-toot-at-point ()
+ "Edit the user's toot at point."
+ (interactive)
+ (let ((toot (or (mastodon-tl--property 'base-toot); fave/boost notifs
+ (mastodon-tl--property 'toot-json))))
+ (if (not (mastodon-toot--own-toot-p toot))
+ (message "You can only edit your own toots.")
+ (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
+ (source (mastodon-toot--get-toot-source id))
+ (content (alist-get 'text source))
+ (source-cw (alist-get 'spoiler_text source))
+ (toot-visibility (alist-get 'visibility toot))
+ (reply-id (alist-get 'in_reply_to_id toot)))
+ (when (y-or-n-p "Edit this toot? ")
+ (mastodon-toot--compose-buffer)
+ (goto-char (point-max))
+ (insert content)
+ ;; adopt reply-to-id, visibility and CW:
+ (when reply-id
+ (setq mastodon-toot--reply-to-id reply-id))
+ (setq mastodon-toot--visibility toot-visibility)
+ (mastodon-toot--set-cw source-cw)
+ (mastodon-toot--update-status-fields)
+ (setq mastodon-toot--edit-toot-id id))))))
+
+(defun mastodon-toot--get-toot-source (id)
+ "Fetch the source JSON of toot with ID."
+ (let ((url (mastodon-http--api (format "/statuses/%s/source" id))))
+ (mastodon-http--get-json url :silent)))
+
+(defun mastodon-toot--get-toot-edits (id)
+ "Return the edit history of toot with ID."
+ (let* ((url (mastodon-http--api (format "statuses/%s/history" id))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-toot--view-toot-edits ()
+ "View editing history of the toot at point in a popup buffer."
+ (interactive)
+ (let ((history (mastodon-tl--property 'edit-history)))
+ (with-current-buffer (get-buffer-create "*mastodon-toot-edits*")
+ (let ((inhibit-read-only t))
+ (special-mode)
+ (erase-buffer)
+ (let ((count 1))
+ (mapc (lambda (x)
+ (insert (propertize (if (= count 1)
+ (format "%s [original]:\n" count)
+ (format "%s:\n" count))
+ 'face 'font-lock-comment-face)
+ (mastodon-toot--insert-toot-iter x)
+ "\n")
+ (cl-incf count))
+ history))
+ (switch-to-buffer-other-window (current-buffer))
+ (setq-local header-line-format
+ (propertize
+ (format "Edits to toot by %s:"
+ (alist-get 'username
+ (alist-get 'account (car history))))
+ 'face font-lock-comment-face))))))
+
+(defun mastodon-toot--insert-toot-iter (it)
+ "Insert iteration IT of toot."
+ (let ((content (alist-get 'content it))
+ (account (alist-get 'account it)))
+ ;; TODO: handle polls, media
+ (mastodon-tl--render-text content)))
+
(defun mastodon-toot--restore-previous-window-config (config)
"Restore the window CONFIG after killing the toot compose buffer.
Buffer-local variable `mastodon-toot-previous-window-config' holds the config."
@@ -779,12 +869,15 @@ functions called on ARG to generate formatted candidates, annotation, and
meta fields respectively."
(interactive (list 'interactive))
(let ((handle-before
- (save-match-data
- (save-excursion
- (re-search-backward mastodon-handle-regex nil :no-error)
- (if (match-string-no-properties 2)
- (buffer-substring-no-properties (match-beginning 2) (match-end 2))
- "")))))
+ ;; hack to handle @handles@with.domains, as "@" is a word/symbol boundary
+ (if (string= str-prefix "@")
+ (save-match-data
+ (save-excursion
+ (re-search-backward mastodon-toot-handle-regex nil :no-error)
+ (if (match-string-no-properties 2)
+ ;; match full handle inc. domain (see the regex for subexp 2)
+ (buffer-substring-no-properties (match-beginning 2) (match-end 2))
+ ""))))))
(cl-case command
(interactive (company-begin-backend (quote backend-name)))
(prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode
@@ -792,7 +885,10 @@ meta fields respectively."
(forward-whitespace -1)
(forward-whitespace 1)
(looking-at str-prefix)))
- (concat str-prefix (substring-no-properties handle-before 1))))
+ (if (and (string= str-prefix "@")
+ (> (length handle-before) 1)) ; more than just @
+ (concat str-prefix (substring-no-properties handle-before 1)) ; handle
+ (concat str-prefix (company-grab-symbol))))) ; tag
(candidates (funcall candidates-fun arg))
(annotation (funcall annot-fun arg))
(meta (funcall meta-fun arg)))))
@@ -975,12 +1071,6 @@ which is used to attach it to a toot when posting."
mastodon-toot--media-attachments))
(list "None")))
-(defun mastodon-toot--make-poll-options-params (options)
- "Return an parameter query alist from poll OPTIONS."
- (let ((key "poll[options][]"))
- (cl-loop for o in options
- collect `(,key . ,o))))
-
(defun mastodon-toot--fetch-max-poll-options ()
"Return the maximum number of poll options."
(mastodon-toot--fetch-poll-field 'max_options))
@@ -991,7 +1081,7 @@ which is used to attach it to a toot when posting."
50)) ; masto default
(defun mastodon-toot--fetch-poll-field (field)
- "Return FIELD from the poll settings from the user's instance. "
+ "Return FIELD from the poll settings from the user's instance."
(let* ((instance (mastodon-http--get-json (mastodon-http--api "instance"))))
(alist-get field
(alist-get 'polls
@@ -1023,7 +1113,8 @@ MAX is the maximum number set by their instance."
(message "poll created!")))
(defun mastodon-toot--read-poll-options (count length)
- "Read a list of options for poll of LENGTH options."
+ "Read a list of options for poll with COUNT options.
+LENGTH is the maximum character length allowed for a poll option."
(cl-loop for x from 1 to count
collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length))))
@@ -1177,7 +1268,7 @@ REPLY-JSON is the full JSON of the toot being replied to."
(setq mastodon-toot--reply-to-id reply-to-id)
(unless (equal mastodon-toot--visibility reply-visibility)
(setq mastodon-toot--visibility reply-visibility))
- (mastodon-toot-set-cw reply-cw))))
+ (mastodon-toot--set-cw reply-cw))))
(defun mastodon-toot--update-status-fields (&rest _args)
"Update the status fields in the header based on the current state."
@@ -1219,7 +1310,7 @@ REPLY-JSON is the full JSON of the toot being replied to."
'face 'mastodon-cw-face)))))
(defun mastodon-toot--count-toot-chars (toot-string)
- "Count the characters in the current toot.
+ "Count the characters in TOOT-STRING.
URLs always = 23, and domain names of handles are not counted.
This is how mastodon does it."
(with-temp-buffer
@@ -1246,15 +1337,15 @@ Added to `after-change-functions' in new toot buffers."
(unless (string-empty-p text)
(setq mastodon-toot-current-toot-text text))))
-(defun mastodon-toot-open-draft-toot ()
+(defun mastodon-toot--open-draft-toot ()
"Prompt for a draft and compose a toot with it."
(interactive)
(if mastodon-toot-draft-toots-list
(let ((text (completing-read "Select draft toot: "
mastodon-toot-draft-toots-list
nil t)))
- (if (mastodon-toot-compose-buffer-p)
- (when (and (not (mastodon-toot-empty-p :text-only))
+ (if (mastodon-toot--compose-buffer-p)
+ (when (and (not (mastodon-toot--empty-p :text-only))
(y-or-n-p "Replace current text with draft?"))
(cl-pushnew mastodon-toot-current-toot-text
mastodon-toot-draft-toots-list)
@@ -1266,11 +1357,11 @@ Added to `after-change-functions' in new toot buffers."
;; (delete-region (point) (point-max))
(insert text))
(mastodon-toot--compose-buffer nil nil nil text)))
- (unless (mastodon-toot-compose-buffer-p)
+ (unless (mastodon-toot--compose-buffer-p)
(mastodon-toot--compose-buffer))
(message "No drafts available.")))
-(defun mastodon-toot-delete-draft-toot ()
+(defun mastodon-toot--delete-draft-toot ()
"Prompt for a draft toot and delete it."
(interactive)
(if mastodon-toot-draft-toots-list
@@ -1283,7 +1374,7 @@ Added to `after-change-functions' in new toot buffers."
(message "Draft deleted!"))
(message "No drafts to delete.")))
-(defun mastodon-toot-delete-all-drafts ()
+(defun mastodon-toot--delete-all-drafts ()
"Delete all drafts."
(interactive)
(setq mastodon-toot-draft-toots-list nil)
@@ -1292,7 +1383,7 @@ Added to `after-change-functions' in new toot buffers."
(defun mastodon-toot--propertize-tags-and-handles (&rest _args)
"Propertize tags and handles in toot compose buffer.
Added to `after-change-functions'."
- (when (mastodon-toot-compose-buffer-p)
+ (when (mastodon-toot--compose-buffer-p)
(let ((header-region
(mastodon-tl--find-property-range 'toot-post-header
(point-min))))
@@ -1304,7 +1395,7 @@ Added to `after-change-functions'."
'success
(cdr header-region))
(mastodon-toot--propertize-item
- mastodon-handle-regex
+ mastodon-toot-handle-regex
'mastodon-display-name-face
(cdr header-region)))))
@@ -1317,7 +1408,7 @@ Added to `after-change-functions'."
(match-end 2)
`(face ,face)))))
-(defun mastodon-toot-compose-buffer-p ()
+(defun mastodon-toot--compose-buffer-p ()
"Return t if compose buffer is current."
(equal (buffer-name (current-buffer)) "*new toot*"))
@@ -1375,7 +1466,7 @@ a draft into the buffer."
(insert initial-text))))
;;;###autoload
-(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings-maybe)
+(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe)
(define-minor-mode mastodon-toot-mode
"Minor mode to capture Mastodon toots."
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 7ec6ee3..e6dcd3c 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -91,8 +91,12 @@
(when (require 'lingva nil :no-error)
(autoload 'mastodon-toot--translate-toot-text "mastodon-toot"))
(autoload 'mastodon-search--trending-tags "mastodon-search")
-(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile")
(autoload 'mastodon-profile-account-settings "mastodon-profile")
+(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile")
+(autoload 'mastodon-notifications--get-mentions "mastodon-notifications")
+(autoload 'mastodon-tl--view-lists "mastodon-tl")
+(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot")
+(autoload 'mastodon-toot--view-toot-history "mastodon-tl")
(defgroup mastodon nil
"Interface with Mastodon."
@@ -188,18 +192,16 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle)
(define-key map (kbd "V") #'mastodon-profile--view-favourites)
(define-key map (kbd "R") #'mastodon-profile--view-follow-requests)
- ;; (define-key map (kbd "C-c h") #'mastodon-async--stream-home)
- ;; (define-key map (kbd "C-c f") #'mastodon-async--stream-federated)
- ;; (define-key map (kbd "C-c l") #'mastodon-async--stream-local)
- ;; (define-key map (kbd "C-c n") #'mastodon-async--stream-notifications)
(define-key map (kbd "U") #'mastodon-profile--update-user-profile-note)
- (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept)
- (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject)
(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)
(define-key map (kbd "I") #'mastodon-tl--view-filters)
(define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions)
+ (define-key map (kbd "X") #'mastodon-tl--view-lists)
+ (define-key map (kbd "@") #'mastodon-notifications--get-mentions)
+ (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point)
+ (define-key map (kbd "E") #'mastodon-toot--view-toot-edits)
(when (require 'lingva nil :no-error)
(define-key map (kbd "s") #'mastodon-toot--translate-toot-text))
map)
@@ -214,7 +216,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
(defface mastodon-handle-face
'((t :inherit default))
- "Face used for user display names.")
+ "Face used for user handles in bylines.")
(defface mastodon-display-name-face
'((t :inherit warning))
@@ -253,7 +255,9 @@ Use. e.g. \"%c\" for your locale's date and time format."
(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))))
+ (message "Loading Mastodon account %s on %s..."
+ (mastodon-auth--user-acct)
+ mastodon-instance-url))))
;;;###autoload
(defun mastodon-toot (&optional user reply-to-id reply-json)
@@ -330,7 +334,7 @@ not, just browse the URL in the normal fashion."
(mastodon-toot--enable-custom-emoji)))))
;;;###autoload
-(add-hook 'mastodon-mode-hook #'mastodon-profile-fetch-server-account-settings)
+(add-hook 'mastodon-mode-hook #'mastodon-profile--fetch-server-account-settings)
(define-derived-mode mastodon-mode special-mode "Mastodon"
"Major mode for Mastodon, the federated microblogging network."