diff options
Diffstat (limited to 'lisp/mastodon-toot.el')
| -rw-r--r-- | lisp/mastodon-toot.el | 192 |
1 files changed, 97 insertions, 95 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 2625695..df9a22c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -48,43 +48,44 @@ (defvar mastodon-tl--enable-proportional-fonts) (defvar mastodon-profile-account-settings) +(autoload 'iso8601-parse "iso8601") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--get-json-async "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--get-source-pref "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-preference "mastodon-profile") (autoload 'mastodon-search--search-accounts-query "mastodon-search") (autoload 'mastodon-search--search-tags-query "mastodon-search") (autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") -(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-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl") -(autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot") +(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-toot "mastodon") +(autoload 'mastodon-views--cancel-scheduled-toot "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") (autoload 'org-read-date "org") -(autoload 'iso8601-parse "iso8601") -(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -223,16 +224,16 @@ send.") (defvar mastodon-toot-handle-regex (concat - ;; preceding space or bol [boundary doesn't work with @] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with @] + "\\([(\n\t ]\\|^\\)" "\\(?2:@[1-9a-zA-Z._-]+" ; a handle "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) (defvar mastodon-toot-tag-regex (concat - ;; preceding space or bol [boundary doesn't work with #] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with #] + "\\([(\n\t ]\\|^\\)" "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary @@ -450,7 +451,7 @@ With FAVOURITE, list favouriters, else list boosters." (if (eq (caar json) 'error) (error "%s (Status does not exist or is private)" (alist-get 'error json)) - (let ((handles (mapcar (lambda (x) (alist-get 'acct x)) json)) + (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (error "Looks like this toot has no %s" type-string) @@ -520,12 +521,12 @@ Uses `lingva.el'." (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) (message "You can only pin your own toots.") - (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) - (mastodon-toot--action action - (lambda () - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot %s!" msg))))))) + (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (mastodon-toot--action action + (lambda () + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot %s!" msg))))))) (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." @@ -546,22 +547,22 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot))) (if (not (mastodon-toot--own-toot-p toot)) (message "You can only delete (and redraft) your own toots.") - (if (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda () - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - reply-id - toot-visibility - toot-cw))))))))) + (when (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda () + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + reply-id + toot-visibility + toot-cw))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -727,16 +728,6 @@ to `emojify-user-emojis', and the emoji data is updated." (point-min)))) (buffer-substring (cdr header-region) (point-max)))) -(defun mastodon-toot--set-visibility (visibility) - "Set the visiblity of the next toot to VISIBILITY." - (interactive - (list (completing-read "Visiblity: " '("public" - "unlisted" - "private" - "direct")))) - (setq mastodon-toot--visibility visibility) - (message "Visibility set to %s" visibility)) - (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append @@ -815,7 +806,7 @@ instance to edit a toot." (message "Toot toot!")) ;; cancel scheduled toot if we were editing it: (when scheduled-id - (mastodon-tl--cancel-scheduled-toot + (mastodon-views--cancel-scheduled-toot scheduled-id :no-confirm)) (mastodon-toot--restore-previous-window-config prev-window-config)))))))) @@ -903,9 +894,8 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. Remove empty string (self) from result and joins the sequence with whitespace." (mapconcat (lambda (mention) mention) - (remove "" (mapcar (lambda (x) (mastodon-toot--process-local x)) - mentions)) - " ")) + (remove "" (mapcar #'mastodon-toot--process-local mentions)) + " ")) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -931,8 +921,7 @@ Federated user: `username@host.co`." (alist-get 'mentions (alist-get 'reblog status)) (alist-get 'mentions status)))) ;; reverse does not work on vectors in 24.5 - (mapcar (lambda(x) (alist-get 'acct x)) - (reverse mentions)))) + (mastodon-tl--map-alist 'acct (reverse mentions)))) (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point using REGEX." @@ -1070,16 +1059,18 @@ text of the toot being replied to in the compose buffer." (defun mastodon-toot--change-visibility () "Change the current visibility to the next valid value." (interactive) - (setq mastodon-toot--visibility - (cond ((string= mastodon-toot--visibility "public") - "unlisted") - ((string= mastodon-toot--visibility "unlisted") - "private") - ((string= mastodon-toot--visibility "private") - "direct") - (t - "public"))) - (mastodon-toot--update-status-fields)) + (if (mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't change visibility when editing toots.") + (setq mastodon-toot--visibility + (cond ((string= mastodon-toot--visibility "public") + "unlisted") + ((string= mastodon-toot--visibility "unlisted") + "private") + ((string= mastodon-toot--visibility "private") + "direct") + (t + "public"))) + (mastodon-toot--update-status-fields))) (defun mastodon-toot--clear-all-attachments () "Remove all attachments from a toot draft." @@ -1241,34 +1232,40 @@ 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)))))))) + (cond ((mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't schedule toots you're editing.")) + ((not (or (mastodon-tl--buffer-type-eq 'new-toot) + (mastodon-tl--buffer-type-eq 'scheduled-statuses))) + (message "You can only schedule toots from the compose toot buffer or the scheduled toots view.")) + (t + (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-views--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." @@ -1654,6 +1651,11 @@ EDIT means we are editing an existing toot, not composing a new one." ;;;###autoload (add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) +;; disable auto-fill-mode: +(add-hook 'mastodon-toot-mode-hook + (lambda () + (auto-fill-mode -1))) + (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." :group 'mastodon-toot |