aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-11-30 10:52:00 +0100
committermarty hiatt <martianhiatus [a t] riseup [d o t] net>2022-11-30 10:52:00 +0100
commit3414611e4e2dfa3898a02045cc3dabfdcb8524bf (patch)
tree16ddd8f9aa1813267ed696406ab66f7b01ea88b0 /lisp
parent520b2f86006f2274146ccff4b78f9b765b2280d2 (diff)
parented41f1ce270a25e80b9e75d9da23cc6a7749b9a7 (diff)
Merge branch 'schedule-toots' into develop
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-tl.el117
-rw-r--r--lisp/mastodon-toot.el132
2 files changed, 229 insertions, 20 deletions
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 913c7e7..e732420 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -82,6 +82,9 @@
(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)
@@ -257,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)))
@@ -1838,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 ()
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 121a590..87b1b77 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -80,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")
@@ -176,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.")
@@ -228,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'.")
@@ -514,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.
@@ -687,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[]"
@@ -700,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
@@ -721,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:
@@ -738,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))))))
@@ -1112,7 +1147,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)
@@ -1120,7 +1155,52 @@ 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."
+ (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
@@ -1215,6 +1295,9 @@ REPLY-TEXT is the text of the toot being replied to."
(propertize "Language"
'toot-post-language t)
" "
+ (propertize "Scheduled"
+ 'toot-post-scheduled t)
+ " "
(propertize "CW"
'toot-post-cw-flag t)
" "
@@ -1270,16 +1353,18 @@ REPLY-JSON is the full JSON of the toot being replied to."
(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")
@@ -1288,9 +1373,16 @@ REPLY-JSON is the full JSON of the toot being replied to."
(add-text-properties (car lang-region) (cdr lang-region)
(list 'display
(if mastodon-toot--language
- (format "Language: %s"
+ (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