diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-tl.el | 117 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 132 |
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 |