From d159e634eb6c292e66d4e8cddbb05aad6e3f6aa1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 20:22:14 +0200 Subject: let-alist tl--byline-author --- lisp/mastodon-tl.el | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f9db25a..2bbf52f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -453,13 +453,7 @@ Do so if type of status at poins is not follow_request/follow." (defun mastodon-tl--byline-author (toot &optional avatar) "Propertize author of TOOT. With arg AVATAR, include the account's avatar image." - (let* ((account (alist-get 'account toot)) - (handle (alist-get 'acct account)) - (name (if (not (string-empty-p (alist-get 'display_name account))) - (alist-get 'display_name account) - (alist-get 'username account))) - (profile-url (alist-get 'url account)) - (avatar-url (alist-get 'avatar account))) + (let-alist toot (concat ;; avatar insertion moved up to `mastodon-tl--byline' by default in order ;; to be outside of text prop 'byline t. arg avatar is used by @@ -470,8 +464,10 @@ With arg AVATAR, include the account's avatar image." (if (version< emacs-version "27.1") (image-type-available-p 'imagemagick) (image-transforms-p))) - (mastodon-media--get-avatar-rendering avatar-url)) - (propertize name + (mastodon-media--get-avatar-rendering .account.avatar)) + (propertize (if (not (string-empty-p .account.display_name)) + .account.display_name + .account.username) 'face 'mastodon-display-name-face ;; enable playing of videos when point is on byline: 'attachments (mastodon-tl--get-attachments-for-byline toot) @@ -485,15 +481,15 @@ With arg AVATAR, include the account's avatar image." (string-suffix-p "-following*" (buffer-name))) (mastodon-tl--format-byline-help-echo toot))) " (" - (propertize (concat "@" handle) + (propertize (concat "@" .account.acct) 'face 'mastodon-handle-face 'mouse-face 'highlight 'mastodon-tab-stop 'user-handle - 'account account - 'shr-url profile-url + 'account .account + 'shr-url .account.url 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'mastodon-handle (concat "@" .account.acct) + 'help-echo (concat "Browse user profile of @" .account.acct)) ")"))) (defun mastodon-tl--format-byline-help-echo (toot) -- cgit v1.2.3 From ceaeb56cea5fa2d5214e57b5915e0d315b70e081 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 20:22:29 +0200 Subject: let-alist tl--byline --- lisp/mastodon-tl.el | 200 +++++++++++++++++++++++++++------------------------- 1 file changed, 102 insertions(+), 98 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2bbf52f..a992055 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -577,109 +577,112 @@ favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'. DETAILED-P means display more detailed info. For now this just means displaying toot client." - (let* ((created-time - ;; bosts and faves in notifs view - ;; (makes timestamps be for the original toot - ;; not the boost/fave): - (or (mastodon-tl--field 'created_at - (mastodon-tl--field 'status toot)) - ;; all other toots, inc. boosts/faves in timelines: - ;; (mastodon-tl--field auto fetches from reblogs if needed): - (mastodon-tl--field 'created_at toot))) - (parsed-time (date-to-time created-time)) - (faved (equal 't (mastodon-tl--field 'favourited toot))) - (boosted (equal 't (mastodon-tl--field 'reblogged toot))) - (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (visibility (mastodon-tl--field 'visibility toot)) - (account (alist-get 'account toot)) - (avatar-url (alist-get 'avatar account)) - (edited-time (alist-get 'edited_at toot)) - (edited-parsed (when edited-time (date-to-time edited-time)))) - (concat - ;; Boosted/favourited markers are not technically part of the byline, so - ;; we don't propertize them with 'byline t', as per the rest. This - ;; ensures that `mastodon-tl--goto-next-toot' puts point on - ;; author-byline, not before the (F) or (B) marker. Not propertizing like - ;; this makes the behaviour of these markers consistent whether they are - ;; displayed for an already boosted/favourited toot or as the result of - ;; the toot having just been favourited/boosted. - (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'boost))) - (when faved - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'favourite))) - (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'bookmark)))) - ;; we remove avatars from the byline also, so that they also do not mess - ;; with `mastodon-tl--goto-next-toot': - (when (and mastodon-tl--show-avatars - mastodon-tl--display-media-p - (if (version< emacs-version "27.1") - (image-type-available-p 'imagemagick) - (image-transforms-p))) - (mastodon-media--get-avatar-rendering avatar-url)) - (propertize + (let-alist toot + .favourited + .reblogged + .bookmarked + .visibility + .account + .account.avatar + .edited_at + (let* ((created-time + ;; bosts and faves in notifs view + ;; (makes timestamps be for the original toot + ;; not the boost/fave): + (or .status.created_at + ;; all other toots, inc. boosts/faves in timelines: + ;; (mastodon-tl--field auto fetches from reblogs if needed): + .created_at)) + (parsed-time (date-to-time created-time)) + (faved (equal 't .favourited)) + (boosted (equal 't .reblogged)) + (bookmarked (equal 't .bookmarked)) + (edited-parsed (when .edited_at (date-to-time .edited_at)))) (concat - ;; we propertize help-echo format faves for author name - ;; in `mastodon-tl--byline-author' - (funcall author-byline toot) - ;; visibility: - (cond ((equal visibility "direct") - (concat " " (mastodon-tl--symbol 'direct))) - ((equal visibility "private") - (concat " " (mastodon-tl--symbol 'private)))) - (funcall action-byline toot) - " " + ;; Boosted/favourited markers are not technically part of the byline, so + ;; we don't propertize them with 'byline t', as per the rest. This + ;; ensures that `mastodon-tl--goto-next-toot' puts point on + ;; author-byline, not before the (F) or (B) marker. Not propertizing like + ;; this makes the behaviour of these markers consistent whether they are + ;; displayed for an already boosted/favourited toot or as the result of + ;; the toot having just been favourited/boosted. + (concat (when boosted + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'boost))) + (when faved + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'favourite))) + (when bookmarked + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'bookmark)))) + ;; we remove avatars from the byline also, so that they also do not mess + ;; with `mastodon-tl--goto-next-toot': + (when (and mastodon-tl--show-avatars + mastodon-tl--display-media-p + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + (mastodon-media--get-avatar-rendering .account.avatar)) (propertize - (format-time-string mastodon-toot-timestamp-format parsed-time) - 'timestamp parsed-time - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description parsed-time) - parsed-time)) - (when detailed-p - (let* ((app (alist-get 'application toot)) - (app-name (alist-get 'name app)) - (app-url (alist-get 'website app))) - (when app + (concat + ;; we propertize help-echo format faves for author name + ;; in `mastodon-tl--byline-author' + (funcall author-byline toot) + ;; visibility: + (cond ((equal .visibility "direct") + (concat " " (mastodon-tl--symbol 'direct))) + ((equal .visibility "private") + (concat " " (mastodon-tl--symbol 'private)))) + (funcall action-byline toot) + " " + (propertize + (format-time-string mastodon-toot-timestamp-format parsed-time) + 'timestamp parsed-time + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description parsed-time) + parsed-time)) + (when detailed-p + ;; (let* ((app .application + ;; (app-name (alist-get 'name + ;; (app-url (alist-get 'website app))) + (when .application (concat (propertize " via " 'face 'default) - (propertize app-name + (propertize .application.name 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight 'mastodon-tab-stop 'shr-url - 'shr-url app-url - 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) - (if edited-time - (concat - " " - (mastodon-tl--symbol 'edited) - " " - (propertize - (format-time-string mastodon-toot-timestamp-format - edited-parsed) - 'face font-lock-comment-face - 'timestamp edited-parsed - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description edited-parsed) - edited-parsed))) - "") - (propertize (concat "\n " mastodon-tl--horiz-bar) - 'face 'default) - (if mastodon-tl--show-stats - (mastodon-tl--toot-stats toot) - "") - "\n") - 'favourited-p faved - 'boosted-p boosted - 'bookmarked-p bookmarked - 'edited edited-time - 'edit-history (when edited-time - (mastodon-toot--get-toot-edits (alist-get 'id toot))) - 'byline t)))) + 'shr-url .application.website + 'help-echo .application.website + 'keymap mastodon-tl--shr-map-replacement)))) + (if .edited_at + (concat + " " + (mastodon-tl--symbol 'edited) + " " + (propertize + (format-time-string mastodon-toot-timestamp-format + edited-parsed) + 'face font-lock-comment-face + 'timestamp edited-parsed + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description edited-parsed) + edited-parsed))) + "") + (propertize (concat "\n " mastodon-tl--horiz-bar) + 'face 'default) + (if mastodon-tl--show-stats + (mastodon-tl--toot-stats toot) + "") + "\n") + 'favourited-p faved + 'boosted-p boosted + 'bookmarked-p bookmarked + 'edited .edited_at + 'edit-history (when .edited_at + (mastodon-toot--get-toot-edits .id)) + 'byline t))))) ;;; TIMESTAMPS @@ -1995,9 +1998,10 @@ LANGS is the accumulated array param alist if we re-run recursively." (mastodon-tl--property 'toot-json :no-move)))) ;; profile view, no toots ;; needed for e.g. gup.pe groups which show no toots publically: - ((mastodon-tl--profile-buffer-p) - (list (alist-get 'acct - (mastodon-profile--profile-json)))) + ;; FIXME: this breaks calling 'W' on toots in profile view: + ;; ((mastodon-tl--profile-buffer-p) + ;; (list (alist-get 'acct + ;; (mastodon-profile--profile-json)))) (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) -- cgit v1.2.3 From 92e49d913475fffc8c269cd15940db8b1dac6c87 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 20:33:32 +0200 Subject: let-alist --get-attachments for byline --- lisp/mastodon-tl.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a992055..93ea20c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -534,13 +534,10 @@ Used when point is at the start of a byline, i.e. where The result is added as an attachments property to author-byline." (let ((media-attachments (mastodon-tl--field 'media_attachments toot))) (mapcar - (lambda (attachement) - (let ((remote-url - (or (alist-get 'remote_url attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url attachement))) - (type (alist-get 'type attachement))) - `(:url ,remote-url :type ,type))) + (lambda (attachment) + (let-alist attachment + `(:url ,(or .remote_url .url) ; fallback for notifications + :type ,.type))) media-attachments))) (defun mastodon-tl--byline-boosted (toot) -- cgit v1.2.3 From 471e90374d7be36fdeba9a7a7a97a7ca11159c2e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 08:09:18 +0200 Subject: let-alist tl--content --- lisp/mastodon-tl.el | 106 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 93ea20c..1179cc3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1095,6 +1095,112 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." help-echo (concat help-echo "\nC-RET: play " type " with mpv")))) + +;;; INSERT TOOTS + +(defun mastodon-tl--content (toot) + "Retrieve text content from TOOT. +Runs `mastodon-tl--render-text' and fetches poll or media." + (let-alist toot + (concat (mastodon-tl--render-text .content toot) + (when (or .reblog.poll .poll) + (mastodon-tl--get-poll toot)) + (mastodon-tl--media toot)))) + +(defun mastodon-tl--insert-status (toot body author-byline action-byline + &optional id base-toot detailed-p) + "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 +portion of the byline that takes one variable. By default it is +`mastodon-tl--byline-author'. +ACTION-BYLINE is also an optional function for adding an action, +such as boosting favouriting and following to the byline. It also +takes a single function. By default it is +`mastodon-tl--byline-boosted'. +ID is that of the status if it is a notification, which is +attached as a `toot-id' property if provided. If the +status is a favourite or boost notification, BASE-TOOT is the +JSON of the toot responded to. +DETAILED-P means display more detailed info. For now +this just means displaying toot client." + (let ((start-pos (point))) + (insert + (propertize + (concat "\n" + body + " \n" + (mastodon-tl--byline toot author-byline action-byline detailed-p)) + 'toot-id (or id ; notification's own id + (alist-get 'id toot)) ; toot id + 'base-toot-id (mastodon-tl--toot-id + ;; if status is a notif, get id from base-toot + ;; (-tl--toot-id toot) will not work here: + (or base-toot + ;; else normal toot with reblog check: + toot)) + 'toot-json toot + 'base-toot base-toot) + "\n") + (when mastodon-tl--display-media-p + (mastodon-media--inline-images start-pos (point))))) + +;; from mastodon-alt.el: +(defun mastodon-tl--toot-for-stats (&optional toot) + "Return the TOOT on which we want to extract stats. +If no TOOT is given, the one at point is considered." + (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) + (toot (or (alist-get 'status original-toot) + (when (alist-get 'type original-toot) + original-toot) + (alist-get 'reblog original-toot) + original-toot)) + (type (alist-get 'type (or toot)))) + (unless (member type '("follow" "follow_request")) + toot))) + +(defun mastodon-tl--toot-stats (toot) + "Return a right aligned string (using display align-to). +String is filled with TOOT statistics (boosts, favs, replies). +When the TOOT is a reblog (boost), statistics from reblogged +toots are returned. +To disable showing the stats, customize +`mastodon-tl--show-stats'." + (when-let ((toot (mastodon-tl--toot-for-stats toot))) + (let* ((favourites-count (alist-get 'favourites_count toot)) + (favourited (equal 't (alist-get 'favourited toot))) + (faves-prop (propertize (format "%s" favourites-count) + 'favourites-count favourites-count)) + (boosts-count (alist-get 'reblogs_count toot)) + (boosted (equal 't (alist-get 'reblogged toot))) + (boosts-prop (propertize (format "%s" boosts-count) + 'boosts-count boosts-count)) + (replies-count (alist-get 'replies_count toot)) + (favourites (format "%s %s" faves-prop ;favourites-count + (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-prop ;boosts-count + (mastodon-tl--symbol 'boost))) + (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) + (status (concat + (propertize favourites + 'favourited-p favourited + 'favourites-field t + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) + (propertize boosts + 'boosted-p boosted + 'boosts-field t + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) + (propertize replies + 'replies-field t + 'replies-count replies-count + 'face font-lock-comment-face))) + (status (concat + (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) + status))) + status))) + ;; POLLS -- cgit v1.2.3 From c579efdef65e1d6a6ad29e0a609202cd59a683e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 20:42:08 +0200 Subject: let-alist tl--get-poll --- lisp/mastodon-tl.el | 87 ++++++++++++++++++++++++----------------------------- 1 file changed, 40 insertions(+), 47 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1179cc3..536ad62 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1206,53 +1206,46 @@ To disable showing the stats, customize (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." - (let* ((poll (mastodon-tl--field 'poll toot)) - (expiry (mastodon-tl--field 'expires_at poll)) - (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) - ;; (multi (mastodon-tl--field 'multiple poll)) - (voters-count (mastodon-tl--field 'voters_count poll)) - (vote-count (mastodon-tl--field 'votes_count poll)) - (options (mastodon-tl--field 'options poll)) - (option-titles (mastodon-tl--map-alist 'title options)) - (longest-option (car (sort option-titles - (lambda (x y) - (> (length x) - (length y)))))) - (option-counter 0)) - (concat "\nPoll: \n\n" - (mapconcat (lambda (option) - (progn - (format "%s: %s%s%s\n" - (setq option-counter (1+ option-counter)) - (propertize (alist-get 'title option) - 'face 'success) - (make-string - (1+ - (- (length longest-option) - (length (alist-get 'title - option)))) - ?\ ) - ;; TODO: disambiguate no votes from hidden votes - (format "[%s votes]" (or (alist-get 'votes_count option) - "0"))))) - options - "\n") - "\n" - (propertize - (cond (voters-count ; sometimes it is nil - (if (= voters-count 1) - (format "%s person | " voters-count) - (format "%s people | " voters-count))) - (vote-count - (format "%s votes | " vote-count)) - (t - "")) - 'face 'font-lock-comment-face) - (let ((str (if expired-p - "Poll expired." - (mastodon-tl--format-poll-expiry expiry)))) - (propertize str 'face 'font-lock-comment-face)) - "\n"))) + (let-alist toot + (let* ((option-titles (mastodon-tl--map-alist 'title .poll.options)) + (longest-option (car (sort option-titles + (lambda (x y) + (> (length x) + (length y)))))) + (option-counter 0)) + (concat "\nPoll: \n\n" + (mapconcat (lambda (option) + (progn + (format "%s: %s%s%s\n" + (setq option-counter (1+ option-counter)) + (propertize (alist-get 'title option) + 'face 'success) + (make-string + (1+ + (- (length longest-option) + (length (alist-get 'title option)))) + ?\ ) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0"))))) + .poll.options + "\n") + "\n" + (propertize + (cond (.poll.voters_count ; sometimes it is nil + (if (= .poll.voters_count 1) + (format "%s person | " .poll.voters_count) + (format "%s people | " .poll.voters_count))) + (.poll.vote_count + (format "%s votes | " .poll.vote_count)) + (t + "")) + 'face 'font-lock-comment-face) + (let ((str (if (eq .poll.expired :json-false) + (mastodon-tl--format-poll-expiry expiry) + "Poll expired."))) + (propertize str 'face 'font-lock-comment-face)) + "\n")))) (defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." -- cgit v1.2.3 From 27409107eb3542e24f0b68c79a8cae89ce9afb78 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 20:45:05 +0200 Subject: let-alist tl--toot-id --- lisp/mastodon-tl.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 536ad62..68fa782 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1813,9 +1813,8 @@ If the toot has been boosted use the id found in the reblog portion of the toot. Otherwise, use the body of the toot. This is the same behaviour as the mastodon.social webapp" - (let ((id (alist-get 'id json)) - (reblog (alist-get 'reblog json))) - (if reblog (alist-get 'id reblog) id))) + (let-alist json + (if .reblog .reblog.id .id))) (defun mastodon-tl--toot-or-base (json) "Return the base toot or just the toot from toot JSON." -- cgit v1.2.3 From 347ef54b5d32cf7078e614e13ce7007aa406d54f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 20:50:56 +0200 Subject: tl--byline cleanup --- lisp/mastodon-tl.el | 7 ------- 1 file changed, 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 68fa782..a0284d4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -575,13 +575,6 @@ By default it is `mastodon-tl--byline-boosted'. DETAILED-P means display more detailed info. For now this just means displaying toot client." (let-alist toot - .favourited - .reblogged - .bookmarked - .visibility - .account - .account.avatar - .edited_at (let* ((created-time ;; bosts and faves in notifs view ;; (makes timestamps be for the original toot -- cgit v1.2.3 From dd205f425e03ee2c02e44ea9f780d7a237af5c45 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 25 Apr 2023 21:24:59 +0200 Subject: fix tl--content --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a0284d4..7f72ece 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1095,7 +1095,7 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." (let-alist toot - (concat (mastodon-tl--render-text .content toot) + (concat (mastodon-tl--render-text (or .reblog.content .content toot)) (when (or .reblog.poll .poll) (mastodon-tl--get-poll toot)) (mastodon-tl--media toot)))) -- cgit v1.2.3 From b322eee9e032066296055419037c848abfb00793 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 27 Apr 2023 17:41:16 +0200 Subject: remove quasi-quoting of let-alist dotted vars --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7f72ece..28096e4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -536,8 +536,8 @@ The result is added as an attachments property to author-byline." (mapcar (lambda (attachment) (let-alist attachment - `(:url ,(or .remote_url .url) ; fallback for notifications - :type ,.type))) + (list :url (or .remote_url .url) ; fallback for notifications + :type .type))) media-attachments))) (defun mastodon-tl--byline-boosted (toot) -- cgit v1.2.3 From 3b015ec901d21fc5135acb60c645c15a9cf3afbd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 2 May 2023 20:40:41 +0200 Subject: fix --get-poll --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 28096e4..7cfcc3e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1235,7 +1235,7 @@ To disable showing the stats, customize "")) 'face 'font-lock-comment-face) (let ((str (if (eq .poll.expired :json-false) - (mastodon-tl--format-poll-expiry expiry) + (mastodon-tl--format-poll-expiry .poll.expires_at) "Poll expired."))) (propertize str 'face 'font-lock-comment-face)) "\n")))) -- cgit v1.2.3 From 2c45d3b0fa0155dc0c0fd818dda6d716ed7d57e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 2 May 2023 20:42:37 +0200 Subject: let-alist --show-stats --- lisp/mastodon-tl.el | 62 +++++++++++++++++++++++++---------------------------- 1 file changed, 29 insertions(+), 33 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7cfcc3e..ef4652d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1160,39 +1160,35 @@ toots are returned. To disable showing the stats, customize `mastodon-tl--show-stats'." (when-let ((toot (mastodon-tl--toot-for-stats toot))) - (let* ((favourites-count (alist-get 'favourites_count toot)) - (favourited (equal 't (alist-get 'favourited toot))) - (faves-prop (propertize (format "%s" favourites-count) - 'favourites-count favourites-count)) - (boosts-count (alist-get 'reblogs_count toot)) - (boosted (equal 't (alist-get 'reblogged toot))) - (boosts-prop (propertize (format "%s" boosts-count) - 'boosts-count boosts-count)) - (replies-count (alist-get 'replies_count toot)) - (favourites (format "%s %s" faves-prop ;favourites-count - (mastodon-tl--symbol 'favourite))) - (boosts (format "%s %s" boosts-prop ;boosts-count - (mastodon-tl--symbol 'boost))) - (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) - (status (concat - (propertize favourites - 'favourited-p favourited - 'favourites-field t - 'face font-lock-comment-face) - (propertize " | " 'face font-lock-comment-face) - (propertize boosts - 'boosted-p boosted - 'boosts-field t - 'face font-lock-comment-face) - (propertize " | " 'face font-lock-comment-face) - (propertize replies - 'replies-field t - 'replies-count replies-count - 'face font-lock-comment-face))) - (status (concat - (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) - status))) - status))) + (let-alist toot + (let* ((faves-prop (propertize (format "%s" .favourites_count) + 'favourites-count .favourites_count)) + (boosts-prop (propertize (format "%s" .reblogs_count) + 'boosts-count .reblogs_count)) + (favourites (format "%s %s" faves-prop ;favourites-count + (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-prop ;boosts-count + (mastodon-tl--symbol 'boost))) + (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) + (status (concat + (propertize favourites + 'favourited-p (equal t .favourited) + 'favourites-field t + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) + (propertize boosts + 'boosted-p (equal t .reblogged) + 'boosts-field t + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) + (propertize replies + 'replies-field t + 'replies-count .replies_count + 'face font-lock-comment-face))) + (status (concat + (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) + status))) + status)))) ;; POLLS -- cgit v1.2.3 From 5fb200fa2fce2da10b9377ef7a0ce7d4dbbd6e39 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 08:16:08 +0200 Subject: comments and docstrings --- lisp/mastodon-tl.el | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ef4652d..0cdbad8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1848,12 +1848,10 @@ view all branches of a thread." (let* ((endpoint (format "statuses/%s/context" id)) (url (mastodon-http--api endpoint)) (buffer (format "*mastodon-thread-%s*" id)) - (toot - ;; refetch current toot in case we just faved/boosted: - (mastodon-http--get-json - (mastodon-http--api (concat "statuses/" id)) - nil - :silent)) + (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) (message "Error: %s" (cdar toot)) @@ -2233,7 +2231,7 @@ PREFIX is sent to `mastodon-tl--show-tag-timeline', which see." (defun mastodon-tl--some-followed-tags-timeline (&optional prefix) "Prompt for some tags, and open a timeline for them. The suggestions are from followed tags, but any other tags are also allowed. -PREFIX us sent to `mastodon-tl--show-tag-timeline', which see." +PREFIX is for `mastodon-tl--show-tag-timeline', which see." (interactive "p") (let* ((followed-tags-json (mastodon-tl--followed-tags)) (tags (mastodon-tl--map-alist 'name followed-tags-json)) @@ -2311,7 +2309,7 @@ report the account for spam." (defvar crm-separator) (defun mastodon-tl--map-rules-alist (rules) - "Return an alist of the text and id fields of RULES." + "Convert RULES text and id fields into an alist." (mapcar (lambda (x) (let-alist x (cons .text .id))) -- cgit v1.2.3 From 80c3d0250b9492b877ae93b0cb570b8e2774171e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 2 May 2023 21:13:54 +0200 Subject: let-alist --poll-vote, refactor --read-poll-option --- lisp/mastodon-tl.el | 78 ++++++++++++++++++++++++++--------------------------- 1 file changed, 38 insertions(+), 40 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0cdbad8..0c24b86 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1256,48 +1256,46 @@ To disable showing the stats, customize (plist-get parsed :hours) (plist-get parsed :minutes)))))) +(defun mastodon-tl--read-poll-option () + "Read a poll option to vote on a poll." + (list + (let-alist (mastodon-tl--property 'toot-json) + (let* ((poll (or .reblog.poll .poll)) + (options (mastodon-tl--field 'options poll)) + (options-titles (mastodon-tl--map-alist 'title options)) + (options-number-seq (number-sequence 1 (length options))) + (options-numbers (mapcar #'number-to-string options-number-seq)) + (options-alist (cl-mapcar #'cons options-numbers options-titles)) + ;; we display both option number and the option title + ;; but also store both as cons cell as cdr, as we need it below + (candidates (mapcar (lambda (cell) + (cons (format "%s | %s" (car cell) (cdr cell)) + cell)) + options-alist))) + (if (null .poll) ;(mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) + (message "No poll here.") + ;; var "option" = just the cdr, a cons of option number and desc + (cdr (assoc (completing-read "Poll option to vote for: " + candidates + nil ; (predicate) + t) ; require match + candidates))))))) + (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." - (interactive - (list - (let* ((toot (mastodon-tl--property 'toot-json)) - (reblog (alist-get 'reblog toot)) - (poll (or (alist-get 'poll reblog) - (mastodon-tl--field 'poll toot))) - (options (mastodon-tl--field 'options poll)) - (options-titles (mastodon-tl--map-alist 'title options)) - (options-number-seq (number-sequence 1 (length options))) - (options-numbers (mapcar #'number-to-string options-number-seq)) - (options-alist (cl-mapcar #'cons options-numbers options-titles)) - ;; we display both option number and the option title - ;; but also store both as cons cell as cdr, as we need it below - (candidates (mapcar (lambda (cell) - (cons (format "%s | %s" (car cell) (cdr cell)) - cell)) - options-alist))) - (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) - (message "No poll here.") - ;; var "option" = just the cdr, a cons of option number and desc - (cdr (assoc - (completing-read "Poll option to vote for: " - candidates - nil ; (predicate) - t) ; require match - candidates)))))) - (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) - (message "No poll here.") - (let* ((toot (mastodon-tl--property 'toot-json)) - (poll (mastodon-tl--field 'poll toot)) - (poll-id (alist-get 'id poll)) - (url (mastodon-http--api (format "polls/%s/votes" poll-id))) - ;; need to zero-index our option: - (option-as-arg (number-to-string (1- (string-to-number (car option))))) - (arg `(("choices[]" . ,option-as-arg))) - (response (mastodon-http--post url arg))) - (mastodon-http--triage response - (lambda () - (message "You voted for option %s: %s!" - (car option) (cdr option))))))) + (interactive (mastodon-tl--read-poll-option)) + (let-alist (mastodon-tl--property 'toot-json) + (if (null .poll) ;(mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) + (message "No poll here.") + (let* ((url (mastodon-http--api (format "polls/%s/votes" .poll.id))) + ;; need to zero-index our option: + (option-as-arg (number-to-string (1- (string-to-number (car option))))) + (arg `(("choices[]" . ,option-as-arg))) + (response (mastodon-http--post url arg))) + (mastodon-http--triage response + (lambda () + (message "You voted for option %s: %s!" + (car option) (cdr option)))))))) ;; VIDEOS / MPV -- cgit v1.2.3 From 8ec34ca9f6082b731d270012bbada1b3d2319cc2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 10:02:59 +0200 Subject: revert to use of tl--field in --byline. --- lisp/mastodon-tl.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0c24b86..012017f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -577,12 +577,12 @@ this just means displaying toot client." (let-alist toot (let* ((created-time ;; bosts and faves in notifs view - ;; (makes timestamps be for the original toot - ;; not the boost/fave): - (or .status.created_at + ;; (timestamps for original not the boost/fave): + (or (mastodon-tl--field 'created_at + (mastodon-tl--field 'status toot)) ;; all other toots, inc. boosts/faves in timelines: - ;; (mastodon-tl--field auto fetches from reblogs if needed): - .created_at)) + ;; (mastodon-tl--field fetches from reblogs if needed): + (mastodon-tl--field 'created_at toot))) (parsed-time (date-to-time created-time)) (faved (equal 't .favourited)) (boosted (equal 't .reblogged)) -- cgit v1.2.3 From ec45108342ddb640a58db9bc6f1e70c0e37f93af Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:27:25 +0200 Subject: Revert "tl--byline cleanup" This reverts commit 347ef54b5d32cf7078e614e13ce7007aa406d54f. --- lisp/mastodon-tl.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 012017f..a19f26a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -575,6 +575,13 @@ By default it is `mastodon-tl--byline-boosted'. DETAILED-P means display more detailed info. For now this just means displaying toot client." (let-alist toot + .favourited + .reblogged + .bookmarked + .visibility + .account + .account.avatar + .edited_at (let* ((created-time ;; bosts and faves in notifs view ;; (timestamps for original not the boost/fave): -- cgit v1.2.3 From d46cc6ccb09e54fa5af20fe71ea4cf7da652a109 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:28:30 +0200 Subject: Revert "revert to use of tl--field in --byline." This reverts commit 8ec34ca9f6082b731d270012bbada1b3d2319cc2. --- lisp/mastodon-tl.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a19f26a..48d6036 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -584,12 +584,12 @@ this just means displaying toot client." .edited_at (let* ((created-time ;; bosts and faves in notifs view - ;; (timestamps for original not the boost/fave): - (or (mastodon-tl--field 'created_at - (mastodon-tl--field 'status toot)) + ;; (makes timestamps be for the original toot + ;; not the boost/fave): + (or .status.created_at ;; all other toots, inc. boosts/faves in timelines: - ;; (mastodon-tl--field fetches from reblogs if needed): - (mastodon-tl--field 'created_at toot))) + ;; (mastodon-tl--field auto fetches from reblogs if needed): + .created_at)) (parsed-time (date-to-time created-time)) (faved (equal 't .favourited)) (boosted (equal 't .reblogged)) -- cgit v1.2.3 From edf718826a220a0754a53546d7efd35ff7264b29 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:29:42 +0200 Subject: Revert "let-alist tl--byline" This reverts commit ceaeb56cea5fa2d5214e57b5915e0d315b70e081. --- lisp/mastodon-tl.el | 200 +++++++++++++++++++++++++--------------------------- 1 file changed, 98 insertions(+), 102 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 48d6036..edae3b8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -574,112 +574,109 @@ favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'. DETAILED-P means display more detailed info. For now this just means displaying toot client." - (let-alist toot - .favourited - .reblogged - .bookmarked - .visibility - .account - .account.avatar - .edited_at - (let* ((created-time - ;; bosts and faves in notifs view - ;; (makes timestamps be for the original toot - ;; not the boost/fave): - (or .status.created_at - ;; all other toots, inc. boosts/faves in timelines: - ;; (mastodon-tl--field auto fetches from reblogs if needed): - .created_at)) - (parsed-time (date-to-time created-time)) - (faved (equal 't .favourited)) - (boosted (equal 't .reblogged)) - (bookmarked (equal 't .bookmarked)) - (edited-parsed (when .edited_at (date-to-time .edited_at)))) + (let* ((created-time + ;; bosts and faves in notifs view + ;; (makes timestamps be for the original toot + ;; not the boost/fave): + (or (mastodon-tl--field 'created_at + (mastodon-tl--field 'status toot)) + ;; all other toots, inc. boosts/faves in timelines: + ;; (mastodon-tl--field auto fetches from reblogs if needed): + (mastodon-tl--field 'created_at toot))) + (parsed-time (date-to-time created-time)) + (faved (equal 't (mastodon-tl--field 'favourited toot))) + (boosted (equal 't (mastodon-tl--field 'reblogged toot))) + (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) + (visibility (mastodon-tl--field 'visibility toot)) + (account (alist-get 'account toot)) + (avatar-url (alist-get 'avatar account)) + (edited-time (alist-get 'edited_at toot)) + (edited-parsed (when edited-time (date-to-time edited-time)))) + (concat + ;; Boosted/favourited markers are not technically part of the byline, so + ;; we don't propertize them with 'byline t', as per the rest. This + ;; ensures that `mastodon-tl--goto-next-toot' puts point on + ;; author-byline, not before the (F) or (B) marker. Not propertizing like + ;; this makes the behaviour of these markers consistent whether they are + ;; displayed for an already boosted/favourited toot or as the result of + ;; the toot having just been favourited/boosted. + (concat (when boosted + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'boost))) + (when faved + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'favourite))) + (when bookmarked + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'bookmark)))) + ;; we remove avatars from the byline also, so that they also do not mess + ;; with `mastodon-tl--goto-next-toot': + (when (and mastodon-tl--show-avatars + mastodon-tl--display-media-p + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + (mastodon-media--get-avatar-rendering avatar-url)) + (propertize (concat - ;; Boosted/favourited markers are not technically part of the byline, so - ;; we don't propertize them with 'byline t', as per the rest. This - ;; ensures that `mastodon-tl--goto-next-toot' puts point on - ;; author-byline, not before the (F) or (B) marker. Not propertizing like - ;; this makes the behaviour of these markers consistent whether they are - ;; displayed for an already boosted/favourited toot or as the result of - ;; the toot having just been favourited/boosted. - (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'boost))) - (when faved - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'favourite))) - (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'bookmark)))) - ;; we remove avatars from the byline also, so that they also do not mess - ;; with `mastodon-tl--goto-next-toot': - (when (and mastodon-tl--show-avatars - mastodon-tl--display-media-p - (if (version< emacs-version "27.1") - (image-type-available-p 'imagemagick) - (image-transforms-p))) - (mastodon-media--get-avatar-rendering .account.avatar)) + ;; we propertize help-echo format faves for author name + ;; in `mastodon-tl--byline-author' + (funcall author-byline toot) + ;; visibility: + (cond ((equal visibility "direct") + (concat " " (mastodon-tl--symbol 'direct))) + ((equal visibility "private") + (concat " " (mastodon-tl--symbol 'private)))) + (funcall action-byline toot) + " " (propertize - (concat - ;; we propertize help-echo format faves for author name - ;; in `mastodon-tl--byline-author' - (funcall author-byline toot) - ;; visibility: - (cond ((equal .visibility "direct") - (concat " " (mastodon-tl--symbol 'direct))) - ((equal .visibility "private") - (concat " " (mastodon-tl--symbol 'private)))) - (funcall action-byline toot) - " " - (propertize - (format-time-string mastodon-toot-timestamp-format parsed-time) - 'timestamp parsed-time - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description parsed-time) - parsed-time)) - (when detailed-p - ;; (let* ((app .application - ;; (app-name (alist-get 'name - ;; (app-url (alist-get 'website app))) - (when .application + (format-time-string mastodon-toot-timestamp-format parsed-time) + 'timestamp parsed-time + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description parsed-time) + parsed-time)) + (when detailed-p + (let* ((app (alist-get 'application toot)) + (app-name (alist-get 'name app)) + (app-url (alist-get 'website app))) + (when app (concat (propertize " via " 'face 'default) - (propertize .application.name + (propertize app-name 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight 'mastodon-tab-stop 'shr-url - 'shr-url .application.website - 'help-echo .application.website - 'keymap mastodon-tl--shr-map-replacement)))) - (if .edited_at - (concat - " " - (mastodon-tl--symbol 'edited) - " " - (propertize - (format-time-string mastodon-toot-timestamp-format - edited-parsed) - 'face font-lock-comment-face - 'timestamp edited-parsed - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description edited-parsed) - edited-parsed))) - "") - (propertize (concat "\n " mastodon-tl--horiz-bar) - 'face 'default) - (if mastodon-tl--show-stats - (mastodon-tl--toot-stats toot) - "") - "\n") - 'favourited-p faved - 'boosted-p boosted - 'bookmarked-p bookmarked - 'edited .edited_at - 'edit-history (when .edited_at - (mastodon-toot--get-toot-edits .id)) - 'byline t))))) + 'shr-url app-url + 'help-echo app-url + 'keymap mastodon-tl--shr-map-replacement))))) + (if edited-time + (concat + " " + (mastodon-tl--symbol 'edited) + " " + (propertize + (format-time-string mastodon-toot-timestamp-format + edited-parsed) + 'face font-lock-comment-face + 'timestamp edited-parsed + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description edited-parsed) + edited-parsed))) + "") + (propertize (concat "\n " mastodon-tl--horiz-bar) + 'face 'default) + (if mastodon-tl--show-stats + (mastodon-tl--toot-stats toot) + "") + "\n") + 'favourited-p faved + 'boosted-p boosted + 'bookmarked-p bookmarked + 'edited edited-time + 'edit-history (when edited-time + (mastodon-toot--get-toot-edits (alist-get 'id toot))) + 'byline t)))) ;;; TIMESTAMPS @@ -2085,10 +2082,9 @@ LANGS is the accumulated array param alist if we re-run recursively." (mastodon-tl--property 'toot-json :no-move)))) ;; profile view, no toots ;; needed for e.g. gup.pe groups which show no toots publically: - ;; FIXME: this breaks calling 'W' on toots in profile view: - ;; ((mastodon-tl--profile-buffer-p) - ;; (list (alist-get 'acct - ;; (mastodon-profile--profile-json)))) + ((mastodon-tl--profile-buffer-p) + (list (alist-get 'acct + (mastodon-profile--profile-json)))) (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) -- cgit v1.2.3 From 03ee7ccc93a9285c6c50eec319c7844c60d3cda9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:30:43 +0200 Subject: Revert "let-alist tl--get-poll" This reverts commit c579efdef65e1d6a6ad29e0a609202cd59a683e2. --- lisp/mastodon-tl.el | 87 +++++++++++++++++++++++++++++------------------------ 1 file changed, 47 insertions(+), 40 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index edae3b8..d4d27c6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1199,46 +1199,53 @@ To disable showing the stats, customize (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." - (let-alist toot - (let* ((option-titles (mastodon-tl--map-alist 'title .poll.options)) - (longest-option (car (sort option-titles - (lambda (x y) - (> (length x) - (length y)))))) - (option-counter 0)) - (concat "\nPoll: \n\n" - (mapconcat (lambda (option) - (progn - (format "%s: %s%s%s\n" - (setq option-counter (1+ option-counter)) - (propertize (alist-get 'title option) - 'face 'success) - (make-string - (1+ - (- (length longest-option) - (length (alist-get 'title option)))) - ?\ ) - ;; TODO: disambiguate no votes from hidden votes - (format "[%s votes]" (or (alist-get 'votes_count option) - "0"))))) - .poll.options - "\n") - "\n" - (propertize - (cond (.poll.voters_count ; sometimes it is nil - (if (= .poll.voters_count 1) - (format "%s person | " .poll.voters_count) - (format "%s people | " .poll.voters_count))) - (.poll.vote_count - (format "%s votes | " .poll.vote_count)) - (t - "")) - 'face 'font-lock-comment-face) - (let ((str (if (eq .poll.expired :json-false) - (mastodon-tl--format-poll-expiry .poll.expires_at) - "Poll expired."))) - (propertize str 'face 'font-lock-comment-face)) - "\n")))) + (let* ((poll (mastodon-tl--field 'poll toot)) + (expiry (mastodon-tl--field 'expires_at poll)) + (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) + ;; (multi (mastodon-tl--field 'multiple poll)) + (voters-count (mastodon-tl--field 'voters_count poll)) + (vote-count (mastodon-tl--field 'votes_count poll)) + (options (mastodon-tl--field 'options poll)) + (option-titles (mastodon-tl--map-alist 'title options)) + (longest-option (car (sort option-titles + (lambda (x y) + (> (length x) + (length y)))))) + (option-counter 0)) + (concat "\nPoll: \n\n" + (mapconcat (lambda (option) + (progn + (format "%s: %s%s%s\n" + (setq option-counter (1+ option-counter)) + (propertize (alist-get 'title option) + 'face 'success) + (make-string + (1+ + (- (length longest-option) + (length (alist-get 'title + option)))) + ?\ ) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0"))))) + options + "\n") + "\n" + (propertize + (cond (voters-count ; sometimes it is nil + (if (= voters-count 1) + (format "%s person | " voters-count) + (format "%s people | " voters-count))) + (vote-count + (format "%s votes | " vote-count)) + (t + "")) + 'face 'font-lock-comment-face) + (let ((str (if expired-p + "Poll expired." + (mastodon-tl--format-poll-expiry expiry)))) + (propertize str 'face 'font-lock-comment-face)) + "\n"))) (defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." -- cgit v1.2.3 From 18724d71da1d668136bbe40f3bed3d804706538b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:41:51 +0200 Subject: revert let-alist for poll-vote in tl.el (because --field) --- lisp/mastodon-tl.el | 91 +++++++++++++++++++++++++++-------------------------- 1 file changed, 46 insertions(+), 45 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d4d27c6..423ca10 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1269,59 +1269,60 @@ To disable showing the stats, customize (defun mastodon-tl--read-poll-option () "Read a poll option to vote on a poll." - (list - (let-alist (mastodon-tl--property 'toot-json) - (let* ((poll (or .reblog.poll .poll)) - (options (mastodon-tl--field 'options poll)) - (options-titles (mastodon-tl--map-alist 'title options)) - (options-number-seq (number-sequence 1 (length options))) - (options-numbers (mapcar #'number-to-string options-number-seq)) - (options-alist (cl-mapcar #'cons options-numbers options-titles)) - ;; we display both option number and the option title - ;; but also store both as cons cell as cdr, as we need it below - (candidates (mapcar (lambda (cell) - (cons (format "%s | %s" (car cell) (cdr cell)) - cell)) - options-alist))) - (if (null .poll) ;(mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) - (message "No poll here.") - ;; var "option" = just the cdr, a cons of option number and desc - (cdr (assoc (completing-read "Poll option to vote for: " - candidates - nil ; (predicate) - t) ; require match - candidates))))))) + (list (let* ((toot (mastodon-tl--property 'toot-json)) + (poll (mastodon-tl--field 'poll toot)) + (options (mastodon-tl--field 'options poll)) + (options-titles (mastodon-tl--map-alist 'title options)) + (options-number-seq (number-sequence 1 (length options))) + (options-numbers (mapcar #'number-to-string options-number-seq)) + (options-alist (cl-mapcar #'cons options-numbers options-titles)) + ;; we display both option number and the option title + ;; but also store both as cons cell as cdr, as we need it below + (candidates (mapcar (lambda (cell) + (cons (format "%s | %s" (car cell) (cdr cell)) + cell)) + options-alist))) + (if (null poll) + (message "No poll here.") + ;; var "option" = just the cdr, a cons of option number and desc + (cdr (assoc (completing-read "Poll option to vote for: " + candidates + nil + t) ; require match + candidates)))))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." (interactive (mastodon-tl--read-poll-option)) - (let-alist (mastodon-tl--property 'toot-json) - (if (null .poll) ;(mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) - (message "No poll here.") - (let* ((url (mastodon-http--api (format "polls/%s/votes" .poll.id))) - ;; need to zero-index our option: - (option-as-arg (number-to-string (1- (string-to-number (car option))))) - (arg `(("choices[]" . ,option-as-arg))) - (response (mastodon-http--post url arg))) - (mastodon-http--triage response - (lambda () - (message "You voted for option %s: %s!" - (car option) (cdr option)))))))) + (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) + (message "No poll here.") + (let* ((toot (mastodon-tl--property 'toot-json)) + (poll (mastodon-tl--field 'poll toot)) + (poll-id (alist-get 'id poll)) + (url (mastodon-http--api (format "polls/%s/votes" poll-id))) + ;; need to zero-index our option: + (option-as-arg (number-to-string (1- (string-to-number (car option))))) + (arg `(("choices[]" . ,option-as-arg))) + (response (mastodon-http--post url arg))) + (mastodon-http--triage response + (lambda () + (message "You voted for option %s: %s!" + (car option) (cdr option))))))) ;; VIDEOS / MPV -(defun mastodon-tl--find-first-video-in-attachments () - "Return the first media attachment that is a moving image." - (let ((attachments (mastodon-tl--property 'attachments)) - vids) - (mapc (lambda (x) - (let ((att-type (plist-get x :type))) - (when (or (string= "video" att-type) - (string= "gifv" att-type)) - (push x vids)))) - attachments) - (car vids))) + (defun mastodon-tl--find-first-video-in-attachments () + "Return the first media attachment that is a moving image." + (let ((attachments (mastodon-tl--property 'attachments)) + vids) + (mapc (lambda (x) + (let ((att-type (plist-get x :type))) + (when (or (string= "video" att-type) + (string= "gifv" att-type)) + (push x vids)))) + attachments) + (car vids))) (defun mastodon-tl--mpv-play-video-from-byline () "Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post." -- cgit v1.2.3 From f74946157071b103e5f9c9b038f112d3bf8565e5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:53:57 +0200 Subject: re-let-alist tl-get-poll --- lisp/mastodon-tl.el | 88 +++++++++++++++++++++++++---------------------------- 1 file changed, 41 insertions(+), 47 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 423ca10..7fffb77 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1199,53 +1199,47 @@ To disable showing the stats, customize (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." - (let* ((poll (mastodon-tl--field 'poll toot)) - (expiry (mastodon-tl--field 'expires_at poll)) - (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) - ;; (multi (mastodon-tl--field 'multiple poll)) - (voters-count (mastodon-tl--field 'voters_count poll)) - (vote-count (mastodon-tl--field 'votes_count poll)) - (options (mastodon-tl--field 'options poll)) - (option-titles (mastodon-tl--map-alist 'title options)) - (longest-option (car (sort option-titles - (lambda (x y) - (> (length x) - (length y)))))) - (option-counter 0)) - (concat "\nPoll: \n\n" - (mapconcat (lambda (option) - (progn - (format "%s: %s%s%s\n" - (setq option-counter (1+ option-counter)) - (propertize (alist-get 'title option) - 'face 'success) - (make-string - (1+ - (- (length longest-option) - (length (alist-get 'title - option)))) - ?\ ) - ;; TODO: disambiguate no votes from hidden votes - (format "[%s votes]" (or (alist-get 'votes_count option) - "0"))))) - options - "\n") - "\n" - (propertize - (cond (voters-count ; sometimes it is nil - (if (= voters-count 1) - (format "%s person | " voters-count) - (format "%s people | " voters-count))) - (vote-count - (format "%s votes | " vote-count)) - (t - "")) - 'face 'font-lock-comment-face) - (let ((str (if expired-p - "Poll expired." - (mastodon-tl--format-poll-expiry expiry)))) - (propertize str 'face 'font-lock-comment-face)) - "\n"))) + (let-alist (mastodon-tl--field 'poll toot) ; toot or reblog + (let* ((option-titles (mastodon-tl--map-alist 'title .options)) + (longest-option (car (sort option-titles + (lambda (x y) + (> (length x) + (length y)))))) + (option-counter 0)) + (concat "\nPoll: \n\n" + (mapconcat (lambda (option) + (progn + (format "%s: %s%s%s\n" + (setq option-counter (1+ option-counter)) + (propertize (alist-get 'title option) + 'face 'success) + (make-string + (1+ + (- (length longest-option) + (length (alist-get 'title + option)))) + ?\ ) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0"))))) + .options + "\n") + "\n" + (propertize + (cond (.voters_count ; sometimes it is nil + (if (= .voters_count 1) + (format "%s person | " .voters_count) + (format "%s people | " .voters_count))) + (.vote_count + (format "%s votes | " .vote_count)) + (t + "")) + 'face 'font-lock-comment-face) + (let ((str (if (eq .expired :json-false) + (mastodon-tl--format-poll-expiry .expires_at) + "Poll expired."))) + (propertize str 'face 'font-lock-comment-face)) + "\n")))) (defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." -- cgit v1.2.3 From f1f45761bed72a41f915d78b94962cfe752ea155 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:56:49 +0200 Subject: refactor mastodon-tl--format-poll-option --- lisp/mastodon-tl.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7fffb77..5599609 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1197,6 +1197,20 @@ To disable showing the stats, customize ;; POLLS +(defun mastodon-tl--format-poll-option (option-counter longest-option) + "Format a poll option. OPTION-COUNTER is just a counter. +LONGEST-OPTION is the option whose length determines the formatting." + (format "%s: %s%s%s\n" + (setq option-counter (1+ option-counter)) + (propertize (alist-get 'title option) + 'face 'success) + (make-string (1+ (- (length longest-option) + (length (alist-get 'title option)))) + ?\ ) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0")))) + (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let-alist (mastodon-tl--field 'poll toot) ; toot or reblog @@ -1208,25 +1222,12 @@ To disable showing the stats, customize (option-counter 0)) (concat "\nPoll: \n\n" (mapconcat (lambda (option) - (progn - (format "%s: %s%s%s\n" - (setq option-counter (1+ option-counter)) - (propertize (alist-get 'title option) - 'face 'success) - (make-string - (1+ - (- (length longest-option) - (length (alist-get 'title - option)))) - ?\ ) - ;; TODO: disambiguate no votes from hidden votes - (format "[%s votes]" (or (alist-get 'votes_count option) - "0"))))) + (mastodon-tl--format-poll-option option-counter longest-option)) .options "\n") "\n" (propertize - (cond (.voters_count ; sometimes it is nil + (cond (.voters_count ; sometimes it is nil (if (= .voters_count 1) (format "%s person | " .voters_count) (format "%s people | " .voters_count))) -- cgit v1.2.3 From eaf9d3c8c57a4661f9ba1408c59d6902147a1d6e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:57:50 +0200 Subject: reindent a fun --- lisp/mastodon-tl.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5599609..0b87cc2 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1307,17 +1307,17 @@ LONGEST-OPTION is the option whose length determines the formatting." ;; VIDEOS / MPV - (defun mastodon-tl--find-first-video-in-attachments () - "Return the first media attachment that is a moving image." - (let ((attachments (mastodon-tl--property 'attachments)) - vids) - (mapc (lambda (x) - (let ((att-type (plist-get x :type))) - (when (or (string= "video" att-type) - (string= "gifv" att-type)) - (push x vids)))) - attachments) - (car vids))) +(defun mastodon-tl--find-first-video-in-attachments () + "Return the first media attachment that is a moving image." + (let ((attachments (mastodon-tl--property 'attachments)) + vids) + (mapc (lambda (x) + (let ((att-type (plist-get x :type))) + (when (or (string= "video" att-type) + (string= "gifv" att-type)) + (push x vids)))) + attachments) + (car vids))) (defun mastodon-tl--mpv-play-video-from-byline () "Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post." -- cgit v1.2.3 From 847eea3f622796edfa7b7303144c4d9cca3488bb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 19:50:02 +0200 Subject: adjust format-poll-option --- lisp/mastodon-tl.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0b87cc2..cfa872b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1197,8 +1197,8 @@ To disable showing the stats, customize ;; POLLS -(defun mastodon-tl--format-poll-option (option-counter longest-option) - "Format a poll option. OPTION-COUNTER is just a counter. +(defun mastodon-tl--format-poll-option (option option-counter longest-option) + "Format poll OPTION. OPTION-COUNTER is just a counter. LONGEST-OPTION is the option whose length determines the formatting." (format "%s: %s%s%s\n" (setq option-counter (1+ option-counter)) @@ -1222,7 +1222,7 @@ LONGEST-OPTION is the option whose length determines the formatting." (option-counter 0)) (concat "\nPoll: \n\n" (mapconcat (lambda (option) - (mastodon-tl--format-poll-option option-counter longest-option)) + (mastodon-tl--format-poll-option option option-counter longest-option)) .options "\n") "\n" -- cgit v1.2.3 From f3298f6d51b78cd904f144d54f3b229a7bb70c6b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 19:59:03 +0200 Subject: rename profile--add-author-bylines to profile--format-user --- lisp/mastodon-profile.el | 12 +++---- lisp/mastodon-tl.el | 2 +- test/mastodon-profile-tests.el | 76 +++++++++++++++++++++--------------------- 3 files changed, 44 insertions(+), 46 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 68d74df..bd59bac 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -163,7 +163,7 @@ NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for mastodon-profile--account "following" - #'mastodon-profile--add-author-bylines + #'mastodon-profile--format-user nil :headers) (error "Not in a mastodon profile"))) @@ -175,7 +175,7 @@ NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for mastodon-profile--account "followers" - #'mastodon-profile--add-author-bylines + #'mastodon-profile--format-user nil :headers) (error "Not in a mastodon profile"))) @@ -706,19 +706,17 @@ IMG-TYPE is the JSON key from the account data." (message "Loading your profile...") (mastodon-profile--show-user (mastodon-auth--get-account-name))) -(defun mastodon-profile--add-author-bylines (tootv) - "Convert TOOTV into a author-bylines and insert. +(defun mastodon-profile--format-user (tootv) + "Convert TOOTV into author-bylines and insert. Also insert their profile note. Used to view a user's followers and those they're following." - ;;FIXME change the name of this fun now that we've edited what it does! (let ((inhibit-read-only t)) (unless (seq-empty-p tootv) (mapc (lambda (toot) (let ((start-pos (point))) (insert "\n" (propertize - (mastodon-tl--byline-author `((account . ,toot)) - :avatar) + (mastodon-tl--byline-author `((account . ,toot)) :avatar) 'byline 't 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index cfa872b..1cd5f86 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -457,7 +457,7 @@ With arg AVATAR, include the account's avatar image." (concat ;; avatar insertion moved up to `mastodon-tl--byline' by default in order ;; to be outside of text prop 'byline t. arg avatar is used by - ;; `mastodon-profile--add-author-bylines' + ;; `mastodon-profile--format-user' (when (and avatar mastodon-tl--show-avatars mastodon-tl--display-media-p diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 56cb852..1936b99 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -122,48 +122,48 @@ When formatting Gargon's state we want to see - the url of the avatar (yet to be loaded) - the info attached to the name" (with-mock - ;; Don't start any image loading: - (mock (mastodon-media--inline-images * *) => nil) - ;; Let's not do formatting as that makes it hard to not rely on - ;; window width and reflowing the text. - (mock (shr-render-region * *) => nil) - (if (version< emacs-version "27.1") - (mock (image-type-available-p 'imagemagick) => t) - (mock (image-transforms-p) => t)) + ;; Don't start any image loading: + (mock (mastodon-media--inline-images * *) => nil) + ;; Let's not do formatting as that makes it hard to not rely on + ;; window width and reflowing the text. + (mock (shr-render-region * *) => nil) + (if (version< emacs-version "27.1") + (mock (image-type-available-p 'imagemagick) => t) + (mock (image-transforms-p) => t)) - (with-temp-buffer - (let ((mastodon-tl--show-avatars t) - (mastodon-tl--display-media-p t)) - (mastodon-profile--add-author-bylines (list gargron-profile-json))) + (with-temp-buffer + (let ((mastodon-tl--show-avatars t) + (mastodon-tl--display-media-p t)) + (mastodon-profile--format-user (list gargron-profile-json))) - (should - (equal - (buffer-substring-no-properties (point-min) (point-max)) - "\n Eugen (@Gargron)\n

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n")) + (should + (equal + (buffer-substring-no-properties (point-min) (point-max)) + "\n Eugen (@Gargron)\n

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n")) - ;; Check the avatar at pos 2 - (should - (equal - (get-text-property 2 'media-url) - "https://files.mastodon.social/accounts/avatars/000/000/001/original/d96d39a0abb45b92.jpg")) - (should - (equal - (get-text-property 2 'media-state) - 'needs-loading)) + ;; Check the avatar at pos 2 + (should + (equal + (get-text-property 2 'media-url) + "https://files.mastodon.social/accounts/avatars/000/000/001/original/d96d39a0abb45b92.jpg")) + (should + (equal + (get-text-property 2 'media-state) + 'needs-loading)) - ;; Check the byline state - (should - (equal - (get-text-property 4 'byline) - t)) - (should - (equal - (get-text-property 4 'toot-id) - (alist-get 'id gargron-profile-json))) - (should - (equal - (get-text-property 4 'toot-json) - gargron-profile-json))))) + ;; Check the byline state + (should + (equal + (get-text-property 4 'byline) + t)) + (should + (equal + (get-text-property 4 'toot-id) + (alist-get 'id gargron-profile-json))) + (should + (equal + (get-text-property 4 'toot-json) + gargron-profile-json))))) (ert-deftest mastodon-profile--search-account-by-handle--removes-at () "Should ignore a leading at-sign in user handle. -- cgit v1.2.3 From 9747b547bac2da6d2d377958380d4a71c01409e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 20:46:14 +0200 Subject: remove profile--account-field from tl.el --- lisp/mastodon-tl.el | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1cd5f86..2224bdf 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -60,7 +60,6 @@ (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") (autoload 'mastodon-notifications--get-mentions "mastodon-notifications") -(autoload 'mastodon-profile--account-field "mastodon-profile") (autoload 'mastodon-profile--account-from-id "mastodon-profile") (autoload 'mastodon-profile--extract-users-handles "mastodon-profile") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") @@ -2137,11 +2136,10 @@ LANGS is an array parameters alist of languages to filer user's posts by." ;; if muting/blocking, we select from handles in current status (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json))))) - (user-id (mastodon-profile--account-field account 'id)) - (name (if (not (string-empty-p - (mastodon-profile--account-field account 'display_name))) - (mastodon-profile--account-field account 'display_name) - (mastodon-profile--account-field account 'username))) + (user-id (alist-get 'id account)) + (name (if (not (string-empty-p (alist-get 'display_name account))) + (alist-get 'display_name account) + (alist-get 'username account))) (args (cond (notify `(("notify" . ,notify))) (langs langs) @@ -2255,7 +2253,7 @@ PREFIX is for `mastodon-tl--show-tag-timeline', which see." (defun mastodon-tl--report-params (account toot) "Query user and return report params alist. ACCOUNT and TOOT are the data to use." - (let* ((account-id (mastodon-profile--account-field account 'id)) + (let* ((account-id (alist-get 'id account)) (comment (read-string "Add comment [optional]: ")) (toot-id (when (y-or-n-p "Also report status at point? ") (mastodon-tl--toot-id toot))) ; base toot if poss -- cgit v1.2.3 From 97f7e939f97afe6d926cdf6aaf34df1959797c9f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 22:47:45 +0200 Subject: audit 1/3 of tl.el --- lisp/mastodon-tl.el | 108 ++++++++++++++++++++++------------------------------ 1 file changed, 45 insertions(+), 63 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2224bdf..84c25ec 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -424,15 +424,12 @@ With a double PREFIX arg, limit results to your own instance." (let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag)))) (while list (push (pop list) params)))) - (mastodon-tl--init (if (listp tag) - "tags-multiple" - (concat "tag-" tag)) - (concat "timelines/tag/" (if (listp tag) - ;; endpoint must be /tag/:sth - (car tag) tag)) - 'mastodon-tl--timeline - nil - params))) + (mastodon-tl--init + (if (listp tag) "tags-multiple" (concat "tag-" tag)) + (concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth + 'mastodon-tl--timeline + nil + params))) ;;; BYLINES, etc. @@ -440,9 +437,8 @@ With a double PREFIX arg, limit results to your own instance." (defun mastodon-tl--message-help-echo () "Call message on `help-echo' property at point. Do so if type of status at poins is not follow_request/follow." - (let ((type (alist-get - 'type - (mastodon-tl--property 'toot-json :no-move))) + (let ((type (alist-get 'type + (mastodon-tl--property 'toot-json :no-move))) (echo (mastodon-tl--property 'help-echo :no-move))) (when echo ; not for followers/following in profile (unless (or (string= type "follow_request") @@ -454,10 +450,9 @@ Do so if type of status at poins is not follow_request/follow." With arg AVATAR, include the account's avatar image." (let-alist toot (concat - ;; avatar insertion moved up to `mastodon-tl--byline' by default in order - ;; to be outside of text prop 'byline t. arg avatar is used by - ;; `mastodon-profile--format-user' - (when (and avatar + ;; avatar insertion moved up to `mastodon-tl--byline' by default to be + ;; outside 'byline propt. + (when (and avatar ; used by `mastodon-profile--format-user' mastodon-tl--show-avatars mastodon-tl--display-media-p (if (version< emacs-version "27.1") @@ -498,11 +493,10 @@ moving image media from the byline. Used when point is at the start of a byline, i.e. where `mastodon-tl--goto-next-toot' leaves point." (let* ((toot-to-count - (or - ;; simply praying this order works + (or ; simply praying this order works (alist-get 'status toot) ; notifications timeline - ;; fol-req notif, has 'type - ;; placed before boosts coz fol-reqs have a (useless) reblog entry: + ;; fol-req notif, has 'type placed before boosts coz fol-reqs have + ;; a (useless) reblog entry: (when (and (or (mastodon-tl--buffer-type-eq 'notifications) (mastodon-tl--buffer-type-eq 'mentions)) (alist-get 'type toot)) @@ -516,9 +510,8 @@ Used when point is at the start of a byline, i.e. where (format-media (when media-types (format "media: %s" (mapconcat #'identity media-types " ")))) - (format-media-binding (when (and (or - (member "video" media-types) - (member "gifv" media-types)) + (format-media-binding (when (and (or (member "video" media-types) + (member "gifv" media-types)) (require 'mpv nil :no-error)) (format " | C-RET to view with mpv")))) (format "%s" (concat format-media format-media-binding)))))) @@ -532,22 +525,19 @@ Used when point is at the start of a byline, i.e. where "Return a list of attachment URLs and types for TOOT. The result is added as an attachments property to author-byline." (let ((media-attachments (mastodon-tl--field 'media_attachments toot))) - (mapcar - (lambda (attachment) - (let-alist attachment - (list :url (or .remote_url .url) ; fallback for notifications - :type .type))) - media-attachments))) + (mapcar (lambda (attachment) + (let-alist attachment + (list :url (or .remote_url .url) ; fallback for notifications + :type .type))) + media-attachments))) (defun mastodon-tl--byline-boosted (toot) "Add byline for boosted data from TOOT." (let ((reblog (alist-get 'reblog toot))) (when reblog (concat - "\n " - (propertize "Boosted" 'face 'mastodon-boosted-face) - " " - (mastodon-tl--byline-author reblog))))) + "\n " (propertize "Boosted" 'face 'mastodon-boosted-face) + " " (mastodon-tl--byline-author reblog))))) (defun mastodon-tl--format-faved-or-boosted-byline (letter) "Format the byline marker for a boosted or favourited status. @@ -575,8 +565,7 @@ DETAILED-P means display more detailed info. For now this just means displaying toot client." (let* ((created-time ;; bosts and faves in notifs view - ;; (makes timestamps be for the original toot - ;; not the boost/fave): + ;; (makes timestamps be for the original toot not the boost/fave): (or (mastodon-tl--field 'created_at (mastodon-tl--field 'status toot)) ;; all other toots, inc. boosts/faves in timelines: @@ -785,13 +774,10 @@ START and END are the boundaries of the link in the toot." url toot-instance-url)) (maybe-userhandle (if (proper-list-p toot) ; fails for profile buffers? - (or (mastodon-tl--userhandle-from-mentions toot - link-str) + (or (mastodon-tl--userhandle-from-mentions toot link-str) ;; FIXME: if prev always works, cut this: - (mastodon-tl--extract-userhandle-from-url - url link-str)) - (mastodon-tl--extract-userhandle-from-url - url link-str)))) + (mastodon-tl--extract-userhandle-from-url url link-str)) + (mastodon-tl--extract-userhandle-from-url url link-str)))) (cond (;; Hashtags: maybe-hashtag (setq mastodon-tab-stop-type 'hashtag @@ -812,9 +798,7 @@ START and END are the boundaries of the link in the toot." (when maybe-userid (list 'account-id maybe-userid)))))) ;; Anything else: - (t - ;; Leave it as a url handled by shr.el. - ;; (We still have to replace the keymap so that tabbing works.) + (t ; Leave it as a url handled by shr.el. (setq keymap (if (eq shr-map (get-text-property start 'keymap)) mastodon-tl--shr-map-replacement mastodon-tl--shr-image-map-replacement) @@ -828,18 +812,18 @@ START and END are the boundaries of the link in the toot." (defun mastodon-tl--userhandle-from-mentions (toot link) "Extract a user handle from mentions in json TOOT. -LINK is maybe the '@handle' to search for." +LINK is maybe the `@handle' to search for." (mastodon-tl--extract-el-from-mentions 'acct toot link)) (defun mastodon-tl--extract-userid-toot (toot link) "Extract a user id for an ACCT from mentions in a TOOT. -LINK is maybe the '@handle' to search for." +LINK is maybe the `@handle' to search for." (mastodon-tl--extract-el-from-mentions 'id toot link)) (defun mastodon-tl--extract-el-from-mentions (el toot link) "Extract element EL from TOOT mentions that matches LINK. -LINK should be a simple handle string with no domain, i.e. @user. -Return nil if no matching element" +LINK should be a simple handle string with no domain, i.e. \"@user\". +Return nil if no matching element." ;; Must return nil if nothing found! ;; TODO: we should break the while loop as soon as we get sth (let ((mentions (append (alist-get 'mentions toot) nil))) @@ -848,8 +832,7 @@ Return nil if no matching element" (name (substring-no-properties link 1 (length link))) ; cull @ return) (while mention - (when (string= (alist-get 'username mention) - name) + (when (string= name (alist-get 'username mention)) (setq return (alist-get el mention))) (setq mention (pop mentions))) return)))) @@ -866,7 +849,7 @@ this should be of the form , e.g. \"@Gargon\"." (string= (downcase buffer-text) (downcase (substring (url-filename parsed-url) 1)))) (if local-p - buffer-text ; no instance suffic for local mention + buffer-text ; no instance suffix for local mention (concat buffer-text "@" (url-host parsed-url)))))) (defun mastodon-tl--extract-hashtag-from-url (url instance-url) @@ -890,17 +873,15 @@ the toot)." (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. LINK-TYPE is the type of link to produce." - (let ((help-text (cond - ((eq link-type 'content-warning) - "Toggle hidden text") - (t - (error "Unknown link type %s" link-type))))) - (propertize - string - 'mastodon-tab-stop link-type - 'mouse-face 'highlight - 'keymap mastodon-tl--link-keymap - 'help-echo help-text))) + (let ((help-text (cond ((eq link-type 'content-warning) + "Toggle hidden text") + (t + (error "Unknown link type %s" link-type))))) + (propertize string + 'mastodon-tab-stop link-type + 'mouse-face 'highlight + 'keymap mastodon-tl--link-keymap + 'help-echo help-text))) (defun mastodon-tl--do-link-action-at-point (position) "Do the action of the link at POSITION. @@ -910,7 +891,8 @@ Used for hitting RET on a given link." (cond ((eq link-type 'content-warning) (mastodon-tl--toggle-spoiler-text position)) ((eq link-type 'hashtag) - (mastodon-tl--show-tag-timeline nil (get-text-property position 'mastodon-tag))) + (mastodon-tl--show-tag-timeline + nil (get-text-property position 'mastodon-tag))) ;; 'account / 'account-id is not set for mentions, only bylines ((eq link-type 'user-handle) (let ((account-json (get-text-property position 'account)) -- cgit v1.2.3 From e1d7c7f526c331487f1ce4c4bf39dd7363b61740 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 08:49:07 +0200 Subject: remove duplicate funs --- lisp/mastodon-tl.el | 102 ---------------------------------------------------- 1 file changed, 102 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 84c25ec..6dbb8ad 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1073,108 +1073,6 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." help-echo (concat help-echo "\nC-RET: play " type " with mpv")))) - -;;; INSERT TOOTS - -(defun mastodon-tl--content (toot) - "Retrieve text content from TOOT. -Runs `mastodon-tl--render-text' and fetches poll or media." - (let-alist toot - (concat (mastodon-tl--render-text (or .reblog.content .content toot)) - (when (or .reblog.poll .poll) - (mastodon-tl--get-poll toot)) - (mastodon-tl--media toot)))) - -(defun mastodon-tl--insert-status (toot body author-byline action-byline - &optional id base-toot detailed-p) - "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 -portion of the byline that takes one variable. By default it is -`mastodon-tl--byline-author'. -ACTION-BYLINE is also an optional function for adding an action, -such as boosting favouriting and following to the byline. It also -takes a single function. By default it is -`mastodon-tl--byline-boosted'. -ID is that of the status if it is a notification, which is -attached as a `toot-id' property if provided. If the -status is a favourite or boost notification, BASE-TOOT is the -JSON of the toot responded to. -DETAILED-P means display more detailed info. For now -this just means displaying toot client." - (let ((start-pos (point))) - (insert - (propertize - (concat "\n" - body - " \n" - (mastodon-tl--byline toot author-byline action-byline detailed-p)) - 'toot-id (or id ; notification's own id - (alist-get 'id toot)) ; toot id - 'base-toot-id (mastodon-tl--toot-id - ;; if status is a notif, get id from base-toot - ;; (-tl--toot-id toot) will not work here: - (or base-toot - ;; else normal toot with reblog check: - toot)) - 'toot-json toot - 'base-toot base-toot) - "\n") - (when mastodon-tl--display-media-p - (mastodon-media--inline-images start-pos (point))))) - -;; from mastodon-alt.el: -(defun mastodon-tl--toot-for-stats (&optional toot) - "Return the TOOT on which we want to extract stats. -If no TOOT is given, the one at point is considered." - (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) - (toot (or (alist-get 'status original-toot) - (when (alist-get 'type original-toot) - original-toot) - (alist-get 'reblog original-toot) - original-toot)) - (type (alist-get 'type (or toot)))) - (unless (member type '("follow" "follow_request")) - toot))) - -(defun mastodon-tl--toot-stats (toot) - "Return a right aligned string (using display align-to). -String is filled with TOOT statistics (boosts, favs, replies). -When the TOOT is a reblog (boost), statistics from reblogged -toots are returned. -To disable showing the stats, customize -`mastodon-tl--show-stats'." - (when-let ((toot (mastodon-tl--toot-for-stats toot))) - (let-alist toot - (let* ((faves-prop (propertize (format "%s" .favourites_count) - 'favourites-count .favourites_count)) - (boosts-prop (propertize (format "%s" .reblogs_count) - 'boosts-count .reblogs_count)) - (favourites (format "%s %s" faves-prop ;favourites-count - (mastodon-tl--symbol 'favourite))) - (boosts (format "%s %s" boosts-prop ;boosts-count - (mastodon-tl--symbol 'boost))) - (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) - (status (concat - (propertize favourites - 'favourited-p (equal t .favourited) - 'favourites-field t - 'face font-lock-comment-face) - (propertize " | " 'face font-lock-comment-face) - (propertize boosts - 'boosted-p (equal t .reblogged) - 'boosts-field t - 'face font-lock-comment-face) - (propertize " | " 'face font-lock-comment-face) - (propertize replies - 'replies-field t - 'replies-count .replies_count - 'face font-lock-comment-face))) - (status (concat - (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) - status))) - status)))) - ;; POLLS -- cgit v1.2.3 From 2c50ee77e6929cb38c5e32717aa1ad9ddd4cf8d0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 09:25:17 +0200 Subject: auditing -tl.el --- lisp/mastodon-tl.el | 77 +++++++++++++++++++++++------------------------------ 1 file changed, 33 insertions(+), 44 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6dbb8ad..9618cfe 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -282,7 +282,8 @@ than `switch-to-buffer'." "Move to the next interesting item. This could be the next toot, link, or image; whichever comes first. Don't move if nothing else to move to is found, i.e. near the end of the buffer. -This also skips tab items in invisible text, i.e. hidden spoiler text." +This also skips tab items in invisible text, i.e. hidden spoiler text. +PREVIOUS means move to previous item." (interactive) (let (next-range (search-pos (point))) @@ -979,17 +980,15 @@ content warning message are displayed. The content warning message is a link which unhides/hides the main body." (let* ((spoiler (mastodon-tl--field 'spoiler_text toot)) (string (mastodon-tl--set-face - ;; remove trailing whitespace (mastodon-tl--clean-tabs-and-nl (mastodon-tl--render-text spoiler toot)) 'default)) - (message (concat - " " mastodon-tl--horiz-bar "\n " - (mastodon-tl--make-link - (concat "CW: " string) - 'content-warning) - "\n " - mastodon-tl--horiz-bar "\n")) + (message (concat " " mastodon-tl--horiz-bar "\n " + (mastodon-tl--make-link + (concat "CW: " string) + 'content-warning) + "\n " + mastodon-tl--horiz-bar "\n")) (cw (mastodon-tl--set-face message 'mastodon-cw-face))) (concat cw @@ -1022,10 +1021,8 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media-attachment (media-attachment) "Return a propertized string for MEDIA-ATTACHMENT." (let* ((preview-url (alist-get 'preview_url media-attachment)) - (remote-url - (or (alist-get 'remote_url media-attachment) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachment))) + (remote-url (or (alist-get 'remote_url media-attachment) + (alist-get 'url media-attachment))) ; for notifs (type (alist-get 'type media-attachment)) (caption (alist-get 'description media-attachment)) (display-str @@ -1039,18 +1036,17 @@ message is a link which unhides/hides the main body." preview-url remote-url type caption) ; 2nd arg for shr-browse-url ;; return URL/caption: (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) ;; string + (concat "Media:: " preview-url) ; string preview-url remote-url type caption - display-str ;; display + display-str ; display ;; FIXME: shr-link underlining is awful for captions with ;; newlines, as the underlining runs to the edge of the - ;; frame even if the text doesn' + ;; frame even if the text doesn't 'shr-link) "\n")))) -(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url - type help-echo - &optional display face) +(defun mastodon-tl--propertize-img-str-or-url + (str media-url full-remote-url type help-echo &optional display face) "Propertize an media placeholder string \"[img]\" or media URL. STR is the string to propertize, MEDIA-URL is the preview link, FULL-REMOTE-URL is the link to the full resolution image on the @@ -1069,7 +1065,7 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." 'keymap mastodon-tl--shr-image-map-replacement 'help-echo (if (or (string= type "image") (string= type nil) - (string= type "unknown")) ;handle borked images + (string= type "unknown")) ; handle borked images help-echo (concat help-echo "\nC-RET: play " type " with mpv")))) @@ -1101,12 +1097,13 @@ LONGEST-OPTION is the option whose length determines the formatting." (option-counter 0)) (concat "\nPoll: \n\n" (mapconcat (lambda (option) - (mastodon-tl--format-poll-option option option-counter longest-option)) + (mastodon-tl--format-poll-option + option option-counter longest-option)) .options "\n") "\n" (propertize - (cond (.voters_count ; sometimes it is nil + (cond (.voters_count ; sometimes it is nil (if (= .voters_count 1) (format "%s person | " .voters_count) (format "%s people | " .voters_count))) @@ -1135,7 +1132,7 @@ LONGEST-OPTION is the option whose length determines the formatting." (plist-get parsed :minutes))) ((> (plist-get parsed :minutes) 0) (format "%s minutes left" (plist-get parsed :minutes))) - (t ;; we failed to guess: + (t ; we failed to guess: (format "%s days, %s hours, %s minutes left" (plist-get parsed :days) (plist-get parsed :hours) @@ -1211,15 +1208,11 @@ LONGEST-OPTION is the option whose length determines the formatting." URL and TYPE are provided when called while point is on byline, in which case play first video or gif from current toot." (interactive) - (let ((url (or - ;; point in byline: - url - ;; point in toot: - (mastodon-tl--property 'image-url :no-move))) - (type (or ;; in byline: - type - ;; point in toot: - (mastodon-tl--property 'mastodon-media-type :no-move)))) + (let ((url (or url ; point in byline: + (mastodon-tl--property 'image-url :no-move))) ; point in toot + (type (or type ; in byline + ;; point in toot: + (mastodon-tl--property 'mastodon-media-type :no-move)))) (if url (if (or (equal type "gifv") (equal type "video")) @@ -1240,18 +1233,16 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (poll-p (if reblog (alist-get 'poll reblog) (alist-get 'poll toot)))) - (concat - (mastodon-tl--render-text content toot) - (when poll-p - (mastodon-tl--get-poll toot)) - (mastodon-tl--media toot)))) + (concat (mastodon-tl--render-text content toot) + (when poll-p + (mastodon-tl--get-poll toot)) + (mastodon-tl--media toot)))) (defun mastodon-tl--prev-toot-id () "Return the id of the last toot inserted into the buffer." - (let ((prev-pos (1- (save-excursion - (previous-single-property-change - (point) - 'base-toot-id))))) + (let ((prev-pos + (1- (save-excursion + (previous-single-property-change (point) 'base-toot-id))))) (get-text-property prev-pos 'base-toot-id))) (defun mastodon-tl--after-reply-status (reply-to-id) @@ -1296,7 +1287,6 @@ THREAD means the status will be displayed in a thread view." 'line-prefix bar 'wrap-prefix bar)) body) - ;; body " \n" (mastodon-tl--byline toot author-byline action-byline detailed-p)) 'toot-id (or id ; notification's own id @@ -1305,8 +1295,7 @@ THREAD means the status will be displayed in a thread view." ;; if status is a notif, get id from base-toot ;; (-tl--toot-id toot) will not work here: (or base-toot - ;; else normal toot with reblog check: - toot)) + toot)) ; else normal toot with reblog check 'toot-json toot 'base-toot base-toot) "\n") -- cgit v1.2.3 From ca8d6676dab2ace4812d9d6ccc2f592eac8bc23f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 09:25:33 +0200 Subject: let-alist for tl--toot-stats --- lisp/mastodon-tl.el | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9618cfe..82b037f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1323,38 +1323,31 @@ When the TOOT is a reblog (boost), statistics from reblogged toots are returned. To disable showing the stats, customize `mastodon-tl--show-stats'." - (when-let ((toot (mastodon-tl--toot-for-stats toot))) - (let* ((favourites-count (alist-get 'favourites_count toot)) - (favourited (equal 't (alist-get 'favourited toot))) - (faves-prop (propertize (format "%s" favourites-count) - 'favourites-count favourites-count)) - (boosts-count (alist-get 'reblogs_count toot)) - (boosted (equal 't (alist-get 'reblogged toot))) - (boosts-prop (propertize (format "%s" boosts-count) - 'boosts-count boosts-count)) - (replies-count (alist-get 'replies_count toot)) - (favourites (format "%s %s" faves-prop ;favourites-count - (mastodon-tl--symbol 'favourite))) - (boosts (format "%s %s" boosts-prop ;boosts-count - (mastodon-tl--symbol 'boost))) - (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) + (let-alist (mastodon-tl--toot-for-stats toot) + (let* ((faves-prop (propertize (format "%s" .favourites_count) + 'favourites-count .favourites_count)) + (boosts-prop (propertize (format "%s" .reblogs_count) + 'boosts-count .reblogs_count)) + (faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost))) + (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) (status (concat - (propertize favourites - 'favourited-p favourited + (propertize faves + 'favourited-p (eq 't .favourited) 'favourites-field t - 'help-echo (format "%s favourites" favourites-count) + 'help-echo (format "%s favourites" .favourites_count) 'face font-lock-comment-face) (propertize " | " 'face font-lock-comment-face) (propertize boosts - 'boosted-p boosted + 'boosted-p (eq 't .reblogged) 'boosts-field t - 'help-echo (format "%s boosts" boosts-count) + 'help-echo (format "%s boosts" .reblogs_count) 'face font-lock-comment-face) (propertize " | " 'face font-lock-comment-face) (propertize replies 'replies-field t - 'replies-count replies-count - 'help-echo (format "%s replies" replies-count) + 'replies-count .replies_count + 'help-echo (format "%s replies" .replies_count) 'face font-lock-comment-face))) (status (concat -- cgit v1.2.3 From 2bdbb602059bd1d0114ecd560b87c12d184ff437 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 10:09:12 +0200 Subject: audit -tl.el finish --- lisp/mastodon-tl.el | 168 +++++++++++++++++++++------------------------------- 1 file changed, 67 insertions(+), 101 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 82b037f..1c0d878 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1369,16 +1369,11 @@ this just means displaying toot client. THREAD means the status will be displayed in a thread view." (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)) + (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)) (defun mastodon-tl--timeline (toots &optional thread) "Display each toot in TOOTS. @@ -1430,19 +1425,18 @@ Optionally get it for BUFFER." (defun mastodon-tl--get-buffer-property (property &optional buffer no-error) "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'. If NO-ERROR is non-nil, do not error when property is empty." - (with-current-buffer (or buffer (current-buffer)) + (with-current-buffer (or buffer (current-buffer)) (if no-error (plist-get mastodon-tl--buffer-spec property) (or (plist-get mastodon-tl--buffer-spec property) (error "Mastodon-tl--buffer-spec is not defined for buffer %s" (or buffer (current-buffer))))))) -(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function - &optional link-header update-params - hide-replies) +(defun mastodon-tl--set-buffer-spec + (buffer endpoint update-fun &optional link-header update-params hide-replies) "Set `mastodon-tl--buffer-spec' for the current buffer. BUFFER is buffer name, ENDPOINT is buffer's enpoint, -UPDATE-FUNCTION is its update function. +UPDATE-FUN is its update function. LINK-HEADER is the http Link header if present. UPDATE-PARAMS is any http parameters needed for the update function. HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." @@ -1451,13 +1445,14 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." mastodon-instance-url) buffer-name ,buffer endpoint ,endpoint - update-function ,update-function + update-function ,update-fun link-header ,link-header update-params ,update-params hide-replies ,hide-replies))) ;;; BUFFERS + (defun mastodon-tl--endpoint-str-= (str &optional type) "Return T if STR is equal to the current buffer's endpoint. TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix." @@ -1505,12 +1500,8 @@ call this function after it is set or use something else." ;; profiles: ((mastodon-tl--profile-buffer-p) (cond - ;; own profile: - ;; perhaps not needed, and needlessly confusing, - ;; e.g. for `mastodon-profile--account-view-cycle': - ;; ((equal (mastodon-tl--buffer-name) - ;; (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) - ;; 'own-profile-statuses) + ;; an own profile option is needlessly confusing e.g. for + ;; `mastodon-profile--account-view-cycle' ;; profile note: ((string-suffix-p "update-profile*" buffer-name) 'update-profile-note) @@ -1569,8 +1560,8 @@ This includes the update profile note buffer, but not the preferences one." (defun mastodon-tl--timeline-proper-p () "Return non-nil if the current buffer is a 'proper' timeline. -A proper timeline excludes notifications, threads, and other toot -buffers that aren't strictly mastodon timelines." +A proper timeline excludes notifications, threads, profiles, and +other toot buffers that aren't strictly mastodon timelines." (let ((timeline-buffers '(home federated local tag-timeline list-timeline profile-statuses))) (member (mastodon-tl--get-buffer-type) timeline-buffers))) @@ -1658,9 +1649,8 @@ BACKWARD means move backward (up) the timeline." (cond ((numberp numeric) (number-to-string numeric)) ((stringp numeric) numeric) - (t (error - "Numeric:%s must be either a string or a number" - numeric)))) + (t (error "Numeric:%s must be either a string or a number" + numeric)))) (defun mastodon-tl--toot-id (json) "Find approproiate toot id in JSON. @@ -1716,8 +1706,7 @@ view all branches of a thread." (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)) + nil :silent)) (context (mastodon-http--get-json url nil :silent))) (if (equal (caar toot) 'error) (message "Error: %s" (cdar toot)) @@ -1729,8 +1718,7 @@ view all branches of a thread." ;; 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--set-buffer-spec buffer endpoint #'mastodon-tl--thread) (mastodon-tl--timeline (alist-get 'ancestors context) :thread) (goto-char (point-max)) @@ -1829,8 +1817,7 @@ If NOTIFY is \"false\", disable notifications when that user posts. Can be called to toggle NOTIFY on users already being followed. LANGS is an array parameters alist of languages to filer user's posts by." (interactive - (list - (mastodon-tl--interactive-user-handles-get "follow"))) + (list (mastodon-tl--interactive-user-handles-get "follow"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify langs))) @@ -1838,16 +1825,14 @@ LANGS is an array parameters alist of languages to filer user's posts by." (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." (interactive - (list - (mastodon-tl--interactive-user-handles-get "enable"))) + (list (mastodon-tl--interactive-user-handles-get "enable"))) (mastodon-tl--do-if-toot (mastodon-tl--follow-user user-handle "true"))) (defun mastodon-tl--disable-notify-user-posts (user-handle) "Query for USER-HANDLE and disable notifications when they post." (interactive - (list - (mastodon-tl--interactive-user-handles-get "disable"))) + (list (mastodon-tl--interactive-user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) (defun mastodon-tl--filter-user-user-posts-by-language (user-handle) @@ -1870,8 +1855,7 @@ LANGS is the accumulated array param alist if we re-run recursively." (when choice (setq langs-alist (push `("languages[]" . ,(alist-get choice mastodon-iso-639-1 - nil nil - #'string=)) + nil nil #'string=)) langs-alist)) (if (y-or-n-p "Filter by another language? ") (mastodon-tl--read-filter-langs langs-alist) @@ -1880,24 +1864,21 @@ LANGS is the accumulated array param alist if we re-run recursively." (defun mastodon-tl--unfollow-user (user-handle) "Query for USER-HANDLE from current status and unfollow that user." (interactive - (list - (mastodon-tl--interactive-user-handles-get "unfollow"))) + (list (mastodon-tl--interactive-user-handles-get "unfollow"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) (defun mastodon-tl--block-user (user-handle) "Query for USER-HANDLE from current status and block that user." (interactive - (list - (mastodon-tl--interactive-user-handles-get "block"))) + (list (mastodon-tl--interactive-user-handles-get "block"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "block"))) (defun mastodon-tl--unblock-user (user-handle) "Query for USER-HANDLE from list of blocked users and unblock that user." (interactive - (list - (mastodon-tl--interactive-blocks-or-mutes-list-get "unblock"))) + (list (mastodon-tl--get-blocks-or-mutes-list "unblock"))) (if (not user-handle) (message "Looks like you have no blocks to unblock!") (mastodon-tl--do-user-action-and-response user-handle "unblock" t))) @@ -1905,16 +1886,14 @@ LANGS is the accumulated array param alist if we re-run recursively." (defun mastodon-tl--mute-user (user-handle) "Query for USER-HANDLE from current status and mute that user." (interactive - (list - (mastodon-tl--interactive-user-handles-get "mute"))) + (list (mastodon-tl--interactive-user-handles-get "mute"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "mute"))) (defun mastodon-tl--unmute-user (user-handle) "Query for USER-HANDLE from list of muted users and unmute that user." (interactive - (list - (mastodon-tl--interactive-blocks-or-mutes-list-get "unmute"))) + (list (mastodon-tl--get-blocks-or-mutes-list "unmute"))) (if (not user-handle) (message "Looks like you have no mutes to unmute!") (mastodon-tl--do-user-action-and-response user-handle "unmute" t))) @@ -1922,8 +1901,7 @@ LANGS is the accumulated array param alist if we re-run recursively." (defun mastodon-tl--dm-user (user-handle) "Query for USER-HANDLE from current status and compose a message to that user." (interactive - (list - (mastodon-tl--interactive-user-handles-get "message"))) + (list (mastodon-tl--interactive-user-handles-get "message"))) (mastodon-tl--do-if-toot (mastodon-toot--compose-buffer (concat "@" user-handle)) (setq mastodon-toot--visibility "direct") @@ -1937,11 +1915,10 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; follow suggests / search / foll requests compat: (mastodon-tl--buffer-type-eq 'search) (mastodon-tl--buffer-type-eq 'follow-requests) - ;; profile view follows/followers compat: - ;; but not for profile statuses: - ;; fetch 'toot-json: + ;; profile follows/followers but not statuses: (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following)) + ;; fetch 'toot-json: (list (alist-get 'acct (mastodon-tl--property 'toot-json :no-move)))) ;; profile view, no toots @@ -1963,7 +1940,7 @@ LANGS is the accumulated array param alist if we re-run recursively." nil ; predicate 'confirm))))) -(defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) +(defun mastodon-tl--get-blocks-or-mutes-list (action) "Fetch the list of accounts for ACTION from the server. Action must be either \"unblock\" or \"unmute\"." (let* ((endpoint (cond ((equal action "unblock") @@ -1975,9 +1952,7 @@ Action must be either \"unblock\" or \"unmute\"." (accts (mastodon-tl--map-alist 'acct json))) (when accts (completing-read (format "Handle of user to %s: " action) - accts - nil ; predicate - t)))) + accts nil t)))) ; require match (defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify langs) @@ -1988,22 +1963,20 @@ If NOTIFY is \"false\", disable notifications when that user posts. NOTIFY is only non-nil when called by `mastodon-tl--follow-user'. LANGS is an array parameters alist of languages to filer user's posts by." (let* ((account (if negp - ;; if unmuting/unblocking, we got handle from mute/block list - (mastodon-profile--search-account-by-handle - user-handle) - ;; if profile view, use 'profile-json as status: + ;; unmuting/unblocking, handle from mute/block list + (mastodon-profile--search-account-by-handle user-handle) + ;; profile view, use 'profile-json as status: (if (mastodon-tl--profile-buffer-p) (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--profile-json)) - ;; if muting/blocking, we select from handles in current status + ;; muting/blocking, select from handles in current status (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json))))) (user-id (alist-get 'id account)) (name (if (not (string-empty-p (alist-get 'display_name account))) (alist-get 'display_name account) (alist-get 'username account))) - (args (cond (notify - `(("notify" . ,notify))) + (args (cond (notify `(("notify" . ,notify))) (langs langs) (t nil))) (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) @@ -2065,8 +2038,7 @@ If TAG is provided, unfollow it." (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) (tags (unless tag (mastodon-tl--map-alist 'name followed-tags-json))) - (tag (or tag (completing-read "Unfollow tag: " - tags))) + (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) (response (mastodon-http--post url))) (mastodon-http--triage response @@ -2165,7 +2137,6 @@ report the account for spam." (handle (alist-get 'acct account)) (params (mastodon-tl--report-params account toot)) (response (mastodon-http--post url params))) - ;; (setq masto-report-response response) (mastodon-http--triage response (lambda () (message "User %s reported!" handle))))))) @@ -2200,7 +2171,8 @@ report the account for spam." (url (mastodon-http--api endpoint))) (mastodon-http--get-json url args))) -(defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs) +(defun mastodon-tl--more-json-async + (endpoint id &optional params callback &rest cbargs) "Return JSON for timeline ENDPOINT before ID. Then run CALLBACK with arguments CBARGS. PARAMS is used to send any parameters needed to correctly update @@ -2247,10 +2219,9 @@ POS is a number, where point will be placed." endpoint) (mastodon-tl--thread (match-string 2 endpoint)))))) - ;; TODO: sends point to POS, which was where point was in buffer before - ;; reload. This is very rough; we may have removed an item (deleted a - ;; toot, cleared a notif), so the buffer will be smaller, point will end - ;; up past where we were, etc. + ;; TODO: sends point to where point was in buffer. This is very rough; we + ;; may have removed an item , so the buffer will be smaller, point will + ;; end up past where we were, etc. (when pos (goto-char pos) (mastodon-tl--goto-prev-item)))) @@ -2326,7 +2297,8 @@ HEADERS is the http headers returned in the response, if any." link-header)) (message "Loading older toots... done."))))) -(defun mastodon-tl--find-property-range (property start-point &optional search-backwards) +(defun mastodon-tl--find-property-range (property start-point + &optional search-backwards) "Return `nil` if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. @@ -2348,14 +2320,13 @@ before (non-nil) or after (nil)" (and (not (equal start-point (point-min))) (get-text-property (1- start-point) property) start-point))) - (start (and - end - (previous-single-property-change end property nil (point-min))))) + (start (and end (previous-single-property-change + end property nil (point-min))))) (when end (cons start end))) (let* ((start (next-single-property-change start-point property)) - (end (and start - (next-single-property-change start property nil (point-max))))) + (end (and start (next-single-property-change + start property nil (point-max))))) (when start (cons start end)))))) @@ -2404,7 +2375,8 @@ no-op." ;; We need to re-schedule for an earlier time (cancel-timer mastodon-tl--timestamp-update-timer) (setq mastodon-tl--timestamp-update-timer - (run-at-time (time-to-seconds (time-subtract this-update (current-time))) + (run-at-time (time-to-seconds (time-subtract this-update + (current-time))) nil ;; don't repeat #'mastodon-tl--update-timestamps-callback (current-buffer) nil))))))) @@ -2414,7 +2386,7 @@ no-op." Start searching for more timestamps from PREVIOUS-MARKER or from the start if it is nil." ;; only do things if the buffer hasn't been killed in the meantime - (when (and mastodon-tl--enable-relative-timestamps ;; should be true but just in case... + (when (and mastodon-tl--enable-relative-timestamps ; just in case (buffer-live-p buffer)) (save-excursion (with-current-buffer buffer @@ -2424,8 +2396,7 @@ from the start if it is nil." (iteration 0) next-timestamp-range) (if previous-marker - ;; This is a follow-up call to process the next batch of - ;; timestamps. + ;; a follow-up call to process the next batch of timestamps. ;; Release the marker to not slow things down. (set-marker previous-marker nil) ;; Otherwise this is a rew run, so let's initialize the next-run time. @@ -2444,8 +2415,9 @@ from the start if it is nil." (unless (string= current-display new-display) (let ((inhibit-read-only t)) (add-text-properties - start end (list 'display - (mastodon-tl--relative-time-description timestamp))))) + start end + (list 'display + (mastodon-tl--relative-time-description timestamp))))) (mastodon-tl--consider-timestamp-for-updates timestamp) (setq iteration (1+ iteration) previous-timestamp (1+ (cdr next-timestamp-range))))) @@ -2521,12 +2493,12 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (if headers - (mastodon-http--get-response-async url params - 'mastodon-tl--init* buffer endpoint update-function - headers params hide-replies) - (mastodon-http--get-json-async url params - 'mastodon-tl--init* buffer endpoint update-function nil - params hide-replies)))) + (mastodon-http--get-response-async + url params 'mastodon-tl--init* + buffer endpoint update-function headers params hide-replies) + (mastodon-http--get-json-async + url params 'mastodon-tl--init* + buffer endpoint update-function nil params hide-replies)))) (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers update-params hide-replies) @@ -2541,12 +2513,8 @@ JSON and http headers, without it just the JSON." (let* ((headers (if headers (cdr response) nil)) (link-header (mastodon-tl--get-link-header-from-response headers))) (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header - update-params - hide-replies) + (mastodon-tl--set-buffer-spec buffer endpoint update-function + link-header update-params hide-replies) (funcall update-function json) (setq ;; Initialize with a minimal interval; we re-scan at least once @@ -2565,7 +2533,8 @@ JSON and http headers, without it just the JSON." (unless (mastodon-tl--profile-buffer-p) (mastodon-tl--goto-first-item))))))) -(defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type) +(defun mastodon-tl--init-sync (buffer-name endpoint update-function + &optional note-type) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. Runs synchronously. @@ -2574,8 +2543,6 @@ Optional arg NOTE-TYPE means only get that type of note." (mastodon-notifications--filter-types-list note-type))) (args (when note-type (mastodon-http--build-array-params-alist "exclude_types[]" exclude-types))) - ;; NB: we now store 'update-params separately in `mastodon-tl--buffer-spec' - ;; and -http.el handles all conversion of params alists into query strings. (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*")) (json (mastodon-http--get-json url args))) @@ -2597,7 +2564,6 @@ Optional arg NOTE-TYPE means only get that type of note." (current-buffer) nil))) (unless (mastodon-tl--profile-buffer-p) - ;; FIXME: this breaks test (because test has empty buffer) (mastodon-tl--goto-first-item))) buffer)) -- cgit v1.2.3 From 0152557eb84237425c7fac1aa107b73c7ece98dd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 14:56:02 +0200 Subject: indent buffers --- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-tl.el | 22 +++++++++++----------- lisp/mastodon-toot.el | 18 +++++++++--------- 3 files changed, 22 insertions(+), 22 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 384f9a9..0c6e3b2 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -755,9 +755,9 @@ These include the author, author of reblogged entries and any user mentioned." (when status (let ((this-account (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) + (mentions (or (alist-get 'mentions (alist-get 'status status)) (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) + (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter #'stringp (seq-uniq diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1c0d878..79897bd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -479,12 +479,12 @@ With arg AVATAR, include the account's avatar image." (propertize (concat "@" .account.acct) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account .account - 'shr-url .account.url - 'keymap mastodon-tl--link-keymap + 'shr-url .account.url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" .account.acct) - 'help-echo (concat "Browse user profile of @" .account.acct)) + 'help-echo (concat "Browse user profile of @" .account.acct)) ")"))) (defun mastodon-tl--format-byline-help-echo (toot) @@ -635,10 +635,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat " " @@ -1388,8 +1388,8 @@ THREAD means the status will be displayed in a thread view." (mastodon-tl--get-buffer-property 'hide-replies nil :no-error) ;; loading a tl with a prefix arg: (mastodon-tl--hide-replies-p current-prefix-arg)) - (cl-remove-if-not #'mastodon-tl--is-reply toots) - toots))) + (cl-remove-if-not #'mastodon-tl--is-reply toots) + toots))) (goto-char (point-min))) @@ -1918,7 +1918,7 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; profile follows/followers but not statuses: (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following)) - ;; fetch 'toot-json: + ;; fetch 'toot-json: (list (alist-get 'acct (mastodon-tl--property 'toot-json :no-move)))) ;; profile view, no toots @@ -2509,7 +2509,7 @@ RESPONSE is the data returned from the server by JSON and http headers, without it just the JSON." (let ((json (if headers (car response) response))) (if (not json) ; praying this is right here, else try "\n[]" - (message "Looks like nothing returned from endpoint: %s" endpoint) + (message "Looks like nothing returned from endpoint: %s" endpoint) (let* ((headers (if headers (cdr response) nil)) (link-header (mastodon-tl--get-link-header-from-response headers))) (with-mastodon-buffer buffer #'mastodon-mode nil diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 11b2bc0..cbf0447 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -919,7 +919,7 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. Remove empty string (self) from result and joins the sequence with whitespace." (mapconcat (lambda (mention) mention) - (remove "" (mapcar #'mastodon-toot--process-local mentions)) + (remove "" (mapcar #'mastodon-toot--process-local mentions)) " ")) (defun mastodon-toot--process-local (acct) @@ -941,8 +941,8 @@ Local user (including the logged in): `username`. Federated user: `username@host.co`." (let* ((boosted (mastodon-tl--field 'reblog status)) (mentions (if boosted - (alist-get 'mentions (alist-get 'reblog status)) - (alist-get 'mentions status)))) + (alist-get 'mentions (alist-get 'reblog status)) + (alist-get 'mentions status)))) ;; reverse does not work on vectors in 24.5 (mastodon-tl--map-alist 'acct (reverse mentions)))) @@ -1049,17 +1049,17 @@ text of the toot being replied to in the compose buffer." (if (and (not (equal user booster)) (not (member booster mentions))) ;; different booster, user and mentions: - (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) + (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) ;; booster is either user or in mentions: (if (not (member user mentions)) ;; user not already in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) ;; user already in mentions: (mastodon-toot--mentions-to-string (copy-sequence mentions)))) ;; ELSE no booster: (if (not (member user mentions)) ;; user not in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) ;; user in mentions already: (mastodon-toot--mentions-to-string (copy-sequence mentions))))) id @@ -1443,16 +1443,16 @@ REPLY-TEXT is the text of the toot being replied to." The default is given by `mastodon-toot--default-reply-visibility'." (unless (null reply-visibility) (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) - mastodon-toot-visibility-list))) + mastodon-toot-visibility-list))) (if (member (intern reply-visibility) less-restrictive) - mastodon-toot--default-reply-visibility reply-visibility)))) + mastodon-toot--default-reply-visibility reply-visibility)))) (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. REPLY-JSON is the full JSON of the toot being replied to." (let ((reply-visibility (mastodon-toot--most-restrictive-visibility - (alist-get 'visibility reply-json))) + (alist-get 'visibility reply-json))) (reply-cw (alist-get 'spoiler_text reply-json))) (when reply-to-user (when (> (length reply-to-user) 0) ; self is "" unforch -- cgit v1.2.3 From 9722f59b00fe76994d01ce980d619bb04b87b9ff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 14:54:01 +0200 Subject: remove overlays in tl--init*/-sync --- lisp/mastodon-tl.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 79897bd..9920aeb 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2509,12 +2509,13 @@ RESPONSE is the data returned from the server by JSON and http headers, without it just the JSON." (let ((json (if headers (car response) response))) (if (not json) ; praying this is right here, else try "\n[]" - (message "Looks like nothing returned from endpoint: %s" endpoint) + (message "Looks like nothing returned from endpoint: %s" endpoint) (let* ((headers (if headers (cdr response) nil)) (link-header (mastodon-tl--get-link-header-from-response headers))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header update-params hide-replies) + (remove-overlays) ; video overlays (funcall update-function json) (setq ;; Initialize with a minimal interval; we re-scan at least once @@ -2552,6 +2553,7 @@ Optional arg NOTE-TYPE means only get that type of note." ;; every 5 minutes to catch any timestamps we may have missed mastodon-tl--timestamp-next-update (time-add (current-time) (seconds-to-time 300))) + (remove-overlays) ; video overlays (funcall update-function json) (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args) (setq mastodon-tl--timestamp-update-timer -- cgit v1.2.3 From 5c6a6815b116c07439051228840333b47dc763cf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 11 May 2023 19:57:31 +0200 Subject: fix poll count display. --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9920aeb..1ddc708 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1076,7 +1076,7 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." "Format poll OPTION. OPTION-COUNTER is just a counter. LONGEST-OPTION is the option whose length determines the formatting." (format "%s: %s%s%s\n" - (setq option-counter (1+ option-counter)) + option-counter (propertize (alist-get 'title option) 'face 'success) (make-string (1+ (- (length longest-option) @@ -1097,6 +1097,7 @@ LONGEST-OPTION is the option whose length determines the formatting." (option-counter 0)) (concat "\nPoll: \n\n" (mapconcat (lambda (option) + (setq option-counter (1+ option-counter)) (mastodon-tl--format-poll-option option option-counter longest-option)) .options -- cgit v1.2.3 From 156ee6ea522f3c6eb23ae8a78e210d0da88d3f7a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 12 May 2023 11:36:12 +0200 Subject: follow-tag: use tag at point by default --- lisp/mastodon-tl.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1ddc708..bcbb7e3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2020,7 +2020,11 @@ ARGS is an alist of any parameters to send with the request." "Prompt for a tag and follow it. If TAG provided, follow it." (interactive) - (let* ((tag (or tag (read-string "Tag to follow: "))) + (let* ((tag-at-point + (when (eq 'hashtag (get-text-property (point) 'mastodon-tab-stop)) + (get-text-property (point) 'mastodon-tag))) + (tag (or tag (read-string (format "Tag to follow [%s]: " tag-at-point) + nil nil tag-at-point))) (url (mastodon-http--api (format "tags/%s/follow" tag))) (response (mastodon-http--post url))) (mastodon-http--triage response -- cgit v1.2.3 From e34cc6acb20f9f32b42d0d51ce127a5c8a6778ae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 12 May 2023 15:04:42 +0200 Subject: FIX #467. follow tag: prompt for tags in post, default tag at point. --- lisp/mastodon-tl.el | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index bcbb7e3..f682c50 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2016,15 +2016,27 @@ ARGS is an alist of any parameters to send with the request." ;; FOLLOW TAGS +(defun mastodon-tl--get-tags-list () + "Return the list of tags of the toot at point." + (let* ((toot (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs + (mastodon-tl--property 'toot-json :no-move))) + (tags (mastodon-tl--field 'tags toot))) + (mapcar (lambda (x) + (alist-get 'name x)) + tags))) + (defun mastodon-tl--follow-tag (&optional tag) "Prompt for a tag and follow it. If TAG provided, follow it." (interactive) - (let* ((tag-at-point - (when (eq 'hashtag (get-text-property (point) 'mastodon-tab-stop)) - (get-text-property (point) 'mastodon-tag))) - (tag (or tag (read-string (format "Tag to follow [%s]: " tag-at-point) - nil nil tag-at-point))) + (let* ((tags (unless tag (mastodon-tl--get-tags-list))) + (tag-at-point + (unless tag + (when (eq 'hashtag (get-text-property (point) 'mastodon-tab-stop)) + (get-text-property (point) 'mastodon-tag)))) + (tag (or tag (completing-read + (format "Tag to follow [%s]: " tag-at-point) + tags nil nil nil nil tag-at-point))) (url (mastodon-http--api (format "tags/%s/follow" tag))) (response (mastodon-http--post url))) (mastodon-http--triage response -- cgit v1.2.3 From c53f8c544283d7e82ce99d830defdbde16ea79f4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:09:54 +0200 Subject: no kw arg for completing-read require-match --- lisp/mastodon-tl.el | 2 +- lisp/mastodon-views.el | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f682c50..8114705 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2174,7 +2174,7 @@ report the account for spam." (crm-separator (replace-regexp-in-string "," "|" crm-separator)) (choices (completing-read-multiple "rules [TAB for options, | to separate]: " - alist nil :match))) + alist nil t))) (mapcar (lambda (x) (alist-get x alist nil nil 'equal)) choices))) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 790c548..7d5ac1e 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -291,7 +291,7 @@ If ID is provided, use that list." (name-choice (read-string "List name: " name-old)) (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") - nil :match nil nil "list")) + nil t nil nil "list")) (url (mastodon-http--api (format "lists/%s" id))) (response (mastodon-http--put url `(("title" . ,name-choice) @@ -333,7 +333,7 @@ Prompt for name and replies policy." (let* ((title (read-string "New list name: ")) (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") - nil :match nil nil "list")) ; default + nil t nil nil "list")) ; default (response (mastodon-http--post (mastodon-http--api "lists") `(("title" . ,title) ("replies_policy" . ,replies-policy)) @@ -621,7 +621,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (completing-read-multiple "Contexts to filter [TAB for options]: " '("home" "notifications" "public" "thread") - nil :match))) + nil t))) (contexts-processed (if (equal nil contexts) (error "You must select at least one context for a filter") -- cgit v1.2.3 From 7b07c95304689e297b72114f0c425a6ce9aada57 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:15:41 +0200 Subject: tiny audits in profile.el and tl.el --- lisp/mastodon-profile.el | 61 +++++++++++++++++++++++------------------------- lisp/mastodon-tl.el | 7 ++---- 2 files changed, 31 insertions(+), 37 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index fe1e1dc..6bfe64c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -345,13 +345,11 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." (source-keys '(privacy sensitive language))) (mapc (lambda (k) (mastodon-profile--update-preference-plist - k - (mastodon-profile--get-json-value k))) + k (mastodon-profile--get-json-value k))) keys) (mapc (lambda (sk) (mastodon-profile--update-preference-plist - sk - (mastodon-profile--get-source-value sk))) + sk (mastodon-profile--get-source-value sk))) source-keys) ;; hack for max toot chars: (mastodon-toot--get-max-toot-chars :no-toot) @@ -401,9 +399,8 @@ Current settings are fetched from the server." (defun mastodon-profile--edit-string-value (key) "Edit the string for account preference KEY." (let* ((val (mastodon-profile--get-json-value key)) - (new-val - (read-string (format "Edit account setting %s: " key) - val))) + (new-val (read-string (format "Edit account setting %s: " key) + val))) (mastodon-profile--update-preference (symbol-name key) new-val))) (defun mastodon-profile--update-display-name () @@ -432,8 +429,8 @@ Returns an alist." (mastodon-http--triage response (lambda () (mastodon-profile--fetch-server-account-settings) - (message "Account setting %s updated to %s!" - "metadata fields" fields-updated))))) + (message "Metadata fields updated to %s!" + fields-updated))))) (defun mastodon-profile--update-meta-fields-alist () "Prompt for new metadata fields information. @@ -481,11 +478,10 @@ This endpoint only holds a few preferences. For others, see (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil) (while response (let ((el (pop response))) - (insert - (format "%-30s %s" - (prin1-to-string (car el)) - (prin1-to-string (cdr el))) - "\n\n"))) + (insert (format "%-30s %s" + (prin1-to-string (car el)) + (prin1-to-string (cdr el))) + "\n\n"))) (goto-char (point-min))))) @@ -706,22 +702,23 @@ Also insert their profile note. Used to view a user's followers and those they're following." (let ((inhibit-read-only t)) (unless (seq-empty-p tootv) - (mapc (lambda (toot) - (let ((start-pos (point))) - (insert "\n" - (propertize - (mastodon-tl--byline-author `((account . ,toot)) :avatar) - 'byline 't - 'toot-id (alist-get 'id toot) - 'base-toot-id (mastodon-tl--toot-id toot) - 'toot-json toot)) - (mastodon-media--inline-images start-pos (point)) - (insert "\n" - (propertize - (mastodon-tl--render-text (alist-get 'note toot) nil) - 'toot-json toot) - "\n"))) - tootv)))) + (mapc + (lambda (toot) + (let ((start-pos (point))) + (insert "\n" + (propertize + (mastodon-tl--byline-author `((account . ,toot)) :avatar) + 'byline 't + 'toot-id (alist-get 'id toot) + 'base-toot-id (mastodon-tl--toot-id toot) + 'toot-json toot)) + (mastodon-media--inline-images start-pos (point)) + (insert "\n" + (propertize + (mastodon-tl--render-text (alist-get 'note toot) nil) + 'toot-json toot) + "\n"))) + tootv)))) (defun mastodon-profile--search-account-by-handle (handle) "Return an account based on a user's HANDLE. @@ -750,9 +747,9 @@ These include the author, author of reblogged entries and any user mentioned." (when status (let ((this-account (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) + (mentions (or (alist-get 'mentions (alist-get 'status status)) (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) + (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter #'stringp (seq-uniq diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8114705..8fb0f5e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2231,11 +2231,8 @@ POS is a number, where point will be placed." ((eq type 'thread) (save-match-data (let ((endpoint (mastodon-tl--get-endpoint))) - (string-match - "statuses/\\(?2:[[:digit:]]+\\)/context" - endpoint) - (mastodon-tl--thread - (match-string 2 endpoint)))))) + (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" endpoint) + (mastodon-tl--thread (match-string 2 endpoint)))))) ;; TODO: sends point to where point was in buffer. This is very rough; we ;; may have removed an item , so the buffer will be smaller, point will ;; end up past where we were, etc. -- cgit v1.2.3 From da2e9048315dfa83a830eb11e656eb33bf95a85a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 13:32:24 +0200 Subject: no stats for foll/foll_req notifs --- lisp/mastodon-tl.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8fb0f5e..592f993 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -579,6 +579,7 @@ this just means displaying toot client." (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) (avatar-url (alist-get 'avatar account)) + (type (alist-get 'type toot)) (edited-time (alist-get 'edited_at toot)) (edited-parsed (when edited-time (date-to-time edited-time)))) (concat @@ -635,10 +636,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat " " @@ -655,7 +656,8 @@ this just means displaying toot client." "") (propertize (concat "\n " mastodon-tl--horiz-bar) 'face 'default) - (if mastodon-tl--show-stats + (if (and mastodon-tl--show-stats + (not (member type '("follow" "follow_request")))) (mastodon-tl--toot-stats toot) "") "\n") -- cgit v1.2.3 From e2eab3970d9821c0985777be44cdb24c0431403f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 21:37:38 +0200 Subject: factor out mastodon-tl--do-init --- lisp/mastodon-tl.el | 62 +++++++++++++++++++++-------------------------------- 1 file changed, 25 insertions(+), 37 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 592f993..7a7eae9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2531,24 +2531,7 @@ JSON and http headers, without it just the JSON." (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header update-params hide-replies) - (remove-overlays) ; video overlays - (funcall update-function json) - (setq - ;; Initialize with a minimal interval; we re-scan at least once - ;; every 5 minutes to catch any timestamps we may have missed - mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) - (setq mastodon-tl--timestamp-update-timer - (when mastodon-tl--enable-relative-timestamps - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil))) - (unless (mastodon-tl--profile-buffer-p) - (mastodon-tl--goto-first-item))))))) + (mastodon-tl--do-init json update-function)))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type) @@ -2564,26 +2547,31 @@ Optional arg NOTE-TYPE means only get that type of note." (buffer (concat "*mastodon-" buffer-name "*")) (json (mastodon-http--get-json url args))) (with-mastodon-buffer buffer #'mastodon-mode nil - (setq - ;; Initialize with a minimal interval; we re-scan at least once - ;; every 5 minutes to catch any timestamps we may have missed - mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) - (remove-overlays) ; video overlays - (funcall update-function json) (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args) - (setq mastodon-tl--timestamp-update-timer - (when mastodon-tl--enable-relative-timestamps - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil))) - (unless (mastodon-tl--profile-buffer-p) - (mastodon-tl--goto-first-item))) - buffer)) + (mastodon-tl--do-init json update-function) + buffer))) + +(defun mastodon-tl--do-init (json update-fun) + "Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'. +JSON is the data to call UPDATE-FUN on." + (remove-overlays) ; video overlays + (funcall update-fun json) + (setq + ;; Initialize with a minimal interval; we re-scan at least once + ;; every 5 minutes to catch any timestamps we may have missed + mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300))) + (setq mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil))) + (unless (mastodon-tl--profile-buffer-p) + (mastodon-tl--goto-first-item))) (provide 'mastodon-tl) ;;; mastodon-tl.el ends here -- cgit v1.2.3 From d7d88f4676d084a9bfdb95977142c2cde938218a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 21:38:32 +0200 Subject: indent -tl.el --- lisp/mastodon-tl.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7a7eae9..941fb94 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -479,12 +479,12 @@ With arg AVATAR, include the account's avatar image." (propertize (concat "@" .account.acct) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account .account - 'shr-url .account.url - 'keymap mastodon-tl--link-keymap + 'shr-url .account.url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" .account.acct) - 'help-echo (concat "Browse user profile of @" .account.acct)) + 'help-echo (concat "Browse user profile of @" .account.acct)) ")"))) (defun mastodon-tl--format-byline-help-echo (toot) @@ -1391,8 +1391,8 @@ THREAD means the status will be displayed in a thread view." (mastodon-tl--get-buffer-property 'hide-replies nil :no-error) ;; loading a tl with a prefix arg: (mastodon-tl--hide-replies-p current-prefix-arg)) - (cl-remove-if-not #'mastodon-tl--is-reply toots) - toots))) + (cl-remove-if-not #'mastodon-tl--is-reply toots) + toots))) (goto-char (point-min))) -- cgit v1.2.3 From 122368ac1f418ab0ed54da0f6b8a657cc309a5f0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 21:40:38 +0200 Subject: if not in tl--set-after-update-marker --- lisp/mastodon-tl.el | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 941fb94..47a1216 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2455,23 +2455,23 @@ from the start if it is nil." "Set `mastodon-tl--after-update-marker' to the after-update location. This location is defined by a non-nil value of `mastodon-tl-position-after-update'." - (if mastodon-tl-position-after-update - (let ((marker (make-marker))) - (set-marker marker - (cond - ((eq 'keep-point mastodon-tl-position-after-update) - (point)) - ((eq 'last-old-toot mastodon-tl-position-after-update) - (next-single-property-change - (or mastodon-tl--update-point (point-min)) - 'byline)) - (t - (error "Unknown mastodon-tl-position-after-update value %S" - mastodon-tl-position-after-update)))) - ;; Make the marker advance if text gets inserted there. - (set-marker-insertion-type marker t) - (setq mastodon-tl--after-update-marker marker)) - (setq mastodon-tl--after-update-marker nil))) + (if (not mastodon-tl-position-after-update) + (setq mastodon-tl--after-update-marker nil) + (let ((marker (make-marker))) + (set-marker marker + (cond + ((eq 'keep-point mastodon-tl-position-after-update) + (point)) + ((eq 'last-old-toot mastodon-tl-position-after-update) + (next-single-property-change + (or mastodon-tl--update-point (point-min)) + 'byline)) + (t + (error "Unknown mastodon-tl-position-after-update value %S" + mastodon-tl-position-after-update)))) + ;; Make the marker advance if text gets inserted there. + (set-marker-insertion-type marker t) + (setq mastodon-tl--after-update-marker marker)))) (defun mastodon-tl--update () "Update timeline with new toots." -- cgit v1.2.3 From ebbeaa745a107b0ebba25858553b6a52532f672d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 21:44:52 +0200 Subject: rename buffer-spec get funs --- lisp/mastodon-tl.el | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 47a1216..fa2bca6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1388,7 +1388,7 @@ THREAD means the status will be displayed in a thread view." (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) toots (if (or ; we were called via --more*: - (mastodon-tl--get-buffer-property 'hide-replies nil :no-error) + (mastodon-tl--buffer-property 'hide-replies nil :no-error) ;; loading a tl with a prefix arg: (mastodon-tl--hide-replies-p current-prefix-arg)) (cl-remove-if-not #'mastodon-tl--is-reply toots) @@ -1398,34 +1398,34 @@ THREAD means the status will be displayed in a thread view." ;;; BUFFER SPEC -(defun mastodon-tl--get-update-function (&optional buffer) +(defun mastodon-tl--update-function (&optional buffer) "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'update-function buffer)) + (mastodon-tl--buffer-property 'update-function buffer)) -(defun mastodon-tl--get-endpoint (&optional buffer no-error) +(defun mastodon-tl--endpoint (&optional buffer no-error) "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'. Optionally set it for BUFFER. NO-ERROR means to fail silently." - (mastodon-tl--get-buffer-property 'endpoint buffer no-error)) + (mastodon-tl--buffer-property 'endpoint buffer no-error)) (defun mastodon-tl--buffer-name (&optional buffer no-error) "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER. NO-ERROR means to fail silently." - (mastodon-tl--get-buffer-property 'buffer-name buffer no-error)) + (mastodon-tl--buffer-property 'buffer-name buffer no-error)) (defun mastodon-tl--link-header (&optional buffer) "Get the LINK HEADER stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'link-header buffer :no-error)) + (mastodon-tl--buffer-property 'link-header buffer :no-error)) (defun mastodon-tl--update-params (&optional buffer) "Get the UPDATE PARAMS stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'update-params buffer :no-error)) + (mastodon-tl--buffer-property 'update-params buffer :no-error)) -(defun mastodon-tl--get-buffer-property (property &optional buffer no-error) +(defun mastodon-tl--buffer-property (property &optional buffer no-error) "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'. If NO-ERROR is non-nil, do not error when property is empty." (with-current-buffer (or buffer (current-buffer)) @@ -1459,7 +1459,7 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." (defun mastodon-tl--endpoint-str-= (str &optional type) "Return T if STR is equal to the current buffer's endpoint. TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix." - (let ((endpoint-fun (mastodon-tl--get-endpoint nil :no-error))) + (let ((endpoint-fun (mastodon-tl--endpoint nil :no-error))) (cond ((eq type :prefix) (string-prefix-p str endpoint-fun)) ((eq type :suffix) @@ -1559,7 +1559,7 @@ call this function after it is set or use something else." (defun mastodon-tl--profile-buffer-p () "Return t if current buffer is a profile buffer of any kind. This includes the update profile note buffer, but not the preferences one." - (string-prefix-p "accounts" (mastodon-tl--get-endpoint nil :no-error))) + (string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error))) (defun mastodon-tl--timeline-proper-p () "Return non-nil if the current buffer is a 'proper' timeline. @@ -1751,7 +1751,7 @@ Note that you can only (un)mute threads you have posted in." (defun mastodon-tl--mute-or-unmute-thread (&optional unmute) "Mute a thread. If UNMUTE, unmute it." - (let ((endpoint (mastodon-tl--get-endpoint))) + (let ((endpoint (mastodon-tl--endpoint))) (if (mastodon-tl--buffer-type-eq 'thread) (let* ((id (save-match-data @@ -2232,7 +2232,7 @@ POS is a number, where point will be placed." (mastodon-profile--my-profile)) ((eq type 'thread) (save-match-data - (let ((endpoint (mastodon-tl--get-endpoint))) + (let ((endpoint (mastodon-tl--endpoint))) (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" endpoint) (mastodon-tl--thread (match-string 2 endpoint)))))) ;; TODO: sends point to where point was in buffer. This is very rough; we @@ -2280,7 +2280,7 @@ when showing followers or accounts followed." (mastodon-http--get-response-async url nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) (mastodon-tl--more-json-async - (mastodon-tl--get-endpoint) + (mastodon-tl--endpoint) (mastodon-tl--oldest-id) (mastodon-tl--update-params) 'mastodon-tl--more* (current-buffer) (point)))) @@ -2301,21 +2301,21 @@ HEADERS is the http headers returned in the response, if any." ;; if thread view, call --thread with parent ID (progn (goto-char (point-min)) (mastodon-tl--goto-next-toot) - (funcall (mastodon-tl--get-update-function))) - (funcall (mastodon-tl--get-update-function) json)) + (funcall (mastodon-tl--update-function))) + (funcall (mastodon-tl--update-function) json)) (goto-char point-before) ;; update buffer spec to new link-header: ;; (other values should just remain as they were) (when headers (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) - (mastodon-tl--get-endpoint) - (mastodon-tl--get-update-function) + (mastodon-tl--endpoint) + (mastodon-tl--update-function) link-header)) (message "Loading older toots... done."))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) - "Return `nil` if no such range is found. + "Return nil if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. SEARCH-BACKWARDS determines whether we pick point @@ -2476,8 +2476,8 @@ This location is defined by a non-nil value of (defun mastodon-tl--update () "Update timeline with new toots." (interactive) - (let* ((endpoint (mastodon-tl--get-endpoint)) - (update-function (mastodon-tl--get-update-function)) + (let* ((endpoint (mastodon-tl--endpoint)) + (update-function (mastodon-tl--update-function)) (thread-id (mastodon-tl--property 'toot-id))) ;; update a thread, without calling `mastodon-tl--updated-json': (if (mastodon-tl--buffer-type-eq 'thread) -- cgit v1.2.3 From 1adae0361a479003946ab804567d835627314197 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 21:48:12 +0200 Subject: macros together in tl.el --- lisp/mastodon-tl.el | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fa2bca6..1b7c954 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -257,7 +257,7 @@ types of mastodon links and not just shr.el-generated ones.") It is active where point is placed by `mastodon-tl--goto-next-toot.'") -;;; BUFFER MACRO +;;; MACROS (defmacro with-mastodon-buffer (buffer mode-fun other-window &rest body) "Evaluate BODY in a new or existing buffer called BUFFER. @@ -275,6 +275,21 @@ than `switch-to-buffer'." (switch-to-buffer ,buffer)) ,@body))) +(defmacro mastodon-tl--do-if-toot (&rest body) + "Execute BODY if we have a toot or user at point." + (declare (debug t)) + `(if (and (not (mastodon-tl--profile-buffer-p)) + (not (mastodon-tl--property 'toot-json))) ; includes user listings + (message "Looks like there's no toot or user at point?") + ,@body)) + +(defmacro mastodon-tl--do-if-toot-strict (&rest body) + "Execute BODY if we have a toot, and only a toot, at point." + (declare (debug t)) + `(if (not (mastodon-tl--property 'toot-id :no-move)) + (message "Looks like there's no toot at point?") + ,@body)) + ;;; NAV @@ -1798,21 +1813,6 @@ ID is that of the post the context is currently displayed for." ;;; FOLLOW/BLOCK/MUTE, ETC -(defmacro mastodon-tl--do-if-toot (&rest body) - "Execute BODY if we have a toot or user at point." - (declare (debug t)) - `(if (and (not (mastodon-tl--profile-buffer-p)) - (not (mastodon-tl--property 'toot-json))) ; includes user listings - (message "Looks like there's no toot or user at point?") - ,@body)) - -(defmacro mastodon-tl--do-if-toot-strict (&rest body) - "Execute BODY if we have a toot, and only a toot, at point." - (declare (debug t)) - `(if (not (mastodon-tl--property 'toot-id :no-move)) - (message "Looks like there's no toot at point?") - ,@body)) - (defun mastodon-tl--follow-user (user-handle &optional notify langs) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. -- cgit v1.2.3 From 6318ddd80bc6442b4d32454cc043dc9ba873e29a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 22:01:33 +0200 Subject: tiny comments/wrap --- lisp/mastodon-tl.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1b7c954..e26645e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -843,7 +843,6 @@ LINK is maybe the `@handle' to search for." LINK should be a simple handle string with no domain, i.e. \"@user\". Return nil if no matching element." ;; Must return nil if nothing found! - ;; TODO: we should break the while loop as soon as we get sth (let ((mentions (append (alist-get 'mentions toot) nil))) (when mentions (let* ((mention (pop mentions)) @@ -986,8 +985,7 @@ content should be hidden." (defun mastodon-tl--clean-tabs-and-nl (string) "Remove tabs and newlines from STRING." - (replace-regexp-in-string - "[\t\n ]*\\'" "" string)) + (replace-regexp-in-string "[\t\n ]*\\'" "" string)) (defun mastodon-tl--spoiler (toot) "Render TOOT with spoiler message. -- cgit v1.2.3 From e0a69c9b25224b9dadb6c533c188de34673245d6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 22:01:46 +0200 Subject: let-alist tl--media-attachment --- lisp/mastodon-tl.el | 40 ++++++++++++++++------------------------ 1 file changed, 16 insertions(+), 24 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e26645e..6f9a985 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1035,30 +1035,22 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media-attachment (media-attachment) "Return a propertized string for MEDIA-ATTACHMENT." - (let* ((preview-url (alist-get 'preview_url media-attachment)) - (remote-url (or (alist-get 'remote_url media-attachment) - (alist-get 'url media-attachment))) ; for notifs - (type (alist-get 'type media-attachment)) - (caption (alist-get 'description media-attachment)) - (display-str - (if (and mastodon-tl--display-caption-not-url-when-no-media - caption) - (concat "Media:: " caption) - (concat "Media:: " preview-url)))) - (if mastodon-tl--display-media-p - ;; return placeholder [img]: - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - ;; return URL/caption: - (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) ; string - preview-url remote-url type caption - display-str ; display - ;; FIXME: shr-link underlining is awful for captions with - ;; newlines, as the underlining runs to the edge of the - ;; frame even if the text doesn't - 'shr-link) - "\n")))) + (let-alist media-attachment + (let ((display-str + (if (and mastodon-tl--display-caption-not-url-when-no-media + .description) + (concat "Media:: " .description) + (concat "Media:: " .preview_url)))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering ; placeholder: "[img]" + .preview_url (or .remote_url .url) .type .description) ; 2nd arg for shr-browse-url + ;; return URL/caption: + (concat (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " .preview_url) ; string + .preview_url .remote_url .type .description + display-str ; display + 'shr-link) + "\n"))))) (defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type help-echo &optional display face) -- cgit v1.2.3 From b16a09f9b488098b818ac68c10a9a199db215d46 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 22:08:10 +0200 Subject: move list call in tl--read-poll-option --- lisp/mastodon-tl.el | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6f9a985..0977475 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1148,27 +1148,27 @@ LONGEST-OPTION is the option whose length determines the formatting." (defun mastodon-tl--read-poll-option () "Read a poll option to vote on a poll." - (list (let* ((toot (mastodon-tl--property 'toot-json)) - (poll (mastodon-tl--field 'poll toot)) - (options (mastodon-tl--field 'options poll)) - (options-titles (mastodon-tl--map-alist 'title options)) - (options-number-seq (number-sequence 1 (length options))) - (options-numbers (mapcar #'number-to-string options-number-seq)) - (options-alist (cl-mapcar #'cons options-numbers options-titles)) - ;; we display both option number and the option title - ;; but also store both as cons cell as cdr, as we need it below - (candidates (mapcar (lambda (cell) - (cons (format "%s | %s" (car cell) (cdr cell)) - cell)) - options-alist))) - (if (null poll) - (message "No poll here.") - ;; var "option" = just the cdr, a cons of option number and desc - (cdr (assoc (completing-read "Poll option to vote for: " - candidates - nil - t) ; require match - candidates)))))) + (let* ((toot (mastodon-tl--property 'toot-json)) + (poll (mastodon-tl--field 'poll toot)) + (options (mastodon-tl--field 'options poll)) + (options-titles (mastodon-tl--map-alist 'title options)) + (options-number-seq (number-sequence 1 (length options))) + (options-numbers (mapcar #'number-to-string options-number-seq)) + (options-alist (cl-mapcar #'cons options-numbers options-titles)) + ;; we display both option number and the option title + ;; but also store both as cons cell as cdr, as we need it below + (candidates (mapcar (lambda (cell) + (cons (format "%s | %s" (car cell) (cdr cell)) + cell)) + options-alist))) + (if (null poll) + (message "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: " + candidates + nil t) ; require match + candidates)))))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." -- cgit v1.2.3 From bc7be89d5297b5e2cd7b31a9281123578eb5c5bc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 22:12:36 +0200 Subject: tl--content: use tl--field --- lisp/mastodon-tl.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0977475..90c2cbf 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1237,10 +1237,7 @@ in which case play first video or gif from current toot." "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." (let* ((content (mastodon-tl--field 'content toot)) - (reblog (alist-get 'reblog toot)) - (poll-p (if reblog - (alist-get 'poll reblog) - (alist-get 'poll toot)))) + (poll-p (mastodon-tl--field 'poll toot))) (concat (mastodon-tl--render-text content toot) (when poll-p (mastodon-tl--get-poll toot)) -- cgit v1.2.3 From 34979f1a660f687795e10e2130bf05863181717b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 23 May 2023 22:23:53 +0200 Subject: tiny refactor tl--mute-or-unmute-thread --- lisp/mastodon-tl.el | 42 +++++++++++++++++++----------------------- 1 file changed, 19 insertions(+), 23 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 90c2cbf..95a1456 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1753,29 +1753,25 @@ Note that you can only (un)mute threads you have posted in." (defun mastodon-tl--mute-or-unmute-thread (&optional unmute) "Mute a thread. If UNMUTE, unmute it." - (let ((endpoint (mastodon-tl--endpoint))) - (if (mastodon-tl--buffer-type-eq 'thread) - (let* ((id - (save-match-data - (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" - endpoint) - (match-string 2 endpoint))) - (we-posted-p (mastodon-tl--user-in-thread-p id)) - (url (mastodon-http--api - (if unmute - (format "statuses/%s/unmute" id) - (format "statuses/%s/mute" id))))) - (if (not we-posted-p) - (message "You can only (un)mute a thread you have posted in.") - (when (if unmute - (y-or-n-p "Unnute this thread? ") - (y-or-n-p "Mute this thread? ")) - (let ((response (mastodon-http--post url))) - (mastodon-http--triage response - (lambda () - (if unmute - (message "Thread unmuted!") - (message "Thread muted!"))))))))))) + (let ((endpoint (mastodon-tl--endpoint)) + (mute-str (if unmute "unmute" "mute"))) + (when (mastodon-tl--buffer-type-eq 'thread) + (let* ((id + (save-match-data + (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" + endpoint) + (match-string 2 endpoint))) + (we-posted-p (mastodon-tl--user-in-thread-p id)) + (url (mastodon-http--api (format "statuses/%s/%s" id mute-str)))) + (if (not we-posted-p) + (message "You can only (un)mute a thread you have posted in.") + (when (y-or-n-p (format "%s this thread? " (capitalize mute-str))) + (let ((response (mastodon-http--post url))) + (mastodon-http--triage response + (lambda () + (if unmute + (message "Thread unmuted!") + (message "Thread muted!"))))))))))) (defun mastodon-tl--map-account-id-from-toot (statuses) "Return a list of the account IDs of the author of each toot in STATUSES." -- cgit v1.2.3 From b29306c44b8b112b24f8c14a150fdcd1ef73bb3d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 24 May 2023 09:26:03 +0200 Subject: rename tl--user-handles-get --- lisp/mastodon-profile.el | 8 ++++---- lisp/mastodon-tl.el | 19 +++++++++---------- 2 files changed, 13 insertions(+), 14 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 7865170..d9d8a4c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -63,7 +63,7 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl.el") (autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") (autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--interactive-user-handles-get "mastodon-tl") +(autoload 'mastodon-tl--user-handles-get "mastodon-tl") (autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl") (autoload 'mastodon-tl--profile-buffer-p "mastodon tl") @@ -867,11 +867,11 @@ NOTE-OLD is the text of any existing note." (defun mastodon-profile--add-or-view-private-note (action-fun &optional message view) "Add or view a private note for an account. ACTION-FUN does the adding or viewing, MESSAGE is a prompt for -`mastodon-tl--interactive-user-handles-get', VIEW is a flag." +`mastodon-tl--user-handles-get', VIEW is a flag." (let* ((profile-json (mastodon-profile--profile-json)) (handle (if (mastodon-tl--profile-buffer-p) (alist-get 'acct profile-json) - (mastodon-tl--interactive-user-handles-get message))) + (mastodon-tl--user-handles-get message))) (account (if (mastodon-tl--profile-buffer-p) profile-json (mastodon-profile--search-account-by-handle handle))) @@ -893,7 +893,7 @@ the given account." (handle (if (mastodon-tl--profile-buffer-p) (alist-get 'acct profile-json) - (mastodon-tl--interactive-user-handles-get "show familiar followers of"))) + (mastodon-tl--user-handles-get "show familiar followers of"))) (account (if (mastodon-tl--profile-buffer-p) profile-json (mastodon-profile--search-account-by-handle handle))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 95a1456..5c39c93 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1803,7 +1803,7 @@ If NOTIFY is \"false\", disable notifications when that user posts. Can be called to toggle NOTIFY on users already being followed. LANGS is an array parameters alist of languages to filer user's posts by." (interactive - (list (mastodon-tl--interactive-user-handles-get "follow"))) + (list (mastodon-tl--user-handles-get "follow"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify langs))) @@ -1811,14 +1811,14 @@ LANGS is an array parameters alist of languages to filer user's posts by." (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." (interactive - (list (mastodon-tl--interactive-user-handles-get "enable"))) + (list (mastodon-tl--user-handles-get "enable"))) (mastodon-tl--do-if-toot (mastodon-tl--follow-user user-handle "true"))) (defun mastodon-tl--disable-notify-user-posts (user-handle) "Query for USER-HANDLE and disable notifications when they post." (interactive - (list (mastodon-tl--interactive-user-handles-get "disable"))) + (list (mastodon-tl--user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) (defun mastodon-tl--filter-user-user-posts-by-language (user-handle) @@ -1826,8 +1826,7 @@ LANGS is an array parameters alist of languages to filer user's posts by." This feature is experimental and for now not easily varified by the instance API." (interactive - (list - (mastodon-tl--interactive-user-handles-get "filter by language"))) + (list (mastodon-tl--user-handles-get "filter by language"))) (let ((langs (mastodon-tl--read-filter-langs))) (mastodon-tl--do-if-toot (mastodon-tl--follow-user user-handle nil langs)))) @@ -1850,14 +1849,14 @@ LANGS is the accumulated array param alist if we re-run recursively." (defun mastodon-tl--unfollow-user (user-handle) "Query for USER-HANDLE from current status and unfollow that user." (interactive - (list (mastodon-tl--interactive-user-handles-get "unfollow"))) + (list (mastodon-tl--user-handles-get "unfollow"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) (defun mastodon-tl--block-user (user-handle) "Query for USER-HANDLE from current status and block that user." (interactive - (list (mastodon-tl--interactive-user-handles-get "block"))) + (list (mastodon-tl--user-handles-get "block"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "block"))) @@ -1872,7 +1871,7 @@ LANGS is the accumulated array param alist if we re-run recursively." (defun mastodon-tl--mute-user (user-handle) "Query for USER-HANDLE from current status and mute that user." (interactive - (list (mastodon-tl--interactive-user-handles-get "mute"))) + (list (mastodon-tl--user-handles-get "mute"))) (mastodon-tl--do-if-toot (mastodon-tl--do-user-action-and-response user-handle "mute"))) @@ -1887,13 +1886,13 @@ LANGS is the accumulated array param alist if we re-run recursively." (defun mastodon-tl--dm-user (user-handle) "Query for USER-HANDLE from current status and compose a message to that user." (interactive - (list (mastodon-tl--interactive-user-handles-get "message"))) + (list (mastodon-tl--user-handles-get "message"))) (mastodon-tl--do-if-toot (mastodon-toot--compose-buffer (concat "@" user-handle)) (setq mastodon-toot--visibility "direct") (mastodon-toot--update-status-fields))) -(defun mastodon-tl--interactive-user-handles-get (action) +(defun mastodon-tl--user-handles-get (action) "Get the list of user-handles for ACTION from the current toot." (mastodon-tl--do-if-toot (let ((user-handles -- cgit v1.2.3 From ea60d9aa25bff1ce1bfae0e10b34b07a790a53f5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 24 May 2023 09:26:18 +0200 Subject: more tiny -tl cleanups --- lisp/mastodon-tl.el | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5c39c93..ae87532 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1896,13 +1896,13 @@ LANGS is the accumulated array param alist if we re-run recursively." "Get the list of user-handles for ACTION from the current toot." (mastodon-tl--do-if-toot (let ((user-handles - (cond ((or (mastodon-tl--buffer-type-eq 'follow-suggestions) - ;; follow suggests / search / foll requests compat: - (mastodon-tl--buffer-type-eq 'search) - (mastodon-tl--buffer-type-eq 'follow-requests) - ;; profile follows/followers but not statuses: - (mastodon-tl--buffer-type-eq 'profile-followers) - (mastodon-tl--buffer-type-eq 'profile-following)) + (cond ((or ; follow suggests / search / foll requests compat: + (mastodon-tl--buffer-type-eq 'follow-suggestions) + (mastodon-tl--buffer-type-eq 'search) + (mastodon-tl--buffer-type-eq 'follow-requests) + ;; profile follows/followers but not statuses: + (mastodon-tl--buffer-type-eq 'profile-followers) + (mastodon-tl--buffer-type-eq 'profile-following)) ;; fetch 'toot-json: (list (alist-get 'acct (mastodon-tl--property 'toot-json :no-move)))) @@ -1958,9 +1958,9 @@ LANGS is an array parameters alist of languages to filer user's posts by." (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json))))) (user-id (alist-get 'id account)) - (name (if (not (string-empty-p (alist-get 'display_name account))) - (alist-get 'display_name account) - (alist-get 'username account))) + (name (if (string-empty-p (alist-get 'display_name account)) + (alist-get 'username account) + (alist-get 'display_name account))) (args (cond (notify `(("notify" . ,notify))) (langs langs) (t nil))) @@ -2037,8 +2037,7 @@ If TAG provided, follow it." If TAG is provided, unfollow it." (interactive) (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) - (tags (unless tag - (mastodon-tl--map-alist 'name followed-tags-json))) + (tags (unless tag (mastodon-tl--map-alist 'name followed-tags-json))) (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) (response (mastodon-http--post url))) -- cgit v1.2.3 From 37e51051dc74506fdbda93cfb7046d855ce235c9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 May 2023 08:51:17 +0200 Subject: extract-userhandle-from-url: check for url-filename i ran into a "handle" that was just a TLD link. if we don't error when url-filename is "", and just do nothing, SHR seems to render such a handle fine. --- lisp/mastodon-tl.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ae87532..c791f7e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -863,6 +863,8 @@ this should be of the form , e.g. \"@Gargon\"." (url-host (url-generic-parse-url mastodon-instance-url)) (url-host parsed-url)))) (when (and (string= "@" (substring buffer-text 0 1)) + ;; don't error on domain only url (rare): + (not (string= "" (url-filename parsed-url))) (string= (downcase buffer-text) (downcase (substring (url-filename parsed-url) 1)))) (if local-p -- cgit v1.2.3 From 17ef1093bc0c3f1ba8b842df7a698b9c41161c6e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 3 Jun 2023 12:44:33 +0200 Subject: fix get user handles profile note test. FIX #472. this way, if in profile note, we just return profile owner, else we might be on a toot in a profile, and so just proceed normally. --- lisp/mastodon-tl.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c791f7e..6c1a771 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1908,9 +1908,10 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; fetch 'toot-json: (list (alist-get 'acct (mastodon-tl--property 'toot-json :no-move)))) - ;; profile view, no toots + ;; profile view, point in profile details, poss no toots ;; needed for e.g. gup.pe groups which show no toots publically: - ((mastodon-tl--profile-buffer-p) + ((and (mastodon-tl--profile-buffer-p) + (get-text-property (point) 'profile-json)) (list (alist-get 'acct (mastodon-profile--profile-json)))) (t -- cgit v1.2.3 From bc5ae8643130f55df84da9e07b5e292888d68770 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Jun 2023 17:28:15 +0200 Subject: mute thread from notifs view uses base-toot-id, which i'm just praying is right. --- lisp/mastodon-tl.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6c1a771..4d49dea 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1757,12 +1757,15 @@ Note that you can only (un)mute threads you have posted in." If UNMUTE, unmute it." (let ((endpoint (mastodon-tl--endpoint)) (mute-str (if unmute "unmute" "mute"))) - (when (mastodon-tl--buffer-type-eq 'thread) + (when (or (mastodon-tl--buffer-type-eq 'thread) + (mastodon-tl--buffer-type-eq 'notifications)) (let* ((id - (save-match-data - (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" - endpoint) - (match-string 2 endpoint))) + (if (mastodon-tl--buffer-type-eq 'notifications) + (get-text-property (point) 'base-toot-id) + (save-match-data + (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" + endpoint) + (match-string 2 endpoint)))) (we-posted-p (mastodon-tl--user-in-thread-p id)) (url (mastodon-http--api (format "statuses/%s/%s" id mute-str)))) (if (not we-posted-p) -- cgit v1.2.3 From fec34bf00faf37b757bf6393c3042159b2fefe13 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Jun 2023 14:24:05 +0200 Subject: handle nil value in poll expires_at attr. --- lisp/mastodon-tl.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4d49dea..c947807 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1123,7 +1123,9 @@ LONGEST-OPTION is the option whose length determines the formatting." "")) 'face 'font-lock-comment-face) (let ((str (if (eq .expired :json-false) - (mastodon-tl--format-poll-expiry .expires_at) + (if (eq .expires_at nil) + "" + (mastodon-tl--format-poll-expiry .expires_at)) "Poll expired."))) (propertize str 'face 'font-lock-comment-face)) "\n")))) -- cgit v1.2.3 From 2999a8d1d0ba315799beddfe8465edcc7681650b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 22 Jun 2023 10:34:35 +0200 Subject: help-echo for direct/private byline icons --- lisp/mastodon-tl.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c947807..aa52f82 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -629,9 +629,11 @@ this just means displaying toot client." (funcall author-byline toot) ;; visibility: (cond ((equal visibility "direct") - (concat " " (mastodon-tl--symbol 'direct))) + (propertize (concat " " (mastodon-tl--symbol 'direct)) + 'help-echo visibility)) ((equal visibility "private") - (concat " " (mastodon-tl--symbol 'private)))) + (propertize (concat " " (mastodon-tl--symbol 'private)) + 'help-echo visibility))) (funcall action-byline toot) " " (propertize -- cgit v1.2.3 From d9d3bb07a65ee6350a3272d589e8298436eb34fb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 27 Jun 2023 15:33:17 +0200 Subject: handle updating a single-toot view. FIX #476. --- lisp/mastodon-tl.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aa52f82..f7f000b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1689,8 +1689,16 @@ ID is that of the toot to view." (if (equal (caar toot) 'error) (message "Error: %s" (cdar toot)) (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) nil) - (mastodon-tl--toot toot :detailed-p))))) + (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) + #'mastodon-tl--update-toot) + (mastodon-tl--toot toot :detailed-p) + (goto-char (point-min)) + (mastodon-tl--goto-next-item))))) + +(defun mastodon-tl--update-toot (json) + "" + (let ((id (alist-get 'id json))) + (mastodon-tl--single-toot id))) (defun mastodon-tl--view-whole-thread () "From a thread view, view entire thread. -- cgit v1.2.3 From 150f4c34b85724a0dc389ce8a1e3bea52ddf1f39 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 6 Jul 2023 16:53:03 +0200 Subject: mastodon-tl--scroll-up-command --- lisp/mastodon-tl.el | 9 +++++++++ lisp/mastodon.el | 1 + 2 files changed, 10 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f7f000b..44365bc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -341,6 +341,15 @@ Optionally start from POS." (mastodon-tl--message-help-echo)) (funcall refresh)))) +(defun mastodon-tl--scroll-up-command () + "Call `scroll-up-command'. +If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." + (interactive) + (if (not (equal (point) (point-max))) + (scroll-up-command) + (mastodon-tl--more) + (scroll-up-command))) + (defun mastodon-tl--goto-next-toot () "Jump to next toot header." (interactive) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bb316e9..8eac782 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -216,6 +216,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "I") #'mastodon-views--view-filters) (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) map) "Keymap for `mastodon-mode'.") -- cgit v1.2.3 From 04088be6b1be835132c1ae69d65ef45a13193121 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 6 Jul 2023 18:57:53 +0200 Subject: better docstring for mastodon-tl--scroll-up-command --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 44365bc..13226a3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -342,7 +342,7 @@ Optionally start from POS." (funcall refresh)))) (defun mastodon-tl--scroll-up-command () - "Call `scroll-up-command'. + "Call `scroll-up-command', loading more toots if necessary. If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." (interactive) (if (not (equal (point) (point-max))) -- cgit v1.2.3 From dbb8631f90bc249432746bf372bb6c1f698fc8d1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 13 Jul 2023 10:22:27 +0200 Subject: fix type name for tl--show-stats --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 13226a3..360aeaa 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -127,7 +127,7 @@ nil." (defcustom mastodon-tl--show-stats t "Whether to show toot stats (faves, boosts, replies counts)." - :type 'bool) + :type 'boolean) (defcustom mastodon-tl--symbols '((reply . ("💬" . "R")) -- cgit v1.2.3