diff options
Diffstat (limited to 'lisp/mastodon-toot.el')
| -rw-r--r-- | lisp/mastodon-toot.el | 217 |
1 files changed, 166 insertions, 51 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7f867fe..2f58bfb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -5,7 +5,7 @@ ;; Marty Hiatt <martianhiatus@riseup.net> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 1.0.0 -;; Package-Requires: ((emacs "27.1")) +;; Package-Requires: ((emacs "27.1") (persist "0.4")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -30,7 +30,7 @@ ;; mastodon-toot.el supports POSTing status data to Mastodon. ;;; Code: - +(eval-when-compile (require 'subr-x)) (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify") @@ -39,6 +39,7 @@ (defvar emojify-user-emojis)) (require 'cl-lib) +(require 'persist) (when (require 'company nil :noerror) (declare-function company-mode-on "company") @@ -73,6 +74,7 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-profile--get-source-pref "mastodon-profile") (autoload 'mastodon-profile--update-preference "mastodon-profile") +(autoload 'mastodon-tl--render-text "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -113,6 +115,16 @@ This is only used if company mode is installed." (const :tag "following only" "following") (const :tag "all users" "all"))) +(defcustom mastodon-toot-display-orig-in-reply-buffer nil + "Display a copy of the toot replied to in the compose buffer." + :group 'mastodon-toot + :type 'boolean) + +(defcustom mastodon-toot-orig-in-reply-length 160 + "Length to crop toot replied to in the compose buffer to." + :group 'mastodon-toot + :type 'integer) + (defcustom mastodon-toot--enable-custom-instance-emoji nil "Whether to enable your instance's custom emoji by default." :group 'mastodon-toot @@ -131,13 +143,15 @@ This is only used if company mode is installed." '(direct private unlisted public) "A list of the available toot visibility settings.") -(defvar-local mastodon-toot--visibility "public" +(defvar-local mastodon-toot--visibility nil "A string indicating the visibility of the toot being composed. Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\". -This may be set by the account setting on the server.") +This is determined by the account setting on the server. To +change the setting on the server, see +`mastodon-toot-set-default-visibility'.") (defvar-local mastodon-toot--media-attachments nil "A list of the media attachments of the toot being composed.") @@ -151,6 +165,15 @@ This may be set by the account setting on the server.") (defvar mastodon-toot--max-toot-chars nil "The maximum allowed characters count for a single toot.") +(defvar mastodon-toot-current-toot-text nil + "The text of the toot being composed.") + +(persist-defvar mastodon-toot-draft-toots-list nil + "A list of toots that have been saved as drafts. +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-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -173,12 +196,12 @@ This may be set by the account setting on the server.") nil t))) (mastodon-profile--update-preference "privacy" vis :source))) -(defun mastodon-toot--get-max-toot-chars () +(defun mastodon-toot--get-max-toot-chars (&optional no-toot) "Fetch max_toot_chars from `mastodon-instance-url' asynchronously." (mastodon-http--get-json-async - (mastodon-http--api "instance") 'mastodon-toot--get-max-toot-chars-callback)) + (mastodon-http--api "instance") 'mastodon-toot--get-max-toot-chars-callback 'no-toot)) -(defun mastodon-toot--get-max-toot-chars-callback (json-response) +(defun mastodon-toot--get-max-toot-chars-callback (json-response &optional no-toot) "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer." (let ((max-chars (or @@ -189,8 +212,9 @@ This may be set by the account setting on the server.") (alist-get 'configuration json-response)))))) (setq mastodon-toot--max-toot-chars max-chars) - (with-current-buffer "*new toot*" - (mastodon-toot--update-status-fields)))) + (unless no-toot + (with-current-buffer "*new toot*" + (mastodon-toot--update-status-fields))))) (defun mastodon-toot--action-success (marker byline-region remove) "Insert/remove the text MARKER with 'success face in byline. @@ -415,7 +439,7 @@ NO-REDRAFT means delete toot only." (defun mastodon-toot-set-cw (&optional cw) "Set content warning to CW if it is non-nil." - (unless (equal cw "") + (unless (string-empty-p cw) (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft cw))) @@ -425,7 +449,7 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (with-current-buffer response (let* ((json-response (mastodon-http--process-json)) (content (alist-get 'text json-response))) - (mastodon-toot--compose-buffer nil nil) + (mastodon-toot--compose-buffer) (goto-char (point-max)) (insert content) ;; adopt reply-to-id, visibility and CW from deleted toot: @@ -435,20 +459,35 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (mastodon-toot-set-cw toot-cw) (mastodon-toot--update-status-fields)))) -(defun mastodon-toot--kill () - "Kill `mastodon-toot-mode' buffer and window." - (kill-buffer-and-window)) +(defun mastodon-toot--kill (&optional cancel) + "Kill `mastodon-toot-mode' buffer and window. +CANCEL means the toot was not sent, so we save the toot text as a draft." + (with-current-buffer (get-buffer "*new toot*") + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot-save-toot-text after-change-functions) + (kill-buffer-and-window))) (defun mastodon-toot--cancel () - "Kill new-toot buffer/window. Does not POST content to Mastodon." + "Kill new-toot buffer/window. Does not POST content to Mastodon. +Toot text is saved as a draft." (interactive) - (let* ((toot (mastodon-toot--remove-docs)) - (empty-toot-p (and (not mastodon-toot--media-attachments) - (string= "" (mastodon-tl--clean-tabs-and-nl toot))))) - (if empty-toot-p - (mastodon-toot--kill) - (when (y-or-n-p "Discard draft toot? ") - (mastodon-toot--kill))))) + (if (mastodon-toot-empty-p) + (mastodon-toot--kill :cancel) + (when (y-or-n-p "Discard draft toot? (text will be saved)") + (mastodon-toot--kill :cancel)))) + +(defun mastodon-toot-empty-p (&optional text-only) + "Return t if no text or attachments have been added to the compose buffer. +TEXT-ONLY means don't check for attachments." + (and (if text-only + t + (not mastodon-toot--media-attachments)) + (string-empty-p (mastodon-tl--clean-tabs-and-nl + (mastodon-toot--remove-docs))))) (defalias 'mastodon-toot--insert-emoji 'emojify-insert-emoji @@ -523,7 +562,6 @@ to `emojify-user-emojis', and the emoji data is updated." (when (featurep 'emojify) (emojify-set-emoji-data))) - (defun mastodon-toot--remove-docs () "Get the body of a toot from the current compose buffer." (let ((header-region (mastodon-tl--find-property-range 'toot-post-header @@ -546,10 +584,8 @@ If media items have been attached and uploaded with `mastodon-toot--attach-media', they are attached to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) - (empty-toot-p (and (not mastodon-toot--media-attachments) - (string= "" (mastodon-tl--clean-tabs-and-nl toot)))) (endpoint (mastodon-http--api "statuses")) - (spoiler (when (and (not empty-toot-p) + (spoiler (when (and (not (mastodon-toot-empty-p)) mastodon-toot--content-warning) (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) @@ -573,7 +609,7 @@ 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.")) - (empty-toot-p + ((mastodon-toot-empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t (let ((response (mastodon-http--post endpoint args nil))) @@ -721,7 +757,9 @@ candidate ARG. IGNORED remains a mystery." ignored)) (defun mastodon-toot--reply () - "Reply to toot at `point'." + "Reply to toot at `point'. +Customize `mastodon-toot-display-orig-in-reply-buffer' to display +text of the toot being replied to in the compose buffer." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (parent (mastodon-tl--property 'parent-toot)) ; for new notifs handling @@ -736,9 +774,8 @@ candidate ARG. IGNORED remains a mystery." (alist-get 'account toot))))) (mastodon-toot (when user (if booster - (if (and - (not (equal user booster)) - (not (string-match booster mentions))) + (if (and (not (equal user booster)) + (not (string-match booster mentions))) ;; different booster, user and mentions: (concat (mastodon-toot--process-local user) ;; "@" booster " " @@ -928,26 +965,23 @@ LONGEST is the length of the longest binding." (mastodon-toot--format-kbinds kbinds)))) (concat " Compose a new toot here. The following keybindings are available:" - ;; (mastodon-toot--format-kbinds kbinds)))) (mapconcat 'identity (mastodon-toot--formatted-kbinds-pairs (mastodon-toot--format-kbinds kbinds) longest-kbind) nil)))) -(defun mastodon-toot--display-docs-and-status-fields () +(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text) "Insert propertized text with documentation about `mastodon-toot-mode'. Also includes and the status fields which will get updated based -on the status of NSFW, content warning flags, media attachments, etc." +on the status of NSFW, content warning flags, media attachments, etc. +REPLY-TEXT is the text of the toot being replied to." (let ((divider "|=================================================================|")) (insert (propertize (concat - divider "\n" (mastodon-toot--make-mode-docs) "\n" - ;; divider "\n" - ;; "\n" divider "\n" " " (propertize "Count" @@ -963,11 +997,21 @@ on the status of NSFW, content warning flags, media attachments, etc." 'toot-post-nsfw-flag t) "\n" " Attachments: " - (propertize "None " 'toot-attachments t) - "\n" - divider - (propertize "\n" - 'rear-nonsticky t)) + (propertize "None " + 'toot-attachments t) + "\n") + 'face 'font-lock-comment-face + 'read-only "Edit your message below." + 'toot-post-header t) + (if reply-text + (propertize (truncate-string-to-width + (mastodon-tl--render-text reply-text) + mastodon-toot-orig-in-reply-length) + 'face '(variable-pitch :foreground "#7c6f64")) + "") + (propertize + (concat divider "\n") + 'rear-nonsticky t 'face 'font-lock-comment-face 'read-only "Edit your message below." 'toot-post-header t)))) @@ -981,8 +1025,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (when reply-to-user (insert (format "%s " reply-to-user)) (setq mastodon-toot--reply-to-id reply-to-id) - (unless (equal mastodon-toot--visibility - reply-visibility) + (unless (equal mastodon-toot--visibility reply-visibility) (setq mastodon-toot--visibility reply-visibility)) (mastodon-toot-set-cw reply-cw)))) @@ -1023,24 +1066,91 @@ REPLY-JSON is the full JSON of the toot being replied to." (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face))))) -(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id &optional reply-json) +(defun mastodon-toot-save-toot-text (&rest _args) + "Save the current toot text in `mastodon-toot-current-toot-text'. +Added to `after-change-functions' in new toot buffers." + (interactive) + (let ((text (mastodon-toot--remove-docs))) + (unless (string-empty-p text) + (setq mastodon-toot-current-toot-text text)))) + +(defun mastodon-toot-open-draft-toot () + "Prompt for a draft toot and open a new compose buffer containing the draft." + (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)) + (y-or-n-p "Replace current text with draft?")) + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list) + (goto-char + (cdr (mastodon-tl--find-property-range 'toot-post-header + (point-min)))) + (kill-region (point) (point-max)) + ;; to not save to kill-ring: + ;; (delete-region (point) (point-max)) + (insert text)) + (mastodon-toot--compose-buffer nil nil nil text))) + (unless (mastodon-toot-compose-buffer-p) + (mastodon-toot--compose-buffer)) + (message "No drafts available."))) + +(defun mastodon-toot-delete-draft-toot () + "Prompt for a draft toot and delete it." + (interactive) + (if mastodon-toot-draft-toots-list + (let ((draft (completing-read "Select draft to delete: " + mastodon-toot-draft-toots-list + nil t))) + (setq mastodon-toot-draft-toots-list + (cl-delete draft mastodon-toot-draft-toots-list + :test 'equal)) + (message "Draft deleted!")) + (message "No drafts to delete."))) + +(defun mastodon-toot-delete-all-drafts () + "Delete all drafts." + (interactive) + (setq mastodon-toot-draft-toots-list nil) + (message "All drafts deleted!")) + +(defun mastodon-toot-compose-buffer-p () + "Return t if compose buffer is current." + (equal (buffer-name (current-buffer)) "*new toot*")) + +;; NB: now that we have toot drafts, to ensure offline composing remains +;; possible, avoid any direct requests here: +(defun mastodon-toot--compose-buffer (&optional reply-to-user + reply-to-id reply-json initial-text) "Create a new buffer to capture text for a new toot. If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var. -REPLY-JSON is the full JSON of the toot being replied to." +REPLY-JSON is the full JSON of the toot being replied to. +INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add +a draft into the buffer." (let* ((buffer-exists (get-buffer "*new toot*")) (buffer (or buffer-exists (get-buffer-create "*new toot*"))) - (inhibit-read-only t)) + (inhibit-read-only t) + (reply-text (alist-get 'content reply-json))) (switch-to-buffer-other-window buffer) (text-mode) (mastodon-toot-mode t) - ;; use toot visibility setting from the server: (setq mastodon-toot--visibility - (mastodon-profile--get-source-pref 'privacy)) + (or (plist-get mastodon-profile-account-settings 'privacy) + ;; use toot visibility setting from the server: + (mastodon-profile--get-source-pref 'privacy) + "public")) ; fallback (unless buffer-exists - (mastodon-toot--display-docs-and-status-fields) + (mastodon-toot--display-docs-and-status-fields + (when mastodon-toot-display-orig-in-reply-buffer + reply-text)) (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json)) (unless mastodon-toot--max-toot-chars + ;; no need to fetch from `mastodon-profile-account-settings' as + ;; `mastodon-toot--max-toot-chars' is set when we set it (mastodon-toot--get-max-toot-chars)) ;; set up company backends: (when (require 'company nil :noerror) @@ -1052,7 +1162,12 @@ REPLY-JSON is the full JSON of the toot being replied to." (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) - (mastodon-toot--update-status-fields))) + (mastodon-toot--update-status-fields) + ;; draft toot text saving: + (setq mastodon-toot-current-toot-text nil) + (push #'mastodon-toot-save-toot-text after-change-functions) + (when initial-text + (insert initial-text)))) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." |