From 9b1b08c9b32eaec12c952437a5657e78b84c25cc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 1 Jul 2024 18:03:30 +0200 Subject: img help echo: cmd keys and toggle sensitive binding --- lisp/mastodon-media.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index d14d283..9dc8517 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -497,8 +497,12 @@ TYPE is the attachment's type field on the server. CAPTION is the image caption if provided. SENSITIVE is a flag from the item's JSON data." (let* ((help-echo-base - "RET/i: load full image (prefix: copy URL), +/-: zoom,\ - r: rotate, o: save preview") + (substitute-command-keys + (concat "\\`RET'/\\`i': load full image (prefix: copy URL), \\`+'/\\`-': zoom,\ + \\`r': rotate, \\`o': save preview" + (if (not (eq sensitive :json-false)) + ", \\`S': toggle sensitive media" + "")))) (help-echo (if caption (concat help-echo-base "\n\"" caption "\"") -- cgit v1.2.3 From 92e1e7b991d06e83aa5bf22911d18019391aa3db Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 1 Jul 2024 21:49:46 +0200 Subject: move/rename with-toot-item --- lisp/mastodon-tl.el | 8 -------- lisp/mastodon-toot.el | 21 +++++++++++++++------ 2 files changed, 15 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 41ecd85..2574a0f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -339,14 +339,6 @@ than `pop-to-buffer'." (message "Looks like there's no item at point?") ,@body)) -(defmacro mastodon-tl--do-if-item-strict (&rest body) - "Execute BODY if we have a toot object at point. -Includes boosts, and notifications that display toots." - (declare (debug t)) - `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) - (message "Looks like there's no toot at point?") - ,@body)) - ;;; NAV diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 23de8b7..e934352 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -76,7 +76,6 @@ (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--do-if-item-strict "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") @@ -267,6 +266,16 @@ send.") "\\>")) ; boundary end +;;; MACRO + +(defmacro mastodon-tl--with-toot-item (&rest body) + "Execute BODY if we have a toot object at point. +Includes boosts, and notifications that display toots." + (declare (debug t)) + `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) + (message "Looks like there's no toot at point?") + ,@body)) + ;;; MODE MAP (defvar mastodon-toot-mode-map @@ -364,7 +373,7 @@ boosting, or bookmarking toots." (defun mastodon-toot--toggle-boost-or-favourite (type) "Toggle boost or favourite of toot at `point'. TYPE is a symbol, either `favourite' or `boost.'" - (mastodon-tl--do-if-item-strict + (mastodon-tl--with-toot-item (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) @@ -467,7 +476,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--do-if-item-strict + (mastodon-tl--with-toot-item (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) @@ -515,7 +524,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--do-if-item-strict + (mastodon-tl--with-toot-item (let* ((base-toot (mastodon-tl--property 'base-item-id)) (endpoint (if favourite "favourited_by" "reblogged_by")) (url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint))) @@ -948,7 +957,7 @@ instance to edit a toot." (defun mastodon-toot--edit-toot-at-point () "Edit the user's toot at point." (interactive) - (mastodon-tl--do-if-item-strict + (mastodon-tl--with-toot-item (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs (mastodon-tl--property 'item-json)))) (if (not (mastodon-toot--own-toot-p toot)) @@ -1174,7 +1183,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--do-if-item-strict + (mastodon-tl--with-toot-item (let* ((quote (when (region-active-p) (buffer-substring (region-beginning) (region-end)))) -- cgit v1.2.3 From b8e8328a35efa67b5f4b3eb2ea26821fa13120f9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 2 Jul 2024 10:02:23 +0200 Subject: use with-toot-item and clean up functions that use it --- lisp/mastodon-toot.el | 177 +++++++++++++++++++++++++------------------------- 1 file changed, 88 insertions(+), 89 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e934352..d732e3d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -265,16 +265,37 @@ send.") ;; "/" ; poss an ending slash? incompat with boundary end: "\\>")) ; boundary end + +;;; UTILS + +(defun mastodon-toot--base-toot-or-item-json () + "Return the JSON data of either base-toot or item-json property. +The former is for boost or favourite notifications, returning +data about the item boosted or favourited." + (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs + (mastodon-tl--property 'item-json))) + ;;; MACRO (defmacro mastodon-tl--with-toot-item (&rest body) "Execute BODY if we have a toot object at point. -Includes boosts, and notifications that display toots." +Includes boosts, and notifications that display toots. +This macro makes the id local variable available." (declare (debug t)) `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) - (message "Looks like there's no toot at point?") - ,@body)) + (user-error "Looks like there's no toot at point?") + (mastodon-tl--with-toot-helper + (lambda (id) + ,@body)))) + +(defun mastodon-tl--with-toot-helper (body-fun) + "Helper function for `mastodon-tl--with-toot-item'. +Extract any common variables needed, such as base-item-id +property, and call BODY-FUN on them." + (let ((id (mastodon-tl--property 'base-item-id))) + (funcall body-fun id))) + ;;; MODE MAP @@ -370,20 +391,17 @@ boosting, or bookmarking toots." (response (mastodon-http--post url))) (mastodon-http--triage response callback))) -(defun mastodon-toot--toggle-boost-or-favourite (type) +(defun mastodon-toot--toggle-boost-or-favourite (action) "Toggle boost or favourite of toot at `point'. -TYPE is a symbol, either `favourite' or `boost.'" +ACTION is a symbol, either `favourite' or `boost.'" (mastodon-tl--with-toot-item (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) (user-error (format "Can't do action on %s notifications." n-type)) - (let* ((boost-p (equal type 'boost)) - ;; (has-id (mastodon-tl--property 'base-item-id)) - (byline-region ;(when has-id + (let* ((boost-p (equal action 'boost)) + (byline-region (mastodon-tl--find-property-range 'byline (point))) - (id (when byline-region - (mastodon-tl--as-string (mastodon-tl--property 'base-item-id)))) (boosted (when byline-region (get-text-property (car byline-region) 'boosted-p))) (faved (when byline-region @@ -395,44 +413,35 @@ TYPE is a symbol, either `favourite' or `boost.'" (action-string (if boost-p "boost" "favourite")) (remove (if boost-p (when boosted t) (when faved t))) (item-json (mastodon-tl--property 'item-json)) - (toot-type (alist-get 'type item-json)) (visibility (mastodon-tl--field 'visibility item-json))) - (if byline-region - (if (and (or (equal visibility "direct") - (equal visibility "private")) - boost-p) - (message "You cant boost posts with visibility: %s" visibility) - (cond ;; actually there's nothing wrong with faving/boosting own toots! - ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'item-json)) - ;;(error "You can't %s your own toots" action-string)) - ;; & nothing wrong with faving/boosting own toots from notifs: - ;; this boosts/faves the base toot, not the notif status - ((and (equal "reblog" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (user-error "You can't %s boosts" action-string)) - ((and (equal "favourite" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (user-error "You can't %s favourites" action-string)) - ((and (equal "private" visibility) - (equal type 'boost)) - (user-error "You can't boost private toots")) - (t - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action type remove) - (mastodon-toot--action-success (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove)) - (message (format "%s #%s" (if boost-p msg action) id))))))) - (message (format "Nothing to %s here?!?" action-string)))))))) + (if (not byline-region) + (user-error "Nothing to %s here?!?" action-string) + (if (and (or (equal visibility "direct") + (equal visibility "private")) + boost-p) + (user-error "You cant boost posts with visibility: %s" + visibility) + ;; there's nothing wrong with faving/boosting own toots + ;; & nothing wrong with faving/boosting own toots from notifs, + ;; it boosts/faves the base toot, not the notif status + (if (and (equal "private" visibility) + (eq action 'boost)) + (user-error "You can't boost private toots") + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--update-stats-on-action action remove) + (mastodon-toot--action-success (if boost-p + (mastodon-tl--symbol 'boost) + (mastodon-tl--symbol 'favourite)) + byline-region remove)) + (message "%s #%s" (if boost-p msg action) id))))))))))) (defun mastodon-toot--inc-or-dec (count subtract) "If SUBTRACT, decrement COUNT, else increment." @@ -480,16 +489,15 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (let ((n-type (mastodon-tl--property 'notification-type :no-move))) (if (or (equal n-type "follow") (equal n-type "follow_request")) - (user-error (format "Can't do action on %s notifications." n-type)) - (let* ((id (mastodon-tl--property 'base-item-id)) - (bookmarked-p - (mastodon-tl--property - 'bookmarked-p - (if (mastodon-tl--property 'byline :no-move) - ;; no move if not in byline, the idea being if in body, we do - ;; move forward to byline to toggle correctly. - ;; alternatively we could bookmarked-p whole posts. - :no-move))) + (user-error (format "Can't bookmark %s notifications." n-type)) + (let* ((bookmarked-p (mastodon-tl--property + 'bookmarked-p + (if (mastodon-tl--property 'byline :no-move) + ;; no move if not in byline, the idea being + ;; if in body, we do move forward to byline + ;; to toggle correctly. alternatively we + ;; could bookmarked-p whole posts. + :no-move))) (byline-region (when id (mastodon-tl--find-property-range 'byline (point)))) (action (if bookmarked-p "unbookmark" "bookmark")) @@ -525,22 +533,20 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." (mastodon-tl--with-toot-item - (let* ((base-toot (mastodon-tl--property 'base-item-id)) - (endpoint (if favourite "favourited_by" "reblogged_by")) - (url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint))) + (let* ((endpoint (if favourite "favourited_by" "reblogged_by")) + (url (mastodon-http--api (format "statuses/%s/%s" id endpoint))) (params '(("limit" . "80"))) (json (mastodon-http--get-json url params))) (if (eq (caar json) 'error) - (user-error "%s (Status does not exist or is private)" (alist-get 'error json)) + (user-error "%s (Status does not exist or is private)" + (alist-get 'error json)) (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (user-error "Looks like this toot has no %s" type-string) (let ((choice (completing-read (format "%s (enter to view profile): " type-string) - handles - nil - t))) + handles nil t))) (mastodon-profile--show-user choice)))))))) (defun mastodon-toot--copy-toot-url () @@ -958,27 +964,22 @@ instance to edit a toot." "Edit the user's toot at point." (interactive) (mastodon-tl--with-toot-item - (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs - (mastodon-tl--property 'item-json)))) + (let ((toot (mastodon-toot--base-toot-or-item-json))) (if (not (mastodon-toot--own-toot-p toot)) - (message "You can only edit your own toots.") - (let* ((id (mastodon-tl--as-string (mastodon-tl--item-id toot))) - (source (mastodon-toot--get-toot-source id)) + (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)) - (toot-visibility (alist-get 'visibility toot)) - (toot-language (alist-get 'language toot)) - (reply-id (alist-get 'in_reply_to_id toot)) - (media (alist-get 'media_attachments toot)) - (poll (alist-get 'poll toot))) - (when (y-or-n-p "Edit this toot? ") - (mastodon-toot--compose-buffer nil reply-id nil content :edit) - (goto-char (point-max)) - ;; adopt reply-to-id, visibility, CW, language, and media: - (mastodon-toot--set-toot-properties reply-id toot-visibility - source-cw toot-language nil - nil media poll) - (setq mastodon-toot--edit-item-id id))))))) + (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." @@ -1187,14 +1188,12 @@ prefixed by >." (let* ((quote (when (region-active-p) (buffer-substring (region-beginning) (region-end)))) - (toot (mastodon-tl--property 'item-json)) ;; no-move arg for base toot: don't try next toot - (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling - (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) + (toot (mastodon-toot--base-toot-or-item-json)) (account (mastodon-tl--field 'account toot)) (user (alist-get 'acct account)) - (mentions (mastodon-toot--mentions (or base-toot toot))) - (boosted (mastodon-tl--field 'reblog (or base-toot toot))) + (mentions (mastodon-toot--mentions toot)) + (boosted (mastodon-tl--field 'reblog toot)) (booster (when boosted (alist-get 'acct (alist-get 'account toot))))) @@ -1218,7 +1217,7 @@ prefixed by >." ;; user in mentions already: (mastodon-toot--mentions-to-string (copy-sequence mentions))))) id - (or base-toot toot) + toot quote)))) -- cgit v1.2.3 From 41404473ea8a12f4ef5cbb5b6356e6c0a6e9be9a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 2 Jul 2024 10:02:47 +0200 Subject: toot.el: user-error not message when needed --- lisp/mastodon-toot.el | 60 +++++++++++++++++++++++++-------------------------- 1 file changed, 29 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d732e3d..18bedab 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -363,7 +363,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (beginning-of-line) ;; The marker is not part of the byline (if (search-forward (format "(%s) " marker) eol t) (replace-match "") - (message "Oops: could not find marker '(%s)'" marker))) + (user-error "Oops: could not find marker '(%s)'" marker))) (unless remove (goto-char bol) (insert @@ -506,18 +506,18 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "Bookmark removed!" "Toot bookmarked!")) (remove (when bookmarked-p t))) - (if byline-region - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success bookmark-str - byline-region remove) - (message (format "%s #%s" message id)))) - (message (format "Nothing to %s here?!?" action)))))))) + (if (not byline-region) + (user-error "Nothing to %s here?!?" action) + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p)))) + (mastodon-toot--action-success bookmark-str + byline-region remove) + (message "%s #%s" message id))))))))) (defun mastodon-toot--list-toot-boosters () "List the boosters of toot at point." @@ -593,10 +593,10 @@ Uses `lingva.el'." (when mastodon-tl--enable-proportional-fonts t)) (void-function - (message "Looks like you need to install lingva.el. Error: %s" - (error-message-string x)))) - (message "No toot to translate?")) - (message "No mastodon buffer?"))) + (user-error "Looks like you need to install lingva.el. Error: %s" + (error-message-string x)))) + (user-error "No toot to translate?")) + (user-error "No mastodon buffer?"))) (defun mastodon-toot--own-toot-p (toot) "Check if TOOT is user's own, for deleting, editing, or pinning it." @@ -617,7 +617,7 @@ Uses `lingva.el'." (msg (if pinned-p "unpinned" "pinned")) (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) - (message "You can only pin your own toots.") + (user-error "You can only pin your own toots.") (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) (mastodon-toot--action action (lambda (_) @@ -647,7 +647,7 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot)) (pos (point))) (if (not (mastodon-toot--own-toot-p toot)) - (message "You can only delete (and redraft) your own toots.") + (user-error "You can only delete (and redraft) your own toots.") (when (y-or-n-p (if no-redraft (format "Delete this toot? ") (format "Delete and redraft this toot? "))) @@ -787,7 +787,7 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (custom-emoji (mastodon-http--get-json url)) (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) (if (not (file-directory-p emojify-emojis-dir)) - (message "Looks like you need to set up emojify first.") + (user-error "Looks like you need to set up emojify first.") (unless (file-directory-p mastodon-custom-emoji-dir) (make-directory mastodon-custom-emoji-dir nil)) ; no add parent (mapc (lambda (x) @@ -921,12 +921,12 @@ instance to edit a toot." (or (not args-media) (not (= (length mastodon-toot--media-attachments) (length mastodon-toot--media-attachment-ids))))) - (message "Something is wrong with your uploads. Wait for them to complete or try again.")) + (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)) - (message "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) + (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) ((mastodon-toot--empty-p) - (message "Empty toot. Cowardly refusing to post this.")) + (user-error "Empty toot. Cowardly refusing to post this.")) (t (let ((response (if edit-id ; we are sending an edit: (mastodon-http--put endpoint args) @@ -936,9 +936,7 @@ instance to edit a toot." (lambda (_) ;; kill buffer: (mastodon-toot--kill) - (if scheduled - (message "Toot scheduled!") - (message "Toot toot!")) + (message "Toot %s!" (if scheduled "scheduled" "toot")) ;; cancel scheduled toot if we were editing it: (when scheduled-id (mastodon-views--cancel-scheduled-toot @@ -1242,7 +1240,7 @@ prefixed by >." "Change the current visibility to the next valid value." (interactive) (if (mastodon-tl--buffer-type-eq 'edit-toot) - (message "You can't change visibility when editing toots.") + (user-error "You can't change visibility when editing toots.") (setq mastodon-toot--visibility (cond ((string= mastodon-toot--visibility "public") "unlisted") @@ -1286,7 +1284,7 @@ File is actually attached to the toot upon posting." ;; Only a max. of 4 attachments are allowed, so pop the oldest one. (pop mastodon-toot--media-attachments)) (if (file-directory-p file) - (message "Looks like you chose a directory not a file.") + (user-error "Looks like you chose a directory not a file.") (setq mastodon-toot--media-attachments (nconc mastodon-toot--media-attachments `(((:contents . ,(mastodon-http--read-file-as-string file)) @@ -1425,7 +1423,7 @@ LENGTH is the maximum character length allowed for a poll option." (longest (apply #'max (mapcar #'length choices)))) (if (> longest length) (progn - (message "looks like you went over the max length. Try again.") + (user-error "looks like you went over the max length. Try again.") (sleep-for 2) (mastodon-toot--read-poll-options count length)) choices))) @@ -1493,10 +1491,10 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;; https://codeberg.org/martianh/mastodon.el/issues/285 (interactive) (cond ((mastodon-tl--buffer-type-eq 'edit-toot) - (message "You can't schedule toots you're editing.")) + (user-error "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 buffer or scheduled toots view.")) + (user-error "You can only schedule toots from the compose buffer or scheduled toots view.")) (t (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) (ts (when reschedule -- cgit v1.2.3 From f43ecd6bad329bd16b76d1b6962ef4b3715f362c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 3 Jul 2024 13:40:01 +0200 Subject: docstring --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 18bedab..408a783 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -281,7 +281,7 @@ data about the item boosted or favourited." (defmacro mastodon-tl--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 id local variable available." +This macro makes the local variable ID available." (declare (debug t)) `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) (user-error "Looks like there's no toot at point?") -- cgit v1.2.3 From f19f3bc2735bd78bb3150b8507b6f8949108cece Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 4 Jul 2024 13:17:13 +0200 Subject: replace persist with multisession --- lisp/mastodon-profile.el | 19 +++++++++++-------- lisp/mastodon-toot.el | 4 +++- lisp/mastodon.el | 2 +- 3 files changed, 15 insertions(+), 10 deletions(-) (limited to 'lisp') 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-toot.el b/lisp/mastodon-toot.el index e934352..694d9c0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1964,7 +1964,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 diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d0dddee..0747d53 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -7,7 +7,7 @@ ;; Marty Hiatt ;; Maintainer: Marty Hiatt ;; 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. -- cgit v1.2.3 From a9c6c04ac6b4eeeae0ac8ed6344588a72af8def9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 4 Jul 2024 14:32:10 +0200 Subject: comments on mastodon-tl--goto-item-pos --- lisp/mastodon-tl.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2574a0f..f84f7c0 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -396,14 +396,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"))))) -- cgit v1.2.3 From 7b4d77b86bb88377ca75938d2f1b88b839e96a02 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 4 Jul 2024 15:35:48 +0200 Subject: tl: no-refresh for next-item in --single-toot --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f84f7c0..128298d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1957,7 +1957,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." -- cgit v1.2.3 From 4e8d28616431d2ddedc01eb021d20718f1eb1877 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 6 Jul 2024 17:04:46 +0200 Subject: mastodon-use-emojify customize --- lisp/mastodon-toot.el | 5 +---- lisp/mastodon.el | 8 +++++++- 2 files changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 694d9c0..496f334 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -158,10 +158,7 @@ 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) +(defvar mastodon-use-emojify) (defcustom mastodon-toot--proportional-fonts-compose nil "Nonnil to enable using proportional fonts in the compose buffer. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 0747d53..8a0aa91 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -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))) -- cgit v1.2.3 From 534644d2bd6a0a14b89d7bdacc41d305fcf265b6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 5 Jul 2024 17:11:21 +0200 Subject: toot: default to emoji.el, emojify customize mastodon-use-emojify customize --- lisp/mastodon-toot.el | 16 +++++++--------- lisp/mastodon.el | 8 +++++++- 2 files changed, 14 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e934352..ecee301 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") @@ -158,11 +160,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." @@ -285,8 +282,7 @@ Includes boosts, and notifications that display toots." (define-key map (kbd "C-c C-w") #'mastodon-toot--toggle-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) @@ -764,7 +760,9 @@ TEXT-ONLY means don't check for attachments or polls." ;;; EMOJIS (defalias 'mastodon-toot--insert-emoji - #'emojify-insert-emoji + (if mastodon-use-emojify + #'emojify-insert-emoji + #'emoji-search) "Prompt to insert an emoji.") (defun mastodon-toot--emoji-dir () @@ -2022,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..73a8665 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -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))) -- cgit v1.2.3 From 4697c073e871afa2d69b64d03a7b03354e4e4dba Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 Jul 2024 10:24:13 +0200 Subject: message -> user-error --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 128298d..c4585b8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1361,7 +1361,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: " @@ -1373,7 +1373,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)) -- cgit v1.2.3 From 8f8c461e01a9cd85624b40bb158607f4240c80e6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 12 Jul 2024 14:19:46 +0200 Subject: wrap --thread in with-item macro --- lisp/mastodon-tl.el | 73 +++++++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 36 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c4585b8..a82d437 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1979,42 +1979,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-tl--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. -- cgit v1.2.3 From e9ddf28832eb06f9731b74f3fff11c4606f05a70 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 11:25:46 +0200 Subject: horiz-bar refactor --- lisp/mastodon-tl.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a82d437..ac30005 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -239,9 +239,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 -- cgit v1.2.3 From c8565612b95ce09c1d55470943a52c25798c27a1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 11:27:41 +0200 Subject: fold long posts, unfolding cmd. FIX #572. --- lisp/mastodon-tl.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 47 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ac30005..d87a469 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -979,6 +979,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 @@ -1020,6 +1022,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))))) @@ -1526,12 +1530,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))) + (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)) @@ -1551,6 +1556,44 @@ 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) + "Fold toot BODY if it is very long." + (if (length> body 500) + (let* ((heading (mastodon-search--format-heading + (mastodon-tl--make-link + "READ MORE" + 'read-more))) + (display (concat (substring body 0 500) + heading))) + (propertize display + 'read-more body)) + 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)) + (range (mastodon-tl--find-property-range + 'read-more (point) byline))) + (if (not range) + (user-error "No folded item at point?") + (let* ((inhibit-read-only t) + (body (save-excursion + (goto-char (car range)) + (mastodon-tl--property 'read-more)))) + ;; `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) + (insert body)) + ;; 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. -- cgit v1.2.3 From 344da8f2f2a1dff0249bb5e8d73d088d2bd824e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 11:42:40 +0200 Subject: fold toots customize/ refactor --- lisp/mastodon-tl.el | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d87a469..a0a0c18 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -219,6 +219,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 @@ -1558,16 +1565,18 @@ When DOMAIN, force inclusion of user's domain in their handle." (defun mastodon-tl--fold-body-maybe (body) "Fold toot BODY if it is very long." - (if (length> body 500) - (let* ((heading (mastodon-search--format-heading - (mastodon-tl--make-link - "READ MORE" - 'read-more))) - (display (concat (substring body 0 500) - heading))) - (propertize display - 'read-more body)) - body)) + (if (or (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)." -- cgit v1.2.3 From 3f9b305b5f02954568ec7e7b95eb0653286ccf3a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 11:43:11 +0200 Subject: flymake --- lisp/mastodon-tl.el | 8 +++++--- lisp/mastodon-toot.el | 12 ++++++------ 2 files changed, 11 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a0a0c18..cb7ccf1 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) @@ -1371,7 +1373,7 @@ displayed when the duration is smaller than a minute)." cell)) options-alist))) (if (null poll) - (user-error "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: " @@ -1383,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))) - (user-error "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)) @@ -2030,7 +2032,7 @@ view all branches of a thread." (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." (interactive) - (mastodon-tl--with-toot-item + (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") diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 496f334..bb5a4c3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -265,7 +265,7 @@ send.") ;;; 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." (declare (debug t)) @@ -370,7 +370,7 @@ boosting, or bookmarking toots." (defun mastodon-toot--toggle-boost-or-favourite (type) "Toggle boost or favourite of toot at `point'. TYPE 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")) @@ -473,7 +473,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")) @@ -521,7 +521,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* ((base-toot (mastodon-tl--property 'base-item-id)) (endpoint (if favourite "favourited_by" "reblogged_by")) (url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint))) @@ -954,7 +954,7 @@ 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 + (mastodon-toot--with-toot-item (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs (mastodon-tl--property 'item-json)))) (if (not (mastodon-toot--own-toot-p toot)) @@ -1180,7 +1180,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)))) -- cgit v1.2.3 From 00ac9103adba722f8c2ddbd67db6b0ff6bcebc46 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 12:51:52 +0200 Subject: multisession var in -toot.el --- lisp/mastodon-toot.el | 48 ++++++++++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bb5a4c3..902acf9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -38,7 +38,6 @@ (defvar emojify-user-emojis) (require 'cl-lib) -(require 'persist) (require 'mastodon-iso) (require 'facemenu) (require 'text-property-search) @@ -226,8 +225,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.") @@ -720,8 +719,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) @@ -743,8 +744,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) @@ -1840,15 +1843,17 @@ 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 (multisession-value mastodon-toot-draft-toots-list) + (let ((text (completing-read + "Select draft toot: " + (multisession-value 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) + (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)))) @@ -1864,19 +1869,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)) + (if (multisession-value mastodon-toot-draft-toots-list) + (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!")) (message "No drafts to delete."))) (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!")) -- cgit v1.2.3 From 3ba86999d3369b7e44172403d9aed7d48e1c9813 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 12:53:00 +0200 Subject: flymake toot.el --- lisp/mastodon-toot.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 902acf9..3218709 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1041,7 +1041,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 @@ -1541,7 +1541,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) @@ -1554,7 +1554,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 @@ -1610,7 +1610,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)))) -- cgit v1.2.3 From f16fcb15a8be0143db1f4a11f5025512feca5b44 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 12:55:56 +0200 Subject: use mastodon-use-emojify in toot.el --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3218709..51cf1c0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2029,7 +2029,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)) -- cgit v1.2.3 From 6721f40cfd9111ed8d511d7aa3a3a5d2a0a771cb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 14:49:11 +0200 Subject: unfold toot: replace whole item on unfolding (so we have props!) --- lisp/mastodon-tl.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index cb7ccf1..17f7ae5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1506,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 @@ -1540,7 +1540,7 @@ When DOMAIN, force inclusion of user's domain in their handle." "\n") "") (let ((bar (mastodon-tl--symbol 'reply-bar)) - (body (mastodon-tl--fold-body-maybe body))) + (body (mastodon-tl--fold-body-maybe body unfolded))) (if (and after-reply-status-p thread) (propertize body 'line-prefix bar @@ -1565,9 +1565,10 @@ 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) +(defun mastodon-tl--fold-body-maybe (body &optional unfolded) "Fold toot BODY if it is very long." - (if (or (eq nil mastodon-tl--fold-toots-at-length) + (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 @@ -1585,22 +1586,22 @@ When DOMAIN, force inclusion of user's domain in their handle." (interactive) ;; if at byline, must search backwards: (let* ((byline (mastodon-tl--property 'byline :no-move)) - (range (mastodon-tl--find-property-range - 'read-more (point) byline))) - (if (not range) + (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) - (body (save-excursion - (goto-char (car range)) - (mastodon-tl--property 'read-more)))) - ;; `replace-region-contents' is much to slow, our hack from fedi.el is - ;; much simpler and much faster + (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) - (insert body)) + (mastodon-tl--toot toot nil nil nil :unfolded)) ;; move point to line where text formerly ended: (goto-char end) (beginning-of-line)))))) @@ -1665,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. @@ -1677,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. -- cgit v1.2.3 From db227a8c2572f9985370325eca9f47d697531697 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 18 Jul 2024 20:33:37 +0200 Subject: flip an if clause --- lisp/mastodon-toot.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e1d7259..4b1e225 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1849,20 +1849,20 @@ Added to `after-change-functions' in new toot buffers." "Select draft toot: " (multisession-value 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?")) - (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)) - (mastodon-toot--compose-buffer nil nil nil text))) + (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."))) -- cgit v1.2.3 From 8c4f18cca757f639aa9c19fc03a92b94c22b9d07 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Jul 2024 09:59:49 +0200 Subject: toot--insert-emoji: defalis -> defun. the alias is only set on loading, when mastodon-use-emojify may not be set yet. so we defun it which means it'll check the var whenever it is run. --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4b1e225..f07e461 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -762,11 +762,12 @@ TEXT-ONLY means don't check for attachments or polls." ;;; EMOJIS -(defalias 'mastodon-toot--insert-emoji +(defun mastodon-toot--insert-emoji () + "Prompt to insert an emoji." + (interactive) (if mastodon-use-emojify - #'emojify-insert-emoji - #'emoji-search) - "Prompt to insert an emoji.") + (emojify-insert-emoji) + (emoji-search))) (defun mastodon-toot--emoji-dir () "Return the file path for the mastodon custom emojis directory." -- cgit v1.2.3 From d60d1d4c316a74397b6607b4d050d71b08ac007b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 19 Jul 2024 10:33:56 +0200 Subject: read CW when setting, not when sending, also display it. FIX #569. --- lisp/mastodon-toot.el | 34 ++++++++++++---------------------- 1 file changed, 12 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f07e461..e884f97 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -166,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.") @@ -278,7 +275,7 @@ Includes boosts, and notifications that display toots." (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) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji) @@ -658,8 +655,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 @@ -863,13 +859,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 @@ -887,13 +876,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 @@ -919,7 +907,8 @@ instance to edit a toot." (length mastodon-toot--media-attachment-ids))))) (message "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)) (message "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) @@ -1226,11 +1215,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 () @@ -1806,8 +1795,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)))) -- cgit v1.2.3 From d7816ab59fdf64fc64adf3185052ee10931d7076 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 29 Jul 2024 22:04:18 +0200 Subject: add item-json prop to fave/boost strings, so (un)folding works --- lisp/mastodon-toot.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e884f97..666d1b0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -319,11 +319,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)) @@ -342,7 +343,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 @@ -422,7 +424,7 @@ TYPE is a symbol, either `favourite' or `boost.'" (mastodon-toot--action-success (if boost-p (mastodon-tl--symbol 'boost) (mastodon-tl--symbol 'favourite)) - byline-region remove)) + byline-region remove item-json)) (message (format "%s #%s" (if boost-p msg action) id))))))) (message (format "Nothing to %s here?!?" action-string)))))))) -- cgit v1.2.3 From f8ee682bb403b5488294e69c464149626221f7c7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 09:24:50 +0200 Subject: flip an if clause --- lisp/mastodon-toot.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 666d1b0..0cd66db 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1863,17 +1863,17 @@ 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 (multisession-value mastodon-toot-draft-toots-list) - (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!")) - (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." -- cgit v1.2.3 From 80ce719004cb243a7149e7bb45749cf033ae77b2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 09:37:23 +0200 Subject: flymake our user-error mess --- lisp/mastodon-toot.el | 54 +++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 856c5bb..a422cc2 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -611,7 +611,7 @@ Uses `lingva.el'." (msg (if pinned-p "unpinned" "pinned")) (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) - (user-error "You can only pin your own toots.") + (user-error "You can only pin your own toots") (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) (mastodon-toot--action action (lambda (_) @@ -641,7 +641,7 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot)) (pos (point))) (if (not (mastodon-toot--own-toot-p toot)) - (user-error "You can only delete (and redraft) your own toots.") + (user-error "You can only delete (and redraft) your own toots") (when (y-or-n-p (if no-redraft (format "Delete this toot? ") (format "Delete and redraft this toot? "))) @@ -787,7 +787,7 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (custom-emoji (mastodon-http--get-json url)) (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) (if (not (file-directory-p emojify-emojis-dir)) - (user-error "Looks like you need to set up emojify first.") + (user-error "Looks like you need to set up emojify first") (unless (file-directory-p mastodon-custom-emoji-dir) (make-directory mastodon-custom-emoji-dir nil)) ; no add parent (mapc (lambda (x) @@ -913,13 +913,13 @@ instance to edit a toot." (or (not args-media) (not (= (length mastodon-toot--media-attachments) (length mastodon-toot--media-attachment-ids))))) - (user-error "Something is wrong with your uploads. Wait for them to complete or try again.")) + (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 mastodon-toot--content-warning) mastodon-toot--max-toot-chars)) - (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length.")) + (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.")) + (user-error "Empty toot. Cowardly refusing to post this")) (t (let ((response (if edit-id ; we are sending an edit: (mastodon-http--put endpoint args) @@ -955,22 +955,22 @@ instance to edit a toot." "Edit the user's toot at point." (interactive) (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)))))))) + (let ((toot (mastodon-tl--property 'base-toot))) + (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." @@ -1233,7 +1233,7 @@ prefixed by >." "Change the current visibility to the next valid value." (interactive) (if (mastodon-tl--buffer-type-eq 'edit-toot) - (user-error "You can't change visibility when editing toots.") + (user-error "You can't change visibility when editing toots") (setq mastodon-toot--visibility (cond ((string= mastodon-toot--visibility "public") "unlisted") @@ -1277,7 +1277,7 @@ File is actually attached to the toot upon posting." ;; Only a max. of 4 attachments are allowed, so pop the oldest one. (pop mastodon-toot--media-attachments)) (if (file-directory-p file) - (user-error "Looks like you chose a directory not a file.") + (user-error "Looks like you chose a directory not a file") (setq mastodon-toot--media-attachments (nconc mastodon-toot--media-attachments `(((:contents . ,(mastodon-http--read-file-as-string file)) @@ -1416,7 +1416,7 @@ LENGTH is the maximum character length allowed for a poll option." (longest (apply #'max (mapcar #'length choices)))) (if (> longest length) (progn - (user-error "looks like you went over the max length. Try again.") + (user-error "Looks like you went over the max length. Try again") (sleep-for 2) (mastodon-toot--read-poll-options count length)) choices))) @@ -1484,10 +1484,10 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;; https://codeberg.org/martianh/mastodon.el/issues/285 (interactive) (cond ((mastodon-tl--buffer-type-eq 'edit-toot) - (user-error "You can't schedule toots you're editing.")) + (user-error "You can't schedule toots you're editing")) ((not (or (mastodon-tl--buffer-type-eq 'new-toot) (mastodon-tl--buffer-type-eq 'scheduled-statuses))) - (user-error "You can only schedule toots from the compose buffer or scheduled toots view.")) + (user-error "You can only schedule toots from the compose buffer or scheduled toots view")) (t (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) (ts (when reschedule -- cgit v1.2.3 From bb1b33e2fb498188f57d5b26c3405802e2cc58f1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 09:39:39 +0200 Subject: toot.el: use mastodon-toot--base-toot-or-item-json --- lisp/mastodon-toot.el | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a422cc2..3a88f33 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -559,8 +559,7 @@ base toot." (defun mastodon-toot--toot-url () "Return the URL of the base toot at point." - (let* ((toot (or (mastodon-tl--property 'base-toot) - (mastodon-tl--property 'item-json)))) + (let* ((toot (mastodon-toot--base-toot-or-item-json))) (if (mastodon-tl--field 'reblog toot) (alist-get 'url (alist-get 'reblog toot)) (alist-get 'url toot)))) @@ -570,8 +569,7 @@ base toot." If the toot is a fave/boost notification, copy the text of the base toot." (interactive) - (let* ((toot (or (mastodon-tl--property 'base-toot) - (mastodon-tl--property 'item-json)))) + (let* ((toot (mastodon-toot--base-toot-or-item-json))) (kill-new (mastodon-tl--content toot)) (message "Toot content copied to the clipboard."))) @@ -603,8 +601,7 @@ Uses `lingva.el'." (defun mastodon-toot--pin-toot-toggle () "Pin or unpin user's toot at point." (interactive) - (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs - (mastodon-tl--property 'item-json))) + (let* ((toot (mastodon-toot--base-toot-or-item-json)) (pinnable-p (mastodon-toot--own-toot-p toot)) (pinned-p (equal (alist-get 'pinned toot) t)) (action (if pinned-p "unpin" "pin")) @@ -632,8 +629,7 @@ Uses `lingva.el'." "Delete and redraft user's toot at point synchronously. NO-REDRAFT means delete toot only." (interactive) - (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs - (mastodon-tl--property 'item-json))) + (let* ((toot (mastodon-toot--base-toot-or-item-json)) (id (mastodon-tl--as-string (mastodon-tl--item-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) (toot-cw (alist-get 'spoiler_text toot)) @@ -955,7 +951,7 @@ instance to edit a toot." "Edit the user's toot at point." (interactive) (mastodon-toot--with-toot-item - (let ((toot (mastodon-tl--property 'base-toot))) + (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)) -- cgit v1.2.3 From bc83b400b14240820a10606279709d8e5dfcdf9f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 09:54:18 +0200 Subject: fix unfolding faved/bookmarked toots --- lisp/mastodon-toot.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3a88f33..a935c9e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -434,7 +434,7 @@ ACTION is a symbol, either `favourite' or `boost.'" (mastodon-toot--action-success (if boost-p (mastodon-tl--symbol 'boost) (mastodon-tl--symbol 'favourite)) - byline-region remove)) + byline-region remove item-json)) (message "%s #%s" (if boost-p msg action) id))))))))))) (defun mastodon-toot--inc-or-dec (count subtract) @@ -499,7 +499,8 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (message (if bookmarked-p "Bookmark removed!" "Toot bookmarked!")) - (remove (when bookmarked-p t))) + (remove (when bookmarked-p t)) + (item-json (mastodon-tl--property 'item-json))) (if (not byline-region) (user-error "Nothing to %s here?!?" action) (mastodon-toot--action @@ -510,7 +511,7 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (cdr byline-region) (list 'bookmarked-p (not bookmarked-p)))) (mastodon-toot--action-success bookmark-str - byline-region remove) + byline-region remove item-json) (message "%s #%s" message id))))))))) (defun mastodon-toot--list-toot-boosters () -- cgit v1.2.3 From 3eb1c4f794edcf582c2eed7e2857f1ee01a5c107 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 13:39:14 +0200 Subject: --thread: diff name for option arg to avoid macro var --- lisp/mastodon-tl.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 17f7ae5..d3a11ed 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2030,11 +2030,14 @@ view all branches of a thread." (let ((id (mastodon-tl--property 'base-item-id))) (mastodon-tl--thread id)))) -(defun mastodon-tl--thread (&optional id) - "Open thread buffer for toot at point or with ID." +(defun mastodon-tl--thread (&optional thread-id) + "Open thread buffer for toot at point or with THREAD-ID." (interactive) (mastodon-toot--with-toot-item - (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move))) + ;; this function's var must not be id as the above macro binds id and even + ;; if we provide the arg (e.g. url-lookup), the macro definition overrides + ;; it, making the optional arg unusable! + (let* ((id (or thread-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 -- cgit v1.2.3 From dd1b0ab77043508623e0bb0e7861beeeb00c8e2f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 14:24:10 +0200 Subject: add mastodon-tl--fold-post --- lisp/mastodon-tl.el | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d3a11ed..908a063 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1566,7 +1566,8 @@ When DOMAIN, force inclusion of user's domain in their handle." (mastodon-media--inline-images start-pos (point))))) (defun mastodon-tl--fold-body-maybe (body &optional unfolded) - "Fold toot BODY if it is very long." + "Fold toot BODY if it is very long. +Folding decided by `mastodon-tl--fold-toots-at-length'." (if (or unfolded (eq nil mastodon-tl--fold-toots-at-length) (length< body mastodon-tl--fold-toots-at-length)) @@ -1581,30 +1582,37 @@ When DOMAIN, force inclusion of user's domain in their handle." (propertize display 'read-more body)))) -(defun mastodon-tl--unfold-post () +(defun mastodon-tl--unfold-post (&optional fold) "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) + (if (and (not fold) + (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))) + (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 + ;; `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)) + (mastodon-tl--toot toot nil nil nil + (when (not fold) :unfolded))) ;; move point to line where text formerly ended: - (goto-char end) - (beginning-of-line)))))) + (unless fold + (goto-char end) + (beginning-of-line))))))) + +(defun mastodon-tl--fold-post () + "Fold post at point, if it is too long." + (interactive) + (mastodon-tl--unfold-post :fold)) ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) -- cgit v1.2.3 From 028ab8ea22283fe4ae956894ef4cb6b002e2272e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 14:57:19 +0200 Subject: fix newlines accumulating on (un)folding toots --- lisp/mastodon-tl.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 908a063..70d0223 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1602,6 +1602,7 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (save-excursion (goto-char beg) (delete-region beg end) + (delete-char 1) ;; prevent newlines accumulating (mastodon-tl--toot toot nil nil nil (when (not fold) :unfolded))) ;; move point to line where text formerly ended: @@ -1612,7 +1613,9 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (defun mastodon-tl--fold-post () "Fold post at point, if it is too long." (interactive) - (mastodon-tl--unfold-post :fold)) + (mastodon-tl--unfold-post :fold) + ;; inserting leaves us at beg of toot, so let's leave point at byline: + (mastodon-tl--goto-next-item)) ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) -- cgit v1.2.3 From 4844a1147a7ae23c996aa21a98ae4229fe172649 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 15:35:32 +0200 Subject: no newline after READ MORE heading --- lisp/mastodon-search.el | 4 ++-- lisp/mastodon-tl.el | 5 ++--- 2 files changed, 4 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index e69366e..f862f3c 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -128,14 +128,14 @@ Optionally add string TYPE after HEADING." (insert (mastodon-search--format-heading str type))) -(defun mastodon-search--format-heading (str &optional type) +(defun mastodon-search--format-heading (str &optional type no-newline) "Format STR as a heading. Optionally add string TYPE after HEADING." (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " (upcase str) " " (if type (upcase type) "") "\n" - " " mastodon-tl--horiz-bar "\n") + " " mastodon-tl--horiz-bar (unless no-newline "\n")) 'success)) (defvar mastodon-search-types diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 70d0223..b9a5535 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1573,9 +1573,8 @@ Folding decided by `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))) + (mastodon-tl--make-link "READ MORE" 'read-more) + nil :no-newline)) (display (concat (substring body 0 mastodon-tl--fold-toots-at-length) heading))) -- cgit v1.2.3 From 134ec9413a86bc97320548cba3dcfda286ebd938 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 15:35:44 +0200 Subject: small adjustments to point placement with (un)folding --- lisp/mastodon-tl.el | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b9a5535..ad8cc1a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1597,24 +1597,27 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." ;; `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))) + (end (cdr range)) + (last-point (point))) (save-excursion (goto-char beg) (delete-region beg end) (delete-char 1) ;; prevent newlines accumulating (mastodon-tl--toot toot nil nil nil (when (not fold) :unfolded))) - ;; move point to line where text formerly ended: - (unless fold - (goto-char end) - (beginning-of-line))))))) + (cond ((or fold byline) + ;; if folding, or if point was at byline already: + ;; FIXME: ideally we could goto last-point if folding but + ;; point was not in now hidden area) + (mastodon-tl--goto-next-item)) + (t + (goto-char last-point) + (beginning-of-line)))))))) (defun mastodon-tl--fold-post () "Fold post at point, if it is too long." (interactive) - (mastodon-tl--unfold-post :fold) - ;; inserting leaves us at beg of toot, so let's leave point at byline: - (mastodon-tl--goto-next-item)) + (mastodon-tl--unfold-post :fold)) ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) -- cgit v1.2.3 From dad54cccbcc2385315ff8c32369bb607a937d15d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 16:01:23 +0200 Subject: fold-post-toggle --- lisp/mastodon-tl.el | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ad8cc1a..a357146 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1619,6 +1619,17 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (interactive) (mastodon-tl--unfold-post :fold)) +(defun mastodon-tl--fold-post-toggle () + "Toggle the folding status of the toot at point." + (interactive) + (let* ((byline-p (mastodon-tl--property 'byline)) + (read-more-p (save-excursion + (when byline-p + (previous-line) + (beginning-of-line)) + (mastodon-tl--property 'read-more)))) + (mastodon-tl--unfold-post (if (not read-more-p) :fold)))) + ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) "Return the TOOT on which we want to extract stats. -- cgit v1.2.3 From cf72fb5af09123663ef80dd373e44bc1e26233b0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 Jul 2024 16:04:34 +0200 Subject: bind fold toggle --- lisp/mastodon.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 8a0aa91..c771705 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -234,6 +234,7 @@ while emojify,el has this feature and mastodon.el implements it.") (define-key map (kbd "G") #'mastodon-views--view-follow-suggestions) (define-key map (kbd "X") #'mastodon-views--view-lists) (define-key map (kbd "SPC") #'mastodon-tl--scroll-up-command) + (define-key map (kbd "!") #'mastodon-tl--fold-post-toggle) (define-key map (kbd "z") #'bury-buffer) map) "Keymap for `mastodon-mode'.") -- cgit v1.2.3 From 30b02296caffeb2fb95ccb26f7fed31c4961f358 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 31 Jul 2024 09:49:15 +0200 Subject: fix where we leave point on (un)folding --- lisp/mastodon-tl.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a357146..651427a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1605,10 +1605,11 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (delete-char 1) ;; prevent newlines accumulating (mastodon-tl--toot toot nil nil nil (when (not fold) :unfolded))) - (cond ((or fold byline) - ;; if folding, or if point was at byline already: - ;; FIXME: ideally we could goto last-point if folding but - ;; point was not in now hidden area) + (cond ((or byline + (and fold + ;; if point was in area now folded: + (> last-point + (+ beg mastodon-tl--fold-toots-at-length)))) (mastodon-tl--goto-next-item)) (t (goto-char last-point) -- cgit v1.2.3 From d0a5bae33167402f6abc8707642945a738b2fe19 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 1 Aug 2024 12:52:19 +0200 Subject: refactor toot--toggle-boost-or-favourite --- lisp/mastodon-toot.el | 91 ++++++++++++++++++++++++++------------------------- 1 file changed, 46 insertions(+), 45 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a935c9e..9b8117a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -386,56 +386,57 @@ boosting, or bookmarking toots." (mastodon-http--triage response callback))) (defun mastodon-toot--toggle-boost-or-favourite (action) - "Toggle boost or favourite of toot at `point'. + "Toggle boost or favourite of toot at point. ACTION is a symbol, either `favourite' or `boost.'" (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")) - (user-error (format "Can't do action on %s notifications." n-type)) - (let* ((boost-p (equal action 'boost)) - (byline-region - (mastodon-tl--find-property-range 'byline (point))) - (boosted (when byline-region + (let* ((n-type (mastodon-tl--property 'notification-type :no-move)) + (byline-region (mastodon-tl--find-property-range 'byline (point))) + (boost-p (eq action 'boost)) + (action-str (symbol-name action)) + (item-json (mastodon-tl--property 'item-json)) + (vis (mastodon-tl--field 'vis item-json))) + (cond + ((not byline-region) + (user-error "Nothing to %s here?!?" action-str)) + ;; there's nothing wrong with faving/boosting own toots + ;; & nothing wrong with faving/boosting own toots from notifs, + ;; it boosts/faves the base toot, not the notif status + ((or (equal n-type "follow") + (equal n-type "follow_request")) + (user-error "Can't %s %s notifications" action n-type)) + ((and boost-p + (or (equal vis "direct") + (equal vis "private"))) + (user-error "Can't boost posts with visibility: %s" vis)) + (t + (let* ((boosted (when byline-region (get-text-property (car byline-region) 'boosted-p))) (faved (when byline-region (get-text-property (car byline-region) 'favourited-p))) - (action (if boost-p - (if boosted "unreblog" "reblog") - (if faved "unfavourite" "favourite"))) - (msg (if boosted "unboosted" "boosted")) - (action-string (if boost-p "boost" "favourite")) - (remove (if boost-p (when boosted t) (when faved t))) - (item-json (mastodon-tl--property 'item-json)) - (visibility (mastodon-tl--field 'visibility item-json))) - (if (not byline-region) - (user-error "Nothing to %s here?!?" action-string) - (if (and (or (equal visibility "direct") - (equal visibility "private")) - boost-p) - (user-error "You cant boost posts with visibility: %s" - visibility) - ;; there's nothing wrong with faving/boosting own toots - ;; & nothing wrong with faving/boosting own toots from notifs, - ;; it boosts/faves the base toot, not the notif status - (if (and (equal "private" visibility) - (eq action 'boost)) - (user-error "You can't boost private toots") - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action action remove) - (mastodon-toot--action-success (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove item-json)) - (message "%s #%s" (if boost-p msg action) id))))))))))) + (str-api (if boost-p "reblog" action-str)) + (action-str-api (mastodon-toot--str-negify str-api faved boosted)) + (action-pp (concat (mastodon-toot--str-negify action-str faved boosted) + (if boost-p "ed" "d"))) + (remove (if boost-p (when boosted t) (when faved t)))) + (mastodon-toot--action + action-str-api + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--update-stats-on-action action remove) + (mastodon-toot--action-success (mastodon-tl--symbol action) + byline-region remove item-json)) + (message "%s #%s" action-pp id))))))))) + +(defun mastodon-toot--str-negify (str faved boosted) + "Add \"un\" to STR if FAVED or BOOSTED is non-nil." + (if (or faved boosted) + (concat "un" str) + str)) (defun mastodon-toot--inc-or-dec (count subtract) "If SUBTRACT, decrement COUNT, else increment." -- cgit v1.2.3 From 8d6983667d51f6aec7a024bb0e2f3dd3fdddb7f4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 1 Aug 2024 13:04:07 +0200 Subject: refactor toot--toggle-bookmark --- lisp/mastodon-toot.el | 59 +++++++++++++++++++++++---------------------------- 1 file changed, 26 insertions(+), 33 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9b8117a..0324c32 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -481,39 +481,32 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "Bookmark or unbookmark toot at point." (interactive) (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")) - (user-error (format "Can't bookmark %s notifications." n-type)) - (let* ((bookmarked-p (mastodon-tl--property - 'bookmarked-p - (if (mastodon-tl--property 'byline :no-move) - ;; no move if not in byline, the idea being - ;; if in body, we do move forward to byline - ;; to toggle correctly. alternatively we - ;; could bookmarked-p whole posts. - :no-move))) - (byline-region (when id - (mastodon-tl--find-property-range 'byline (point)))) - (action (if bookmarked-p "unbookmark" "bookmark")) - (bookmark-str (mastodon-tl--symbol 'bookmark)) - (message (if bookmarked-p - "Bookmark removed!" - "Toot bookmarked!")) - (remove (when bookmarked-p t)) - (item-json (mastodon-tl--property 'item-json))) - (if (not byline-region) - (user-error "Nothing to %s here?!?" action) - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success bookmark-str - byline-region remove item-json) - (message "%s #%s" message id))))))))) + (let* ((n-type (mastodon-tl--property 'notification-type :no-move)) + (byline-region (mastodon-tl--find-property-range 'byline (point))) + (bookmarked-p (when byline-region + (get-text-property (car byline-region) 'bookmarked-p))) + (action (if bookmarked-p "unbookmark" "bookmark"))) + (cond ((or (equal n-type "follow") + (equal n-type "follow_request")) + (user-error "Can't bookmark %s notifications" n-type)) + ((not byline-region) + (user-error "Nothing to %s here?!?" action)) + (t + (let* ((bookmark-str (mastodon-tl--symbol 'bookmark)) + (message (if bookmarked-p + "Bookmark removed!" + "Toot bookmarked!")) + (item-json (mastodon-tl--property 'item-json))) + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p))) + (mastodon-toot--action-success bookmark-str + byline-region bookmarked-p item-json) + (message "%s #%s" message id)))))))))) (defun mastodon-toot--list-toot-boosters () "List the boosters of toot at point." -- cgit v1.2.3 From e66ce7b6fb55a5f78a840ca4c00aa9773bbc9e4f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 1 Aug 2024 19:38:34 +0200 Subject: folding comments / action docstring --- lisp/mastodon-tl.el | 18 ++++++++++++++++-- lisp/mastodon-toot.el | 2 +- 2 files changed, 17 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 651427a..797b355 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1588,14 +1588,28 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (let* ((byline (mastodon-tl--property 'byline :no-move)) (read-more-p (mastodon-tl--find-property-range 'read-more (point) byline))) + ;; FIXME: handle any point of the item body and byline + ;; ie if we are inbetween, try moving up or down (and check again?) (if (and (not fold) (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))) + ;; FIXME: we need to reload toot data if we want + ;; fave/boost/bookmark stats to display correctly. ie if we do + ;; an action then (un)fold, stats/(*)/etc display incorrectly. + + ;; another option may be to check favourited-p/boosted-p prop, + ;; and then call toot--action-success again with the relevant + ;; symbol (to insert it after re-display)? as per + ;; `mastodon-toot--toggle-boost-or-favourite' callback? + + ;; or, is it simpler to just not replace the byline? to do that, + ;; we need to call `mastodont-tl--insert-status' without + ;; inserting a byline, so that props are all correct... (toot (mastodon-tl--property 'item-json))) - ;; `replace-region-contents' is much to slow, our hack from fedi.el is - ;; much simpler and much faster + ;; `replace-region-contents' is much too slow, our hack from fedi.el + ;; is much simpler and much faster: (let ((beg (car range)) (end (cdr range)) (last-point (point))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0324c32..1269516 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -376,7 +376,7 @@ JSON is added to the string as its item-json." (mastodon-tl--goto-next-item))))) (defun mastodon-toot--action (action callback) - "Take ACTION on toot at point, then execute CALLBACK. + "Take ACTION, a string, on toot at point, then execute CALLBACK. Makes a POST request to the server. Used for favouriting, boosting, or bookmarking toots." (let* ((id (mastodon-tl--property 'base-item-id)) -- cgit v1.2.3 From 35a26600afca9bcf6fd033a2a7199a4df048c655 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 11:15:14 +0200 Subject: reimplement folding via insert body only. adds a toot-body prop to body only adds toot-foldable and toot-folded props to whole toot (so can check it at byline) shouldn't add any wrong newlines adds no-byline flag to insert-status --- lisp/mastodon-tl.el | 188 ++++++++++++++++++++++++++++------------------------ 1 file changed, 101 insertions(+), 87 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 797b355..99d6eac 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1506,7 +1506,8 @@ 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 unfolded) + &optional id base-toot detailed-p + thread domain unfolded no-byline) "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,32 +1524,46 @@ JSON of the toot responded to. DETAILED-P means display more detailed info. For now this just means displaying toot client. THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle." +When DOMAIN, force inclusion of user's domain in their handle. +UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. +NO-BYLINE means just insert toot body, used for folding." (let* ((start-pos (point)) (reply-to-id (alist-get 'in_reply_to_id toot)) (after-reply-status-p (when (and thread reply-to-id) (mastodon-tl--after-reply-status reply-to-id))) - (type (alist-get 'type toot))) - ;; body: + (type (alist-get 'type toot)) + (toot-foldable + (and mastodon-tl--fold-toots-at-length + (length> body mastodon-tl--fold-toots-at-length)))) (insert (propertize (concat - "\n" - (if (and after-reply-status-p thread) - (concat (mastodon-tl--symbol 'replied) - "\n") - "") - (let ((bar (mastodon-tl--symbol 'reply-bar)) - (body (mastodon-tl--fold-body-maybe body unfolded))) + (propertize + (concat + "\n" + ;; relpy symbol (broken): (if (and after-reply-status-p thread) - (propertize body - 'line-prefix bar - 'wrap-prefix bar) - body)) - " \n" + (concat (mastodon-tl--symbol 'replied) + "\n") + "") + ;; actual body: + (let ((bar (mastodon-tl--symbol 'reply-bar)) + (body (if (and toot-foldable (not unfolded)) + (mastodon-tl--fold-body body) + body))) + (if (and after-reply-status-p thread) + (propertize body + 'line-prefix bar + 'wrap-prefix bar) + body))) + 'toot-body t) ;; includes newlines etc. for folding ;; byline: - (mastodon-tl--byline toot author-byline action-byline detailed-p domain)) + "\n" + (if no-byline + "" + (mastodon-tl--byline toot author-byline action-byline + detailed-p domain))) 'item-type 'toot 'item-id (or id ; notification's own id (alist-get 'id toot)) ; toot id @@ -1560,90 +1575,86 @@ When DOMAIN, force inclusion of user's domain in their handle." 'item-json toot 'base-toot base-toot 'cursor-face 'mastodon-cursor-highlight-face - 'notification-type type) - "\n") + 'notification-type type + 'toot-foldable toot-foldable + 'toot-folded (and toot-foldable (not unfolded))) + (if no-byline "" "\n")) (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) -(defun mastodon-tl--fold-body-maybe (body &optional unfolded) +(defun mastodon-tl--fold-body (body) "Fold toot BODY if it is very long. Folding decided by `mastodon-tl--fold-toots-at-length'." - (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) - nil :no-newline)) - (display (concat (substring body 0 - mastodon-tl--fold-toots-at-length) - heading))) - (propertize display - 'read-more body)))) + (let* ((heading (mastodon-search--format-heading + (mastodon-tl--make-link "READ MORE" 'read-more) + nil :no-newline)) + (display (concat (substring body 0 + mastodon-tl--fold-toots-at-length) + heading))) + (propertize display + 'read-more body))) (defun mastodon-tl--unfold-post (&optional fold) - "Unfold the toot at point if it is folded (read-more)." + "Unfold the toot at point if it is folded (read-more). +FOLD means to fold it instead" (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))) - ;; FIXME: handle any point of the item body and byline - ;; ie if we are inbetween, try moving up or down (and check again?) - (if (and (not fold) - (not read-more-p)) - (user-error "No folded item at point?") + (let ((at-byline (mastodon-tl--property 'byline :no-move))) + (if (save-excursion + (when (not at-byline) + (mastodon-tl--goto-next-item)) + (not (mastodon-tl--property 'toot-foldable :no-move))) + (user-error "No foldable item at point?") (let* ((inhibit-read-only t) - (range (mastodon-tl--find-property-range 'item-json (point))) - ;; FIXME: we need to reload toot data if we want - ;; fave/boost/bookmark stats to display correctly. ie if we do - ;; an action then (un)fold, stats/(*)/etc display incorrectly. - - ;; another option may be to check favourited-p/boosted-p prop, - ;; and then call toot--action-success again with the relevant - ;; symbol (to insert it after re-display)? as per - ;; `mastodon-toot--toggle-boost-or-favourite' callback? - - ;; or, is it simpler to just not replace the byline? to do that, - ;; we need to call `mastodont-tl--insert-status' without - ;; inserting a byline, so that props are all correct... - (toot (mastodon-tl--property 'item-json))) - ;; `replace-region-contents' is much too slow, our hack from fedi.el - ;; is much simpler and much faster: - (let ((beg (car range)) - (end (cdr range)) - (last-point (point))) - (save-excursion - (goto-char beg) - (delete-region beg end) - (delete-char 1) ;; prevent newlines accumulating - (mastodon-tl--toot toot nil nil nil - (when (not fold) :unfolded))) - (cond ((or byline - (and fold - ;; if point was in area now folded: - (> last-point - (+ beg mastodon-tl--fold-toots-at-length)))) - (mastodon-tl--goto-next-item)) - (t - (goto-char last-point) - (beginning-of-line)))))))) + (body-range (mastodon-tl--find-property-range 'toot-body + (point) :backward)) + (toot (mastodon-tl--property 'item-json :no-move)) + ;; `replace-region-contents' is much too slow, our hack from + ;; fedi.el is much simpler and much faster: + (beg (car body-range)) + (end (cdr body-range)) + (last-point (point)) + (point-after-fold (> last-point + (+ beg mastodon-tl--fold-toots-at-length)))) + ;; save-excursion here useless actually: + + ;; FIXME: because point goes to top of item, the screen gets scrolled + ;; by insertion + (goto-char beg) + (delete-region beg end) + (delete-char 1) ;; prevent newlines accumulating + ;; insert toot body: + (mastodon-tl--toot toot nil nil nil + (not fold) ;; (if fold :folded :unfolded) + :no-byline) + ;; set toot-folded prop on entire toot (not just body): + (let ((toot-range ;; post fold action range: + (mastodon-tl--find-property-range 'item-json + (point) :backward))) + (add-text-properties (car toot-range) + (cdr toot-range) + `(toot-folded ,fold))) + ;; try to leave point somewhere sane: + (cond ((or at-byline + (and fold + point-after-fold)) ;; point was in area now folded + (ignore-errors (forward-line -1)) ;; in case we are btw + (mastodon-tl--goto-next-item)) ;; goto byline + (t + (goto-char last-point) + (when point-after-fold ;; point was in READ MORE heading: + (beginning-of-line)))) + (message (format "%s" (if fold "Fold" "Unfold"))))))) (defun mastodon-tl--fold-post () "Fold post at point, if it is too long." (interactive) - (mastodon-tl--unfold-post :fold)) + (mastodon-tl--unfold-post t)) (defun mastodon-tl--fold-post-toggle () "Toggle the folding status of the toot at point." (interactive) - (let* ((byline-p (mastodon-tl--property 'byline)) - (read-more-p (save-excursion - (when byline-p - (previous-line) - (beginning-of-line)) - (mastodon-tl--property 'read-more)))) - (mastodon-tl--unfold-post (if (not read-more-p) :fold)))) + (let* ((folded (mastodon-tl--property 'toot-folded :no-move))) + (mastodon-tl--unfold-post (not folded)))) ;; from mastodon-alt.el: (defun mastodon-tl--toot-for-stats (&optional toot) @@ -1705,19 +1716,22 @@ 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 unfolded) +(defun mastodon-tl--toot (toot &optional detailed-p thread domain + unfolded no-byline) "Format TOOT and insert it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client. THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle." +When DOMAIN, force inclusion of user's domain in their handle. +UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. +NO-BYLINE means just insert toot body, used for folding." (mastodon-tl--insert-status toot (mastodon-tl--clean-tabs-and-nl (if (mastodon-tl--has-spoiler toot) (mastodon-tl--spoiler toot) (mastodon-tl--content toot))) 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted - nil nil detailed-p thread domain unfolded)) + nil nil detailed-p thread domain unfolded no-byline)) (defun mastodon-tl--timeline (toots &optional thread domain) "Display each toot in TOOTS. -- cgit v1.2.3 From 351bd73875c5d59a02b7126a35a7883be15b5058 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 16:17:37 +0200 Subject: fix prev-item-id --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 99d6eac..8c00418 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1494,11 +1494,11 @@ Runs `mastodon-tl--render-text' and fetches poll or media." "Return the id of the last toot inserted into the buffer." (let* ((prev-change (save-excursion - (previous-single-property-change (point) 'base-toot-id))) + (previous-single-property-change (point) 'base-item-id))) (prev-pos (when prev-change (1- prev-change)))) (when prev-pos - (get-text-property prev-pos 'base-toot-id)))) + (get-text-property prev-pos 'base-item-id)))) (defun mastodon-tl--after-reply-status (reply-to-id) "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer." -- cgit v1.2.3 From 0ef13ab348d0b6b6fde5a8ecf3b5131917c24c34 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 16:17:37 +0200 Subject: fix prev-item-id --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 797b355..2660ef5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1494,11 +1494,11 @@ Runs `mastodon-tl--render-text' and fetches poll or media." "Return the id of the last toot inserted into the buffer." (let* ((prev-change (save-excursion - (previous-single-property-change (point) 'base-toot-id))) + (previous-single-property-change (point) 'base-item-id))) (prev-pos (when prev-change (1- prev-change)))) (when prev-pos - (get-text-property prev-pos 'base-toot-id)))) + (get-text-property prev-pos 'base-item-id)))) (defun mastodon-tl--after-reply-status (reply-to-id) "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer." -- cgit v1.2.3 From 5621b2df84802fca40ea5461308f601aeb9b361a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 16:34:55 +0200 Subject: add underscores to user-like url regexes --- lisp/mastodon.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index c771705..cd32a2d 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -414,24 +414,27 @@ not, just browse the URL in the normal fashion." "Check if QUERY resembles a fediverse URL." ;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt ;; thx to Conny Duck! + ;; mastodon at least seems to allow only [a-z0-9_] for usernames, plus "." + ;; but not at beginning or end, see https://github.com/mastodon/mastodon/issues/6830 + ;; objects may have - in them (let* ((uri-parsed (url-generic-parse-url query)) (query (url-filename uri-parsed))) (save-match-data (or (string-match "^/@[^/]+$" query) (string-match "^/@[^/]+/[[:digit:]]+$" query) - (string-match "^/user[s]?/@?[[:alnum:]]+$" query) ; @: pleroma or soapbox + (string-match "^/user[s]?/@?[[:alnum:]_]+$" query) ; @: pleroma or soapbox (string-match "^/notice/[[:alnum:]]+$" query) (string-match "^/objects/[-a-f0-9]+$" query) (string-match "^/notes/[a-z0-9]+$" query) (string-match "^/display/[-a-f0-9]+$" query) - (string-match "^/profile/[[:alpha:]]+$" query) - (string-match "^/p/[[:alpha:]]+/[[:digit:]]+$" query) - (string-match "^/[[:alpha:]]+$" query) - (string-match "^/u/[[:alpha:]]+$" query) - (string-match "^/c/[[:alnum:]]+$" query) + (string-match "^/profile/[[:alpha:]_]+$" query) + (string-match "^/p/[[:alpha:]_]+/[[:digit:]]+$" query) + (string-match "^/[[:alpha:]_]+$" query) + (string-match "^/u/[[:alpha:]_]+$" query) + (string-match "^/c/[[:alnum:]_]+$" query) (string-match "^/post/[[:digit:]]+$" query) (string-match "^/comment/[[:digit:]]+$" query) ; lemmy - (string-match "^/user[s]?/[[:alnum:]]+/statuses/[[:digit:]]+$" query) ; hometown + (string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown (string-match "^/notes/[[:alnum:]]+$" query))))) ; misskey post (defun mastodon-live-buffers () -- cgit v1.2.3 From 46b66e332a95096773c952598c363df5e0091d53 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 16:50:16 +0200 Subject: commentary --- lisp/mastodon.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index cd32a2d..41b6fbe 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -32,8 +32,8 @@ ;; mastodon.el is a client for fediverse services that implement the Mastodon ;; API. See . -;; See the readme file at https://codeberg.org/martianh/mastodon.el for set up -;; and usage details. +;; For set up and usage details, see the Info documentation, or the readme +;; file at https://codeberg.org/martianh/mastodon.el. ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon -- cgit v1.2.3 From 49261b91b075b9ee77c96bbd04fa05043d29d28a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 4 Aug 2024 09:39:04 +0200 Subject: Revert "replace persist with multisession" This reverts commit f19f3bc2735bd78bb3150b8507b6f8949108cece. --- lisp/mastodon-profile.el | 19 ++++++++----------- lisp/mastodon-toot.el | 4 +--- lisp/mastodon.el | 2 +- 3 files changed, 10 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index cd1978f..de16b7d 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -35,6 +35,7 @@ ;;; Code: (require 'seq) (require 'cl-lib) +(require 'persist) (require 'parse-time) (require 'mastodon-http) (eval-when-compile @@ -124,8 +125,8 @@ It contains details of the current user's account.") map) "Keymap for `mastodon-profile-update-mode'.") -(define-multisession-variable mastodon-profile-account-settings nil - "An alist of account settings saved from the server. +(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 @@ -364,16 +365,13 @@ 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 (multisession-value mastodon-profile-account-settings) - pref)) + (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." - (setf (multisession-value mastodon-profile-account-settings) - (plist-put - (multisession-value mastodon-profile-account-settings) - pref val))) + (setq mastodon-profile-account-settings + (plist-put mastodon-profile-account-settings pref val))) ;; used in toot.el (defun mastodon-profile--fetch-server-account-settings-maybe () @@ -386,8 +384,7 @@ 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 - (multisession-value mastodon-profile-account-settings)) + (unless (and no-force mastodon-profile-account-settings) (let ((keys '(locked discoverable display_name bot)) (source-keys '(privacy sensitive language))) (mapc (lambda (k) @@ -405,7 +402,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)) - (multisession-value mastodon-profile-account-settings)))) + mastodon-profile-account-settings))) (defun mastodon-profile--account-locked-toggle () "Toggle the locked status of your account. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1269516..6387bea 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1951,9 +1951,7 @@ 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 - (multisession-value mastodon-profile-account-settings) - 'privacy) + (or (plist-get mastodon-profile-account-settings 'privacy) ;; use toot visibility setting from the server: (mastodon-profile--get-source-value 'privacy) "public")) ; fallback diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 41b6fbe..82a2491 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -7,7 +7,7 @@ ;; Marty Hiatt ;; Maintainer: Marty Hiatt ;; Version: 1.0.24 -;; Package-Requires: ((emacs "27.1") (request "0.3.0")) +;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From da0e348bc7aaa48474da8cf0ee657fed3f5e485d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 4 Aug 2024 09:44:10 +0200 Subject: Revert "multisession var in -toot.el" This reverts commit 00ac9103adba722f8c2ddbd67db6b0ff6bcebc46. --- lisp/mastodon-toot.el | 50 +++++++++++++++++++++----------------------------- 1 file changed, 21 insertions(+), 29 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6387bea..7497429 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -40,6 +40,7 @@ (defvar emojify-user-emojis) (require 'cl-lib) +(require 'persist) (require 'mastodon-iso) (require 'facemenu) (require 'text-property-search) @@ -222,8 +223,8 @@ Takes its form from `window-configuration-to-register'.") (defvar mastodon-toot-current-toot-text nil "The text of the toot being composed.") -(define-multisession-variable mastodon-toot-draft-toots-list nil - "A list of toots that have been saved as drafts. +(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.") @@ -713,10 +714,8 @@ 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 - (setf (multisession-value mastodon-toot-draft-toots-list) - (cl-pushnew mastodon-toot-current-toot-text - (multisession-value mastodon-toot-draft-toots-list) - :test 'equal)))) + (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) (quit-window 'kill) @@ -738,10 +737,8 @@ Pushes `mastodon-toot-current-toot-text' to `mastodon-toot-draft-toots-list'." (interactive) (unless (eq mastodon-toot-current-toot-text nil) - (setf (multisession-value mastodon-toot-draft-toots-list) - (cl-pushnew mastodon-toot-current-toot-text - (multisession-value mastodon-toot-draft-toots-list) - :test 'equal)) + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal) (message "Draft saved!"))) (defun mastodon-toot--empty-p (&optional text-only) @@ -1825,18 +1822,16 @@ 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 (multisession-value mastodon-toot-draft-toots-list) - (let ((text (completing-read - "Select draft toot: " - (multisession-value mastodon-toot-draft-toots-list) - nil t))) + (if mastodon-toot-draft-toots-list + (let ((text (completing-read "Select draft toot: " + 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))) + (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)))) @@ -1851,22 +1846,19 @@ 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 (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)) + (if (not mastodon-toot-draft-toots-list) + (user-error "No drafts to delete") + (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!")))) (defun mastodon-toot--delete-all-drafts () "Delete all drafts." (interactive) - (setf (multisession-value mastodon-toot-draft-toots-list) nil) + (setq mastodon-toot-draft-toots-list nil) (message "All drafts deleted!")) -- cgit v1.2.3