aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-12-01 11:42:26 +0100
committermarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-12-01 11:42:26 +0100
commitc1b7d20c019b2be5e6d025ed7de9b0cf7878a092 (patch)
tree1df046c513ea470fd1d7002d96be0594bf392841
parent1ae42ccc7771ee8584d5aad0675b62f7ba851939 (diff)
parent7a70e091f64729b03ad55079b5a3a86afd178d0c (diff)
Merge branch 'develop'
-rw-r--r--lisp/mastodon-discover.el2
-rw-r--r--lisp/mastodon-http.el2
-rw-r--r--lisp/mastodon-inspect.el2
-rw-r--r--lisp/mastodon-media.el2
-rw-r--r--lisp/mastodon-notifications.el2
-rw-r--r--lisp/mastodon-profile.el132
-rw-r--r--lisp/mastodon-tl.el215
-rw-r--r--lisp/mastodon-toot.el196
-rw-r--r--test/mastodon-tl-tests.el20
9 files changed, 499 insertions, 74 deletions
diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el
index 08df46e..1b960e5 100644
--- a/lisp/mastodon-discover.el
+++ b/lisp/mastodon-discover.el
@@ -1,7 +1,9 @@
;;; mastodon-discover.el --- Use Mastodon.el with discover.el -*- lexical-binding: t -*-
;; Copyright (C) 2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
+;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1"))
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index d677e57..9ef7aec 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -1,7 +1,9 @@
;;; mastodon-http.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
+;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1") (request "0.3.0"))
diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el
index cbf6a8e..112a753 100644
--- a/lisp/mastodon-inspect.el
+++ b/lisp/mastodon-inspect.el
@@ -1,7 +1,9 @@
;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
+;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1"))
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index c783130..4e50dbc 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -1,7 +1,9 @@
;;; mastodon-media.el --- Functions for inlining Mastodon media -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
+;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1"))
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index f5ddea3..b7fe038 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -1,7 +1,9 @@
;;; mastodon-notifications.el --- Notification functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
+;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1"))
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 1200972..7e3262a 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -1,7 +1,9 @@
;;; mastodon-profile.el --- Functions for inspecting Mastodon profiles -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
+;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
;; Version: 1.0.0
;; Package-Requires: ((emacs "27.1"))
@@ -75,6 +77,7 @@
(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl")
(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
(autoload 'mastodon-tl--symbol "mastodon-tl")
+(autoload 'mastodon-auth--get-account-id "mastodon-auth")
(defvar mastodon-instance-url)
(defvar mastodon-tl--buffer-spec)
@@ -129,7 +132,7 @@ extra keybindings."
(defvar mastodon-profile-update-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'mastodon-profile--user-profile-send-updated)
- (define-key map (kbd "C-c C-k") #'kill-buffer-and-window)
+ (define-key map (kbd "C-c C-k") #'mastodon-profile--update-profile-note-cancel)
map)
"Keymap for `mastodon-profile-update-mode'.")
@@ -293,31 +296,77 @@ JSON is the data returned by the server."
(source (alist-get 'source json))
(note (alist-get 'note source))
(buffer (get-buffer-create "*mastodon-update-profile*"))
- (inhibit-read-only t))
+ (inhibit-read-only t)
+ (msg-str "Edit your profile note. C-c C-c to send, C-c C-k to cancel."))
(switch-to-buffer-other-window buffer)
(text-mode)
(mastodon-tl--set-buffer-spec (buffer-name buffer)
endpoint
nil)
(setq-local header-line-format
- (propertize
- "Edit your profile note. C-c C-c to send, C-c C-k to cancel."
- 'face font-lock-comment-face))
+ (propertize msg-str
+ 'face font-lock-comment-face))
(mastodon-profile-update-mode t)
- (insert note)
- (goto-char (point-min))
+ (insert (propertize (concat (propertize "0"
+ 'note-counter t
+ 'display nil)
+ "/500 characters")
+ 'read-only t
+ 'face 'font-lock-comment-face
+ 'note-header t)
+ "\n")
+ (make-local-variable 'after-change-functions)
+ (push #'mastodon-profile--update-note-count after-change-functions)
+ (let ((start-point (point)))
+ (insert note)
+ (goto-char start-point))
(delete-trailing-whitespace) ; remove all ^M's
- (message "Edit your profile note. C-c C-c to send, C-c C-k to cancel.")))
+ (message msg-str)))
+
+(defun mastodon-profile--update-note-count (&rest _args)
+ "Display the character count of the profile note buffer."
+ (let ((inhibit-read-only t)
+ (header-region (mastodon-tl--find-property-range 'note-header
+ (point-min)))
+ (count-region (mastodon-tl--find-property-range 'note-counter
+ (point-min))))
+ (add-text-properties (car count-region) (cdr count-region)
+ (list 'display
+ (number-to-string
+ (mastodon-toot--count-toot-chars
+ (buffer-substring-no-properties
+ (cdr header-region) (point-max))))))))
+
+(defun mastodon-profile--update-profile-note-cancel ()
+ "Cancel updating user profile and kill buffer and window."
+ (interactive)
+ (when (y-or-n-p "Cancel updating your profile note?")
+ (kill-buffer-and-window)))
+
+(defun mastodon-profile--note-remove-header ()
+ "Get the body of a toot from the current compose buffer."
+ (let ((header-region (mastodon-tl--find-property-range 'note-header
+ (point-min))))
+ (buffer-substring (cdr header-region) (point-max))))
(defun mastodon-profile--user-profile-send-updated ()
- "Send PATCH request with the updated profile note."
+ "Send PATCH request with the updated profile note.
+Ask for confirmation if length > 500 characters."
(interactive)
- (let* ((note (buffer-substring-no-properties (point-min) (point-max)))
+ (let* ((note (mastodon-profile--note-remove-header))
(url (mastodon-http--api "accounts/update_credentials")))
- (kill-buffer-and-window)
- (let ((response (mastodon-http--patch url `(("note" . ,note)))))
- (mastodon-http--triage response
- (lambda () (message "Profile note updated!"))))))
+ (if (> (mastodon-toot--count-toot-chars note) 500)
+ (when (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?")
+ (kill-buffer-and-window)
+ (mastodon-profile--user-profile-send-updated-do url note))
+ (kill-buffer-and-window)
+ (mastodon-profile--user-profile-send-updated-do url note))))
+
+(defun mastodon-profile--user-profile-send-updated-do (url note)
+ "Send PATCH request with the updated profile note."
+ (let ((response (mastodon-http--patch url `(("note" . ,note)))))
+ (mastodon-http--triage response
+ (lambda () (message "Profile note updated!")))))
(defun mastodon-profile--update-preference (pref val &optional source)
"Update account PREF erence to setting VAL.
@@ -573,14 +622,14 @@ NO-REBLOGS means do not display boosts in statuses.
HEADERS means also fetch link headers for pagination."
(let* ((id (mastodon-profile--account-field account 'id))
(args (when no-reblogs '(("exclude_reblogs" . "t"))))
- (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type)))
+ (endpoint (format "accounts/%s/%s" id endpoint-type))
+ (url (mastodon-http--api endpoint))
(acct (mastodon-profile--account-field account 'acct))
(buffer (concat "*mastodon-" acct "-" endpoint-type "*"))
(response (if headers
(mastodon-http--get-response url args)
(mastodon-http--get-json url args)))
(json (if headers (car response) response))
- (endpoint (format "accounts/%s/%s" id endpoint-type))
(link-header (when headers
(mastodon-tl--get-link-header-from-response
(cdr response))))
@@ -838,5 +887,56 @@ These include the author, author of reblogged entries and any user mentioned."
(t
(mastodon-profile--search-account-by-handle handle)))))
+(defun mastodon-profile--remove-user-from-followers (&optional id)
+ "Remove a user from your followers.
+Optionally provide the ID of the account to remove."
+ (interactive)
+ (let* ((account (unless id (get-text-property (point) 'toot-json)))
+ (id (or id (alist-get 'id account)))
+ (handle (if account
+ (alist-get 'acct account)
+ (let ((account
+ (mastodon-profile--account-from-id id)))
+ (alist-get 'acct account))))
+ (url (mastodon-http--api
+ (format "accounts/%s/remove_from_followers" id))))
+ (when (y-or-n-p (format "Remove follower %s? " handle))
+ (let ((response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda ()
+ (message "Follower %s removed!" handle)))))))
+
+(defun mastodon-profile--remove-from-followers-at-point ()
+ "Prompt for a user in the item at point and remove from followers."
+ (interactive)
+ (let* ((handles (mastodon-profile--extract-users-handles
+ (mastodon-profile--toot-json)))
+ (handle (completing-read "Remove from followers: "
+ handles nil))
+ (account (mastodon-profile--lookup-account-in-status
+ handle (mastodon-profile--toot-json)))
+ (id (alist-get 'id account)))
+ (mastodon-profile--remove-user-from-followers id)))
+
+(defun mastodon-profile--remove-from-followers-list ()
+ "Select a user from your followers and remove from followers.
+Currently limited to 100 handles. If not found, try
+`mastodon-search--search-query'."
+ (interactive)
+ (let* ((endpoint (format "accounts/%s/followers"
+ (mastodon-auth--get-account-id)))
+ (url (mastodon-http--api endpoint))
+ (response (mastodon-http--get-json url
+ `(("limit" . "100"))))
+ (handles (mapcar (lambda (x)
+ (cons
+ (alist-get 'acct x)
+ (alist-get 'id x)))
+ response))
+ (choice (completing-read "Remove from followers: "
+ handles))
+ (id (alist-get choice handles nil nil 'equal)))
+ (mastodon-profile--remove-user-from-followers id)))
+
(provide 'mastodon-profile)
;;; mastodon-profile.el ends here
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index a5b5ed7..e732420 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -1,6 +1,7 @@
;;; mastodon-tl.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
@@ -79,6 +80,14 @@
(autoload 'mastodon-http--build-params-string "mastodon-http")
(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications")
(autoload 'mastodon-toot--get-toot-edits "mastodon-toot")
+(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
+(autoload 'mastodon-toot--compose-buffer "mastodon-toot")
+(autoload 'mastodon-toot--set-toot-properties "mastodon-toot")
+(autoload 'mastodon-toot--schedule-toot "mastodon-toot")
+(autoload 'mastodon-toot--iso-to-human "mastodon-toot")
+
+(defvar mastodon-toot--visibility)
+(defvar mastodon-active-user)
(when (require 'mpv nil :no-error)
(declare-function mpv-start "mpv"))
@@ -251,6 +260,15 @@ types of mastodon links and not just shr.el-generated ones.")
(keymap-canonicalize map))
"Keymap for when point is on list name.")
+(defvar mastodon-tl--scheduled-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "r") 'mastodon-tl--reschedule-toot)
+ (define-key map (kbd "c") 'mastodon-tl--cancel-scheduled-toot)
+ (define-key map (kbd "e") 'mastodon-tl--edit-scheduled-as-new)
+ (define-key map (kbd "<return>") 'mastodon-tl--edit-scheduled-as-new)
+ (keymap-canonicalize map))
+ "Keymap for when point is on a scheduled toot.")
+
(defvar mastodon-tl--byline-link-keymap
(when (require 'mpv nil :no-error)
(let ((map (make-sparse-keymap)))
@@ -564,25 +582,25 @@ TIMESTAMP is assumed to be in the past."
(relative-result
(cond
((< seconds-difference 60)
- (cons "less than a minute ago"
+ (cons "just now"
60))
((< seconds-difference (* 1.5 60))
- (cons "one minute ago"
+ (cons "1 minute ago"
90)) ;; at 90 secs
((< seconds-difference (* 60 59.5))
(funcall regular-response seconds-difference 60 "minute"))
((< seconds-difference (* 1.5 60 60))
- (cons "one hour ago"
+ (cons "1 hour ago"
(* 60 90))) ;; at 90 minutes
((< seconds-difference (* 60 60 23.5))
(funcall regular-response seconds-difference (* 60 60) "hour"))
((< seconds-difference (* 1.5 60 60 24))
- (cons "one day ago"
+ (cons "1 day ago"
(* 1.5 60 60 24))) ;; at a day and a half
((< seconds-difference (* 60 60 24 6.5))
(funcall regular-response seconds-difference (* 60 60 24) "day"))
((< seconds-difference (* 1.5 60 60 24 7))
- (cons "one week ago"
+ (cons "1 week ago"
(* 1.5 60 60 24 7))) ;; a week and a half
((< seconds-difference (* 60 60 24 7 52))
(if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7))))
@@ -590,7 +608,7 @@ TIMESTAMP is assumed to be in the past."
(* 60 60 24 7 52))
(funcall regular-response seconds-difference (* 60 60 24 7) "week")))
((< seconds-difference (* 1.5 60 60 24 365))
- (cons "one year ago"
+ (cons "1 year ago"
(* 60 60 24 365 1.5))) ;; a year and a half
(t
(funcall regular-response seconds-difference (* 60 60 24 365.25) "year")))))
@@ -1157,7 +1175,7 @@ this just means displaying toot client."
(let* ((poll (mastodon-tl--field 'poll toot))
(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))
+ ;; (multi (mastodon-tl--field 'multiple poll))
(voters-count (mastodon-tl--field 'voters_count poll))
(vote-count (mastodon-tl--field 'votes_count poll))
(options (mastodon-tl--field 'options poll))
@@ -1440,6 +1458,8 @@ webapp"
(reblog (alist-get 'reblog json)))
(if reblog (alist-get 'id reblog) id)))
+;;; THREADS
+
(defun mastodon-tl--single-toot (id)
"View toot at point in separate buffer.
ID is that of the toot to view."
@@ -1469,7 +1489,8 @@ ID is that of the toot to view."
(if (or (string= type "follow_request")
(string= type "follow")) ; no can thread these
(error "No thread")
- (let* ((url (mastodon-http--api (format "statuses/%s/context" id)))
+ (let* ((endpoint (format "statuses/%s/context" id))
+ (url (mastodon-http--api endpoint))
(buffer (format "*mastodon-thread-%s*" id))
(toot
;; refetch current toot in case we just faved/boosted:
@@ -1492,7 +1513,7 @@ ID is that of the toot to view."
(switch-to-buffer buffer)
(mastodon-mode)
(mastodon-tl--set-buffer-spec buffer
- (format "statuses/%s/context" id)
+ endpoint
nil)
(let ((inhibit-read-only t))
(mastodon-tl--timeline (alist-get 'ancestors context))
@@ -1507,6 +1528,65 @@ ID is that of the toot to view."
;; else just print the lone toot:
(mastodon-tl--single-toot id)))))))
+
+(defun mastodon-tl--mute-thread ()
+ "Mute the thread displayed in the current buffer.
+Note that you can only (un)mute threads you have posted in."
+ (interactive)
+ (mastodon-tl--mute-or-unmute-thread))
+
+(defun mastodon-tl--unmute-thread ()
+ "Mute the thread displayed in the current buffer.
+Note that you can only (un)mute threads you have posted in."
+ (interactive)
+ (mastodon-tl--mute-or-unmute-thread :unmute))
+
+(defun mastodon-tl--mute-or-unmute-thread (&optional unmute)
+ "Mute a thread.
+If UNMUTE, unmute it."
+ (let ((endpoint (mastodon-tl--get-endpoint)))
+ (if (string-suffix-p "context" endpoint) ; thread view
+ (let* ((id
+ (save-match-data
+ (string-match "statuses/\\(?2:[[:digit:]]+\\)/context"
+ endpoint)
+ (match-string 2 endpoint)))
+ (we-posted-p (mastodon-tl--user-in-thread-p id))
+ (url (mastodon-http--api
+ (if unmute
+ (format "statuses/%s/unmute" id)
+ (format "statuses/%s/mute" id)))))
+ (if (not we-posted-p)
+ (message "You can only (un)mute a thread you have posted in.")
+ (when (if unmute
+ (y-or-n-p "Unnute this thread? ")
+ (y-or-n-p "Mute this thread? "))
+ (let ((response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda ()
+ (if unmute
+ (message "Thread unmuted!")
+ (message "Thread muted!")))))))))))
+
+(defun mastodon-tl--user-in-thread-p (id)
+ "Return non-nil if the logged-in user has posted to the current thread.
+ID is that of the post the context is currently displayed for."
+ (let* ((context-json (mastodon-http--get-json
+ (mastodon-http--api (format "statuses/%s/context" id))
+ nil :silent))
+ (ancestors (alist-get 'ancestors context-json))
+ (descendants (alist-get 'descendants context-json))
+ (a-ids (mapcar (lambda (status)
+ (alist-get 'id
+ (alist-get 'account status)))
+ ancestors))
+ (d-ids (mapcar (lambda (status)
+ (alist-get 'id
+ (alist-get 'account status)))
+ descendants)))
+ (or (member (mastodon-auth--get-account-id) a-ids)
+ (member (mastodon-auth--get-account-id) d-ids))))
+
;;; LISTS
(defun mastodon-tl--get-users-lists ()
@@ -1770,6 +1850,111 @@ If ID is provided, use that list."
(let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id))))
(mastodon-http--get-json url)))
+;;; SCHEDULED TOOTS
+
+(defun mastodon-tl--get-scheduled-toots (&optional id)
+ "Get the user's currently scheduled toots.
+If ID, just return that toot."
+ (let* ((endpoint (if id
+ (format "scheduled_statuses/%s" id)
+ "scheduled_statuses"))
+ (url (mastodon-http--api endpoint)))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl--reschedule-toot ()
+ "Reschedule the scheduled toot at point."
+ (interactive)
+ (mastodon-toot--schedule-toot :reschedule))
+
+(defun mastodon-tl--view-scheduled-toots ()
+ "Show the user's scheduled toots in a new buffer."
+ (interactive)
+ (mastodon-tl--init-sync "scheduled-toots"
+ "scheduled_statuses"
+ 'mastodon-tl--insert-scheduled-toots))
+
+(defun mastodon-tl--insert-scheduled-toots (json)
+ "Insert the user's scheduled toots, from JSON."
+ (let ((scheduleds (mastodon-tl--get-scheduled-toots)))
+ (erase-buffer)
+ (insert (mastodon-tl--set-face
+ (concat "\n ------------\n"
+ " YOUR SCHEDULED TOOTS\n"
+ " ------------\n\n")
+ 'success)
+ (mastodon-tl--set-face
+ "[n/p - prev/next\n r - reschedule\n e/RET - edit toot\n c - cancel]\n\n"
+ 'font-lock-comment-face))
+ (mapc (lambda (x)
+ (mastodon-tl--insert-scheduled-toot x))
+ scheduleds)
+ (goto-char (point-min))
+ (when json
+ (mastodon-tl--goto-next-toot))))
+
+(defun mastodon-tl--insert-scheduled-toot (toot)
+ "Insert scheduled TOOT into the buffer."
+ (let* ((id (alist-get 'id toot))
+ (scheduled (alist-get 'scheduled_at toot))
+ (params (alist-get 'params toot))
+ (text (alist-get 'text params)))
+ (insert
+ (propertize (concat text
+ " | "
+ (mastodon-toot--iso-to-human scheduled))
+ 'byline t ; so we nav here
+ 'toot-id "0" ; so we nav here
+ 'face 'font-lock-comment-face
+ 'keymap mastodon-tl--scheduled-map
+ 'scheduled-json toot
+ 'id id)
+ "\n")))
+
+(defun mastodon-tl--copy-scheduled-toot-text ()
+ "Copy the text of the scheduled toot at point."
+ (interactive)
+ (let* ((toot (get-text-property (point) 'toot))
+ (params (alist-get 'params toot))
+ (text (alist-get 'text params)))
+ (kill-new text)))
+
+(defun mastodon-tl--cancel-scheduled-toot (&optional id no-confirm)
+ "Cancel the scheduled toot at point.
+ID is that of the scheduled toot to cancel.
+NO-CONFIRM means there is no ask or message, there is only do."
+ (interactive)
+ (let* ((id (or id (get-text-property (point) 'id)))
+ (url (mastodon-http--api (format "scheduled_statuses/%s" id))))
+ (when (or no-confirm
+ (y-or-n-p "Cancel scheduled toot?"))
+ (let ((response (mastodon-http--delete url)))
+ (mastodon-http--triage response
+ (lambda ()
+ (mastodon-tl--view-scheduled-toots)
+ (unless no-confirm
+ (message "Toot cancelled!"))))))))
+
+(defun mastodon-tl--edit-scheduled-as-new ()
+ "Edit scheduled status as new toot."
+ (interactive)
+ (let* ((toot (get-text-property (point) 'scheduled-json))
+ (id (alist-get 'id toot))
+ (scheduled (alist-get 'scheduled_at toot))
+ (params (alist-get 'params toot))
+ (text (alist-get 'text params))
+ (visibility (alist-get 'visibility params))
+ (cw (alist-get 'spoiler_text params))
+ (lang (alist-get 'language params))
+ ;; (poll (alist-get 'poll params))
+ (reply-id (alist-get 'in_reply_to_id params)))
+ ;; (media (alist-get 'media_attachments toot)))
+ (mastodon-toot--compose-buffer)
+ (goto-char (point-max))
+ (insert text)
+ ;; adopt properties from scheduled toot:
+ (mastodon-toot--set-toot-properties reply-id visibility cw
+ lang scheduled id)))
+
;;; FILTERS
(defun mastodon-tl--create-filter ()
@@ -1895,7 +2080,7 @@ RESPONSE is the JSON returned by the server."
(message "Looks like there's no toot or user at point?")
,@body))
-;;;; INSTANCES
+;;; INSTANCES
(defun mastodon-tl--view-own-instance (&optional brief)
"View details of your own instance.
@@ -2175,6 +2360,16 @@ LANGS is the accumulated array param alist if we re-run recursively."
(message "Looks like you have no mutes to unmute!")
(mastodon-tl--do-user-action-and-response user-handle "unmute" t)))
+(defun mastodon-tl--dm-user (user-handle)
+ "Query for USER-HANDLE from current status and compose a message to that user."
+ (interactive
+ (list
+ (mastodon-tl--interactive-user-handles-get "message")))
+ (mastodon-tl--do-if-toot
+ (mastodon-toot--compose-buffer (concat "@" user-handle))
+ (setq mastodon-toot--visibility "direct")
+ (mastodon-toot--update-status-fields)))
+
(defun mastodon-tl--interactive-user-handles-get (action)
"Get the list of user-handles for ACTION from the current toot."
(mastodon-tl--do-if-toot
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 099ce10..8d8bfc2 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -1,6 +1,7 @@
;;; mastodon-toot.el --- Minor mode for sending Mastodon toots -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
;; Author: Johnson Denen <johnson.denen@gmail.com>
;; Marty Hiatt <martianhiatus@riseup.net>
;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
@@ -79,6 +80,10 @@
(autoload 'mastodon-tl--get-endpoint "mastodon-tl")
(autoload 'mastodon-http--put "mastodon-http")
(autoload 'mastodon-tl--symbol "mastodon-tl")
+(autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl")
+(autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot")
+(autoload 'org-read-date "org")
+(autoload 'iso8601-parse "iso8601")
;; for mastodon-toot--translate-toot-text
(autoload 'mastodon-tl--content "mastodon-tl")
@@ -175,6 +180,13 @@ change the setting on the server, see
(defvar-local mastodon-toot--language nil
"The language of the toot being composed, in ISO 639 (two-letter).")
+(defvar-local mastodon-toot--scheduled-for nil
+ "An ISO 8601 timestamp that specifying when the post should be published.
+Should be at least 5 minutes into the future.")
+
+(defvar-local mastodon-toot--scheduled-id nil
+ "The id of the scheduled post that we are now editing.")
+
(defvar-local mastodon-toot--reply-to-id nil
"Buffer-local variable to hold the id of the toot being replied to.")
@@ -227,7 +239,8 @@ send.")
(define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media)
(define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments)
(define-key map (kbd "C-c C-p") #'mastodon-toot--create-poll)
- (define-key map (kbd "C-c C-l") #'mastodon-toot--set-toot-lang)
+ (define-key map (kbd "C-c C-l") #'mastodon-toot--set-toot-language)
+ (define-key map (kbd "C-c C-s") #'mastodon-toot--schedule-toot)
map)
"Keymap for `mastodon-toot'.")
@@ -513,11 +526,25 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
(goto-char (point-max))
(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)
- (mastodon-toot--set-cw toot-cw)
- (mastodon-toot--update-status-fields))))
+ (mastodon-toot--set-toot-properties
+ reply-id toot-visibility toot-cw
+ ;; TODO set new lang/scheduled props here
+ nil))))
+
+(defun mastodon-toot--set-toot-properties (reply-id visibility cw lang
+ &optional scheduled
+ scheduled-id)
+ "Set the toot properties for the current redrafted or edited toot.
+REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set."
+ (when reply-id
+ (setq mastodon-toot--reply-to-id reply-id))
+ (setq mastodon-toot--visibility visibility)
+ (setq mastodon-toot--scheduled-for scheduled)
+ (setq mastodon-toot--scheduled-id scheduled-id)
+ (when (not (string-empty-p lang))
+ (setq mastodon-toot--language lang))
+ (mastodon-toot--set-cw cw)
+ (mastodon-toot--update-status-fields))
(defun mastodon-toot--kill (&optional cancel)
"Kill `mastodon-toot-mode' buffer and window.
@@ -686,7 +713,8 @@ instance to edit a toot."
("sensitive" . ,(when mastodon-toot--content-nsfw
(symbol-name t)))
("spoiler_text" . ,spoiler)
- ("language" . ,mastodon-toot--language)))
+ ("language" . ,mastodon-toot--language)
+ ("scheduled_at" . ,mastodon-toot--scheduled-for)))
(args-media (when mastodon-toot--media-attachments
(mastodon-http--build-array-params-alist
"media_ids[]"
@@ -699,7 +727,9 @@ instance to edit a toot."
(if mastodon-toot-poll
(append args-no-media args-poll)
args-no-media)))
- (prev-window-config mastodon-toot-previous-window-config))
+ (prev-window-config mastodon-toot-previous-window-config)
+ (scheduled mastodon-toot--scheduled-for)
+ (scheduled-id mastodon-toot--scheduled-id))
(cond ((and mastodon-toot--media-attachments
;; make sure we have media args
;; and the same num of ids as attachments
@@ -720,8 +750,15 @@ instance to edit a toot."
(mastodon-http--triage response
(lambda ()
(mastodon-toot--kill)
- (message "Toot toot!")
- (mastodon-toot--restore-previous-window-config prev-window-config))))))))
+ (if scheduled
+ (message "Toot scheduled!")
+ (message "Toot toot!"))
+ ;; cancel scheduled toot if we were editing it:
+ (when scheduled-id
+ (mastodon-tl--cancel-scheduled-toot
+ scheduled-id :no-confirm))
+ (mastodon-toot--restore-previous-window-config
+ prev-window-config))))))))
;; EDITING TOOTS:
@@ -737,16 +774,15 @@ instance to edit a toot."
(content (alist-get 'text source))
(source-cw (alist-get 'spoiler_text source))
(toot-visibility (alist-get 'visibility toot))
+ (toot-language (alist-get 'language toot))
(reply-id (alist-get 'in_reply_to_id toot)))
(when (y-or-n-p "Edit this toot? ")
(mastodon-toot--compose-buffer)
(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)
+ ;; adopt reply-to-id, visibility, CW, and language:
+ (mastodon-toot--set-toot-properties reply-id toot-visibility
+ source-cw toot-language)
(mastodon-toot--update-status-fields)
(setq mastodon-toot--edit-toot-id id))))))
@@ -788,8 +824,8 @@ instance to edit a toot."
(defun mastodon-toot--insert-toot-iter (it)
"Insert iteration IT of toot."
- (let ((content (alist-get 'content it))
- (account (alist-get 'account it)))
+ (let ((content (alist-get 'content it)))
+ ;; (account (alist-get 'account it))
;; TODO: handle polls, media
(mastodon-tl--render-text content)))
@@ -827,16 +863,38 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
"")))
(defun mastodon-toot--get-bounds (regex)
- "Get bounds of tag or handle before point."
+ "Get bounds of tag or handle before point using REGEX."
;; needed because # and @ are not part of any existing thing at point
(save-match-data
(save-excursion
;; match full handle inc. domain, or tag including #
;; (see the regexes for subexp 2)
- (when (re-search-backward regex nil :no-error)
+ (when (re-search-backward regex
+ (save-excursion
+ (forward-whitespace -1)
+ (point))
+ :no-error)
(cons (match-beginning 2)
(match-end 2))))))
+(defun mastodon-toot--fetch-completion-candidates (start end &optional tags)
+ "Search for a completion prefix from buffer positions START to END.
+Return a list of candidates.
+If TAGS, we search for tags, else we search for handles."
+ ;; FIXME: can we save the first two-letter search then only filter the
+ ;; resulting list?
+ ;; (or mastodon-toot-completions
+ ;; would work if we could null that var upon completion success
+ (setq mastodon-toot-completions
+ (if tags
+ (let ((tags-list (mastodon-search--search-tags-query
+ (buffer-substring-no-properties start end))))
+ (cl-loop for tag in tags-list
+ collect (cons (concat "#" (car tag))
+ (cdr tag))))
+ (mastodon-search--search-accounts-query
+ (buffer-substring-no-properties start end)))))
+
(defun mastodon-toot--mentions-capf ()
"Build a mentions completion backend for `completion-at-point-functions'."
(let* ((bounds
@@ -849,11 +907,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
;; only search when necessary:
(completion-table-dynamic
(lambda (_)
- ;; TODO: do we really need to set a local var here
- ;; just for the annotation-function?
- (setq mastodon-toot-completions
- (mastodon-search--search-accounts-query
- (buffer-substring-no-properties start end)))))
+ (mastodon-toot--fetch-completion-candidates start end)))
:exclusive 'no
:annotation-function
(lambda (candidate)
@@ -872,13 +926,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
;; only search when necessary:
(completion-table-dynamic
(lambda (_)
- (setq mastodon-toot-completions
- (let ((tags (mastodon-search--search-tags-query
- (buffer-substring-no-properties start end))))
- (mapcar (lambda (x)
- (list (concat "#" (car x))
- (cdr x)))
- tags)))))
+ (mastodon-toot--fetch-completion-candidates start end :tags)))
:exclusive 'no
:annotation-function
(lambda (candidate)
@@ -893,7 +941,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
"Given a tag string CANDIDATE, return an annotation, the tag's URL."
;; FIXME check the list returned here? should be cadr
;;or make it an alist and use cdr
- (caadr (assoc candidate mastodon-toot-completions)))
+ (cadr (assoc candidate mastodon-toot-completions)))
(defun mastodon-toot--reply ()
"Reply to toot at `point'.
@@ -1111,7 +1159,7 @@ LENGTH is the maximum character length allowed for a poll option."
("14 days" . ,(number-to-string (* 60 60 24 14)))
("30 days" . ,(number-to-string (* 60 60 24 30)))))
-(defun mastodon-toot--set-toot-lang ()
+(defun mastodon-toot--set-toot-language ()
"Prompt for a language and set `mastodon-toot--language'.
Return its two letter ISO 639 1 code."
(interactive)
@@ -1119,7 +1167,54 @@ Return its two letter ISO 639 1 code."
mastodon-iso-639-1)))
(setq mastodon-toot--language
(alist-get choice mastodon-iso-639-1 nil nil 'equal))
- (message "Language set to %s" choice)))
+ (message "Language set to %s" choice)
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-toot--schedule-toot (&optional reschedule)
+ "Read a date (+ time) in the minibuffer and schedule the current toot.
+With RESCHEDULE, reschedule the scheduled toot at point without editing."
+ ;; original idea by christian tietze, thanks!
+ ;; https://codeberg.org/martianh/mastodon.el/issues/285
+ (interactive)
+ (let* ((id (when reschedule (get-text-property (point) 'id)))
+ (ts (when reschedule
+ (alist-get 'scheduled_at
+ (get-text-property (point) 'scheduled-json))))
+ (time-value
+ (org-read-date t t nil "Schedule toot:"
+ ;; default to scheduled timestamp if already set:
+ (mastodon-toot--iso-to-org
+ ;; we are rescheduling without editing:
+ (or ts
+ ;; we are maybe editing the scheduled toot:
+ mastodon-toot--scheduled-for))))
+ (iso8601-str (format-time-string "%FT%T%z" time-value))
+ (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value)))
+ (if (not reschedule)
+ (progn
+ (setq-local mastodon-toot--scheduled-for iso8601-str)
+ (message (format "Toot scheduled for %s." msg-str)))
+ (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str))))
+ (url (when reschedule (mastodon-http--api
+ (format "scheduled_statuses/%s" id))))
+ (response (mastodon-http--put url args)))
+ (mastodon-http--triage response
+ (lambda ()
+ ;; reschedule means we are in scheduled toots view:
+ (mastodon-tl--view-scheduled-toots)
+ (message
+ (format "Toot rescheduled for %s." msg-str))))))))
+
+(defun mastodon-toot--iso-to-human (ts)
+ "Format an ISO8601 timestamp TS to be more human-readable."
+ (let* ((decoded (iso8601-parse ts))
+ (encoded (encode-time decoded)))
+ (format-time-string "%d-%m-%y, %H:%M[%z]" encoded)))
+
+(defun mastodon-toot--iso-to-org (ts)
+ "Convert ISO8601 timestamp TS to something `org-read-date' can handle."
+ (when ts (let* ((decoded (iso8601-parse ts)))
+ (encode-time decoded))))
;; we'll need to revisit this if the binds get
;; more diverse than two-chord bindings
@@ -1211,6 +1306,12 @@ REPLY-TEXT is the text of the toot being replied to."
(propertize "Visibility"
'toot-post-visibility t)
" ⋅ "
+ (propertize "Language"
+ 'toot-post-language t)
+ " "
+ (propertize "Scheduled"
+ 'toot-post-scheduled t)
+ " "
(propertize "CW"
'toot-post-cw-flag t)
" "
@@ -1264,25 +1365,42 @@ REPLY-JSON is the full JSON of the toot being replied to."
(point-min)))
(cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
(point-min)))
+ (lang-region (mastodon-tl--find-property-range 'toot-post-language
+ (point-min)))
+ (scheduled-region (mastodon-tl--find-property-range 'toot-post-scheduled
+ (point-min)))
(toot-string (buffer-substring-no-properties (cdr header-region)
(point-max))))
(add-text-properties (car count-region) (cdr count-region)
(list 'display
- (format "%s/%s characters"
+ (format "%s/%s chars"
(mastodon-toot--count-toot-chars toot-string)
(number-to-string mastodon-toot--max-toot-chars))))
(add-text-properties (car visibility-region) (cdr visibility-region)
(list 'display
- (format "Visibility: %s"
+ (format "%s"
(if (equal
mastodon-toot--visibility
"private")
"followers-only"
mastodon-toot--visibility))))
+ (add-text-properties (car lang-region) (cdr lang-region)
+ (list 'display
+ (if mastodon-toot--language
+ (format "Lang: %s ⋅"
+ mastodon-toot--language)
+ "")))
+ (add-text-properties (car scheduled-region) (cdr scheduled-region)
+ (list 'display
+ (if mastodon-toot--scheduled-for
+ (format "Scheduled: %s ⋅"
+ (mastodon-toot--iso-to-human
+ mastodon-toot--scheduled-for))
+ "")))
(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)")
+ "NSFW" "NSFW (for attachments only)")
"")
'face 'mastodon-cw-face))
(add-text-properties (car cw-region) (cdr cw-region)
@@ -1434,7 +1552,9 @@ a draft into the buffer."
'completion-at-point-functions
#'mastodon-toot--tags-capf)
;; company
- (when mastodon-toot--use-company-for-completion
+ (when (and mastodon-toot--use-company-for-completion
+ (require 'company nil :no-error))
+ (declare-function 'company-mode-on "company")
(set (make-local-variable 'company-backends)
(add-to-list 'company-backends 'company-capf))
(company-mode-on)))
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index 1d9355b..726e21a 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -213,28 +213,28 @@ Strict-Transport-Security: max-age=31536000
(mastodon-tl--relative-time-description timestamp)))
(check (seconds expected)
(should (string= (format-seconds-since seconds) expected))))
- (check 1 "less than a minute ago")
- (check 59 "less than a minute ago")
- (check 60 "one minute ago")
- (check 89 "one minute ago") ;; rounding down
+ (check 1 "just now")
+ (check 59 "just now")
+ (check 60 "1 minute ago")
+ (check 89 "1 minute ago") ;; rounding down
(check 91 "2 minutes ago") ;; rounding up
(check (minutes 3.49) "3 minutes ago") ;; rounding down
(check (minutes 3.52) "4 minutes ago")
(check (minutes 59) "59 minutes ago")
- (check (minutes 60) "one hour ago")
- (check (minutes 89) "one hour ago")
+ (check (minutes 60) "1 hour ago")
+ (check (minutes 89) "1 hour ago")
(check (minutes 91) "2 hours ago")
(check (hours 3.49) "3 hours ago") ;; rounding down
(check (hours 3.51) "4 hours ago") ;; rounding down
(check (hours 23.4) "23 hours ago")
- (check (hours 23.6) "one day ago") ;; rounding up
- (check (days 1.48) "one day ago") ;; rounding down
+ (check (hours 23.6) "1 day ago") ;; rounding up
+ (check (days 1.48) "1 day ago") ;; rounding down
(check (days 1.52) "2 days ago") ;; rounding up
- (check (days 6.6) "one week ago") ;; rounding up
+ (check (days 6.6) "1 week ago") ;; rounding up
(check (weeks 2.49) "2 weeks ago") ;; rounding down
(check (weeks 2.51) "3 weeks ago") ;; rounding down
(check (1- (weeks 52)) "52 weeks ago")
- (check (weeks 52) "one year ago")
+ (check (weeks 52) "1 year ago")
(check (years 2.49) "2 years ago") ;; rounding down
(check (years 2.51) "3 years ago") ;; rounding down
))