diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-profile.el | 19 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 163 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 193 | ||||
| -rw-r--r-- | lisp/mastodon.el | 10 |
4 files changed, 227 insertions, 158 deletions
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index de16b7d..cd1978f 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -35,7 +35,6 @@ ;;; Code: (require 'seq) (require 'cl-lib) -(require 'persist) (require 'parse-time) (require 'mastodon-http) (eval-when-compile @@ -125,8 +124,8 @@ It contains details of the current user's account.") map) "Keymap for `mastodon-profile-update-mode'.") -(persist-defvar mastodon-profile-account-settings nil - "An alist of account settings saved from the server. +(define-multisession-variable 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 @@ -365,13 +364,16 @@ SOURCE means that the preference is in the `source' part of the account JSON." (defun mastodon-profile--get-pref (pref) "Return PREF from `mastodon-profile-account-settings'." - (plist-get mastodon-profile-account-settings pref)) + (plist-get (multisession-value 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))) + (setf (multisession-value mastodon-profile-account-settings) + (plist-put + (multisession-value mastodon-profile-account-settings) + pref val))) ;; used in toot.el (defun mastodon-profile--fetch-server-account-settings-maybe () @@ -384,7 +386,8 @@ Only do so if `mastodon-profile-account-settings' is nil." Store the values in `mastodon-profile-account-settings'. Run in `mastodon-mode-hook'. If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." - (unless (and no-force mastodon-profile-account-settings) + (unless (and no-force + (multisession-value mastodon-profile-account-settings)) (let ((keys '(locked discoverable display_name bot)) (source-keys '(privacy sensitive language))) (mapc (lambda (k) @@ -402,7 +405,7 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." ;; 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))) + (multisession-value mastodon-profile-account-settings)))) (defun mastodon-profile--account-locked-toggle () "Toggle the locked status of your account. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2574a0f..17f7ae5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -89,6 +89,8 @@ (autoload 'mastodon-search--insert-heading "mastodon-search") (autoload 'mastodon-media--process-full-sized-image-response "mastodon-media") (autoload 'mastodon-search--trending-statuses "mastodon-search") +(autoload 'mastodon-search--format-heading "mastodon-search") +(autoload 'mastodon-toot--with-toot-item "mastodon-toot") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) @@ -219,6 +221,13 @@ respects the user's `browse-url' settings." See `mastodon-tl--get-remote-local-timeline' for view remote local domains." :type '(repeat string)) + +(defcustom mastodon-tl--fold-toots-at-length 1200 + "Length, in characters, to fold a toot at. +Longer toots will be folded and the remainder replaced by a +\"read more\" button. If the value is nil, don't fold at all." + :type '(integer)) + ;;; VARIABLES @@ -239,9 +248,8 @@ If nil `(point-min)' is used instead.") "The timer that, when set will scan the buffer to update the timestamps.") (defvar mastodon-tl--horiz-bar - (if (char-displayable-p ?―) - (make-string 12 ?―) - (make-string 12 ?-))) + (make-string 12 + (if (char-displayable-p ?―) ?― ?-))) ;;; KEYMAPS @@ -396,14 +404,18 @@ Optionally start from POS." (current-buffer)))) (if npos (if (not - ;; (get-text-property npos 'item-id) ; toots, users, not tags (get-text-property npos 'item-type)) ; generic + ;; FIXME let's make refresh &optional and only call refresh/recur + ;; if non-nil: (mastodon-tl--goto-item-pos find-pos refresh npos) (goto-char npos) ;; force display of help-echo on moving to a toot byline: (mastodon-tl--message-help-echo)) - ;; FIXME: this doesn't work, as the funcall doesn't return if we - ;; run into an endless refresh loop + ;; FIXME: doesn't work, the funcall doesn't return if in an endless + ;; refresh loop. + ;; either let-bind `max-lisp-eval-depth' and try to error handle when it + ;; errors, or else set up a counter, and error when it gets to high + ;; (like >2 would already be too much) (condition-case nil (funcall refresh) (error "No more items"))))) @@ -976,6 +988,8 @@ the toot)." LINK-TYPE is the type of link to produce." (let ((help-text (cond ((eq link-type 'content-warning) "Toggle hidden text") + ((eq link-type 'read-more) + "Toggle full post") (t (error "Unknown link type %s" link-type))))) (propertize string @@ -1017,6 +1031,8 @@ Used for hitting RET on a given link." "Search for account returned nothing. Perform URL lookup?") (mastodon-url-lookup (get-text-property position 'shr-url)) (message "Unable to find account.")))))))) + ((eq link-type 'read-more) + (mastodon-tl--unfold-post)) (t (error "Unknown link type %s" link-type))))) @@ -1357,7 +1373,7 @@ displayed when the duration is smaller than a minute)." cell)) options-alist))) (if (null poll) - (message "No poll here.") + (user-error "No poll here") (list ;; var "option" = just the cdr, a cons of option number and desc (cdr (assoc (completing-read "Poll option to vote for: " @@ -1369,7 +1385,7 @@ displayed when the duration is smaller than a minute)." "If there is a poll at point, prompt user for OPTION to vote on it." (interactive (mastodon-tl--read-poll-option)) (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'item-json))) - (message "No poll here.") + (user-error "No poll here") (let* ((toot (mastodon-tl--property 'item-json)) (poll (mastodon-tl--field 'poll toot)) (poll-id (alist-get 'id poll)) @@ -1490,7 +1506,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (string= reply-to-id prev-id))) (defun mastodon-tl--insert-status (toot body author-byline action-byline - &optional id base-toot detailed-p thread domain) + &optional id base-toot detailed-p thread domain unfolded) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author @@ -1523,12 +1539,13 @@ When DOMAIN, force inclusion of user's domain in their handle." (concat (mastodon-tl--symbol 'replied) "\n") "") - (if (and after-reply-status-p thread) - (let ((bar (mastodon-tl--symbol 'reply-bar))) + (let ((bar (mastodon-tl--symbol 'reply-bar)) + (body (mastodon-tl--fold-body-maybe body unfolded))) + (if (and after-reply-status-p thread) (propertize body 'line-prefix bar - 'wrap-prefix bar)) - body) + 'wrap-prefix bar) + body)) " \n" ;; byline: (mastodon-tl--byline toot author-byline action-byline detailed-p domain)) @@ -1548,6 +1565,47 @@ When DOMAIN, force inclusion of user's domain in their handle." (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) +(defun mastodon-tl--fold-body-maybe (body &optional unfolded) + "Fold toot BODY if it is very long." + (if (or unfolded + (eq nil mastodon-tl--fold-toots-at-length) + (length< body mastodon-tl--fold-toots-at-length)) + body + (let* ((heading (mastodon-search--format-heading + (mastodon-tl--make-link + "READ MORE" + 'read-more))) + (display (concat (substring body 0 + mastodon-tl--fold-toots-at-length) + heading))) + (propertize display + 'read-more body)))) + +(defun mastodon-tl--unfold-post () + "Unfold the toot at point if it is folded (read-more)." + (interactive) + ;; if at byline, must search backwards: + (let* ((byline (mastodon-tl--property 'byline :no-move)) + (read-more-p (mastodon-tl--find-property-range + 'read-more (point) byline))) + (if (not read-more-p) + (user-error "No folded item at point?") + (let* ((inhibit-read-only t) + (range (mastodon-tl--find-property-range + 'item-json (point))) + (toot (mastodon-tl--property 'item-json))) + ;; `replace-region-contents' is much to slow, our hack from fedi.el + ;; is much simpler and much faster + (let ((beg (car range)) + (end (cdr range))) + (save-excursion + (goto-char beg) + (delete-region beg end) + (mastodon-tl--toot toot nil nil nil :unfolded)) + ;; move point to line where text formerly ended: + (goto-char end) + (beginning-of-line)))))) + ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) "Return the TOOT on which we want to extract stats. @@ -1608,7 +1666,7 @@ To disable showing the stats, customize (and (null (mastodon-tl--field 'in_reply_to_id toot)) (not (mastodon-tl--field 'rebloged toot)))) -(defun mastodon-tl--toot (toot &optional detailed-p thread domain) +(defun mastodon-tl--toot (toot &optional detailed-p thread domain unfolded) "Format TOOT and insert it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client. @@ -1620,7 +1678,7 @@ When DOMAIN, force inclusion of user's domain in their handle." (mastodon-tl--spoiler toot) (mastodon-tl--content toot))) 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted - nil nil detailed-p thread domain)) + nil nil detailed-p thread domain unfolded)) (defun mastodon-tl--timeline (toots &optional thread domain) "Display each toot in TOOTS. @@ -1953,7 +2011,7 @@ ID is that of the toot to view." #'mastodon-tl--update-toot) (mastodon-tl--toot toot :detailed-p) (goto-char (point-min)) - (mastodon-tl--goto-next-item))))) + (mastodon-tl--goto-next-item :no-refresh))))) (defun mastodon-tl--update-toot (json) "Call `mastodon-tl--single-toot' on id found in JSON." @@ -1975,42 +2033,43 @@ view all branches of a thread." (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." (interactive) - (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move))) - (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) - (if (or (string= type "follow_request") - (string= type "follow")) ; no can thread these - (user-error "No thread") - (let* ((endpoint (format "statuses/%s/context" id)) - (url (mastodon-http--api endpoint)) - (buffer (format "*mastodon-thread-%s*" id)) - (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: - (mastodon-http--api (concat "statuses/" id)) - nil :silent)) - (context (mastodon-http--get-json url nil :silent))) - (if (equal (caar toot) 'error) - (user-error "Error: %s" (cdar toot)) - (when (member (alist-get 'type toot) '("reblog" "favourite")) - (setq toot (alist-get 'status toot))) - (if (> (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))) - 0) - ;; if we have a thread: - (with-mastodon-buffer buffer #'mastodon-mode nil - (let ((marker (make-marker))) - (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread) - (mastodon-tl--timeline (alist-get 'ancestors context) :thread) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p :thread) - (mastodon-tl--timeline (alist-get 'descendants context) - :thread) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl--goto-next-item))) - ;; else just print the lone toot: - (mastodon-tl--single-toot id))))))) + (mastodon-toot--with-toot-item + (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) + (if (or (string= type "follow_request") + (string= type "follow")) ; no can thread these + (user-error "No thread") + (let* ((endpoint (format "statuses/%s/context" id)) + (url (mastodon-http--api endpoint)) + (buffer (format "*mastodon-thread-%s*" id)) + (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: + (mastodon-http--api (concat "statuses/" id)) + nil :silent)) + (context (mastodon-http--get-json url nil :silent))) + (if (equal (caar toot) 'error) + (user-error "Error: %s" (cdar toot)) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (> (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))) + 0) + ;; if we have a thread: + (with-mastodon-buffer buffer #'mastodon-mode nil + (let ((marker (make-marker))) + (mastodon-tl--set-buffer-spec buffer endpoint + #'mastodon-tl--thread) + (mastodon-tl--timeline (alist-get 'ancestors context) :thread) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p :thread) + (mastodon-tl--timeline (alist-get 'descendants context) + :thread) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl--goto-next-item))) + ;; else just print the lone toot: + (mastodon-tl--single-toot id)))))))) (defun mastodon-tl--mute-thread () "Mute the thread displayed in the current buffer. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 408a783..856c5bb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -31,6 +31,8 @@ ;;; Code: (eval-when-compile (require 'subr-x)) + +(defvar mastodon-use-emojify) (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify") (declare-function emojify-set-emoji-data "emojify") @@ -38,7 +40,6 @@ (defvar emojify-user-emojis) (require 'cl-lib) -(require 'persist) (require 'mastodon-iso) (require 'facemenu) (require 'text-property-search) @@ -158,11 +159,6 @@ If the original toot visibility is different we use the more restricted one." "Whether to enable your instance's custom emoji by default." :type 'boolean) -(defcustom mastodon-toot--emojify-in-compose-buffer t - "Whether to enable `emojify-mode' in the compose buffer. -We only attempt to enable it if its bound." - :type 'boolean) - (defcustom mastodon-toot--proportional-fonts-compose nil "Nonnil to enable using proportional fonts in the compose buffer. By default fixed width fonts are used." @@ -170,10 +166,7 @@ By default fixed width fonts are used." width fonts")) (defvar-local mastodon-toot--content-warning nil - "A flag whether the toot should be marked with a content warning.") - -(defvar-local mastodon-toot--content-warning-from-reply-or-redraft nil - "The content warning of the toot being replied to.") + "The content warning of the current toot.") (defvar-local mastodon-toot--content-nsfw nil "A flag indicating whether the toot should be marked as NSFW.") @@ -229,8 +222,8 @@ Takes its form from `window-configuration-to-register'.") (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. +(define-multisession-variable 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.") @@ -278,7 +271,7 @@ data about the item boosted or favourited." ;;; MACRO -(defmacro mastodon-tl--with-toot-item (&rest body) +(defmacro mastodon-toot--with-toot-item (&rest body) "Execute BODY if we have a toot object at point. Includes boosts, and notifications that display toots. This macro makes the local variable ID available." @@ -303,11 +296,10 @@ property, and call BODY-FUN on them." (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) (define-key map (kbd "C-c C-k") #'mastodon-toot--cancel) - (define-key map (kbd "C-c C-w") #'mastodon-toot--toggle-warning) + (define-key map (kbd "C-c C-w") #'mastodon-toot--set-content-warning) (define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) - (when (require 'emojify nil :noerror) - (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji) (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) @@ -348,11 +340,12 @@ NO-TOOT means we are not calling from a toot buffer." (with-current-buffer "*new toot*" (mastodon-toot--update-status-fields))))) -(defun mastodon-toot--action-success (marker byline-region remove) +(defun mastodon-toot--action-success (marker byline-region remove &optional json) "Insert/remove the text MARKER with `success' face in byline. BYLINE-REGION is a cons of start and end pos of the byline to be modified. -Remove MARKER if REMOVE is non-nil, otherwise add it." +Remove MARKER if REMOVE is non-nil, otherwise add it. +JSON is added to the string as its item-json." (let ((inhibit-read-only t) (bol (car byline-region)) (eol (cdr byline-region)) @@ -371,7 +364,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (format "(%s) " (propertize marker 'face 'success)) - 'cursor-face 'mastodon-cursor-highlight-face)))) + 'cursor-face 'mastodon-cursor-highlight-face + 'item-json json)))) ;; for (un)folding items (when at-byline-p ;; leave point after the marker: (unless remove @@ -394,7 +388,7 @@ boosting, or bookmarking toots." (defun mastodon-toot--toggle-boost-or-favourite (action) "Toggle boost or favourite of toot at `point'. ACTION is a symbol, either `favourite' or `boost.'" - (mastodon-tl--with-toot-item + (mastodon-toot--with-toot-item (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) @@ -485,7 +479,7 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (defun mastodon-toot--toggle-bookmark () "Bookmark or unbookmark toot at point." (interactive) - (mastodon-tl--with-toot-item + (mastodon-toot--with-toot-item (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) @@ -532,7 +526,7 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." - (mastodon-tl--with-toot-item + (mastodon-toot--with-toot-item (let* ((endpoint (if favourite "favourited_by" "reblogged_by")) (url (mastodon-http--api (format "statuses/%s/%s" id endpoint))) (params '(("limit" . "80"))) @@ -669,8 +663,7 @@ NO-REDRAFT means delete toot only." "Set content warning to CW if it is non-nil." (unless (or (null cw) ; cw is nil for `mastodon-tl--dm-user' (string-empty-p cw)) - (setq mastodon-toot--content-warning t) - (setq mastodon-toot--content-warning-from-reply-or-redraft cw))) + (setq mastodon-toot--content-warning cw))) ;;; REDRAFT @@ -729,8 +722,10 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." (let ((prev-window-config mastodon-toot-previous-window-config)) (unless (eq mastodon-toot-current-toot-text nil) (when cancel - (cl-pushnew mastodon-toot-current-toot-text - mastodon-toot-draft-toots-list :test 'equal))) + (setf (multisession-value mastodon-toot-draft-toots-list) + (cl-pushnew mastodon-toot-current-toot-text + (multisession-value 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) (quit-window 'kill) @@ -752,8 +747,10 @@ Pushes `mastodon-toot-current-toot-text' to `mastodon-toot-draft-toots-list'." (interactive) (unless (eq mastodon-toot-current-toot-text nil) - (cl-pushnew mastodon-toot-current-toot-text - mastodon-toot-draft-toots-list :test 'equal) + (setf (multisession-value mastodon-toot-draft-toots-list) + (cl-pushnew mastodon-toot-current-toot-text + (multisession-value mastodon-toot-draft-toots-list) + :test 'equal)) (message "Draft saved!"))) (defun mastodon-toot--empty-p (&optional text-only) @@ -769,9 +766,12 @@ TEXT-ONLY means don't check for attachments or polls." ;;; EMOJIS -(defalias 'mastodon-toot--insert-emoji - #'emojify-insert-emoji - "Prompt to insert an emoji.") +(defun mastodon-toot--insert-emoji () + "Prompt to insert an emoji." + (interactive) + (if mastodon-use-emojify + (emojify-insert-emoji) + (emoji-search))) (defun mastodon-toot--emoji-dir () "Return the file path for the mastodon custom emojis directory." @@ -867,13 +867,6 @@ to `emojify-user-emojis', and the emoji data is updated." `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))) -(defun mastodon-toot--read-cw-string () - "Read a content warning from the minibuffer." - (when (and (not (mastodon-toot--empty-p)) - mastodon-toot--content-warning) - (read-string "Warning: " - mastodon-toot--content-warning-from-reply-or-redraft))) - ;;; SEND TOOT FUNCTION @@ -891,13 +884,12 @@ instance to edit a toot." (endpoint (if edit-id ; we are sending an edit: (mastodon-http--api (format "statuses/%s" edit-id)) (mastodon-http--api "statuses"))) - (cw (mastodon-toot--read-cw-string)) (args-no-media (append `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) ("sensitive" . ,(when mastodon-toot--content-nsfw (symbol-name t))) - ("spoiler_text" . ,cw) + ("spoiler_text" . ,mastodon-toot--content-warning) ("language" . ,mastodon-toot--language)) ;; Pleroma instances can't handle null-valued ;; scheduled_at args, so only add if non-nil @@ -923,7 +915,8 @@ instance to edit a toot." (length mastodon-toot--media-attachment-ids))))) (user-error "Something is wrong with your uploads. Wait for them to complete or try again.")) ((and mastodon-toot--max-toot-chars - (> (mastodon-toot--count-toot-chars toot cw) mastodon-toot--max-toot-chars)) + (> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning) + mastodon-toot--max-toot-chars)) (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) ((mastodon-toot--empty-p) (user-error "Empty toot. Cowardly refusing to post this.")) @@ -961,23 +954,23 @@ instance to edit a toot." (defun mastodon-toot--edit-toot-at-point () "Edit the user's toot at point." (interactive) - (mastodon-tl--with-toot-item - (let ((toot (mastodon-toot--base-toot-or-item-json))) - (if (not (mastodon-toot--own-toot-p toot)) - (user-error "You can only edit your own toots.") - (let* ((source (mastodon-toot--get-toot-source id)) - (content (alist-get 'text source)) - (source-cw (alist-get 'spoiler_text source))) - (let-alist toot - (when (y-or-n-p "Edit this toot? ") - (mastodon-toot--compose-buffer nil .in_reply_to_id nil - content :edit) - (goto-char (point-max)) - ;; adopt reply-to-id, visibility, CW, language, and media: - (mastodon-toot--set-toot-properties .in_reply_to_id .visibility - source-cw .language nil nil - .media_attachments .poll) - (setq mastodon-toot--edit-item-id id)))))))) + (mastodon-toot--with-toot-item + (mastodon-tl--with-toot-item + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only edit your own toots.") + (let* ((source (mastodon-toot--get-toot-source id)) + (content (alist-get 'text source)) + (source-cw (alist-get 'spoiler_text source))) + (let-alist toot + (when (y-or-n-p "Edit this toot? ") + (mastodon-toot--compose-buffer nil .in_reply_to_id nil + content :edit) + (goto-char (point-max)) + ;; adopt reply-to-id, visibility, CW, language, and media: + (mastodon-toot--set-toot-properties .in_reply_to_id .visibility + source-cw .language nil nil + .media_attachments .poll) + (setq mastodon-toot--edit-item-id id)))))))) (defun mastodon-toot--get-toot-source (id) "Fetch the source JSON of toot with ID." @@ -1040,7 +1033,7 @@ Remove empty string (self) from result and joins the sequence with whitespace." "Add domain to local ACCT and replace the curent user name with \"\". Mastodon requires the full @user@domain, even in the case of local accts. eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the -mastodon-instance-url). +`mastodon-instance-url'). eg. \"yourusername\" -> \"\" eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"." (cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct @@ -1182,7 +1175,7 @@ text of the toot being replied to in the compose buffer. If the region is active, inject it into the reply buffer, prefixed by >." (interactive) - (mastodon-tl--with-toot-item + (mastodon-toot--with-toot-item (let* ((quote (when (region-active-p) (buffer-substring (region-beginning) (region-end)))) @@ -1221,11 +1214,11 @@ prefixed by >." ;;; COMPOSE TOOT SETTINGS -(defun mastodon-toot--toggle-warning () - "Toggle `mastodon-toot--content-warning'." +(defun mastodon-toot--set-content-warning () + "Set a content warning for the current toot." (interactive) (setq mastodon-toot--content-warning - (not mastodon-toot--content-warning)) + (read-string "Warning: " mastodon-toot--content-warning)) (mastodon-toot--update-status-fields)) (defun mastodon-toot--toggle-nsfw () @@ -1538,7 +1531,7 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;;; DISPLAY KEYBINDINGS (defun mastodon-toot--get-mode-kbinds () - "Get a list of the keybindings in the mastodon-toot-mode." + "Get a list of the keybindings in the `mastodon-toot-mode'." (let* ((binds (copy-tree mastodon-toot-mode-map)) (prefix (car (cadr binds))) (bindings (remove nil (mapcar (lambda (i) @@ -1551,7 +1544,7 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (defun mastodon-toot--format-kbind-command (cmd) "Format CMD to be more readable. -e.g. mastodon-toot--send -> Send." +e.g. `mastodon-toot--send' -> Send." (let* ((str (symbol-name cmd)) (re "--\\(.*\\)$") (str2 (save-match-data @@ -1607,7 +1600,7 @@ LONGEST is the length of the longest binding." ;;; DISPLAY DOCS (defun mastodon-toot--make-mode-docs () - "Create formatted documentation text for the mastodon-toot-mode." + "Create formatted documentation text for the `mastodon-toot-mode'." (let* ((kbinds (mastodon-toot--get-mode-kbinds)) (longest-kbind (mastodon-toot--formatted-kbinds-longest (mastodon-toot--format-kbinds kbinds)))) @@ -1801,8 +1794,9 @@ REPLY-REGION is a string to be injected into the buffer." (prin1-to-string mastodon-toot-poll)) (mastodon-toot--apply-fields-props cw-region - (if mastodon-toot--content-warning - "CW" + (if (and mastodon-toot--content-warning + (not (equal "" mastodon-toot--content-warning))) + (format "CW: %s" mastodon-toot--content-warning) " ") ;; hold the blank space 'mastodon-cw-face)))) @@ -1840,23 +1834,25 @@ Added to `after-change-functions' in new toot buffers." (defun mastodon-toot--open-draft-toot () "Prompt for a draft and compose a toot with it." (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))) + (if (multisession-value mastodon-toot-draft-toots-list) + (let ((text (completing-read + "Select draft toot: " + (multisession-value mastodon-toot-draft-toots-list) + nil t))) + (if (not (mastodon-toot--compose-buffer-p)) + (mastodon-toot--compose-buffer nil nil nil text) + (when (and (not (mastodon-toot--empty-p :text-only)) + (y-or-n-p "Replace current text with draft?")) + (setf (multisession-value mastodon-toot-draft-toots-list) + (cl-pushnew mastodon-toot-current-toot-text + (multisession-value 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)))) (unless (mastodon-toot--compose-buffer-p) (mastodon-toot--compose-buffer)) (message "No drafts available."))) @@ -1864,19 +1860,22 @@ Added to `after-change-functions' in new toot buffers." (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."))) + (if (not (multisession-value mastodon-toot-draft-toots-list)) + (message "No drafts to delete.") + (let ((draft (completing-read + "Select draft to delete: " + (multisession-value mastodon-toot-draft-toots-list) + nil t))) + (setf (multisession-value mastodon-toot-draft-toots-list) + (cl-delete draft + (multisession-value mastodon-toot-draft-toots-list) + :test #'equal)) + (message "Draft deleted!")))) (defun mastodon-toot--delete-all-drafts () "Delete all drafts." (interactive) - (setq mastodon-toot-draft-toots-list nil) + (setf (multisession-value mastodon-toot-draft-toots-list) nil) (message "All drafts deleted!")) @@ -1961,7 +1960,9 @@ EDIT means we are editing an existing toot, not composing a new one." (mastodon-toot-mode t) ;; set visibility: (setq mastodon-toot--visibility - (or (plist-get mastodon-profile-account-settings 'privacy) + (or (plist-get + (multisession-value mastodon-profile-account-settings) + 'privacy) ;; use toot visibility setting from the server: (mastodon-profile--get-source-value 'privacy) "public")) ; fallback @@ -2019,7 +2020,7 @@ EDIT means we are editing an existing toot, not composing a new one." (setq mastodon-toot-previous-window-config previous-window-config) (when mastodon-toot--proportional-fonts-compose (facemenu-set-face 'variable-pitch)) - (when (and mastodon-toot--emojify-in-compose-buffer + (when (and mastodon-use-emojify ;; emojify loaded but poss not enabled in our buffer: (boundp 'emojify-mode)) (emojify-mode)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d0dddee..8a0aa91 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -7,7 +7,7 @@ ;; Marty Hiatt <martianhiatus@riseup.net> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 1.0.24 -;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4")) +;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. @@ -144,6 +144,11 @@ The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS. Use. e.g. \"%c\" for your locale's date and time format." :type 'string) +(defcustom mastodon-use-emojify nil + "Whether to use emojify.el to display emojis. +From version 28, Emacs can display emojis natively. But +currently, it doesn't seem to have a way to handle custom emoji, +while emojify,el has this feature and mastodon.el implements it.") (defun mastodon-kill-window () "Quit window and delete helper." @@ -464,7 +469,8 @@ Calls `mastodon-tl--get-buffer-type', which see." (defun mastodon-mode-hook-fun () "Function to add to `mastodon-mode-hook'." - (when (require 'emojify nil :noerror) + (when (and mastodon-use-emojify + (require 'emojify nil :noerror)) (emojify-mode t) (when mastodon-toot--enable-custom-instance-emoji (mastodon-toot--enable-custom-emoji))) |