diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-http.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 157 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 35 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 217 | ||||
| -rw-r--r-- | lisp/mastodon.el | 6 |
7 files changed, 308 insertions, 113 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index af1a9da..086dcec 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -155,7 +155,7 @@ Pass response buffer to CALLBACK function." (buffer-substring-no-properties (point) (point-max)) 'utf-8))) (kill-buffer) - (unless (or (string-equal "" json-string) (null json-string)) + (unless (or (string-empty-p json-string) (null json-string)) (json-read-from-string json-string)))) (defun mastodon-http--delete (url) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 32cc4ee..c0ca684 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -255,7 +255,7 @@ of the toot responded to." (defun mastodon-notifications--timeline (json) "Format JSON in Emacs buffer." - (if (equal json '[]) + (if (seq-empty-p json) (message "Looks like you have no (more) notifications for the moment.") (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 00ffedd..012e357 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -35,6 +35,7 @@ ;;; Code: (require 'seq) (require 'cl-lib) +(require 'persist) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -67,10 +68,12 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") +(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) (defvar mastodon-mode-map) +(defvar mastodon-toot--max-toot-chars) (defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") @@ -116,6 +119,13 @@ extra keybindings." map) "Keymap for `mastodon-profile-update-mode'.") +(persist-defvar mastodon-profile-account-settings nil + "An alist of account settings saved from the server. +Other clients can change these settings on the server at any +time, so this list is not the canonical source for settings. It +is updated on entering mastodon mode and on toggle any setting it +contains") + (define-minor-mode mastodon-profile-update-mode "Minor mode to update Mastodon user profile." :group 'mastodon-profile @@ -201,7 +211,7 @@ JSON is the data returned by the server." (mastodon-tl--set-face "[a/r - accept/reject request at point\n n/p - go to next/prev request]\n\n" 'font-lock-comment-face)) - (if (equal json '[]) + (if (seq-empty-p json) (insert (propertize "Looks like you have no follow requests for now." 'face font-lock-comment-face @@ -210,7 +220,7 @@ JSON is the data returned by the server." (mastodon-search--insert-users-propertized json :note))) ;; (mastodon-profile--add-author-bylines json))) -;;; account preferences +;;; ACCOUNT PREFERENCES (defun mastodon-profile--get-json-value (val) "Fetch current VAL ue from account." @@ -218,13 +228,13 @@ JSON is the data returned by the server." (response (mastodon-http--get-json url))) (alist-get val response))) -(defun mastodon-profile--get-source-prefs () +(defun mastodon-profile--get-source-values () "Return the \"source\" preferences from the server." (mastodon-profile--get-json-value 'source)) -(defun mastodon-profile--get-source-pref (pref) +(defun mastodon-profile--get-source-value (pref) "Return account PREF erence from the \"source\" section on the server." - (let ((source (mastodon-profile--get-source-prefs))) + (let ((source (mastodon-profile--get-source-values))) (alist-get pref source))) (defun mastodon-profile--update-user-profile-note () @@ -259,19 +269,55 @@ JSON is the data returned by the server." (lambda () (message "Profile note updated!")))))) (defun mastodon-profile--update-preference (pref val &optional source) - "Update a single acount PREF erence to setting VAL. + "Update account PREF erence to setting VAL. Both args are strings. -SOURCE means that the preference is in the 'source' part of the account json." +SOURCE means that the preference is in the 'source' part of the account JSON." (let* ((url (mastodon-http--api "accounts/update_credentials")) (pref-formatted (if source (concat "source[" pref "]") pref)) (response (mastodon-http--patch url `((,pref-formatted ,val))))) (mastodon-http--triage response (lambda () + (mastodon-profile-fetch-server-account-settings) (message "Account setting %s updated to %s!" pref val))))) +(defun mastodon-profile--get-pref (pref) + "Return PREF from `mastodon-profile-account-settings'." + (plist-get mastodon-profile-account-settings pref)) + +(defun mastodon-profile-update-preference-plist (pref val) + "Set local account preference plist preference PREF to VAL. +This is done after changing the setting on the server." + (setq mastodon-profile-account-settings + (plist-put mastodon-profile-account-settings pref val))) + +(defun mastodon-profile-fetch-server-account-settings () + "Fetch basic account settings from the server. +Store the values in `mastodon-profile-account-settings'. +Run in `mastodon-mode-hook'." + (let ((keys '(locked discoverable display_name bot)) + (source-keys '(privacy sensitive language))) + (mapc (lambda (k) + (mastodon-profile-update-preference-plist + k + (mastodon-profile--get-json-value k))) + keys) + (mapc (lambda (sk) + (mastodon-profile-update-preference-plist + sk + (mastodon-profile--get-source-value sk))) + source-keys) + ;; hack for max toot chars: + (mastodon-toot--get-max-toot-chars :no-toot) + (mastodon-profile-update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) + ;; TODO: remove now redundant vars, replace with fetchers from the plist + (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) + mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) + mastodon-profile-account-settings)) + (defun mastodon-profile-account-locked-toggle () "Toggle the locked status of your account. -Locked accounts mean follow requests have to be manually approved." +Locked means follow requests have to be approved." (interactive) (mastodon-profile--toggle-account-key 'locked)) @@ -281,18 +327,33 @@ Discoverable means the account is listed in the server directory." (interactive) (mastodon-profile--toggle-account-key 'discoverable)) -(defun mastodon-profile--toggle-account-key (key) - "Toggle the boolean account setting KEY." - (let* ((val (mastodon-profile--get-json-value key)) +(defun mastodon-profile-account-bot-toggle () + "Toggle the bot status of your account." + (interactive) + (mastodon-profile--toggle-account-key 'bot)) + +(defun mastodon-profile-account-sensitive-toggle () + "Toggle the sensitive status of your account. +When enabled, statuses are marked as sensitive by default." + (interactive) + (mastodon-profile--toggle-account-key 'sensitive :source)) + +(defun mastodon-profile--toggle-account-key (key &optional source) + "Toggle the boolean account setting KEY. +SOURCE means the setting is located under \"source\" in the account JSON. +Current settings are fetched from the server." + (let* ((val (if source + (mastodon-profile--get-source-value key) + (mastodon-profile--get-json-value key))) (prompt (format "Account setting %s is %s. Toggle?" key val))) (if (not (equal val :json-false)) (when (y-or-n-p prompt) - (mastodon-profile--update-preference (symbol-name key) "false")) + (mastodon-profile--update-preference (symbol-name key) "false" source)) (when (y-or-n-p prompt) - (mastodon-profile--update-preference (symbol-name key) "true"))))) + (mastodon-profile--update-preference (symbol-name key) "true" source))))) -(defun mastodon-profile--edit-account-string (key) - "Edit the string for account setting KEY." +(defun mastodon-profile--edit-string-value (key) + "Edit the string for account preference KEY." (let* ((val (mastodon-profile--get-json-value key)) (new-val (read-string (format "Edit account setting %s: " key) @@ -302,7 +363,16 @@ Discoverable means the account is listed in the server directory." (defun mastodon-profile-update-display-name () "Update display name for your account." (interactive) - (mastodon-profile--edit-account-string 'display_name)) + (mastodon-profile--edit-string-value 'display_name)) + +(defun mastodon-profile--get-preferences-pref (pref) + "Fetch PREF from the endpoint \"/preferences\". +This endpoint only holds a few preferences. For others, see +`mastodon-profile--update-preference' and its endpoint, +\"/accounts/update_credentials.\"" + (alist-get pref + (mastodon-http--get-json + (mastodon-http--api "preferences")))) (defun mastodon-profile-view-preferences () "View user preferences in another window." @@ -324,6 +394,8 @@ Discoverable means the account is listed in the server directory." "\n\n")))) (goto-char (point-min))))) +;; PROFILE VIEW DETAILS + (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." (let* ((their-id id) @@ -414,30 +486,33 @@ Returns a list of lists." (is-followers " FOLLOWERS ") (is-following " FOLLOWING ")))) (insert - "\n" - (mastodon-profile--image-from-account account) - "\n" - (propertize (mastodon-profile--account-field - account 'display_name) - 'face 'mastodon-display-name-face) - "\n" - (propertize (concat "@" acct) - 'face 'default) - (if (equal locked t) - (if (fontp (char-displayable-p #10r9993)) - " 🔒" - " [locked]") - "") - "\n ------------\n" - (mastodon-tl--render-text note account) - ;; account here to enable tab-stops in profile note - (if fields - (concat "\n" - (mastodon-tl--set-face - (mastodon-profile--fields-insert fields) - 'success) - "\n") - "") + (propertize + (concat + "\n" + (mastodon-profile--image-from-account account) + "\n" + (propertize (mastodon-profile--account-field + account 'display_name) + 'face 'mastodon-display-name-face) + "\n" + (propertize (concat "@" acct) + 'face 'default) + (if (equal locked t) + (if (fontp (char-displayable-p #10r9993)) + " 🔒" + " [locked]") + "") + "\n ------------\n" + (mastodon-tl--render-text note account) + ;; account here to enable tab-stops in profile note + (if fields + (concat "\n" + (mastodon-tl--set-face + (mastodon-profile--fields-insert fields) + 'success) + "\n") + "")) + 'profile-json account) ;; insert counts (mastodon-tl--set-face (concat " ------------\n" @@ -538,7 +613,7 @@ Also insert their profile note. Used to view a user's followers and those they're following." ;;FIXME change the name of this fun now that we've edited what it does! (let ((inhibit-read-only t)) - (when (not (equal tootv '[])) + (unless (seq-empty-p tootv) (mapc (lambda (toot) (let ((start-pos (point))) (insert "\n" diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index c7658ba..d161544 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -208,7 +208,7 @@ user's profile note. This is also called by (defun mastodon-search--get-user-info (account) "Get user handle, display name, account URL and profile note from ACCOUNT." - (list (if (not (equal "" (alist-get 'display_name account))) + (list (if (not (string-empty-p (alist-get 'display_name account))) (alist-get 'display_name account) (alist-get 'username account)) (alist-get 'acct account) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4b0bd9f..8e75705 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -66,6 +66,7 @@ (autoload 'mastodon-search--get-user-info "mastodon-search") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -271,7 +272,7 @@ text, i.e. hidden spoiler text." (interactive) (let* ((word (or (word-at-point) "")) (input (read-string (format "Load timeline for tag (%s): " word))) - (tag (if (equal input "") word input))) + (tag (if (string-empty-p input) word input))) (message "Loading timeline for #%s..." tag) (mastodon-tl--show-tag-timeline tag))) @@ -338,7 +339,7 @@ Used on initializing a timeline or thread." "Propertize author of TOOT." (let* ((account (alist-get 'account toot)) (handle (alist-get 'acct account)) - (name (if (not (string= "" (alist-get 'display_name account))) + (name (if (not (string-empty-p (alist-get 'display_name account))) (alist-get 'display_name account) (alist-get 'username account))) (profile-url (alist-get 'url account)) @@ -370,12 +371,12 @@ Used on initializing a timeline or thread." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--format-faves-count (toot) @@ -856,7 +857,12 @@ message is a link which unhides/hides the main body." (concat cw (propertize (mastodon-tl--content toot) - 'invisible t + 'invisible + ;; check server setting to expand all spoilers: + (unless (eq t + (mastodon-profile--get-preferences-pref + 'reading:expand:spoilers)) + t) 'mastodon-content-warning-body t)))) (defun mastodon-tl--media (toot) @@ -878,7 +884,7 @@ message is a link which unhides/hides the main body." (concat "Media::" preview-url "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p - (equal media-string ""))) + (string-empty-p media-string))) (concat "\n" media-string) ""))) @@ -1175,13 +1181,6 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) -(defun mastodon-tl--single-toot-from-url (url) - "Open the toot at URL in `mastodon.el'." - ;; TODO: test if URL is masto - ;; FIXME: this only works 1/2 the time - (let ((id (url-file-nondirectory url))) - (mastodon-tl--single-toot id))) - (defun mastodon-tl--single-toot (&optional id) "View toot at point in separate buffer. ID is that of the toot to view." @@ -1272,7 +1271,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (format "Word(s) to filter (%s): " (or (current-word) "")) nil nil (or (current-word) ""))) (contexts - (if (equal "" word) + (if (string-empty-p word) (error "You must select at least one word for a filter") (completing-read-multiple "Contexts to filter [TAB for options]:" @@ -1316,7 +1315,7 @@ JSON is what is returned by by the server." (mastodon-tl--set-face "[c - create filter\n d - delete filter at point\n n/p - go to next/prev filter]\n\n" 'font-lock-comment-face)) - (if (equal json '[]) + (if (seq-empty-p json) (insert (propertize "Looks like you have no filters for now." 'face font-lock-comment-face @@ -1654,7 +1653,7 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) (user-id (mastodon-profile--account-field account 'id)) - (name (if (not (equal "" (mastodon-profile--account-field account 'display_name))) + (name (if (not (string-empty-p (mastodon-profile--account-field account 'display_name))) (mastodon-profile--account-field account 'display_name) (mastodon-profile--account-field account 'username))) (url (mastodon-http--api 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." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 4578e13..72043cf 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -33,8 +33,10 @@ ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon +(eval-when-compile (require 'subr-x)) (require 'mastodon-http) (require 'mastodon-toot) +(require 'url) (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") @@ -94,6 +96,7 @@ (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") (defgroup mastodon nil "Interface with Mastodon." @@ -326,6 +329,9 @@ not, just browse the URL in the normal fashion." (when mastodon-toot--enable-custom-instance-emoji (mastodon-toot--enable-custom-emoji))))) +;;;###autoload +(add-hook 'mastodon-mode-hook #'mastodon-profile-fetch-server-account-settings) + (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." :group 'mastodon |