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(-) 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(-) 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(-) 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(+) 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(-) 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(-) 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(-) 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 2e902e9a1458f7e4220bffb47f412a28366c8dc0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 08:10:56 +0200 Subject: let-alist -views.el --- lisp/mastodon-views.el | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4f102a6..9974071 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -505,20 +505,17 @@ JSON is the data returned by the server." (defun mastodon-views--insert-scheduled-toot (toot) "Insert scheduled TOOT into the buffer." - (let* ((id (alist-get 'id toot)) - (scheduled (alist-get 'scheduled_at toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params))) + (let-alist toot (insert - (propertize (concat text + (propertize (concat .params.text " | " - (mastodon-toot--iso-to-human scheduled)) + (mastodon-toot--iso-to-human .scheduled_at)) 'byline t ; so we nav here 'toot-id "0" ; so we nav here 'face 'font-lock-comment-face 'keymap mastodon-views--scheduled-map 'scheduled-json toot - 'id id) + 'id .id) "\n"))) (defun mastodon-views--get-scheduled-toots (&optional id) @@ -889,21 +886,18 @@ IND is the optional indentation level to print at." (defun mastodon-views--print-instance-rules-or-fields (alist) "Print ALIST of instance rules or contact account or emoji fields." - (let ((key (or (alist-get 'id alist) - (alist-get 'name alist) - (alist-get 'shortcode alist))) - (value (or (alist-get 'text alist) - (alist-get 'value alist) - (alist-get 'url alist)))) - (indent-to 4) - (insert - (format "%-5s: " - (propertize key - 'face '(:underline t))) - (mastodon-views--newline-if-long value) - (format "%s" (mastodon-tl--render-text - value)) - "\n"))) + (let-alist alist + (let ((key (or .id .name .shortcode)) + (value (or .text .value .url))) + (indent-to 4) + (insert + (format "%-5s: " + (propertize key) + 'face '(:underline t)) + (mastodon-views--newline-if-long value) + (format "%s" (mastodon-tl--render-text + value)) + "\n")))) (defun mastodon-views--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." -- 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(-) 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 5d365fd5af58f715cf0e95a407cc6d840054a29b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 26 Apr 2023 21:14:51 +0200 Subject: profile-show-user: allow calling when point on profile header. --- lisp/mastodon-profile.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 241fbbe..296616d 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -724,6 +724,7 @@ IMG-TYPE is the JSON key from the account data." (if (not (or ;; own profile has no need for toot-json test: (equal user-handle (mastodon-auth--get-account-name)) + (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status -- cgit v1.2.3 From 8539f1eb911e8bdcd62488ac974ffc7592ceb1ff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 08:13:31 +0200 Subject: let-alist the hell out of --make-profile-buffer-for --- lisp/mastodon-profile.el | 244 ++++++++++++++++++++++------------------------- 1 file changed, 116 insertions(+), 128 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 296616d..0c74dca 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -554,138 +554,126 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-tl--toot pinned-status)) pinned-statuses)) -(defun mastodon-profile--make-profile-buffer-for (account endpoint-type - update-function - &optional no-reblogs headers) +(defun mastodon-profile--follows-p (list) + "T if you have any relationship." + (let (result) + (dolist (x list result) + (when (not (equal :json-false x)) + (setq result x))))) + +(defun mastodon-profile--make-profile-buffer-for + (account endpoint-type update-function &optional no-reblogs headers) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. NO-REBLOGS means do not display boosts in statuses. HEADERS means also fetch link headers for pagination." - (let* ((id (mastodon-profile--account-field account 'id)) - (args `(("limit" . ,mastodon-tl--timeline-posts-count))) - (args (if no-reblogs (push '("exclude_reblogs" . "t") args) args)) - (endpoint (format "accounts/%s/%s" id endpoint-type)) - (url (mastodon-http--api endpoint)) - (acct (mastodon-profile--account-field account 'acct)) - (buffer (concat "*mastodon-" acct "-" - (if no-reblogs - (concat endpoint-type "-no-boosts") - endpoint-type) - "*")) - (response (if headers - (mastodon-http--get-response url args) - (mastodon-http--get-json url args))) - (json (if headers (car response) response)) - (link-header (when headers - (mastodon-tl--get-link-header-from-response - (cdr response)))) - (note (mastodon-profile--account-field account 'note)) - (locked (mastodon-profile--account-field account 'locked)) - (followers-count (mastodon-tl--as-string - (mastodon-profile--account-field - account 'followers_count))) - (following-count (mastodon-tl--as-string - (mastodon-profile--account-field - account 'following_count))) - (toots-count (mastodon-tl--as-string - (mastodon-profile--account-field - account 'statuses_count))) - (relationships (mastodon-profile--relationships-get id)) - (requested-you (when (not (seq-empty-p relationships)) - (alist-get 'requested_by relationships))) - (followed-by-you (when (not (seq-empty-p relationships)) - (alist-get 'following relationships))) - (follows-you (when (not (seq-empty-p relationships)) - (alist-get 'followed_by relationships))) - (followsp (or (equal follows-you 't) (equal followed-by-you 't) - (equal requested-you 't))) - (fields (mastodon-profile--fields-get account)) - (pinned (mastodon-profile--get-statuses-pinned account)) - (joined (mastodon-profile--account-field account 'created_at))) - (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-profile-mode) - (setq mastodon-profile--account account) - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header) - (let* ((inhibit-read-only t) - (is-statuses (string= endpoint-type "statuses")) - (is-followers (string= endpoint-type "followers")) - (is-following (string= endpoint-type "following")) - (endpoint-name (cond - (is-statuses (if no-reblogs - " TOOTS (no boosts)" - " TOOTS ")) - (is-followers " FOLLOWERS ") - (is-following " FOLLOWING ")))) - (insert - (propertize - (concat - "\n" - (mastodon-profile--image-from-account account 'avatar_static) - (mastodon-profile--image-from-account account 'header_static) - "\n" - (propertize (mastodon-profile--account-field - account 'display_name) - 'face 'mastodon-display-name-face) - "\n" - (propertize (concat "@" acct) - 'face 'default) - (if (equal locked t) - (concat " " (mastodon-tl--symbol 'locked)) - "") - "\n " mastodon-tl--horiz-bar "\n" - ;; profile note: - ;; account here to enable tab-stops in profile note - (mastodon-tl--render-text note account) - ;; meta fields: - (if fields - (concat "\n" - (mastodon-tl--set-face - (mastodon-profile--fields-insert fields) - 'success)) - "") - "\n" - ;; Joined date: + (let-alist account + (let* ((args `(("limit" . ,mastodon-tl--timeline-posts-count))) + (args (if no-reblogs (push '("exclude_reblogs" . "t") args) args)) + (endpoint (format "accounts/%s/%s" .id endpoint-type)) + (url (mastodon-http--api endpoint)) + (buffer (concat "*mastodon-" .acct "-" + (if no-reblogs + (concat endpoint-type "-no-boosts") + endpoint-type) + "*")) + (response (if headers + (mastodon-http--get-response url args) + (mastodon-http--get-json url args))) + (json (if headers (car response) response)) + (link-header (when headers + (mastodon-tl--get-link-header-from-response + (cdr response)))) + (fields (mastodon-profile--fields-get account)) + (pinned (mastodon-profile--get-statuses-pinned account)) + (relationships (mastodon-profile--relationships-get .id))) + (with-mastodon-buffer buffer #'mastodon-mode nil + (mastodon-profile-mode) + (setq mastodon-profile--account account) + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (let* ((inhibit-read-only t) + (is-statuses (string= endpoint-type "statuses")) + (is-followers (string= endpoint-type "followers")) + (is-following (string= endpoint-type "following")) + (endpoint-name (cond + (is-statuses (if no-reblogs + " TOOTS (no boosts)" + " TOOTS ")) + (is-followers " FOLLOWERS ") + (is-following " FOLLOWING ")))) + (insert (propertize - (mastodon-profile--format-joined-date-string joined) - 'face 'success) - "\n\n") - 'profile-json account) - ;; insert counts - (mastodon-tl--set-face - (concat " " mastodon-tl--horiz-bar "\n" - " TOOTS: " toots-count " | " - "FOLLOWERS: " followers-count " | " - "FOLLOWING: " following-count "\n" - " " mastodon-tl--horiz-bar "\n\n") - 'success) - ;; insert relationship (follows) - (if followsp - (mastodon-tl--set-face - (concat (when (equal follows-you 't) - " | FOLLOWS YOU") - (when (equal followed-by-you 't) - " | FOLLOWED BY YOU") - (when (equal requested-you 't) - " | REQUESTED TO FOLLOW YOU") - "\n\n") - 'success) - "") ; if no followsp we still need str-or-char-p for insert - ;; insert endpoint - (mastodon-tl--set-face - (concat " " mastodon-tl--horiz-bar "\n" - endpoint-name "\n" - " " mastodon-tl--horiz-bar "\n") - 'success)) - (setq mastodon-tl--update-point (point)) - (mastodon-media--inline-images (point-min) (point)) - ;; insert pinned toots first - (when (and pinned (equal endpoint-type "statuses")) - (mastodon-profile--insert-statuses-pinned pinned) - (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots - (funcall update-function json))) - (goto-char (point-min)))) + (concat + "\n" + (mastodon-profile--image-from-account account 'avatar_static) + (mastodon-profile--image-from-account account 'header_static) + "\n" + (propertize .display_name + 'face 'mastodon-display-name-face) + "\n" + (propertize (concat "@" .acct) + 'face 'default) + (if (equal .locked t) + (concat " " (mastodon-tl--symbol 'locked)) + "") + "\n " mastodon-tl--horiz-bar "\n" + ;; profile note: + ;; account here to enable tab-stops in profile note + (mastodon-tl--render-text .note account) + ;; meta fields: + (if fields + (concat "\n" + (mastodon-tl--set-face + (mastodon-profile--fields-insert fields) + 'success)) + "") + "\n" + ;; Joined date: + (propertize + (mastodon-profile--format-joined-date-string .created_at) + 'face 'success) + "\n\n") + 'profile-json account) + ;; insert counts + (mastodon-tl--set-face + (concat " " mastodon-tl--horiz-bar "\n" + " TOOTS: " (mastodon-tl--as-string .statuses_count) " | " + "FOLLOWERS: " (mastodon-tl--as-string .followers_count) " | " + "FOLLOWING: " (mastodon-tl--as-string .following_count) "\n" + " " mastodon-tl--horiz-bar "\n\n") + 'success) + ;; insert relationship (follows) + (let-alist relationships + (let ((followsp + (mastodon-profile--follows-p + (list .requested_by .following .followed_by)))) + (if followsp + (mastodon-tl--set-face + (concat (when (equal .following 't) + " | FOLLOWS YOU") + (when (equal .followed_by 't) + " | FOLLOWED BY YOU") + (when (equal .requested_by 't) + " | REQUESTED TO FOLLOW YOU") + "\n\n") + 'success) + ""))) ; if no followsp we still need str-or-char-p for insert + ;; insert endpoint + (mastodon-tl--set-face + (concat " " mastodon-tl--horiz-bar "\n" + endpoint-name "\n" + " " mastodon-tl--horiz-bar "\n") + 'success)) + (setq mastodon-tl--update-point (point)) + (mastodon-media--inline-images (point-min) (point)) + ;; insert pinned toots first + (when (and pinned (equal endpoint-type "statuses")) + (mastodon-profile--insert-statuses-pinned pinned) + (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots + (funcall update-function json))) + (goto-char (point-min))))) (defun mastodon-profile--format-joined-date-string (joined) "Format a human-readable Joined string from timestamp JOINED. -- 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(-) 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(-) 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(-) 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(-) 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(-) 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 87e6975d7ff26aeaca1b2020dd2a3ccfd9d6e1a2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 May 2023 19:52:36 +0200 Subject: audit: mastodon.el, -toot.el (started) --- lisp/mastodon-toot.el | 39 +++++++++++++++++---------------------- lisp/mastodon.el | 15 +++++---------- 2 files changed, 22 insertions(+), 32 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 825831d..f07e61a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -281,13 +281,11 @@ NO-TOOT means we are not calling from a toot buffer." "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer. NO-TOOT means we are not calling from a toot buffer." (let ((max-chars - (or - (alist-get 'max_toot_chars json-response) - ;; some servers have this instead: - (alist-get 'max_characters - (alist-get 'statuses - (alist-get 'configuration - json-response)))))) + (or (alist-get 'max_toot_chars json-response) + (alist-get 'max_characters ; some servers have this instead + (alist-get 'statuses + (alist-get 'configuration + json-response)))))) (setq mastodon-toot--max-toot-chars max-chars) (unless no-toot (with-current-buffer "*new toot*" @@ -327,10 +325,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." Makes a POST request to the server. Used for favouriting, boosting, or bookmarking toots." (let* ((id (mastodon-tl--property 'base-toot-id)) - (url (mastodon-http--api (concat "statuses/" - (mastodon-tl--as-string id) - "/" - action)))) + (url (mastodon-http--api + (concat "statuses/" (mastodon-tl--as-string id) "/" action)))) (let ((response (mastodon-http--post url))) (mastodon-http--triage response callback)))) @@ -339,9 +335,9 @@ boosting, or bookmarking toots." TYPE is a symbol, either `favourite' or `boost.'" (mastodon-tl--do-if-toot-strict (let* ((boost-p (equal type 'boost)) - (has-id (mastodon-tl--property 'base-toot-id)) - (byline-region (when has-id - (mastodon-tl--find-property-range 'byline (point)))) + ;; (has-id (mastodon-tl--property 'base-toot-id)) + (byline-region ;(when has-id + (mastodon-tl--find-property-range 'byline (point))) (id (when byline-region (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) (boosted (when byline-region @@ -354,9 +350,9 @@ TYPE is a symbol, either `favourite' or `boost.'" (msg (if boosted "unboosted" "boosted")) (action-string (if boost-p "boost" "favourite")) (remove (if boost-p (when boosted t) (when faved t))) - (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) - (visibility (mastodon-tl--field 'visibility - (mastodon-tl--property 'toot-json)))) + (toot-json (mastodon-tl--property 'toot-json)) + (toot-type (alist-get 'type toot-json)) + (visibility (mastodon-tl--field 'visibility toot-json))) (if byline-region (if (and (or (equal visibility "direct") (equal visibility "unlisted")) @@ -387,11 +383,10 @@ TYPE is a symbol, either `favourite' or `boost.'" (list 'boosted-p (not boosted)) (list 'favourited-p (not faved)))) (mastodon-toot--update-stats-on-action type remove) - (mastodon-toot--action-success - (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove)) + (mastodon-toot--action-success (if boost-p + (mastodon-tl--symbol 'boost) + (mastodon-tl--symbol 'favourite)) + byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id))))))) (message (format "Nothing to %s here?!?" action-string)))))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index e181786..ede0662 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -306,11 +306,10 @@ from the server and load anew." (progn (switch-to-buffer buffer) (mastodon-tl--update)) (message "Loading your notifications...") - (mastodon-tl--init-sync - (or buffer-name "notifications") - "notifications" - 'mastodon-notifications--timeline - type) + (mastodon-tl--init-sync (or buffer-name "notifications") + "notifications" + 'mastodon-notifications--timeline + type) (with-current-buffer buffer (use-local-map mastodon-notifications--map))))) @@ -329,11 +328,7 @@ not, just browse the URL in the normal fashion." (mastodon-tl--property 'shr-url :no-move) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) - ;; this doesn't work as shr-browse-url doesn't take a url arg - ;; and with no args it can't use our read-string query, but only - ;; looks for a url at point - ;; (if (equal major-mode 'mastodon-mode) - ;; (shr-browse-url query) ;; keep our shr keymap + ;; (shr-browse-url query) ; doesn't work (keep our shr keymap) (browse-url query) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) -- cgit v1.2.3 From a98c5182a589b88d73f289ebf741612bd7b924b9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 May 2023 20:19:09 +0200 Subject: if-let for translate-toot --- lisp/mastodon-toot.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f07e61a..8474bca 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -531,13 +531,12 @@ Uses `lingva.el'." (if (not (require 'lingva nil :no-error)) (message "Looks like you need to install lingva.el first.") (if mastodon-tl--buffer-spec - (let ((toot (mastodon-tl--property 'toot-json))) - (if toot - (lingva-translate nil - (mastodon-tl--content toot) - (when mastodon-tl--enable-proportional-fonts - t)) - (message "No toot to translate?"))) + (if-let ((toot (mastodon-tl--property 'toot-json))) + (lingva-translate nil + (mastodon-tl--content toot) + (when mastodon-tl--enable-proportional-fonts + t)) + (message "No toot to translate?")) (message "No mastodon buffer?")))) (defun mastodon-toot--own-toot-p (toot) -- cgit v1.2.3 From e43fb1a33591e03fe8b3245a3e83ec738c9ad604 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 7 May 2023 20:30:44 +0200 Subject: touch more audit --- lisp/mastodon-toot.el | 51 +++++++++++++++++++++------------------------------ 1 file changed, 21 insertions(+), 30 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8474bca..98d699d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -408,16 +408,15 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (inhibit-read-only 1)) ;; TODO another way to implement this would be to async fetch counts again ;; and re-display from count-properties - (add-text-properties - (car count-prop-range) - (cdr count-prop-range) - (list 'display ; update the display prop: - (number-to-string - (mastodon-toot--inc-or-dec count subtract)) - ;; update the count prop - ;; we rely on this for any subsequent actions: - count-prop - (mastodon-toot--inc-or-dec count subtract))))) + (add-text-properties (car count-prop-range) + (cdr count-prop-range) + (list 'display + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) + ;; update the count prop + ;; we rely on this for any subsequent actions: + count-prop + (mastodon-toot--inc-or-dec count subtract))))) (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." @@ -434,16 +433,13 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "Bookmark or unbookmark toot at point." (interactive) (mastodon-tl--do-if-toot-strict - (let* ( ;(toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--property 'base-toot-id)) - ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (let* ((id (mastodon-tl--property 'base-toot-id)) (bookmarked-p (mastodon-tl--property 'bookmarked-p)) (prompt (if bookmarked-p (format "Toot already bookmarked. Remove? ") (format "Bookmark this toot? "))) - (byline-region - (when id - (mastodon-tl--find-property-range 'byline (point)))) + (byline-region (when id + (mastodon-tl--find-property-range 'byline (point)))) (action (if bookmarked-p "unbookmark" "bookmark")) (bookmark-str (mastodon-tl--symbol 'bookmark)) (message (if bookmarked-p @@ -459,9 +455,8 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (add-text-properties (car byline-region) (cdr byline-region) (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success - bookmark-str - byline-region remove) + (mastodon-toot--action-success bookmark-str + byline-region remove) (message (format "%s #%s" message id))))) (message (format "Nothing to %s here?!?" action)))))) @@ -481,23 +476,20 @@ With FAVOURITE, list favouriters, else list boosters." (mastodon-tl--do-if-toot-strict (let* ((base-toot (mastodon-tl--property 'base-toot-id)) (endpoint (if favourite "favourited_by" "reblogged_by")) - (url (mastodon-http--api - (format "statuses/%s/%s" base-toot endpoint))) + (url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint))) (params '(("limit" . "80"))) (json (mastodon-http--get-json url params))) (if (eq (caar json) 'error) - (error "%s (Status does not exist or is private)" - (alist-get 'error json)) + (error "%s (Status does not exist or is private)" (alist-get 'error json)) (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (error "Looks like this toot has no %s" type-string) - (let ((choice - (completing-read - (format "%s (enter to view profile): " type-string) - handles - nil - t))) + (let ((choice (completing-read + (format "%s (enter to view profile): " type-string) + handles + nil + t))) (mastodon-profile--show-user choice)))))))) (defun mastodon-toot--copy-toot-url () @@ -523,7 +515,6 @@ base toot." (kill-new (mastodon-tl--content toot)) (message "Toot content copied to the clipboard."))) -;; (when (require 'lingva nil :no-error) (defun mastodon-toot--translate-toot-text () "Translate text of toot at point. Uses `lingva.el'." -- cgit v1.2.3 From d0f7438e0056aa819a0fc32f753282964672362b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 08:36:03 +0200 Subject: audit toot emoji funs --- lisp/mastodon-toot.el | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 98d699d..7bb10e8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -676,18 +676,20 @@ TEXT-ONLY means don't check for attachments or polls." 'emojify-insert-emoji "Prompt to insert an emoji.") + +(defun mastodon-toot--emoji-dir () + "Return the file path for the mastodon custom emojis directory." + (concat (expand-file-name emojify-emojis-dir) + "/mastodon-custom-emojis/")) + (defun mastodon-toot--download-custom-emoji () "Download `mastodon-instance-url's custom emoji. Emoji images are stored in a subdir of `emojify-emojis-dir'. To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (interactive) - (let ((custom-emoji (mastodon-http--get-json - (mastodon-http--api "custom_emojis"))) - (mastodon-custom-emoji-dir (file-name-as-directory - (concat (file-name-as-directory - (expand-file-name - emojify-emojis-dir)) - "mastodon-custom-emojis")))) + (let ((url (mastodon-http--api "custom_emojis")) + (custom-emoji (mastodon-http--get-json url)) + (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) (if (not (file-directory-p emojify-emojis-dir)) (message "Looks like you need to set up emojify first.") (unless (file-directory-p mastodon-custom-emoji-dir) @@ -700,11 +702,10 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (string-match-p "^[a-zA-Z0-9-_]+$" shortcode) (string-match-p "^[a-zA-Z]+$" (file-name-extension url))) (url-copy-file url - (concat - mastodon-custom-emoji-dir - shortcode - "." - (file-name-extension url)) + (concat mastodon-custom-emoji-dir + shortcode + "." + (file-name-extension url)) t)))) custom-emoji) (message "Custom emoji for %s downloaded to %s" @@ -714,13 +715,11 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (defun mastodon-toot--collect-custom-emoji () "Return a list of `mastodon-instance-url's custom emoji. The list is formatted for `emojify-user-emojis', which see." - (let* ((mastodon-custom-emojis-dir (concat (expand-file-name - emojify-emojis-dir) - "/mastodon-custom-emojis/")) + (let* ((mastodon-custom-emojis-dir (mastodon-toot--emoji-dir)) (custom-emoji-files (directory-files mastodon-custom-emojis-dir nil ; not full path "^[^.]")) ; no dot files - (mastodon-emojify-user-emojis)) + mastodon-emojify-user-emojis) (mapc (lambda (x) (push `(,(concat ":" @@ -738,9 +737,7 @@ Custom emoji must first be downloaded with `mastodon-toot--download-custom-emoji'. Custom emoji are appended to `emojify-user-emojis', and the emoji data is updated." (interactive) - (unless (file-exists-p (concat (expand-file-name - emojify-emojis-dir) - "/mastodon-custom-emojis/")) + (unless (file-exists-p (mastodon-toot--emoji-dir)) (when (y-or-n-p "Looks like you haven't downloaded your instance's custom emoji yet. Download now? ") (mastodon-toot--download-custom-emoji))) -- cgit v1.2.3 From 6d78e3df6edd8b2b1bdfb7e56663d7af57a9c907 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 08:57:26 +0200 Subject: audit more of toot.el --- lisp/mastodon-toot.el | 93 +++++++++++++++++++++------------------------------ 1 file changed, 38 insertions(+), 55 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7bb10e8..5839912 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -614,9 +614,8 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." ;; TODO set new lang/scheduled props here nil)))) -(defun mastodon-toot--set-toot-properties (reply-id visibility cw lang - &optional scheduled - scheduled-id) +(defun mastodon-toot--set-toot-properties + (reply-id visibility cw lang &optional scheduled scheduled-id) "Set the toot properties for the current redrafted or edited toot. REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set." (when reply-id @@ -632,15 +631,15 @@ REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set." (defun mastodon-toot--kill (&optional cancel) "Kill `mastodon-toot-mode' buffer and window. CANCEL means the toot was not sent, so we save the toot text as a draft." - (let ((prev-window-config mastodon-toot-previous-window-config)) - (unless (eq mastodon-toot-current-toot-text nil) - (when cancel - (cl-pushnew mastodon-toot-current-toot-text - mastodon-toot-draft-toots-list :test 'equal))) - ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot--save-toot-text after-change-functions) - (kill-buffer-and-window) - (mastodon-toot--restore-previous-window-config prev-window-config))) + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot--save-toot-text after-change-functions) + (kill-buffer-and-window) + (mastodon-toot--restore-previous-window-config + mastodon-toot-previous-window-config)) (defun mastodon-toot--cancel () "Kill new-toot buffer/window. Does not POST content to Mastodon. @@ -687,9 +686,9 @@ TEXT-ONLY means don't check for attachments or polls." Emoji images are stored in a subdir of `emojify-emojis-dir'. To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (interactive) - (let ((url (mastodon-http--api "custom_emojis")) - (custom-emoji (mastodon-http--get-json url)) - (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) + (let* ((url (mastodon-http--api "custom_emojis")) + (custom-emoji (mastodon-http--get-json url)) + (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) (if (not (file-directory-p emojify-emojis-dir)) (message "Looks like you need to set up emojify first.") (unless (file-directory-p mastodon-custom-emoji-dir) @@ -782,12 +781,9 @@ instance to edit a toot." (scheduled mastodon-toot--scheduled-for) (scheduled-id mastodon-toot--scheduled-id) (edit-id mastodon-toot--edit-toot-id) - (endpoint - (if edit-id - ;; we are sending an edit: - (mastodon-http--api (format "statuses/%s" - edit-id)) - (mastodon-http--api "statuses"))) + (endpoint (if edit-id ; we are sending an edit: + (mastodon-http--api (format "statuses/%s" edit-id)) + (mastodon-http--api "statuses"))) (cw (mastodon-toot--read-cw-string)) (args-no-media (append `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) @@ -825,8 +821,7 @@ instance to edit a toot." ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (if edit-id - ;; we are sending an edit: + (let ((response (if edit-id ; we are sending an edit: (mastodon-http--put endpoint args) (mastodon-http--post endpoint args)))) (mastodon-http--triage @@ -850,7 +845,7 @@ instance to edit a toot." (defun mastodon-toot--edit-toot-at-point () "Edit the user's toot at point." (interactive) - (let ((toot (or (mastodon-tl--property 'base-toot); fave/boost notifs + (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs (mastodon-tl--property 'toot-json)))) (if (not (mastodon-toot--own-toot-p toot)) (message "You can only edit your own toots.") @@ -864,7 +859,6 @@ instance to edit a toot." (when (y-or-n-p "Edit this toot? ") (mastodon-toot--compose-buffer nil reply-id nil content :edit) (goto-char (point-max)) - ;; (insert content) ;; adopt reply-to-id, visibility, CW, and language: (mastodon-toot--set-toot-properties reply-id toot-visibility source-cw toot-language) @@ -946,24 +940,22 @@ The mentioned users look like this: 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)))) + (mentions (if boosted + (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)))) (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point using REGEX." - ;; needed because # and @ are not part of any existing thing at point + ;; # and @ are not part of any existing thing at point (save-match-data (save-excursion ;; match full handle inc. domain, or tag including # ;; (see the regexes for subexp 2) (when (re-search-backward regex - (save-excursion - (forward-whitespace -1) - (point)) + (save-excursion (forward-whitespace -1) + (point)) :no-error) (cons (match-beginning 2) (match-end 2)))))) @@ -986,51 +978,43 @@ If TAGS, we search for tags, else we search for handles." (defun mastodon-toot--mentions-capf () "Build a mentions completion backend for `completion-at-point-functions'." - (let* ((bounds - (mastodon-toot--get-bounds mastodon-toot-handle-regex)) + (let* ((bounds (mastodon-toot--get-bounds mastodon-toot-handle-regex)) (start (car bounds)) (end (cdr bounds))) (when bounds (list start end - ;; only search when necessary: - (completion-table-dynamic + (completion-table-dynamic ; only search when necessary (lambda (_) - ;; Interruptible candidate computation - ;; suggestion from minad (d mendler), thanks! + ;; Interruptible candidate computation, from minad/d mendler, thanks! (let ((result (while-no-input (mastodon-toot--fetch-completion-candidates start end)))) (and (consp result) result)))) :exclusive 'no :annotation-function - (lambda (candidate) - (concat " " - (mastodon-toot--mentions-annotation-fun candidate))))))) + (lambda (cand) + (concat " " (mastodon-toot--mentions-annotation-fun cand))))))) (defun mastodon-toot--tags-capf () "Build a tags completion backend for `completion-at-point-functions'." - (let* ((bounds - (mastodon-toot--get-bounds mastodon-toot-tag-regex)) + (let* ((bounds (mastodon-toot--get-bounds mastodon-toot-tag-regex)) (start (car bounds)) (end (cdr bounds))) (when bounds (list start end - ;; only search when necessary: - (completion-table-dynamic + (completion-table-dynamic ; only search when necessary: (lambda (_) - ;; Interruptible candidate computation - ;; suggestion from minad (d mendler), thanks! + ;; Interruptible candidate computation, from minad/d mendler, thanks! (let ((result (while-no-input (mastodon-toot--fetch-completion-candidates start end :tags)))) (and (consp result) result)))) :exclusive 'no :annotation-function - (lambda (candidate) - (concat " " - (mastodon-toot--tags-annotation-fun candidate))))))) + (lambda (cand) + (concat " " (mastodon-toot--tags-annotation-fun cand))))))) (defun mastodon-toot--mentions-annotation-fun (candidate) "Given a handle completion CANDIDATE, return its annotation string, a username." @@ -1038,8 +1022,8 @@ If TAGS, we search for tags, else we search for handles." (defun mastodon-toot--tags-annotation-fun (candidate) "Given a tag string CANDIDATE, return an annotation, the tag's URL." - ;; FIXME check the list returned here? should be cadr - ;;or make it an alist and use cdr + ;; TODO: check the list returned here? should be cadr + ;; or make it an alist and use cdr (cadr (assoc candidate mastodon-toot-completions))) (defun mastodon-toot--reply () @@ -1049,8 +1033,7 @@ text of the toot being replied to in the compose buffer." (interactive) (mastodon-tl--do-if-toot-strict (let* ((toot (mastodon-tl--property 'toot-json)) - ;; no-move arg for base toot, because if it doesn't have one, it is - ;; fetched from next toot! + ;; no-move arg for base toot: don't try next toot (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) (account (mastodon-tl--field 'account toot)) -- cgit v1.2.3 From 48fb5dc0cdd09e39ad0d30582de8b9b9bd1ec269 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 09:13:50 +0200 Subject: audit more of toot.el, attachments, scheduled --- lisp/mastodon-toot.el | 49 +++++++++++++++++++++---------------------------- 1 file changed, 21 insertions(+), 28 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5839912..d40395f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1128,8 +1128,7 @@ File is actually attached to the toot upon posting." "Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'. The item's id is added to `mastodon-toot--media-attachment-ids', which is used to attach it to a toot when posting." - (let* ((filename (expand-file-name - (alist-get :filename attachment))) + (let* ((filename (expand-file-name (alist-get :filename attachment))) (caption (alist-get :description attachment)) (url (concat mastodon-instance-url "/api/v2/media"))) (message "Uploading %s..." (file-name-nondirectory filename)) @@ -1168,7 +1167,7 @@ which is used to attach it to a toot when posting." (list "None"))) (defun mastodon-toot--fetch-max-poll-options (instance) - "Return the maximum number of poll options from INSTANCE, which is json." + "Return the maximum number of poll options from JSON data INSTANCE." (mastodon-toot--fetch-poll-field 'max_options instance)) (defun mastodon-toot--fetch-max-poll-option-chars (instance) @@ -1180,7 +1179,7 @@ INSTANCE is JSON." 50))) ; masto default (defun mastodon-toot--fetch-poll-field (field instance) - "Return FIELD from the poll settings from INSTANCE, which is json." + "Return FIELD from the poll settings from JSON data INSTANCE." (let* ((polls (if (alist-get 'pleroma instance) (alist-get 'poll_limits instance) (alist-get 'polls @@ -1190,8 +1189,7 @@ INSTANCE is JSON." (defun mastodon-toot--read-poll-options-count (max) "Read the user's choice of the number of options the poll should have. MAX is the maximum number set by their instance." - (let ((number (read-number - (format "Number of options [2-%s]: " max) 2))) + (let ((number (read-number (format "Number of options [2-%s]: " max) 2))) (if (> number max) (error "You need to choose a number between 2 and %s" max) number))) @@ -1199,7 +1197,6 @@ MAX is the maximum number set by their instance." (defun mastodon-toot--create-poll () "Prompt for new poll options and return as a list." (interactive) - ;; re length, API docs show a poll 9 options. (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance"))) (max-options (mastodon-toot--fetch-max-poll-options instance)) (count (mastodon-toot--read-poll-options-count max-options)) @@ -1216,11 +1213,10 @@ MAX is the maximum number set by their instance." (defun mastodon-toot--read-poll-options (count length) "Read a list of options for poll with COUNT options. LENGTH is the maximum character length allowed for a poll option." - (let* ((choices - (cl-loop for x from 1 to count - collect (read-string - (format "Poll option [%s/%s] [max %s chars]: " - x count length)))) + (let* ((choices (cl-loop for x from 1 to count + collect (read-string + (format "Poll option [%s/%s] [max %s chars]: " + x count length)))) (longest (cl-reduce #'max (mapcar #'length choices)))) (if (> longest length) (progn @@ -1241,7 +1237,7 @@ LENGTH is the maximum character length allowed for a poll option." response)))) (defun mastodon-toot--poll-expiry-options-alist () - "Return an alist of seconds options." + "Return an alist of expiry options options in seconds." `(("5 minutes" . ,(number-to-string (* 60 5))) ("30 minutes" . ,(number-to-string (* 60 30))) ("1 hour" . ,(number-to-string (* 60 60))) @@ -1273,29 +1269,27 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (message "You can't schedule toots you're editing.")) ((not (or (mastodon-tl--buffer-type-eq 'new-toot) (mastodon-tl--buffer-type-eq 'scheduled-statuses))) - (message "You can only schedule toots from the compose toot buffer or the scheduled toots view.")) + (message "You can only schedule toots from the compose buffer or scheduled toots view.")) (t (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) (ts (when reschedule (alist-get 'scheduled_at (mastodon-tl--property 'scheduled-json :no-move)))) - (time-value - (org-read-date t t nil "Schedule toot:" - ;; default to scheduled timestamp if already set: - (mastodon-toot--iso-to-org - ;; we are rescheduling without editing: - (or ts - ;; we are maybe editing the scheduled toot: - mastodon-toot--scheduled-for)))) + (time-value (org-read-date t t nil "Schedule toot:" + ;; default to scheduled timestamp if already set: + (mastodon-toot--iso-to-org + ;; we are rescheduling without editing: + (or ts + ;; we are maybe editing the scheduled toot: + mastodon-toot--scheduled-for)))) (iso8601-str (format-time-string "%FT%T%z" time-value)) (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) (if (not reschedule) (progn (setq-local mastodon-toot--scheduled-for iso8601-str) (message (format "Toot scheduled for %s." msg-str))) - (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str)))) - (url (when reschedule (mastodon-http--api - (format "scheduled_statuses/%s" id)))) + (let* ((args `(("scheduled_at" . ,iso8601-str))) + (url (mastodon-http--api (format "scheduled_statuses/%s" id))) (response (mastodon-http--put url args))) (mastodon-http--triage response (lambda () @@ -1315,13 +1309,12 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (when ts (let* ((decoded (iso8601-parse ts))) (encode-time decoded)))) -;; we'll need to revisit this if the binds get -;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () "Get a list of the keybindings in the mastodon-toot-mode." (let* ((binds (copy-tree mastodon-toot-mode-map)) (prefix (car (cadr binds))) - (bindings (remove nil (mapcar (lambda (i) (if (listp i) i)) + (bindings (remove nil (mapcar (lambda (i) + (when (listp i) i)) (cadr binds))))) (mapcar (lambda (b) (setf (car b) (vector prefix (car b))) -- cgit v1.2.3 From 96fcaaa8d45eeec63199ac7cc11689dabdec08ee Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 09:14:58 +0200 Subject: revert prev-window-config let --- lisp/mastodon-toot.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d40395f..3fd445c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -631,15 +631,15 @@ REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set." (defun mastodon-toot--kill (&optional cancel) "Kill `mastodon-toot-mode' buffer and window. CANCEL means the toot was not sent, so we save the toot text as a draft." - (unless (eq mastodon-toot-current-toot-text nil) - (when cancel - (cl-pushnew mastodon-toot-current-toot-text - mastodon-toot-draft-toots-list :test 'equal))) - ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot--save-toot-text after-change-functions) - (kill-buffer-and-window) - (mastodon-toot--restore-previous-window-config - mastodon-toot-previous-window-config)) + (let ((prev-window-config mastodon-toot-previous-window-config)) + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot--save-toot-text after-change-functions) + (kill-buffer-and-window) + (mastodon-toot--restore-previous-window-config prev-window-config))) (defun mastodon-toot--cancel () "Kill new-toot buffer/window. Does not POST content to Mastodon. -- cgit v1.2.3 From 8db980e433bce0307802663379b84acb51051200 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 09:29:25 +0200 Subject: count chars: use mastodon-toot-handle-regex --- lisp/mastodon-toot.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3fd445c..3d8c1f3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1539,10 +1539,7 @@ CW is the content warning, which contributes to the character count." (replace-match "xxxxxxxxxxxxxxxxxxxxxxx")) ; 23 x's ;; handle @handles (goto-char (point-min)) - (while (search-forward-regexp (concat "\\(?2:@[^ @\n]+\\)" ; a handle only - "\\(@[^ \n]+\\)?" ; with poss domain - "\\b") - nil t) + (while (search-forward-regexp mastodon-toot-handle-regex nil t) (replace-match (match-string 2))) ; replace with handle only (+ (length cw) (length (buffer-substring (point-min) (point-max)))))) -- cgit v1.2.3 From 74f475a1fd3f69358c6f20c2cb37734509b2799f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 09:30:04 +0200 Subject: audit more of toot.el, kbinds, reply in docs --- lisp/mastodon-toot.el | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3d8c1f3..47ab605 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1360,17 +1360,14 @@ LONGEST is the length of the longest binding." (defun mastodon-toot--formatted-kbinds-longest (kbinds-list) "Return the length of the longest item in KBINDS-LIST." - (let ((lengths (mapcar (lambda (x) - (length x)) - kbinds-list))) + (let ((lengths (mapcar #'length kbinds-list))) (car (sort lengths #'>)))) (defun mastodon-toot--make-mode-docs () "Create formatted documentation text for the mastodon-toot-mode." (let* ((kbinds (mastodon-toot--get-mode-kbinds)) - (longest-kbind - (mastodon-toot--formatted-kbinds-longest - (mastodon-toot--format-kbinds kbinds)))) + (longest-kbind (mastodon-toot--formatted-kbinds-longest + (mastodon-toot--format-kbinds kbinds)))) (concat " Compose a new toot here. The following keybindings are available:" (mapconcat #'identity @@ -1383,15 +1380,12 @@ LONGEST is the length of the longest binding." "Format a REPLY-TEXT for display in compose buffer docs." (let* ((rendered (mastodon-tl--render-text reply-text)) (no-props (substring-no-properties rendered)) - ;; FIXME: this regex replaces \n at end of every post - ;; so we have to trim: + ;; FIXME: this replaces \n at end of every post, so we have to trim: (no-newlines (string-trim (replace-regexp-in-string "[\n]+" " " no-props))) (reply-to (concat " Reply to: \"" no-newlines "\"")) - (crop (truncate-string-to-width - ;; (string-limit - reply-to - mastodon-toot-orig-in-reply-length))) + (crop (truncate-string-to-width reply-to + mastodon-toot-orig-in-reply-length))) (if (> (length no-newlines) (length crop)) ; we cropped: (concat crop "\n") @@ -1457,9 +1451,8 @@ The default is given by `mastodon-toot--default-reply-visibility'." "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))) + (let ((reply-visibility (mastodon-toot--most-restrictive-visibility + (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 b03c31fb467ca367c73b048d8574c1a780994cff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 09:37:29 +0200 Subject: audit of toot.el complete --- lisp/mastodon-toot.el | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 47ab605..11b2bc0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1576,8 +1576,7 @@ Added to `after-change-functions' in new toot buffers." mastodon-toot-draft-toots-list nil t))) (setq mastodon-toot-draft-toots-list - (cl-delete draft mastodon-toot-draft-toots-list - :test 'equal)) + (cl-delete draft mastodon-toot-draft-toots-list :test 'equal)) (message "Draft deleted!")) (message "No drafts to delete."))) @@ -1591,9 +1590,8 @@ Added to `after-change-functions' in new toot buffers." "Propertize tags and handles in toot compose buffer. Added to `after-change-functions'." (when (mastodon-toot--compose-buffer-p) - (let ((header-region - (mastodon-tl--find-property-range 'toot-post-header - (point-min))) + (let ((header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) (face (when mastodon-toot--proportional-fonts-compose 'variable-pitch))) ;; cull any prev props: @@ -1629,14 +1627,10 @@ Added to `after-change-functions'." (save-match-data (let* ((fill-column 67)) (goto-char (point-min)) - ;; while-let shoulndn't be needed here, as we really should only have - ;; one. if we have more, the bug is elsewhere. (when-let ((prop (text-property-search-forward 'toot-reply))) (fill-region (prop-match-beginning prop) (point))))))) -;; NB: now that we have toot drafts, to ensure offline composing remains -;; possible, avoid any direct requests here: (defun mastodon-toot--compose-buffer (&optional reply-to-user reply-to-id reply-json initial-text edit) "Create a new buffer to capture text for a new toot. @@ -1680,10 +1674,9 @@ EDIT means we are editing an existing toot, not composing a new one." (mastodon-toot--get-max-toot-chars)) ;; set up completion: (when mastodon-toot--enable-completion - (set ; (setq-local - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - #'mastodon-toot--mentions-capf)) + (set (make-local-variable 'completion-at-point-functions) + (add-to-list 'completion-at-point-functions + #'mastodon-toot--mentions-capf)) (add-to-list 'completion-at-point-functions #'mastodon-toot--tags-capf) ;; company @@ -1695,10 +1688,10 @@ EDIT means we are editing an existing toot, not composing a new one." (company-mode-on))) ;; after-change: (make-local-variable 'after-change-functions) - (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions) (cl-pushnew #'mastodon-toot--save-toot-text after-change-functions) - (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions) + (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--update-status-fields) + (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions) (mastodon-toot--propertize-tags-and-handles) (mastodon-toot--refresh-attachments-display) ;; draft toot text saving: @@ -1712,6 +1705,7 @@ EDIT means we are editing an existing toot, not composing a new one." ;; flyspell ignore masto toot regexes: (defvar flyspell-generic-check-word-predicate) + (defun mastodon-toot-mode-flyspell-verify () "A predicate function for `flyspell'. Only text that is not one of these faces will be spell-checked." -- 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(-) 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 825f0526352741f3a992a84124c371d7f317b15f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 18:21:06 +0200 Subject: docstring --- lisp/mastodon-profile.el | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0c74dca..a0fc9a1 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -91,11 +91,6 @@ (defvar mastodon-profile-mode-map (let ((map (make-sparse-keymap))) - ;; conflicts with `s' keybinding to translate toot at point - ;; seeing as we now have the C-c C-c cycle functionality, - ;; maybe we can retire both of these awful bindings - ;; (define-key map (kbd "s") #'mastodon-profile--open-followers) - ;; (define-key map (kbd "g") #'mastodon-profile--open-following) (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle) map) "Keymap for `mastodon-profile-mode'.") @@ -105,7 +100,6 @@ This minor mode is used for mastodon profile pages and adds a couple of extra keybindings." :init-value nil - ;; modeline indicator: :lighter " Profile" :keymap mastodon-profile-mode-map :group 'mastodon @@ -555,7 +549,7 @@ FIELDS means provide a fields vector fetched by other means." pinned-statuses)) (defun mastodon-profile--follows-p (list) - "T if you have any relationship." + "T if you have any relationship with the accounts in LIST." (let (result) (dolist (x list result) (when (not (equal :json-false x)) -- 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(+) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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 3796619f9236ea035ed6f8f61704c16d2b13ac5b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 19:51:23 +0200 Subject: audit profile.el --- lisp/mastodon-profile.el | 73 +++++++++++++++++++----------------------------- 1 file changed, 28 insertions(+), 45 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index a0fc9a1..b878352 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -207,6 +207,7 @@ NO-REBLOGS means do not display boosts in statuses." (handle (alist-get 'acct profile))) (mastodon-views--add-account-to-list nil id handle)))) + ;;; ACCOUNT PREFERENCES (defun mastodon-profile--get-json-value (val) @@ -241,9 +242,7 @@ NO-REBLOGS means do not display boosts in statuses." (msg-str "Edit your profile note. C-c C-c to send, C-c C-k to cancel.")) (switch-to-buffer-other-window buffer) (text-mode) - (mastodon-tl--set-buffer-spec (buffer-name buffer) - endpoint - nil) + (mastodon-tl--set-buffer-spec (buffer-name buffer) endpoint nil) (setq-local header-line-format (propertize msg-str 'face font-lock-comment-face)) @@ -257,7 +256,7 @@ NO-REBLOGS means do not display boosts in statuses." 'note-header t) "\n") (make-local-variable 'after-change-functions) - (push #'mastodon-profile--update-note-count after-change-functions) + (cl-pushnew #'mastodon-profile--update-note-count after-change-functions) (let ((start-point (point))) (insert note) (goto-char start-point)) @@ -342,9 +341,7 @@ Only do so if `mastodon-profile-account-settings' is nil." Store the values in `mastodon-profile-account-settings'. Run in `mastodon-mode-hook'. If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." - (unless - (and no-force - mastodon-profile-account-settings) + (unless (and no-force mastodon-profile-account-settings) (let ((keys '(locked discoverable display_name bot)) (source-keys '(privacy sensitive language))) (mapc (lambda (k) @@ -424,10 +421,8 @@ Returns an alist." (format "fields_attributes[%s][value]" count))))) (cl-loop for a-pair in keys for b-pair in fields - append (list (cons (car a-pair) - (car b-pair)) - (cons (cdr a-pair) - (cdr b-pair)))))) + append (list (cons (car a-pair) (car b-pair)) + (cons (cdr a-pair) (cdr b-pair)))))) (defun mastodon-profile--update-meta-fields () "Prompt for new metadata fields information and PATCH the server." @@ -463,7 +458,6 @@ Returns the results as an alist." (read-string (format "Metadata value [%s/4] (max. 255 chars): " x) (cdr f)))))) - ;; hack to avoiding using `string-limit', which req. 28.1: (mapcar (lambda (x) (cons (mastodon-profile--limit-to-255 (car x)) (mastodon-profile--limit-to-255 (cdr x)))) @@ -500,15 +494,15 @@ This endpoint only holds a few preferences. For others, see "\n\n"))) (goto-char (point-min))))) -;; PROFILE VIEW DETAILS + +;;; PROFILE VIEW DETAILS (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." (let* ((their-id id) (args `(("id[]" . ,their-id))) (url (mastodon-http--api "accounts/relationships"))) - ;; FIXME: not sure why we need to do this for relationships only! - (car (mastodon-http--get-json url args)))) + (car (mastodon-http--get-json url args)))) ; API takes array, just get 1st (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -522,8 +516,7 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--fields-insert (fields) "Format and insert field pairs (a.k.a profile metadata) in FIELDS." (let* ((car-fields (mapcar #'car fields)) - (left-width (cl-reduce - #'max (mapcar #'length car-fields)))) + (left-width (cl-reduce #'max (mapcar #'length car-fields)))) (mapconcat (lambda (field) (mastodon-tl--render-text (concat @@ -543,8 +536,7 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--insert-statuses-pinned (pinned-statuses) "Insert each of the PINNED-STATUSES for a given account." (mapc (lambda (pinned-status) - (insert (mastodon-tl--set-face - " :pinned: " 'success)) + (insert (mastodon-tl--set-face " :pinned: " 'success)) (mastodon-tl--toot pinned-status)) pinned-statuses)) @@ -583,10 +575,8 @@ HEADERS means also fetch link headers for pagination." (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-profile-mode) (setq mastodon-profile--account account) - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header) + (mastodon-tl--set-buffer-spec buffer endpoint + update-function link-header) (let* ((inhibit-read-only t) (is-statuses (string= endpoint-type "statuses")) (is-followers (string= endpoint-type "followers")) @@ -604,24 +594,20 @@ HEADERS means also fetch link headers for pagination." (mastodon-profile--image-from-account account 'avatar_static) (mastodon-profile--image-from-account account 'header_static) "\n" - (propertize .display_name - 'face 'mastodon-display-name-face) + (propertize .display_name 'face 'mastodon-display-name-face) "\n" - (propertize (concat "@" .acct) - 'face 'default) + (propertize (concat "@" .acct) 'face 'default) (if (equal .locked t) (concat " " (mastodon-tl--symbol 'locked)) "") "\n " mastodon-tl--horiz-bar "\n" ;; profile note: - ;; account here to enable tab-stops in profile note - (mastodon-tl--render-text .note account) + (mastodon-tl--render-text .note account) ; account = tab-stops in profile ;; meta fields: (if fields - (concat "\n" - (mastodon-tl--set-face - (mastodon-profile--fields-insert fields) - 'success)) + (concat "\n" (mastodon-tl--set-face + (mastodon-profile--fields-insert fields) + 'success)) "") "\n" ;; Joined date: @@ -640,9 +626,8 @@ HEADERS means also fetch link headers for pagination." 'success) ;; insert relationship (follows) (let-alist relationships - (let ((followsp - (mastodon-profile--follows-p - (list .requested_by .following .followed_by)))) + (let ((followsp (mastodon-profile--follows-p + (list .requested_by .following .followed_by)))) (if followsp (mastodon-tl--set-face (concat (when (equal .following 't) @@ -653,19 +638,18 @@ HEADERS means also fetch link headers for pagination." " | REQUESTED TO FOLLOW YOU") "\n\n") 'success) - ""))) ; if no followsp we still need str-or-char-p for insert + ""))) ; for insert call ;; insert endpoint - (mastodon-tl--set-face - (concat " " mastodon-tl--horiz-bar "\n" - endpoint-name "\n" - " " mastodon-tl--horiz-bar "\n") - 'success)) + (mastodon-tl--set-face (concat " " mastodon-tl--horiz-bar "\n" + endpoint-name "\n" + " " mastodon-tl--horiz-bar "\n") + 'success)) (setq mastodon-tl--update-point (point)) (mastodon-media--inline-images (point-min) (point)) ;; insert pinned toots first (when (and pinned (equal endpoint-type "statuses")) (mastodon-profile--insert-statuses-pinned pinned) - (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots + (setq mastodon-tl--update-point (point))) ; updates after pinned toots (funcall update-function json))) (goto-char (point-min))))) @@ -703,8 +687,7 @@ IMG-TYPE is the JSON key from the account data." user-handles nil ; predicate 'confirm))))) - (if (not (or - ;; own profile has no need for toot-json test: + (if (not (or ; own profile has no need for toot-json test: (equal user-handle (mastodon-auth--get-account-name)) (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'toot-json :no-move))) -- cgit v1.2.3 From 549cca828aeb92e882b09346e2ccbb60a3fe9faf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 19:51:42 +0200 Subject: remove useless fun profile--account-field --- lisp/mastodon-profile.el | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index b878352..8c55155 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -509,7 +509,7 @@ This endpoint only holds a few preferences. For others, see Returns an alist. FIELDS means provide a fields vector fetched by other means." (let ((fields (or fields - (mastodon-profile--account-field account 'fields)))) + (alist-get 'fields account)))) (when fields (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) @@ -528,7 +528,7 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--get-statuses-pinned (account) "Fetch the pinned toots for ACCOUNT." - (let* ((id (mastodon-profile--account-field account 'id)) + (let* ((id (alist-get 'id account)) (args `(("pinned" . "true"))) (url (mastodon-http--api (format "accounts/%s/statuses" id)))) (mastodon-http--get-json url args))) @@ -707,11 +707,6 @@ 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--account-field (account field) - "Return FIELD from the ACCOUNT. -FIELD is used to identify regions under `account'." - (cdr (assoc field account))) - (defun mastodon-profile--add-author-bylines (tootv) "Convert TOOTV into a author-bylines and insert. Also insert their profile note. -- cgit v1.2.3 From 6493d0dec1cc311ade347327c2b8f9656779abba Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 19:52:00 +0200 Subject: semi-refactor mastodon-profile--toggle-account-key --- lisp/mastodon-profile.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 8c55155..68d74df 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -394,11 +394,10 @@ Current settings are fetched from the server." (mastodon-profile--get-source-value key) (mastodon-profile--get-json-value key))) (prompt (format "Account setting %s is %s. Toggle?" key val))) - (if val - (when (y-or-n-p prompt) - (mastodon-profile--update-preference (symbol-name key) "false" source)) - (when (y-or-n-p prompt) - (mastodon-profile--update-preference (symbol-name key) "true" source))))) + (when (y-or-n-p prompt) + (mastodon-profile--update-preference (symbol-name key) + (if val "false" "true") + source)))) (defun mastodon-profile--edit-string-value (key) "Edit the string for account preference KEY." -- 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(-) 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 fed797d5ea7ade8c4fdbfd6dbba783d8c67105fb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 20:01:28 +0200 Subject: audit some more profile.el --- lisp/mastodon-profile.el | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index bd59bac..139301f 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -507,8 +507,7 @@ This endpoint only holds a few preferences. For others, see "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. Returns an alist. FIELDS means provide a fields vector fetched by other means." - (let ((fields (or fields - (alist-get 'fields account)))) + (let ((fields (or fields (alist-get 'fields account)))) (when fields (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) @@ -725,7 +724,7 @@ Used to view a user's followers and those they're following." (insert "\n" (propertize (mastodon-tl--render-text (alist-get 'note toot) nil) - 'toot-json toot) ' + 'toot-json toot) "\n"))) tootv)))) @@ -736,13 +735,12 @@ If the handle does not match a search return then retun NIL." (substring handle 1 (length handle)) handle)) (args `(("q" . ,handle))) - (matching-account - (seq-remove - (lambda (x) - (not (string= (alist-get 'acct x) handle))) - (mastodon-http--get-json - (mastodon-http--api "accounts/search") - args)))) + (matching-account (seq-remove + (lambda (x) + (not (string= (alist-get 'acct x) handle))) + (mastodon-http--get-json + (mastodon-http--api "accounts/search") + args)))) (when (equal 1 (length matching-account)) (elt matching-account 0)))) -- cgit v1.2.3 From d7b6621df39f9240de80141c7048101261e5c3e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 8 May 2023 20:35:15 +0200 Subject: finish audit of profile.el --- lisp/mastodon-profile.el | 48 +++++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 29 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 139301f..384f9a9 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -753,21 +753,19 @@ If the handle does not match a search return then retun NIL." "Return all user handles found in STATUS. 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 + (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)) (alist-get 'mentions status))) (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) - (seq-filter - #'stringp - (seq-uniq - (seq-concatenate - 'list - (list (alist-get 'acct this-account)) - (mastodon-profile--extract-users-handles reblog) - (mastodon-tl--map-alist 'acct mentions))))))) + (seq-filter #'stringp + (seq-uniq + (seq-concatenate + 'list + (list (alist-get 'acct this-account)) + (mastodon-profile--extract-users-handles reblog) + (mastodon-tl--map-alist 'acct mentions))))))) (defun mastodon-profile--lookup-account-in-status (handle status) "Return account for HANDLE using hints in STATUS if possible." @@ -775,15 +773,12 @@ These include the author, author of reblogged entries and any user mentioned." (reblog-account (alist-get 'account (alist-get 'reblog status))) (mention-id (seq-some (lambda (mention) - (when (string= handle - (alist-get 'acct mention)) + (when (string= handle (alist-get 'acct mention)) (alist-get 'id mention))) (alist-get 'mentions status)))) - (cond ((string= handle - (alist-get 'acct this-account)) + (cond ((string= handle (alist-get 'acct this-account)) this-account) - ((string= handle - (alist-get 'acct reblog-account)) + ((string= handle (alist-get 'acct reblog-account)) reblog-account) (mention-id (mastodon-profile--account-from-id mention-id)) @@ -798,8 +793,7 @@ Optionally provide the ID of the account to remove." (id (or id (alist-get 'id account))) (handle (if account (alist-get 'acct account) - (let ((account - (mastodon-profile--account-from-id id))) + (let ((account (mastodon-profile--account-from-id id))) (alist-get 'acct account)))) (url (mastodon-http--api (format "accounts/%s/remove_from_followers" id)))) @@ -814,8 +808,7 @@ Optionally provide the ID of the account to remove." (interactive) (let* ((handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json))) - (handle (completing-read "Remove from followers: " - handles nil)) + (handle (completing-read "Remove from followers: " handles nil)) (account (mastodon-profile--lookup-account-in-status handle (mastodon-profile--toot-json))) (id (alist-get 'id account))) @@ -829,11 +822,9 @@ Currently limited to 100 handles. If not found, try (let* ((endpoint (format "accounts/%s/followers" (mastodon-auth--get-account-id))) (url (mastodon-http--api endpoint)) - (response (mastodon-http--get-json url - `(("limit" . "100")))) + (response (mastodon-http--get-json url `(("limit" . "100")))) (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response)) - (choice (completing-read "Remove from followers: " - handles)) + (choice (completing-read "Remove from followers: " handles)) (id (alist-get choice handles nil nil 'equal))) (mastodon-profile--remove-user-from-followers id))) @@ -918,16 +909,15 @@ the given account." (defun mastodon-profile--get-familiar-followers (id) "Return JSON data of familiar followers for account ID." - ;; the server can handle multiple IDs, but for now we just handle one. + ;; the server handles multiple IDs, but we just handle one. (let* ((params `(("id" . ,id))) (url (mastodon-http--api "accounts/familiar_followers")) (json (mastodon-http--get-json url params)) - (accounts (alist-get 'accounts (car json))) ; first id result + (accounts (alist-get 'accounts (car json))) ; first id (handles (mastodon-tl--map-alist 'acct accounts))) (if (null handles) (message "Looks like there are no familiar followers for this account") - (let ((choice (completing-read "Show profile of user: " - handles))) + (let ((choice (completing-read "Show profile of user: " handles))) (mastodon-profile--show-user choice))))) (provide 'mastodon-profile) -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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 32225214c8de7d659af07eba4250fed96c6af852 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 19:21:32 +0200 Subject: let-alist follow-request-process --- lisp/mastodon-notifications.el | 45 +++++++++++++++++++----------------------- 1 file changed, 20 insertions(+), 25 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index bed2d9a..b402f2a 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -108,31 +108,26 @@ follow-requests view." (plist-get mastodon-tl--buffer-spec 'endpoint))) (f-req-p (or (string= "follow_request" (alist-get 'type toot-json)) ;notifs f-reqs-view-p))) - (if f-req-p - (let* ((account (or (alist-get 'account toot-json) ;notifs - toot-json)) ;f-reqs - (id (alist-get 'id account)) - (handle (alist-get 'acct account)) - (name (alist-get 'username account))) - (if id - (let ((response - (mastodon-http--post - (concat - (mastodon-http--api "follow_requests") - (format "/%s/%s" id (if reject - "reject" - "authorize")))))) - (mastodon-http--triage response - (lambda () - (if f-reqs-view-p - (mastodon-views--view-follow-requests) - (mastodon-tl--reload-timeline-or-profile)) - (message "Follow request of %s (@%s) %s!" - name handle (if reject - "rejected" - "accepted"))))) - (message "No account result at point?"))) - (message "No follow request at point?"))))) + (if (not f-req-p) + (message "No follow request at point?") + (let-alist (or (alist-get 'account toot-json) ;notifs + toot-json) ;f-reqs + (if .id + (let ((response + (mastodon-http--post + (concat + (mastodon-http--api "follow_requests") + (format "/%s/%s" .id (if reject "reject" "authorize")))))) + (mastodon-http--triage response + (lambda () + (if f-reqs-view-p + (mastodon-views--view-follow-requests) + (mastodon-tl--reload-timeline-or-profile)) + (message "Follow request of %s (@%s) %s!" + .username .acct (if reject + "rejected" + "accepted"))))) + (message "No account result at point?"))))))) (defun mastodon-notifications--follow-request-accept () "Accept a follow request. -- cgit v1.2.3 From 45b5d3f460e6c5578b35eee4ed5a904b8fbeae91 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 19:32:29 +0200 Subject: audit notifications.el --- lisp/mastodon-notifications.el | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index b402f2a..df96122 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -80,8 +80,7 @@ "Alist of subjects for notification types.") (defvar mastodon-notifications--map - (let ((map - (copy-keymap mastodon-mode-map))) + (let ((map (copy-keymap mastodon-mode-map))) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) (define-key map (kbd "C-k") #'mastodon-notifications--clear-current) @@ -90,11 +89,8 @@ (defun mastodon-notifications--byline-concat (message) "Add byline for TOOT with MESSAGE." - (concat - " " - (propertize message 'face 'highlight) - " " - (cdr (assoc message mastodon-notifications--response-alist)))) + (concat " " (propertize message 'face 'highlight) + " " (cdr (assoc message mastodon-notifications--response-alist)))) (defun mastodon-notifications--follow-request-process (&optional reject) "Process the follow request at point. @@ -181,6 +177,7 @@ Status notifications are given when (status (mastodon-tl--field 'status note)) (follower (alist-get 'username (alist-get 'account note)))) (mastodon-notifications--insert-status + ;; toot (cond ((or (equal type 'follow) (equal type 'follow-request)) ;; Using reblog with an empty id will mark this as something @@ -193,6 +190,7 @@ Status notifications are given when note) (t status)) + ;; body (if (or (equal type 'follow) (equal type 'follow-request)) (propertize (if (equal type 'follow) @@ -204,13 +202,14 @@ Status notifications are given when (if (mastodon-tl--has-spoiler status) (mastodon-tl--spoiler status) (mastodon-tl--content status)))) + ;; author-byline (if (or (equal type 'follow) (equal type 'follow-request) (equal type 'mention)) 'mastodon-tl--byline-author (lambda (_status) - (mastodon-tl--byline-author - note))) + (mastodon-tl--byline-author note))) + ;; action-byline (lambda (_status) (mastodon-notifications--byline-concat (cond ((equal type 'boost) @@ -230,13 +229,13 @@ Status notifications are given when ((equal type 'edit) "Edited")))) id + ;; base toot (when (or (equal type 'favourite) (equal type 'boost)) status)))) -(defun mastodon-notifications--insert-status (toot body - author-byline action-byline id - &optional base-toot) +(defun mastodon-notifications--insert-status + (toot body author-byline action-byline id &optional base-toot) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -301,8 +300,7 @@ Status notifications are created when you call (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE removed." - (let ((types - (mapcar #'car mastodon-notifications--types-alist))) + (let ((types (mapcar #'car mastodon-notifications--types-alist))) (remove type types))) (defun mastodon-notifications--clear-all () -- cgit v1.2.3 From c8fa23d5b587dbc0db705d991622dcbb762e4f25 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 20:01:12 +0200 Subject: fix print instance rules propertize call --- lisp/mastodon-views.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 9974071..0dd74a3 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -892,8 +892,7 @@ IND is the optional indentation level to print at." (indent-to 4) (insert (format "%-5s: " - (propertize key) - 'face '(:underline t)) + (propertize key 'face '(:underline t))) (mastodon-views--newline-if-long value) (format "%s" (mastodon-tl--render-text value)) -- cgit v1.2.3 From dbbf6189edb3a7e883c9bb42ff0a7f812538b441 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 20:19:32 +0200 Subject: small refactor of args at end of instances/rules fun --- lisp/mastodon-views.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 0dd74a3..16bcaa1 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -876,12 +876,9 @@ IND is the optional indentation level to print at." (insert (mastodon-views--format-key el pad) " " (mastodon-views--newline-if-long (cdr el)) - ;; only send strings straight to --render-text - ;; this makes hyperlinks work: - (if (not (stringp val)) - (mastodon-tl--render-text - (prin1-to-string val)) - (mastodon-tl--render-text val)) + ;; only send strings to --render-text (for hyperlinks): + (mastodon-tl--render-text + (if (stringp val) val (prin1-to-string val))) "\n")))))))) (defun mastodon-views--print-instance-rules-or-fields (alist) -- cgit v1.2.3 From 1bebf7abc2b9487eeed847c0be1ec804a856b306 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 20:21:00 +0200 Subject: audit views.el --- lisp/mastodon-views.el | 118 ++++++++++++++++++++----------------------------- 1 file changed, 48 insertions(+), 70 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 16bcaa1..3ee68d9 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -168,26 +168,23 @@ provides the JSON data." (insert (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " (upcase view-name) - "\n " - mastodon-tl--horiz-bar "\n\n") + "\n " mastodon-tl--horiz-bar "\n\n") 'success) (if bindings-string - (mastodon-tl--set-face - (concat "[" bindings-string "]" - "\n\n") - 'font-lock-comment-face) + (mastodon-tl--set-face (concat "[" bindings-string "]\n\n") + 'font-lock-comment-face) "")) (if (seq-empty-p data) (insert (propertize (format "Looks like you have no %s for now." view-name) 'face font-lock-comment-face 'byline t - 'toot-id "0")) ; so point can move here when no filters + 'toot-id "0")) ; so point can move here when no item (funcall insert-fun data) (goto-char (point-min))) - ;; (when json + ;; (when data ;; FIXME: this seems to trigger a new request, but ideally would run. - ;; (mastodon-tl--goto-next-toot)))) + ;; (mastodon-tl--goto-next-toot)) ) @@ -196,8 +193,7 @@ provides the JSON data." (defun mastodon-views--view-lists () "Show the user's lists in a new buffer." (interactive) - (mastodon-tl--init-sync "lists" - "lists" + (mastodon-tl--init-sync "lists" "lists" 'mastodon-views--insert-lists) (with-current-buffer "*mastodon-lists*" (use-local-map mastodon-views--view-lists-keymap))) @@ -214,8 +210,7 @@ provides the JSON data." (defun mastodon-views--print-list-set (lists) "Print each account plus a separator for each list in LISTS." - (let ((lists-names - (mastodon-tl--map-alist 'title lists))) + (let ((lists-names (mastodon-tl--map-alist 'title lists))) (mapc (lambda (x) (mastodon-views--print-list-accounts x) (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n") @@ -237,16 +232,14 @@ a: add account to this list, r: remove account from this list" 'keymap mastodon-views--list-name-keymap 'list-name list-name 'list-id id) - (propertize - "\n\n" - 'list t - 'keymap mastodon-views--list-name-keymap - 'list-name list-name - 'list-id id) + (propertize "\n\n" + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id) (propertize (mapconcat #'mastodon-search--propertize-user accounts " ") - ;; (mastodon-search--insert-users-propertized accounts) 'list t 'keymap mastodon-views--list-name-keymap 'list-name list-name @@ -293,13 +286,12 @@ If ID is provided, use that list." (let* ((list-names (unless id (mastodon-views--get-lists-names))) (name-old (if id (mastodon-tl--property 'list-name :no-move) - (completing-read "Edit list: " - list-names))) + (completing-read "Edit list: " list-names))) (id (or id (mastodon-views--get-list-id name-old))) (name-choice (read-string "List name: " name-old)) (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") - nil t nil nil "list")) + nil :match nil nil "list")) (url (mastodon-http--api (format "lists/%s" id))) (response (mastodon-http--put url `(("title" . ,name-choice) @@ -341,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 t nil nil "list")) ; default + nil :match nil nil "list")) ; default (response (mastodon-http--post (mastodon-http--api "lists") `(("title" . ,title) ("replies_policy" . ,replies-policy)) @@ -362,8 +354,7 @@ If ID is provided, delete that list." (let* ((list-names (unless id (mastodon-views--get-lists-names))) (name (if id (mastodon-views--get-list-name id) - (completing-read "Delete list: " - list-names))) + (completing-read "Delete list: " list-names))) (id (or id (mastodon-views--get-list-id name))) (url (mastodon-http--api (format "lists/%s" id)))) (when (y-or-n-p (format "Delete list %s?" name)) @@ -402,11 +393,9 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." handles nil t))) (account-id (or account-id (alist-get account handles nil nil 'equal))) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (response (mastodon-http--post url - `(("account_ids[]" . ,account-id))))) + (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) (mastodon-views--list-action-triage - response - (message "%s added to list %s!" account list-name)))) + response (message "%s added to list %s!" account list-name)))) (defun mastodon-views--add-toot-account-at-point-to-list () "Prompt for a list, and add the account of the toot at point to it." @@ -441,8 +430,7 @@ If ID is provided, use that list." (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) (response (mastodon-http--delete url args))) (mastodon-views--list-action-triage - response - (message "%s removed from list %s!" account list-name)))) + response (message "%s removed from list %s!" account list-name)))) (defun mastodon-views--list-action-triage (response message) "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." @@ -590,8 +578,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (defun mastodon-views--view-filters () "View the user's filters in a new buffer." (interactive) - (mastodon-tl--init-sync "filters" - "filters" + (mastodon-tl--init-sync "filters" "filters" 'mastodon-views--insert-filters) (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) @@ -643,8 +630,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 ; no predicate - t))) ; require-match, as context is mandatory + nil :match))) (contexts-processed (if (equal nil contexts) (error "You must select at least one context for a filter") @@ -657,7 +643,6 @@ Prompt for a context, must be a list containting at least one of \"home\", (mastodon-http--triage response (lambda () (message "Filter created for %s!" word) - ;; reload if we are in filters view: (when (mastodon-tl--buffer-type-eq 'filters) (mastodon-views--view-filters)))))) @@ -666,15 +651,15 @@ Prompt for a context, must be a list containting at least one of \"home\", (interactive) (let* ((filter-id (mastodon-tl--property 'toot-id :no-move)) (phrase (mastodon-tl--property 'phrase :no-move)) - (url (mastodon-http--api - (format "filters/%s" filter-id)))) + (url (mastodon-http--api (format "filters/%s" filter-id)))) (if (null phrase) (error "No filter at point?") (when (y-or-n-p (format "Delete filter %s? " phrase))) (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response (lambda () - (mastodon-views--view-filters) - (message "Filter for \"%s\" deleted!" phrase))))))) + (mastodon-http--triage + response (lambda () + (mastodon-views--view-filters) + (message "Filter for \"%s\" deleted!" phrase))))))) ;;; FOLLOW SUGGESTIONS @@ -757,8 +742,7 @@ INSTANCE is an instance domain name." (let* ((toot (if (mastodon-tl--profile-buffer-p) ;; we may be on profile description itself: (or (mastodon-tl--property 'profile-json) - ;; or on profile account listings, which use toot-json: - ;; or just toots: + ;; or on profile account listings, or just toots: (mastodon-tl--property 'toot-json)) ;; normal timeline/account listing: (mastodon-tl--property 'toot-json))) @@ -820,16 +804,14 @@ INSTANCE is the instance were are working with." (format (concat "%-" (number-to-string pad) "s: ") - (propertize - (prin1-to-string (car el)) - 'face '(:underline t)))) + (propertize (prin1-to-string (car el)) + 'face '(:underline t)))) (defun mastodon-views--print-json-keys (response &optional ind) "Print the JSON keys and values in RESPONSE. IND is the optional indentation level to print at." - (let* ((cars (mapcar - (lambda (x) (symbol-name (car x))) - response)) + (let* ((cars (mapcar (lambda (x) (symbol-name (car x))) + response)) (pad (1+ (cl-reduce #'max (mapcar #'length cars))))) (while response (let ((el (pop response))) @@ -838,9 +820,8 @@ IND is the optional indentation level to print at." ((and (vectorp (cdr el)) (not (seq-empty-p (cdr el))) (consp (seq-elt (cdr el) 0))) - (insert - (mastodon-views--format-key el pad) - "\n\n") + (insert (mastodon-views--format-key el pad) + "\n\n") (seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el)) (insert "\n")) ;; vector of strings (media types): @@ -849,19 +830,17 @@ IND is the optional indentation level to print at." (< 1 (seq-length (cdr el))) (stringp (seq-elt (cdr el) 0))) (when ind (indent-to ind)) - (insert - (mastodon-views--format-key el pad) - "\n" - (seq-mapcat - (lambda (x) (concat x ", ")) - (cdr el) 'string) - "\n\n")) + (insert (mastodon-views--format-key el pad) + "\n" + (seq-mapcat + (lambda (x) (concat x ", ")) + (cdr el) 'string) + "\n\n")) ;; basic nesting: ((consp (cdr el)) (when ind (indent-to ind)) - (insert - (mastodon-views--format-key el pad) - "\n\n") + (insert (mastodon-views--format-key el pad) + "\n\n") (mastodon-views--print-json-keys (cdr el) (if ind (+ ind 4) 4))) (t @@ -887,13 +866,12 @@ IND is the optional indentation level to print at." (let ((key (or .id .name .shortcode)) (value (or .text .value .url))) (indent-to 4) - (insert - (format "%-5s: " - (propertize key 'face '(:underline t))) - (mastodon-views--newline-if-long value) - (format "%s" (mastodon-tl--render-text - value)) - "\n")))) + (insert (format "%-5s: " + (propertize key 'face '(:underline t))) + (mastodon-views--newline-if-long value) + (format "%s" (mastodon-tl--render-text + value)) + "\n")))) (defun mastodon-views--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." -- cgit v1.2.3 From 641e0ca808edd6584d12dfbc1f53fc992efd7a19 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 20:21:18 +0200 Subject: refactor a profile-note-p in view instance descript --- lisp/mastodon-views.el | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 3ee68d9..41f68b8 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -750,18 +750,16 @@ INSTANCE is an instance domain name." (account (or (alist-get 'account reblog) (alist-get 'account toot) toot)) ; else `toot' is already an account listing. - ;; we can't use --profile-buffer-p as our test here because we may - ;; be looking at toots/boosts/users in a profile buffer. - ;; profile-json works as a defacto test for if point is on the - ;; profile details at the top of a profile buffer. - (url (if (and (mastodon-tl--profile-buffer-p) - ;; only call this in profile buffers: - (mastodon-tl--property 'profile-json)) + ;; we may be at toots/boosts/users in a profile buffer. + ;; profile-json is a defacto test for if point is on the profile + ;; details at the top of a profile buffer. + (profile-note-p (and (mastodon-tl--profile-buffer-p) + ;; only call this in profile buffers: + (mastodon-tl--property 'profile-json))) + (url (if profile-note-p (alist-get 'url toot) ; profile description (alist-get 'url account))) - (username (if (and (mastodon-tl--profile-buffer-p) - ;; only call this in profile buffers: - (mastodon-tl--property 'profile-json)) + (username (if profile-note-p (alist-get 'username toot) ;; profile (alist-get 'username account))) (instance (mastodon-views--get-instance-url url username instance)) -- cgit v1.2.3 From b302dafd3a116b7f26326dd13247f131b728f132 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 9 May 2023 20:21:56 +0200 Subject: adjust call of insert-filter-string --- lisp/mastodon-views.el | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 41f68b8..c86884f 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -595,10 +595,7 @@ JSON is what is returned by by the server." (defun mastodon-views--insert-filter-string-set (json) "Insert a filter string plus a blank line. JSON is the filters data." - (mapc (lambda (x) - (mastodon-views--insert-filter-string x) - (insert "\n\n")) - json)) + (mapc #'mastodon-views--insert-filter-string json)) (defun mastodon-views--insert-filter-string (filter) "Insert a single FILTER." @@ -611,9 +608,8 @@ JSON is the filters data." (propertize filter-string 'toot-id id ;for goto-next-filter compat 'phrase phrase - ;;'help-echo "n/p to go to next/prev filter, c to create new filter, d to delete filter at point." - ;;'keymap mastodon-views--view-filters-keymap - 'byline t)))) ;for goto-next-filter compat + 'byline t) ;for goto-next-filter compat + "\n\n"))) (defun mastodon-views--create-filter () "Create a filter for a word. -- cgit v1.2.3 From 528494a2340c46cdf5d589cc95d16d7b3b1a1208 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 08:39:27 +0200 Subject: refactor format-heading in search.el --- lisp/mastodon-search.el | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 4b5f2e0..5e0cc20 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -135,6 +135,14 @@ PRINT-FUN is the function used to print the data from the response." ;; functions for mastodon search +(defun mastodon-search--format-heading (heading) + "Format HEADING as a heading." + (insert + (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " + heading "\n" + " " mastodon-tl--horiz-bar "\n") + 'success))) + (defun mastodon-search--search-query (query) "Prompt for a search QUERY and return accounts, statuses, and hashtags." (interactive "sSearch mastodon for: ") @@ -156,25 +164,13 @@ PRINT-FUN is the function used to print the data from the response." "api/v2/search" nil) ;; user results: - (insert (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n" - " USERS\n" - " " mastodon-tl--horiz-bar "\n\n") - 'success)) + (mastodon-search--format-heading "USERS") (mastodon-search--insert-users-propertized accts :note) ;; hashtag results: - (insert (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n" - " HASHTAGS\n" - " " mastodon-tl--horiz-bar "\n\n") - 'success)) + (mastodon-search--format-heading "HASHTAGS") (mastodon-search--print-tags-list tags-list) ;; status results: - (insert (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n" - " STATUSES\n" - " " mastodon-tl--horiz-bar "\n") - 'success)) + (mastodon-search--format-heading "STATUSES") (mapc #'mastodon-tl--toot toots-list-json) (goto-char (point-min))))) -- cgit v1.2.3 From 5ade017ba748c736079aa42839e5826ec35406bc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 08:40:03 +0200 Subject: audit search.el --- lisp/mastodon-search.el | 81 ++++++++++++++++++++++--------------------------- 1 file changed, 36 insertions(+), 45 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 5e0cc20..1d78cc2 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -62,9 +62,12 @@ "Prompt for a search QUERY and return accounts synchronously. Returns a nested list containing user handle, display name, and URL." (let* ((url (mastodon-http--api "accounts/search")) - (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-json url `(("q" . ,query) ("following" . "true")) :silent) - (mastodon-http--get-json url `(("q" . ,query)) :silent)))) + (response + (if (equal mastodon-toot--completion-style-for-mentions "following") + (mastodon-http--get-json + url `(("q" . ,query) ("following" . "true")) + :silent) + (mastodon-http--get-json url `(("q" . ,query)) :silent)))) (mapcar #'mastodon-search--get-user-info-@ response))) ;; functions for tags completion: @@ -73,8 +76,7 @@ Returns a nested list containing user handle, display name, and URL." "Return an alist containing tag strings plus their URLs. QUERY is the string to search." (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (params `(("q" . ,query) - ("type" . "hashtags"))) + (params `(("q" . ,query) ("type" . "hashtags"))) (response (mastodon-http--get-json url params :silent)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) @@ -95,10 +97,8 @@ QUERY is the string to search." (defun mastodon-search--get-full-statuses-data (response) "For statuses list in RESPONSE, fetch and return full status JSON." - (let ((status-ids-list - (mapcar #'mastodon-search--get-id-from-status response))) - (mapcar #'mastodon-search--fetch-full-status-from-id - status-ids-list))) + (let ((status-ids (mapcar #'mastodon-search--get-id-from-status response))) + (mapcar #'mastodon-search--fetch-full-status-from-id status-ids))) (defun mastodon-search--view-trending (type print-fun) "Display a list of tags trending on your instance. @@ -108,18 +108,16 @@ PRINT-FUN is the function used to print the data from the response." (format "trends/%s" type))) ;; max for statuses = 40, for others = 20 (params (if (equal type "statuses") - `(("limit" . "40")) - `(("limit" . "20")) )) + '(("limit" . "40")) + '(("limit" . "20")))) (response (mastodon-http--get-json url params)) (data (cond ((equal type "tags") - (mapcar #'mastodon-search--get-hashtag-info - response)) + (mapcar #'mastodon-search--get-hashtag-info response)) ((equal type "statuses") (mastodon-search--get-full-statuses-data response)) ((equal type "links") (message "todo")))) - (buffer (get-buffer-create - (format "*mastodon-trending-%s*" type)))) + (buffer (get-buffer-create (format "*mastodon-trending-%s*" type)))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec (buffer-name buffer) (format "api/v1/trends/%s" type) @@ -152,17 +150,10 @@ PRINT-FUN is the function used to print the data from the response." (accts (alist-get 'accounts response)) (tags (alist-get 'hashtags response)) (statuses (alist-get 'statuses response)) - ;; this is now done in search--insert-users-propertized - ;; (user-ids (mapcar #'mastodon-search--get-user-info - ;; accts)) ; returns a list of three-item lists - (tags-list (mapcar #'mastodon-search--get-hashtag-info - tags)) - (toots-list-json - (mastodon-search--get-full-statuses-data statuses))) + (tags-list (mapcar #'mastodon-search--get-hashtag-info tags)) + (toots-list-json (mastodon-search--get-full-statuses-data statuses))) (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec buffer - "api/v2/search" - nil) + (mastodon-tl--set-buffer-spec buffer "api/v2/search" nil) ;; user results: (mastodon-search--format-heading "USERS") (mastodon-search--insert-users-propertized accts :note) @@ -190,32 +181,32 @@ user's profile note. This is also called by "Propertize display string for ACCT, optionally including profile NOTE." (let ((user (mastodon-search--get-user-info acct))) (propertize - (concat (propertize (car user) - 'face 'mastodon-display-name-face - 'byline t - 'toot-id "0") - " : \n : " - (propertize (concat "@" (cadr user)) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" (cadr user)) - 'help-echo (concat "Browse user profile of @" (cadr user))) - " : \n" - (if note - (mastodon-tl--render-text (cadddr user) acct) - "") - "\n") - 'toot-json acct))) ; so named for compat w other processing functions + (concat + (propertize (car user) + 'face 'mastodon-display-name-face + 'byline t + 'toot-id "0") + " : \n : " + (propertize (concat "@" (cadr user)) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" (cadr user)) + 'help-echo (concat "Browse user profile of @" (cadr user))) + " : \n" + (if note + (mastodon-tl--render-text (cadddr user) acct) + "") + "\n") + 'toot-json acct))) ; for compat w other processing functions (defun mastodon-search--print-tags-list (tags) "Insert a propertized list of TAGS." (mapc (lambda (el) (insert " : " - (propertize (concat "#" - (car el)) + (propertize (concat "#" (car el)) 'face '(:box t) 'mouse-face 'highlight 'mastodon-tag (car el) -- cgit v1.2.3 From 2e4ec6b3bb98d18eff6a6d2048cab82eb517fb20 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 08:57:48 +0200 Subject: audit media.el --- lisp/mastodon-media.el | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 4d36f47..0c40ca5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -145,7 +145,7 @@ IMAGE-OPTIONS are the precomputed options to apply to the image. MARKER is the marker to where the response should be visible. REGION-LENGTH is the length of the region that should be replaced with the image." - (when (marker-buffer marker) ; only if the buffer hasn't been kill in the meantime + (when (marker-buffer marker) ; if buffer hasn't been killed (let ((url-buffer (current-buffer)) (is-error-response-p (eq :error (car status-plist)))) (unwind-protect @@ -193,8 +193,7 @@ REGION-LENGTH is the range from start to propertize." `(:max-height ,mastodon-media--preview-max-height)))))) (let ((buffer (current-buffer)) (marker (copy-marker start)) - ;; Keep url.el from spamming us with messages about connecting to hosts: - (url-show-status nil)) + (url-show-status nil)) ; stop url.el from spamming us about connecting (condition-case nil ;; catch any errors in url-retrieve so as to not abort ;; whatever called us @@ -204,11 +203,12 @@ REGION-LENGTH is the range from start to propertize." (with-current-buffer (url-fetch-from-cache url) (set-buffer-multibyte nil) (goto-char (point-min)) - (zlib-decompress-region (goto-char (search-forward "\n\n")) (point-max)) - (mastodon-media--process-image-response nil marker image-options region-length url)) + (zlib-decompress-region + (goto-char (search-forward "\n\n")) (point-max)) + (mastodon-media--process-image-response + nil marker image-options region-length url)) ;; else fetch as usual and process-image-response will cache it - (url-retrieve url - #'mastodon-media--process-image-response + (url-retrieve url #'mastodon-media--process-image-response (list marker image-options region-length url))) (error (with-current-buffer buffer ;; TODO: Consider adding retries @@ -224,20 +224,20 @@ Returns the list of (`start' . `end', `media-symbol') points of that line and string found or nil no more media links were found." (let ((next-pos (point))) - (while (and (setq next-pos (next-single-property-change next-pos 'media-state)) - (or (not (eq 'needs-loading (get-text-property next-pos 'media-state))) - (null (get-text-property next-pos 'media-url)) - (null (get-text-property next-pos 'media-type)))) + (while + (and + (setq next-pos (next-single-property-change next-pos 'media-state)) + (or (not (eq 'needs-loading (get-text-property next-pos 'media-state))) + (null (get-text-property next-pos 'media-url)) + (null (get-text-property next-pos 'media-type)))) ;; do nothing - the loop will proceed ) (when (and next-pos (< next-pos end-pos)) (let ((media-type (get-text-property next-pos 'media-type))) (cond - ;; Avatars are just one character in the buffer - ((eq media-type 'avatar) + ((eq media-type 'avatar) ; avatars are one character (list next-pos (+ next-pos 1) 'avatar)) - ;; Media links are 5 character ("[img]") - ((eq media-type 'media-link) + ((eq media-type 'media-link) ; media links are 5 characters: [img] (list next-pos (+ next-pos 5) 'media-link))))))) (defun mastodon-media--valid-link-p (link) @@ -254,8 +254,8 @@ Replace them with the referenced image." (save-excursion (goto-char search-start) (let (line-details) - (while (setq line-details (mastodon-media--select-next-media-line - search-end)) + (while (setq line-details + (mastodon-media--select-next-media-line search-end)) (let* ((start (car line-details)) (end (cadr line-details)) (media-type (cadr (cdr line-details))) @@ -302,17 +302,18 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url - type caption) +(defun mastodon-media--get-media-link-rendering + (media-url &optional full-remote-url type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." - (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") + (let* ((help-echo-base + "RET/i: load full image (prefix: copy URL), +/-: zoom,\ +r: rotate, o: save preview") (help-echo (if caption (concat help-echo-base - "\n\"" - caption "\"") + "\n\"" caption "\"") help-echo-base))) (concat (mastodon-tl--propertize-img-str-or-url -- cgit v1.2.3 From 8520659c0908a553a7c646fe788bbc64deea903b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:22:25 +0200 Subject: refactor concat-params-to-url, replace append-query string --- lisp/mastodon-auth.el | 4 ++-- lisp/mastodon-http.el | 56 ++++++++++++++++++--------------------------------- 2 files changed, 22 insertions(+), 38 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 0db8a19..e8ff282 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -41,7 +41,7 @@ (autoload 'mastodon-client--make-user-active "mastodon-client") (autoload 'mastodon-client--store-access-token "mastodon-client") (autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--append-query-string "mastodon-http") +(autoload 'mastodon-http--concat-params-to-url "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -83,7 +83,7 @@ We apologize for the inconvenience. (defun mastodon-auth--get-browser-login-url () "Return properly formed browser login url." - (mastodon-http--append-query-string + (mastodon-http--concat-params-to-url (concat mastodon-instance-url "/oauth/authorize/") `(("response_type" "code") ("redirect_uri" ,mastodon-client-redirect-uri) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 49ffbf8..9d9b6e4 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -147,19 +147,21 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) +(defun mastodon-http--concat-params-to-url (url params) + "Build a query string with PARAMS and concat to URL." + (if params + (concat url "?" + (mastodon-http--build-params-string params)) + url)) (defun mastodon-http--get (url &optional params silent) "Make synchronous GET request to URL. PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." - (mastodon-http--authorized-request - "GET" - ;; url-request-data doesn't seem to work with GET requests: - (let ((url (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url))) - (mastodon-http--url-retrieve-synchronously url silent)))) + (mastodon-http--authorized-request "GET" + ;; url-request-data doesn't seem to work with GET requests?: + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--url-retrieve-synchronously url silent)))) (defun mastodon-http--get-response (url &optional params no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. @@ -232,15 +234,10 @@ Callback to `mastodon-http--get-response-async', usually "Make DELETE request to URL. PARAMS is an alist of any extra parameters to send with the request." ;; url-request-data only works with POST requests? - (let ((url - (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url))) - (mastodon-http--authorized-request - "DELETE" - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))))) + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--authorized-request "DELETE" + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--put (url &optional params headers) "Make PUT request to URL. @@ -258,12 +255,6 @@ HEADERS is an alist of any extra headers to send with the request." headers))) (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) -(defun mastodon-http--append-query-string (url params) - "Append PARAMS to URL as query strings and return it. -PARAMS should be an alist as required by `url-build-query-string'." - (let ((query-string (url-build-query-string params))) - (concat url "?" query-string))) - ;; profile update functions (defun mastodon-http--patch-json (url &optional params) @@ -275,12 +266,9 @@ Optionally specify the PARAMS to send." (defun mastodon-http--patch (base-url &optional params) "Make synchronous PATCH request to BASE-URL. Optionally specify the PARAMS to send." - (mastodon-http--authorized-request - "PATCH" - (let ((url - (concat base-url "?" - (mastodon-http--build-params-string params)))) - (mastodon-http--url-retrieve-synchronously url)))) + (mastodon-http--authorized-request "PATCH" + (let ((url (mastodon-http--concat-params-to-url base-url params))) + (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions @@ -288,13 +276,9 @@ Optionally specify the PARAMS to send." "Make GET request to URL. Pass response buffer to CALLBACK function with args CBARGS. PARAMS is an alist of any extra parameters to send with the request." - (let ((url (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url))) - (mastodon-http--authorized-request - "GET" - (url-retrieve url callback cbargs)))) + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--authorized-request "GET" + (url-retrieve url callback cbargs)))) (defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) "Make GET request to URL. Call CALLBACK with http response and CBARGS. -- cgit v1.2.3 From 0326fb24ff527cd67916f9392387068037068b7c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:23:25 +0200 Subject: audit http.el --- lisp/mastodon-http.el | 95 +++++++++++++++++++++++---------------------------- 1 file changed, 43 insertions(+), 52 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9d9b6e4..ba79bd0 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -86,8 +86,6 @@ Message status and JSON error from RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - ;; don't switch to buffer, just with-current-buffer the response: - ;; (switch-to-buffer response) ;; 404 sometimes returns http response so --process-json fails: (if (string-prefix-p "404" status) (message "Error %s: page not found" status) @@ -104,7 +102,8 @@ Message status and JSON error from RESPONSE if unsuccessful." (defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p) "Make a METHOD type request using BODY, with Mastodon authorization. Unless UNAUTHENTICATED-P is non-nil." - (declare (debug 'body)) + (declare (debug 'body) + (indent 1)) `(let ((url-request-method ,method) (url-request-extra-headers (unless ,unauthenticated-p @@ -115,14 +114,12 @@ Unless UNAUTHENTICATED-P is non-nil." (defun mastodon-http--build-params-string (params) "Build a request parameters string from parameters alist PARAMS." ;; (url-build-query-string args nil)) - ;; url-build-query-string adds 'nil' to empty params so lets stay with our + ;; url-build-query-string adds 'nil' for empty params so lets stick with our ;; own: (mapconcat (lambda (p) (concat (url-hexify-string (car p)) - "=" - (url-hexify-string (cdr p)))) - params - "&")) + "=" (url-hexify-string (cdr p)))) + params "&")) (defun mastodon-http--build-array-params-alist (param-str array) "Return parameters alist using PARAM-STR and ARRAY param values. @@ -133,20 +130,18 @@ Used for API form data parameters that take an array." (defun mastodon-http--post (url &optional params headers unauthenticated-p) "POST synchronously to URL, optionally with PARAMS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." - (mastodon-http--authorized-request - "POST" - (let ((url-request-data - (when params - (mastodon-http--build-params-string params))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - ;; pleroma compat: - (unless (assoc "Content-Type" headers) - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))) - unauthenticated-p)) + (mastodon-http--authorized-request "POST" + (let ((url-request-data (when params + (mastodon-http--build-params-string params))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))) + unauthenticated-p)) + (defun mastodon-http--concat-params-to-url (url params) "Build a query string with PARAMS and concat to URL." (if params @@ -199,17 +194,14 @@ Callback to `mastodon-http--get-response-async', usually (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-array-type (if vector 'vector 'list)) - (json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) + (json-string (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) (kill-buffer) - ;; (unless (or (string-empty-p json-string) (null json-string)) (cond ((or (string-empty-p json-string) (null json-string)) nil) - ;; if we don't have json, maybe we have a plain string error - ;; message (misskey works like this for instance, but there are - ;; probably less dunce ways to do this): + ;; if no json, maybe we have a plain string error message (misskey + ;; does this, but there are probably better ways to do this): ;; FIXME: friendica at least sends plain html if endpoint not found. ((not (or (string-prefix-p "\n{" json-string) (string-prefix-p "\n[" json-string))) @@ -243,17 +235,15 @@ PARAMS is an alist of any extra parameters to send with the request." "Make PUT request to URL. PARAMS is an alist of any extra parameters to send with the request. HEADERS is an alist of any extra headers to send with the request." - (mastodon-http--authorized-request - "PUT" - (let ((url-request-data - (when params (mastodon-http--build-params-string params))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - ;; pleroma compat: - (unless (assoc "Content-Type" headers) - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) + (mastodon-http--authorized-request "PUT" + (let ((url-request-data + (when params (mastodon-http--build-params-string params))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) ;; profile update functions @@ -287,7 +277,7 @@ PARAMS is an alist of any extra parameters to send with the request." url params (lambda (status) - (when status ;; only when we actually get sth? + (when status ; for flakey servers (apply callback (mastodon-http--process-response) cbargs))))) (defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) @@ -304,14 +294,12 @@ PARAMS is an alist of any extra parameters to send with the request." "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (mastodon-http--authorized-request - "POST" - (let ((request-timeout 5) - (url-request-data - (when params - (mastodon-http--build-params-string params)))) - (with-temp-buffer - (url-retrieve url callback cbargs))))) + (mastodon-http--authorized-request "POST" + (let ((request-timeout 5) + (url-request-data (when params + (mastodon-http--build-params-string params)))) + (with-temp-buffer + (url-retrieve url callback cbargs))))) ;; TODO: test for curl first? (defun mastodon-http--post-media-attachment (url filename caption) @@ -353,9 +341,12 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." ;; handle mastodon api errors ;; they have the form (error http 401) ((= (car (last error-thrown)) 401) - (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) + (message "Got error: %s Unauthorized: The access token is invalid" + error-thrown)) ((= (car (last error-thrown)) 422) - (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown)) + (message "Got error: %s Unprocessable entity: file or file\ + type is unsupported or invalid" + error-thrown)) (t (message "Got error: %s Shit went south" error-thrown)))))))) -- cgit v1.2.3 From 3d3c5b5eaf1c367ca151ad0493566be498e22f3e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:26:05 +0200 Subject: remove package-requires from inspect.el --- lisp/mastodon-inspect.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 112a753..c332dde 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -6,7 +6,6 @@ ;; Marty Hiatt ;; Maintainer: Marty Hiatt ;; Version: 1.0.0 -;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://codeberg.org/martianh/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From cec605b86a64582f3eb237aec36678cdf311a801 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:55:09 +0200 Subject: audit client.el --- lisp/mastodon-client.el | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index b358ed7..9b4fee9 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -62,14 +62,13 @@ (defun mastodon-client--register () "POST client to Mastodon." - (mastodon-http--post - (mastodon-http--api "apps") - `(("client_name" . "mastodon.el") - ("redirect_uris" . ,mastodon-client-redirect-uri) - ("scopes" . ,mastodon-client-scopes) - ("website" . ,mastodon-client-website)) - nil - :unauthenticated)) + (mastodon-http--post (mastodon-http--api "apps") + `(("client_name" . "mastodon.el") + ("redirect_uris" . ,mastodon-client-redirect-uri) + ("scopes" . ,mastodon-client-scopes) + ("website" . ,mastodon-client-website)) + nil + :unauthenticated)) (defun mastodon-client--fetch () "Return JSON from `mastodon-client--register' call." @@ -154,7 +153,6 @@ Return the plist after the operation." (defun mastodon-client--form-user-from-vars () "Create a username from user variable. Return that username. - Username in the form user@instance.com is formed from the variables `mastodon-instance-url' and `mastodon-active-user'." (concat mastodon-active-user @@ -182,7 +180,6 @@ Otherwise return nil." (defun mastodon-client--active-user () "Return the details of the currently active user. - Details is a plist." (let ((active-user-details mastodon-client--active-user-details-plist)) (unless active-user-details @@ -195,7 +192,6 @@ Details is a plist." (defun mastodon-client () "Return variable client secrets to use for `mastodon-instance-url'. - Read plist from `mastodon-client--token-file' if variable is nil. Fetch and store plist if `mastodon-client--read' returns nil." (let ((client-details -- cgit v1.2.3 From 59a6bb22e51bfcb5d3840315848006272a8341ea Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 09:58:24 +0200 Subject: audit auth.el --- lisp/mastodon-auth.el | 37 ++++++++++++------------------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index e8ff282..96bf877 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -108,11 +108,9 @@ code. Copy this code and paste it in the minibuffer prompt." NOTICE is displayed in vertical split occupying 50% of total width. The buffer name of the buffer being displayed in the window is BUFFER-NAME. - When optional argument ASK is given which should be a string, use ASK as the minibuffer prompt. Return whatever user types in response to the prompt. - When ASK is absent return nil." (let ((buffer (get-buffer-create buffer-name)) (inhibit-read-only t) @@ -170,25 +168,21 @@ When ASK is absent return nil." (defun mastodon-auth--access-token () "Return the access token to use with `mastodon-instance-url'. - Generate/save token if none known yet." (cond (mastodon-auth--token-alist - ;; user variables are known and - ;; initialised already. + ;; user variables are known and initialised. (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil 'equal)) ((plist-get (mastodon-client--active-user) :access_token) - ;; user variables needs to initialised by reading from - ;; plstore. + ;; user variables need to be read from plstore. (push (cons mastodon-instance-url (plist-get (mastodon-client--active-user) :access_token)) mastodon-auth--token-alist) (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil 'equal)) ((null mastodon-active-user) - ;; user not aware of 2FA related changes and has not set the - ;; `mastodon-active-user' properly. Make user aware and error - ;; out. + ;; user not aware of 2FA-related changes and has not set + ;; `mastodon-active-user'. Make user aware and error out. (mastodon-auth--show-notice mastodon-auth--user-unaware "*mastodon-notice*") (error "Variables not set properly")) @@ -199,9 +193,7 @@ Generate/save token if none known yet." (defun mastodon-auth--handle-token-response (response) "Add token RESPONSE to `mastodon-auth--token-alist'. - The token is returned by `mastodon-auth--get-token'. - Handle any errors from the server." (pcase response ((and (let token (plist-get response :access_token)) @@ -210,28 +202,23 @@ Handle any errors from the server." (mastodon-client--store-access-token token)) (cdar (push (cons mastodon-instance-url token) mastodon-auth--token-alist))) - (`(:error ,class :error_description ,error) (error "Mastodon-auth--access-token: %s: %s" class error)) (_ (error "Unknown response from mastodon-auth--get-token!")))) (defun mastodon-auth--get-account-name () "Request user credentials and return an account name." - (alist-get - 'acct - (mastodon-http--get-json - (mastodon-http--api - "accounts/verify_credentials") - nil - :silent))) + (alist-get 'acct + (mastodon-http--get-json (mastodon-http--api + "accounts/verify_credentials") + nil + :silent))) (defun mastodon-auth--get-account-id () "Request user credentials and return an account name." - (alist-get - 'id - (mastodon-http--get-json - (mastodon-http--api - "accounts/verify_credentials")))) + (alist-get 'id + (mastodon-http--get-json (mastodon-http--api + "accounts/verify_credentials")))) (defun mastodon-auth--user-acct () "Return a mastodon user acct name." -- cgit v1.2.3 From e6a9d1228f238294e0f8ade48067a89b109b7572 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 13:01:19 +0200 Subject: readme re completion --- README.org | 37 ++++++++++++++++++++++----------- mastodon.info | 67 +++++++++++++++++++++++++++++++++-------------------------- mastodon.texi | 39 +++++++++++++++++++++++----------- 3 files changed, 89 insertions(+), 54 deletions(-) diff --git a/README.org b/README.org index ffed894..7bc75db 100644 --- a/README.org +++ b/README.org @@ -196,13 +196,10 @@ not contain =:client_id= and =:client_secret=. *** Composing toots -=M-x mastodon-toot= (or =t= from a mastodon.el buffer). - -Pops a new buffer/window in =text-mode= and =mastodon-toot= minor mode. Enter the -contents of your toot here. =C-c C-c= sends the toot. =C-c C-k= cancels. -Both actions kill the buffer and window. - -Autocompletion of mentions and tags is provided by =completion-at-point-functions= (capf) backends. =mastodon-toot--enable-completion= is enabled by default. If you want to enable =company-mode= in the toot compose buffer, set =mastodon-toot--use-company-for-completion= to =t=. (=mastodon.el= used to run its own native company backends, but these have been removed in favour of capfs.) +=M-x mastodon-toot= (or =t= from a mastodon.el buffer) opens a new buffer/window +in =text-mode= and =mastodon-toot= minor mode. Enter the contents of your toot +here. =C-c C-c= sends the toot. =C-c C-k= cancels. Both actions kill the buffer +and window. Further keybindings are displayed in the buffer, and in the following subsection. Replies preserve visibility status/content warnings, and include boosters by default. @@ -239,6 +236,19 @@ value of that hook is as follows: | =C-c C-l= | Set toot language | |---------+----------------------------------| +**** autocompletion of mentions and tags + +Autocompletion of mentions and tags is provided by +=completion-at-point-functions= (capf) backends. +=mastodon-toot--enable-completion= is enabled by default. If you want to enable +=company-mode= in the toot compose buffer, set +=mastodon-toot--use-company-for-completion= to =t=. (=mastodon.el= used to run its +own native company backends, but these have been removed in favour of capfs.) + +If you don’t run =company= and want immediate, keyless completion, you’ll need +to have another completion engine running that handles capfs. A common +combination is =consult= and =corfu=. + **** Draft toots - Compose buffer text is saved as you type, kept in =mastodon-toot-current-toot-text=. @@ -327,7 +337,8 @@ See =M-x customize-group RET mastodon= to view all customize options. *** Alternative timeline layout -The incomparable Nicholas Rougier has written an alternative timeline layout for =mastodon.el=. +The incomparable Nicholas Rougier has written an alternative timeline layout +for =mastodon.el=. The repo is at [[https://github.com/rougier/mastodon-alt][mastodon-alt]]. @@ -346,9 +357,9 @@ view a timeline with one of the commands that begin with *** Translating toots -You can translate toots with =mastodon-toot--translate-toot-text= (=a= in a timeline). At the moment -this requires [[https://codeberg.org/martianh/lingva.el][lingva.el]], a little interface I wrote to [[https://lingva.ml][lingva.ml]], to -be installed to work. +You can translate toots with =mastodon-toot--translate-toot-text= (=a= in a +timeline). At the moment this requires [[https://codeberg.org/martianh/lingva.el][lingva.el]], a little interface I wrote +to [[https://lingva.ml][lingva.ml]], to be installed to work. You could easily modify the simple function to use your Emacs translator of choice (=libretrans.el= , =google-translate=, =babel=, =go-translate=, etc.), you just @@ -368,7 +379,9 @@ to your translator function as its text argument. Here's what #+end_src *** bookmarks and =mastodon.el= -=mastodon.el= doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we implement them, you can get bookmarks going immediately by using [[https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el][bookmark+.el]]. +=mastodon.el= doesn’t currently implement its own bookmark record and handler, +which means that emacs bookmarks will not work as is. Until we implement them, +you can get bookmarks going immediately by using [[https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el][bookmark+.el]]. ** Dependencies diff --git a/mastodon.info b/mastodon.info index d1389a1..12f5da4 100644 --- a/mastodon.info +++ b/mastodon.info @@ -292,19 +292,11 @@ File: mastodon.info, Node: Composing toots, Next: Other commands and account s 1.2.3 Composing toots --------------------- -‘M-x mastodon-toot’ (or ‘t’ from a mastodon.el buffer). - - Pops a new buffer/window in ‘text-mode’ and ‘mastodon-toot’ minor -mode. Enter the contents of your toot here. ‘C-c C-c’ sends the toot. -‘C-c C-k’ cancels. Both actions kill the buffer and window. - - Autocompletion of mentions and tags is provided by -‘completion-at-point-functions’ (capf) backends. -‘mastodon-toot--enable-completion’ is enabled by default. If you want -to enable ‘company-mode’ in the toot compose buffer, set -‘mastodon-toot--use-company-for-completion’ to ‘t’. (‘mastodon.el’ used -to run its own native company backends, but these have been removed in -favour of capfs.) +‘M-x mastodon-toot’ (or ‘t’ from a mastodon.el buffer) opens a new +buffer/window in ‘text-mode’ and ‘mastodon-toot’ minor mode. Enter the +contents of your toot here. ‘C-c C-c’ sends the toot. ‘C-c C-k’ +cancels. Both actions kill the buffer and window. Further keybindings +are displayed in the buffer, and in the following subsection. Replies preserve visibility status/content warnings, and include boosters by default. @@ -340,7 +332,21 @@ is as follows: ‘C-c C-p’ Create a poll ‘C-c C-l’ Set toot language - 2. Draft toots + 2. autocompletion of mentions and tags + + Autocompletion of mentions and tags is provided by + ‘completion-at-point-functions’ (capf) backends. + ‘mastodon-toot--enable-completion’ is enabled by default. If you + want to enable ‘company-mode’ in the toot compose buffer, set + ‘mastodon-toot--use-company-for-completion’ to ‘t’. (‘mastodon.el’ + used to run its own native company backends, but these have been + removed in favour of capfs.) + + If you don’t run ‘company’ and want immediate, keyless completion, + you’ll need to have another completion engine running that handles + capfs. A common combination is ‘consult’ and ‘corfu’. + + 3. Draft toots • Compose buffer text is saved as you type, kept in ‘mastodon-toot-current-toot-text’. @@ -650,22 +656,23 @@ Node: Timelines4522 Ref: Keybindings4997 Ref: Toot byline legend9570 Node: Composing toots9879 -Ref: Keybindings (1)11456 -Ref: Draft toots11974 -Node: Other commands and account settings12445 -Node: Customization15603 -Node: Alternative timeline layout16389 -Node: Live-updating timelines mastodon-async-mode16779 -Node: Translating toots17631 -Node: bookmarks and mastodonel18813 -Node: Dependencies19283 -Node: Network compatibility19889 -Node: Contributing20375 -Node: Bug reports20664 -Node: Fixes and features21570 -Node: Coding style22053 -Node: Supporting mastodonel22677 -Node: Contributors23199 +Ref: Keybindings (1)11118 +Ref: autocompletion of mentions and tags11636 +Ref: Draft toots12349 +Node: Other commands and account settings12820 +Node: Customization15978 +Node: Alternative timeline layout16764 +Node: Live-updating timelines mastodon-async-mode17154 +Node: Translating toots18006 +Node: bookmarks and mastodonel19188 +Node: Dependencies19658 +Node: Network compatibility20264 +Node: Contributing20750 +Node: Bug reports21039 +Node: Fixes and features21945 +Node: Coding style22428 +Node: Supporting mastodonel23052 +Node: Contributors23574  End Tag Table diff --git a/mastodon.texi b/mastodon.texi index 122bbb1..1850844 100644 --- a/mastodon.texi +++ b/mastodon.texi @@ -362,13 +362,10 @@ not contain @samp{:client_id} and @samp{:client_secret}. @node Composing toots @subsection Composing toots -@samp{M-x mastodon-toot} (or @samp{t} from a mastodon.el buffer). - -Pops a new buffer/window in @samp{text-mode} and @samp{mastodon-toot} minor mode. Enter the -contents of your toot here. @samp{C-c C-c} sends the toot. @samp{C-c C-k} cancels. -Both actions kill the buffer and window. - -Autocompletion of mentions and tags is provided by @samp{completion-at-point-functions} (capf) backends. @samp{mastodon-toot--enable-completion} is enabled by default. If you want to enable @samp{company-mode} in the toot compose buffer, set @samp{mastodon-toot--use-company-for-completion} to @samp{t}. (@samp{mastodon.el} used to run its own native company backends, but these have been removed in favour of capfs.) +@samp{M-x mastodon-toot} (or @samp{t} from a mastodon.el buffer) opens a new buffer/window +in @samp{text-mode} and @samp{mastodon-toot} minor mode. Enter the contents of your toot +here. @samp{C-c C-c} sends the toot. @samp{C-c C-k} cancels. Both actions kill the buffer +and window. Further keybindings are displayed in the buffer, and in the following subsection. Replies preserve visibility status/content warnings, and include boosters by default. @@ -418,6 +415,21 @@ value of that hook is as follows: @tab Set toot language @end multitable +@item +@anchor{autocompletion of mentions and tags}autocompletion of mentions and tags + + +Autocompletion of mentions and tags is provided by +@samp{completion-at-point-functions} (capf) backends. +@samp{mastodon-toot--enable-completion} is enabled by default. If you want to enable +@samp{company-mode} in the toot compose buffer, set +@samp{mastodon-toot--use-company-for-completion} to @samp{t}. (@samp{mastodon.el} used to run its +own native company backends, but these have been removed in favour of capfs.) + +If you don’t run @samp{company} and want immediate, keyless completion, you’ll need +to have another completion engine running that handles capfs. A common +combination is @samp{consult} and @samp{corfu}. + @item @anchor{Draft toots}Draft toots @@ -584,7 +596,8 @@ Set default reply visibility @node Alternative timeline layout @subsection Alternative timeline layout -The incomparable Nicholas Rougier has written an alternative timeline layout for @samp{mastodon.el}. +The incomparable Nicholas Rougier has written an alternative timeline layout +for @samp{mastodon.el}. The repo is at @uref{https://github.com/rougier/mastodon-alt, mastodon-alt}. @@ -605,9 +618,9 @@ view a timeline with one of the commands that begin with @node Translating toots @subsection Translating toots -You can translate toots with @samp{mastodon-toot--translate-toot-text} (@samp{a} in a timeline). At the moment -this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote to @uref{https://lingva.ml, lingva.ml}, to -be installed to work. +You can translate toots with @samp{mastodon-toot--translate-toot-text} (@samp{a} in a +timeline). At the moment this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote +to @uref{https://lingva.ml, lingva.ml}, to be installed to work. You could easily modify the simple function to use your Emacs translator of choice (@samp{libretrans.el} , @samp{google-translate}, @samp{babel}, @samp{go-translate}, etc.), you just @@ -629,7 +642,9 @@ to your translator function as its text argument. Here's what @node bookmarks and @samp{mastodonel} @subsection bookmarks and @samp{mastodon.el} -@samp{mastodon.el} doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we implement them, you can get bookmarks going immediately by using @uref{https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el, bookmark+.el}. +@samp{mastodon.el} doesn’t currently implement its own bookmark record and handler, +which means that emacs bookmarks will not work as is. Until we implement them, +you can get bookmarks going immediately by using @uref{https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el, bookmark+.el}. @node Dependencies @section Dependencies -- 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(-) 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 b19390cd38ba93e527e5961723b46779749f1ee1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 11 May 2023 09:08:05 +0200 Subject: fix media tests --- lisp/mastodon-media.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 0c40ca5..fd5bb77 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -310,7 +310,7 @@ TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom,\ -r: rotate, o: save preview") + r: rotate, o: save preview") (help-echo (if caption (concat help-echo-base "\n\"" caption "\"") -- cgit v1.2.3 From 6afc7b87d289265f464f9ad191c2245caf1a3223 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 30 Apr 2023 16:47:55 +0200 Subject: add play symbol after videos in tl. --- lisp/mastodon-media.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index fd5bb77..1e4d8b1 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -174,7 +174,12 @@ with the image." ;; it; we already have set a default image when we ;; added the tag. (put-text-property marker (+ marker region-length) - 'display image)) + 'display image) + (when (not (equal "image" + (get-text-property marker 'mastodon-media-type))) + (let ((ov (make-overlay marker (+ marker region-length) + (marker-buffer marker)))) + (overlay-put ov 'after-string " ▶")))) ;; We are done with the marker; release it: (set-marker marker nil))) (kill-buffer url-buffer))))))) -- cgit v1.2.3 From a9e810c5e7344fb99b984e08c18f690c686a0d0b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 14:52:00 +0200 Subject: overlay for media --- lisp/mastodon-media.el | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 1e4d8b1..541e6de 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -271,22 +271,27 @@ Replace them with the referenced image." ;; proceed to load this image asynchronously (put-text-property start end 'media-state 'loading) (mastodon-media--load-image-from-url - image-url media-type start (- end start)))))))) - ;; (mastodon-media--moving-image-overlay start end))))))) + image-url media-type start (- end start)) + (mastodon-media--moving-image-overlay start end))))))) -;; (defun mastodon-media--moving-image-overlay (start end) -;; "Add play symbol overlay to moving image media items." -;; (let ((ov (make-overlay start end)) -;; (type (get-text-property start 'mastodon-media-type))) -;; (when (or (equal type "gifv") -;; (equal type "video")) -;; (overlay-put -;; ov -;; 'after-string -;; (propertize " " -;; 'face -;; '((:height 1.5 :inherit 'font-lock-comment-face))))))) +;; (defvar-local mastodon-media--overlays nil +;; "Holds a list of overlays in the buffer.") +(defun mastodon-media--moving-image-overlay (start end) + "Add play symbol overlay to moving image media items." + (let ((ov (make-overlay start end)) + (type (get-text-property start 'mastodon-media-type))) + (when (or (equal type "gifv") + (equal type "video")) + (overlay-put + ov + 'after-string + (propertize "" + 'face + '((:height 3.5 :inherit 'font-lock-comment-face))))))) +;; (cl-pushnew ov mastodon-media--overlays))) + +(remove-overlays) (defun mastodon-media--get-avatar-rendering (avatar-url) "Return the string to be written that renders the avatar at AVATAR-URL." ;; We use just an empty space as the textual representation. -- 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(-) 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 6a6f7645c454c080046dc6409cc2583baef3bbab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 10 May 2023 15:55:57 +0200 Subject: re-do vid overlay clean up --- lisp/mastodon-media.el | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 541e6de..12d51a1 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -174,12 +174,7 @@ with the image." ;; it; we already have set a default image when we ;; added the tag. (put-text-property marker (+ marker region-length) - 'display image) - (when (not (equal "image" - (get-text-property marker 'mastodon-media-type))) - (let ((ov (make-overlay marker (+ marker region-length) - (marker-buffer marker)))) - (overlay-put ov 'after-string " ▶")))) + 'display image)) ;; We are done with the marker; release it: (set-marker marker nil))) (kill-buffer url-buffer))))))) @@ -264,6 +259,7 @@ Replace them with the referenced image." (let* ((start (car line-details)) (end (cadr line-details)) (media-type (cadr (cdr line-details))) + (type (get-text-property start 'mastodon-media-type)) (image-url (get-text-property start 'media-url))) (if (not (mastodon-media--valid-link-p image-url)) ;; mark it at least as not needing loading any more @@ -272,26 +268,25 @@ Replace them with the referenced image." (put-text-property start end 'media-state 'loading) (mastodon-media--load-image-from-url image-url media-type start (- end start)) - (mastodon-media--moving-image-overlay start end))))))) + (when (or (equal type "gifv") + (equal type "video")) + (mastodon-media--moving-image-overlay start end)))))))) ;; (defvar-local mastodon-media--overlays nil ;; "Holds a list of overlays in the buffer.") (defun mastodon-media--moving-image-overlay (start end) "Add play symbol overlay to moving image media items." - (let ((ov (make-overlay start end)) - (type (get-text-property start 'mastodon-media-type))) - (when (or (equal type "gifv") - (equal type "video")) - (overlay-put - ov - 'after-string - (propertize "" - 'face - '((:height 3.5 :inherit 'font-lock-comment-face))))))) + (let ((ov (make-overlay start end))) + (overlay-put + ov + 'after-string + (propertize "" + 'help-echo "Video" + 'face + '((:height 3.5 :inherit 'font-lock-comment-face)))))) ;; (cl-pushnew ov mastodon-media--overlays))) -(remove-overlays) (defun mastodon-media--get-avatar-rendering (avatar-url) "Return the string to be written that renders the avatar at AVATAR-URL." ;; We use just an empty space as the textual representation. -- 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(-) 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 6d05cf81ff5a84aa12735aeab2ac99a083c15033 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 11 May 2023 19:58:01 +0200 Subject: use url-http-end-of-headers in http.el --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index ba79bd0..6f472bc 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -192,7 +192,7 @@ Callback to `mastodon-http--get-response-async', usually (let ((headers (unless no-headers (mastodon-http--process-headers)))) (goto-char (point-min)) - (re-search-forward "^$" nil 'move) + (goto-char url-http-end-of-headers) (let ((json-array-type (if vector 'vector 'list)) (json-string (decode-coding-string (buffer-substring-no-properties (point) (point-max)) @@ -215,7 +215,7 @@ Callback to `mastodon-http--get-response-async', usually (goto-char (point-min)) (let* ((head-str (buffer-substring-no-properties (point-min) - (re-search-forward "^$" nil 'move))) + (goto-char url-http-end-of-headers))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) (let ((list (split-string x ": "))) -- 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(-) 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(-) 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 11dc0b2c6130866eaa9bb83386f948a087f5e9f2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 15 May 2023 20:48:17 +0200 Subject: section headings, indentation, comments --- lisp/mastodon-toot.el | 87 ++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 69 insertions(+), 18 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index cbf0447..9c2179a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -225,6 +225,9 @@ For the moment we just put all composed toots in here, as we want to also capture toots that are 'sent' but that don't successfully send.") + +;;; REGEXES + (defvar mastodon-toot-handle-regex (rx (| (any ?\( "\n" "\t "" ") bol) ; preceding things (group-n 2 (+ ?@ (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; handle @@ -240,9 +243,12 @@ send.") ;; adapted from ffap-url-regexp (concat "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix - "[^ \n\t]*\\)" ; any old thing that's, i.e. we allow invalid/unwise chars + "[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars "\\b")) ; boundary + +;;; MODE MAP + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -555,6 +561,9 @@ Uses `lingva.el'." (mastodon-tl--reload-timeline-or-profile)) (message "Toot %s!" msg))))))) + +;;; DELETE, DRAFT, REDRAFT + (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." (interactive) @@ -599,6 +608,9 @@ NO-REDRAFT means delete toot only." (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft cw))) + +;;; REDRAFT + (defun mastodon-toot--redraft (response &optional reply-id toot-visibility toot-cw) "Opens a new toot compose buffer using values from RESPONSE buffer. REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." @@ -671,11 +683,13 @@ TEXT-ONLY means don't check for attachments or polls." (string-empty-p (mastodon-tl--clean-tabs-and-nl (mastodon-toot--remove-docs))))) + +;;; EMOJIS + (defalias 'mastodon-toot--insert-emoji 'emojify-insert-emoji "Prompt to insert an emoji.") - (defun mastodon-toot--emoji-dir () "Return the file path for the mastodon custom emojis directory." (concat (expand-file-name emojify-emojis-dir) @@ -770,6 +784,9 @@ to `emojify-user-emojis', and the emoji data is updated." (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) + +;;; SEND TOOT FUNCTION + (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with @@ -840,7 +857,8 @@ instance to edit a toot." (let ((pos (marker-position (cadr prev-window-config)))) (mastodon-tl--reload-timeline-or-profile pos)))))))))) -;; EDITING TOOTS: + +;;; EDITING TOOTS: (defun mastodon-toot--edit-toot-at-point () "Edit the user's toot at point." @@ -934,6 +952,9 @@ eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"." (t (concat "@" acct "@" ; local acct (cadr (split-string mastodon-instance-url "/" t)))))) + +;;; COMPLETION (TAGS, MENTIONS) + (defun mastodon-toot--mentions (status) "Extract mentions (not the reply-to author or booster) from STATUS. The mentioned users look like this: @@ -941,8 +962,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)))) @@ -1026,6 +1047,9 @@ If TAGS, we search for tags, else we search for handles." ;; or make it an alist and use cdr (cadr (assoc candidate mastodon-toot-completions))) + +;;; REPLY + (defun mastodon-toot--reply () "Reply to toot at `point'. Customize `mastodon-toot-display-orig-in-reply-buffer' to display @@ -1049,22 +1073,25 @@ 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 (or base-toot toot))))) + +;;; COMPOSE TOOT SETTINGS + (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." (interactive) @@ -1096,6 +1123,20 @@ text of the toot being replied to in the compose buffer." "public"))) (mastodon-toot--update-status-fields))) +(defun mastodon-toot--set-toot-language () + "Prompt for a language and set `mastodon-toot--language'. +Return its two letter ISO 639 1 code." + (interactive) + (let* ((choice (completing-read "Language for this toot: " + mastodon-iso-639-1))) + (setq mastodon-toot--language + (alist-get choice mastodon-iso-639-1 nil nil 'equal)) + (message "Language set to %s" choice) + (mastodon-toot--update-status-fields))) + + +;;; ATTACHMENTS + (defun mastodon-toot--clear-all-attachments () "Remove all attachments from a toot draft." (interactive) @@ -1166,6 +1207,9 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) + +;;; POLL + (defun mastodon-toot--fetch-max-poll-options (instance) "Return the maximum number of poll options from JSON data INSTANCE." (mastodon-toot--fetch-poll-field 'max_options instance)) @@ -1248,16 +1292,8 @@ LENGTH is the maximum character length allowed for a poll option." ("14 days" . ,(number-to-string (* 60 60 24 14))) ("30 days" . ,(number-to-string (* 60 60 24 30))))) -(defun mastodon-toot--set-toot-language () - "Prompt for a language and set `mastodon-toot--language'. -Return its two letter ISO 639 1 code." - (interactive) - (let* ((choice (completing-read "Language for this toot: " - mastodon-iso-639-1))) - (setq mastodon-toot--language - (alist-get choice mastodon-iso-639-1 nil nil 'equal)) - (message "Language set to %s" choice) - (mastodon-toot--update-status-fields))) + +;;; SCHEDULE (defun mastodon-toot--schedule-toot (&optional reschedule) "Read a date (+ time) in the minibuffer and schedule the current toot. @@ -1309,6 +1345,9 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (when ts (let* ((decoded (iso8601-parse ts))) (encode-time decoded)))) + +;;; DISPLAY KEYBINDINGS + (defun mastodon-toot--get-mode-kbinds () "Get a list of the keybindings in the mastodon-toot-mode." (let* ((binds (copy-tree mastodon-toot-mode-map)) @@ -1363,6 +1402,9 @@ LONGEST is the length of the longest binding." (let ((lengths (mapcar #'length kbinds-list))) (car (sort lengths #'>)))) + +;;; DISPLAY DOCS + (defun mastodon-toot--make-mode-docs () "Create formatted documentation text for the mastodon-toot-mode." (let* ((kbinds (mastodon-toot--get-mode-kbinds)) @@ -1537,6 +1579,9 @@ CW is the content warning, which contributes to the character count." (+ (length cw) (length (buffer-substring (point-min) (point-max)))))) + +;;; DRAFTS + (defun mastodon-toot--save-toot-text (&rest _args) "Save the current toot text in `mastodon-toot-current-toot-text'. Added to `after-change-functions' in new toot buffers." @@ -1586,6 +1631,9 @@ Added to `after-change-functions' in new toot buffers." (setq mastodon-toot-draft-toots-list nil) (message "All drafts deleted!")) + +;;; PROPERTIZE TAGS AND HANDLES + (defun mastodon-toot--propertize-tags-and-handles (&rest _args) "Propertize tags and handles in toot compose buffer. Added to `after-change-functions'." @@ -1631,6 +1679,9 @@ Added to `after-change-functions'." (fill-region (prop-match-beginning prop) (point))))))) + +;;; COMPOSE BUFFER FUNCTION + (defun mastodon-toot--compose-buffer (&optional reply-to-user reply-to-id reply-json initial-text edit) "Create a new buffer to capture text for a new toot. -- cgit v1.2.3 From 4d896d56eb92b7652c751a1adf44daf5c22a2f21 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 15 May 2023 22:22:47 +0200 Subject: comments in views-print-json-jeys --- lisp/mastodon-views.el | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index c86884f..d23626a 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -810,16 +810,14 @@ IND is the optional indentation level to print at." (while response (let ((el (pop response))) (cond - ;; vector of alists (fields, instance rules): - ((and (vectorp (cdr el)) + ((and (vectorp (cdr el)) ; vector of alists (fields, instance rules): (not (seq-empty-p (cdr el))) (consp (seq-elt (cdr el) 0))) (insert (mastodon-views--format-key el pad) "\n\n") (seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el)) (insert "\n")) - ;; vector of strings (media types): - ((and (vectorp (cdr el)) + ((and (vectorp (cdr el)) ; vector of strings (media types): (not (seq-empty-p (cdr el))) (< 1 (seq-length (cdr el))) (stringp (seq-elt (cdr el) 0))) @@ -830,15 +828,13 @@ IND is the optional indentation level to print at." (lambda (x) (concat x ", ")) (cdr el) 'string) "\n\n")) - ;; basic nesting: - ((consp (cdr el)) + ((consp (cdr el)) ; basic nesting: (when ind (indent-to ind)) (insert (mastodon-views--format-key el pad) "\n\n") (mastodon-views--print-json-keys (cdr el) (if ind (+ ind 4) 4))) - (t - ;; basic handling of raw booleans: + (t ; basic handling of raw booleans: (let ((val (cond ((equal (cdr el) ':json-false) "no") ((equal (cdr el) 't) -- cgit v1.2.3 From 26dadbec3aa68d4317548bae9dbd982df9361e00 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 15 May 2023 22:32:01 +0200 Subject: let-alist views--edit-scheduled-as-new --- lisp/mastodon-views.el | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index d23626a..dc7eb14 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -556,21 +556,16 @@ NO-CONFIRM means there is no ask or message, there is only do." (if (null id) (message "no scheduled toot at point?") (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) - (scheduled (alist-get 'scheduled_at toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params)) - (visibility (alist-get 'visibility params)) - (cw (alist-get 'spoiler_text params)) - (lang (alist-get 'language params)) - ;; (poll (alist-get 'poll params)) - (reply-id (alist-get 'in_reply_to_id params))) - ;; (media (alist-get 'media_attachments toot))) - (mastodon-toot--compose-buffer) - (goto-char (point-max)) - (insert text) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties reply-id visibility cw - lang scheduled id))))) + (scheduled (alist-get 'scheduled_at toot))) + (let-alist (alist-get 'params toot) + ;; (poll (alist-get 'poll params)) + ;; (media (alist-get 'media_attachments toot))) + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert .text) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility .spoiler_text .language scheduled id)))))) ;;; FILTERS -- cgit v1.2.3 From f342a7f7308c75213a0f54af949995cc99a04963 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 15 May 2023 23:13:01 +0200 Subject: fix views--list-action-triage message call --- lisp/mastodon-views.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index dc7eb14..fbeb1c7 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -338,8 +338,8 @@ Prompt for name and replies policy." `(("title" . ,title) ("replies_policy" . ,replies-policy)) nil))) - (mastodon-views--list-action-triage response - (message "list %s created!" title)))) + (mastodon-views--list-action-triage + response "list %s created!" title))) (defun mastodon-views--delete-list-at-point () "Delete list at point." @@ -359,8 +359,8 @@ If ID is provided, delete that list." (url (mastodon-http--api (format "lists/%s" id)))) (when (y-or-n-p (format "Delete list %s?" name)) (let ((response (mastodon-http--delete url))) - (mastodon-views--list-action-triage response - (message "list %s deleted!" name)))))) + (mastodon-views--list-action-triage + response "list %s deleted!" name))))) (defun mastodon-views--get-users-followings () "Return the list of followers of the logged in account." @@ -395,7 +395,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) (mastodon-views--list-action-triage - response (message "%s added to list %s!" account list-name)))) + response "%s added to list %s!" account list-name))) (defun mastodon-views--add-toot-account-at-point-to-list () "Prompt for a list, and add the account of the toot at point to it." @@ -430,15 +430,15 @@ If ID is provided, use that list." (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) (response (mastodon-http--delete url args))) (mastodon-views--list-action-triage - response (message "%s removed from list %s!" account list-name)))) + response "%s removed from list %s!" account list-name))) -(defun mastodon-views--list-action-triage (response message) - "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." +(defun mastodon-views--list-action-triage (response &rest args) + "Call `mastodon-http--triage' on RESPONSE and call message on ARGS." (mastodon-http--triage response (lambda () (when (mastodon-tl--buffer-type-eq 'lists) (mastodon-views--view-lists)) - message))) + (apply #'message args)))) (defun mastodon-views--accounts-in-list (list-id) "Return the JSON of the accounts in list with LIST-ID." -- cgit v1.2.3 From 5a1f2d19de73fa233187b705e4fe72f31db194ff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 09:49:53 +0200 Subject: refactoring in profile--update-note-count --- lisp/mastodon-profile.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0c6e3b2..b4684da 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -269,13 +269,12 @@ NO-REBLOGS means do not display boosts in statuses." (header-region (mastodon-tl--find-property-range 'note-header (point-min))) (count-region (mastodon-tl--find-property-range 'note-counter - (point-min)))) + (point-min))) + (count (number-to-string (mastodon-toot--count-toot-chars + (buffer-substring-no-properties + (cdr header-region) (point-max)))))) (add-text-properties (car count-region) (cdr count-region) - (list 'display - (number-to-string - (mastodon-toot--count-toot-chars - (buffer-substring-no-properties - (cdr header-region) (point-max)))))))) + (list 'display count)))) (defun mastodon-profile--update-profile-note-cancel () "Cancel updating user profile and kill buffer and window." -- cgit v1.2.3 From a203ad2fe6a759f3ac340198b4a168fd0d636a16 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 09:50:16 +0200 Subject: refactoring in update-meta-fields-alist --- lisp/mastodon-profile.el | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index b4684da..9aed0da 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -444,18 +444,14 @@ Returns the results as an alist." (mastodon-profile--get-source-value 'fields)))) ;; offer empty fields if user currently has less than four filled: (while (< (length fields-old) 4) - (setq fields-old - (append fields-old '(("" . ""))))) - (let ((alist + (setq fields-old (append fields-old '(("" . ""))))) + (let ((f-str "Metadata %s [%s/4] (max. 255 chars): ") + (alist (cl-loop for f in fields-old for x from 1 to 5 collect - (cons (read-string - (format "Metadata key [%s/4] (max. 255 chars): " x) - (car f)) - (read-string - (format "Metadata value [%s/4] (max. 255 chars): " x) - (cdr f)))))) + (cons (read-string (format f-str "key" x) (car f)) + (read-string (format f-str "value" x) (cdr f)))))) (mapcar (lambda (x) (cons (mastodon-profile--limit-to-255 (car x)) (mastodon-profile--limit-to-255 (cdr x)))) -- cgit v1.2.3 From e40a7844b48e7262b51df573605e542cd621687e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:01:31 +0200 Subject: don't quote keywords --- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-views.el | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 9aed0da..fe1e1dc 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -214,7 +214,7 @@ NO-REBLOGS means do not display boosts in statuses." "Fetch current VAL ue from account." (let* ((url (mastodon-http--api "accounts/verify_credentials")) (response (mastodon-http--get-json url))) - (if (eq (alist-get val response) ':json-false) + (if (eq (alist-get val response) :json-false) nil (alist-get val response)))) @@ -225,7 +225,7 @@ NO-REBLOGS means do not display boosts in statuses." (defun mastodon-profile--get-source-value (pref) "Return account PREF erence from the \"source\" section on the server." (let ((source (mastodon-profile--get-source-values))) - (if (eq (alist-get pref source) ':json-false) + (if (eq (alist-get pref source) :json-false) nil (alist-get pref source)))) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index fbeb1c7..790c548 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -830,7 +830,7 @@ IND is the optional indentation level to print at." (mastodon-views--print-json-keys (cdr el) (if ind (+ ind 4) 4))) (t ; basic handling of raw booleans: - (let ((val (cond ((equal (cdr el) ':json-false) + (let ((val (cond ((equal (cdr el) :json-false) "no") ((equal (cdr el) 't) "yes") -- 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(-) 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(-) 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 dfe1fb7aabe43bb8dbad198f31752c92d191e7d0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:32:33 +0200 Subject: http docstring --- lisp/mastodon-http.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 6f472bc..a2094be 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -80,8 +80,9 @@ SILENT means don't message." (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) (defun mastodon-http--triage (response success) - "Determine if RESPONSE was successful. Call SUCCESS if successful. -Message status and JSON error from RESPONSE if unsuccessful." + "Determine if RESPONSE was successful. +Call SUCCESS if successful. Message status and JSON error from +RESPONSE if unsuccessful." (let ((status (with-current-buffer response (mastodon-http--status)))) (if (string-prefix-p "2" status) -- cgit v1.2.3 From 14a5358806407a881748b9bbe9bdd113743a2acf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 10:32:43 +0200 Subject: Revert "use url-http-end-of-headers in http.el" To fix tests This reverts commit 6d05cf81ff5a84aa12735aeab2ac99a083c15033. --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a2094be..5dd4fda 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -193,7 +193,7 @@ Callback to `mastodon-http--get-response-async', usually (let ((headers (unless no-headers (mastodon-http--process-headers)))) (goto-char (point-min)) - (goto-char url-http-end-of-headers) + (re-search-forward "^$" nil 'move) (let ((json-array-type (if vector 'vector 'list)) (json-string (decode-coding-string (buffer-substring-no-properties (point) (point-max)) @@ -216,7 +216,7 @@ Callback to `mastodon-http--get-response-async', usually (goto-char (point-min)) (let* ((head-str (buffer-substring-no-properties (point-min) - (goto-char url-http-end-of-headers))) + (re-search-forward "^$" nil 'move))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) (let ((list (split-string x ": "))) -- 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(-) 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 154418341089c335d0679d37a22c42e6cfab6077 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 16 May 2023 13:59:42 +0200 Subject: use toot-url-regex rather than hack regex in count-toot-chars --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9c2179a..59b8364 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1570,7 +1570,8 @@ CW is the content warning, which contributes to the character count." (insert toot-string) (goto-char (point-min)) ;; handle URLs - (while (search-forward-regexp "\\w+://[^ \n]*" nil t) ; URL + (while (search-forward-regexp mastodon-toot-url-regex nil t) + ; "\\w+://[^ \n]*" old regex (replace-match "xxxxxxxxxxxxxxxxxxxxxxx")) ; 23 x's ;; handle @handles (goto-char (point-min)) -- cgit v1.2.3 From 6cdf9565598e5060c568c1503b3d2a80499bc7e6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 17 May 2023 13:15:42 +0200 Subject: remove overlays for profiles also --- lisp/mastodon-profile.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 6bfe64c..7865170 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -563,6 +563,7 @@ HEADERS means also fetch link headers for pagination." (relationships (mastodon-profile--relationships-get .id))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-profile-mode) + (remove-overlays) (setq mastodon-profile--account account) (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header) -- cgit v1.2.3 From 60209c881798aa9e649ddedd2879dfdeaeb32004 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 May 2023 10:45:40 +0200 Subject: add mastodon-index.org --- mastodon-index.org | 264 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 264 insertions(+) create mode 100644 mastodon-index.org diff --git a/mastodon-index.org b/mastodon-index.org new file mode 100644 index 0000000..45c444f --- /dev/null +++ b/mastodon-index.org @@ -0,0 +1,264 @@ + +* mastodon commands index + +#+BEGIN_SRC emacs-lisp :results table :colnames '("Binding" "Command" "Description") :exports results + (let ((rows)) + (mapatoms + (lambda (symbol) + (when (and (string-match "^mastodon" + (symbol-name symbol)) + (commandp symbol)) + (let* ((doc (car + (split-string + (or (documentation symbol t) "") + "\n"))) + ;; add more keymaps here + ;; some keys are in sub 'keymap keys inside a map + (maps (list mastodon-mode-map + mastodon-toot-mode-map + mastodon-profile-mode-map + mastodon-notifications--map + mastodon-tl--shr-image-map-replacement + mastodon-profile-update-mode-map + mastodon-views-map + mastodon-views--follow-suggestions-map + mastodon-views--scheduled-map + mastodon-views--view-lists-keymap + mastodon-views--view-follow-requests-keymap + mastodon-views--view-filters-keymap)) + (binding-code + (let ((keys (where-is-internal symbol maps nil nil (command-remapping symbol)))) + ;; just take first 2 bindings: + (if (> (length keys) 2) + (list (car keys) (cadr keys)) + keys))) + ;; (or (car (rassoc symbol mastodon-mode-map)) + ;; (car (rassoc symbol (cadr mastodon-toot-mode-map))) + ;; (car (rassoc symbol (cadr mastodon-profile-mode-map))) + ;; (car (rassoc symbol mastodon-notifications--map)))) + (binding-str (if binding-code + (mapconcat #'help--key-description-fontified + binding-code ", ") + ""))) + (push `(,binding-str ,symbol ,doc) rows) + rows)))) + (sort rows (lambda (x y) (string-lessp (cadr x) (cadr y))))) +#+END_SRC + +#+RESULTS: +| Binding | Command | Description | +|------------------+---------------------------------------------------+--------------------------------------------------------------------------------| +| | mastodon | Connect Mastodon client to `mastodon-instance-url' instance. | +| | mastodon-async--display-buffer | Display the async user facing buffer. | +| | mastodon-async--stop-http | Stop the http processs and close the async and http buffer. | +| | mastodon-async--stream-federated | Open a stream of Federated. | +| | mastodon-async--stream-home | Open a stream of the home timeline. | +| | mastodon-async--stream-local | Open a stream of Local. | +| | mastodon-async--stream-notifications | Open a stream of user notifications. | +| | mastodon-async-mode | Async Mastodon. | +| | mastodon-discover | Plug Mastodon functionality into `discover'. | +| | mastodon-inspect--get-search-account | Return JSON for a single account after search QUERY. | +| | mastodon-inspect--get-search-result | Inspect function for a search result for QUERY. | +| | mastodon-inspect--toot | Find next toot and dump its meta data into new buffer. | +| | mastodon-inspect--view-single-toot | View the toot/status represented by TOOT-ID. | +| | mastodon-inspect--view-single-toot-source | View the ess source of a toot/status represented by TOOT-ID. | +| C-M-q | mastodon-kill-all-buffers | Kill any and all open mastodon buffers, hopefully. | +| | mastodon-mode | Major mode for Mastodon, the federated microblogging network. | +| | mastodon-notifications--clear-all | Clear all notifications. | +| C-k | mastodon-notifications--clear-current | Dismiss the notification at point. | +| | mastodon-notifications--follow-request-accept | Accept a follow request. | +| j | mastodon-notifications--follow-request-reject | Reject a follow request. | +| | mastodon-notifications--get-boosts | Display boost notifications in buffer. | +| | mastodon-notifications--get-favourites | Display favourite notifications in buffer. | +| @ | mastodon-notifications--get-mentions | Display mention notifications in buffer. | +| | mastodon-notifications--get-polls | Display poll notifications in buffer. | +| | mastodon-notifications--get-statuses | Display status notifications in buffer. | +| N | mastodon-notifications-get | Display NOTIFICATIONS in buffer. | +| | mastodon-profile--account-bot-toggle | Toggle the bot status of your account. | +| | mastodon-profile--account-discoverable-toggle | Toggle the discoverable status of your account. | +| | mastodon-profile--account-locked-toggle | Toggle the locked status of your account. | +| | mastodon-profile--account-sensitive-toggle | Toggle the sensitive status of your account. | +| | mastodon-profile--account-view-cycle | Cycle through profile view: toots, toot sans boosts, followers, and following. | +| | mastodon-profile--add-account-to-list | Add account of current profile buffer to a list. | +| | mastodon-profile--add-private-note-to-account | Add a private note to an account. | +| A | mastodon-profile--get-toot-author | Open profile of author of toot under point. | +| O | mastodon-profile--my-profile | Show the profile of the currently signed in user. | +| | mastodon-profile--open-followers | Open a profile buffer showing the accounts following the current profile. | +| | mastodon-profile--open-following | Open a profile buffer showing the accounts that current profile follows. | +| | mastodon-profile--open-statuses-no-reblogs | Open a profile buffer showing statuses without reblogs. | +| | mastodon-profile--remove-from-followers-at-point | Prompt for a user in the item at point and remove from followers. | +| | mastodon-profile--remove-from-followers-list | Select a user from your followers and remove from followers. | +| | mastodon-profile--remove-user-from-followers | Remove a user from your followers. | +| | mastodon-profile--show-familiar-followers | Show a list of familiar followers. | +| P | mastodon-profile--show-user | Query for USER-HANDLE from current status and show that user's profile. | +| | mastodon-profile--toot-json | Get the next toot-json. | +| | mastodon-profile--update-display-name | Update display name for your account. | +| | mastodon-profile--update-meta-fields | Prompt for new metadata fields information and PATCH the server. | +| | mastodon-profile--update-profile-note-cancel | Cancel updating user profile and kill buffer and window. | +| U | mastodon-profile--update-user-profile-note | Fetch user's profile note and display for editing. | +| | mastodon-profile--user-profile-send-updated | Send PATCH request with the updated profile note. | +| | mastodon-profile--view-account-private-note | Display the private note about a user. | +| K | mastodon-profile--view-bookmarks | Open a new buffer displaying the user's bookmarks. | +| V | mastodon-profile--view-favourites | Open a new buffer displaying the user's favourites. | +| | mastodon-profile--view-preferences | View user preferences in another window. | +| | mastodon-profile-mode | Toggle mastodon profile minor mode. | +| | mastodon-profile-update-mode | Minor mode to update Mastodon user profile. | +| s | mastodon-search--search-query | Prompt for a search QUERY and return accounts, statuses, and hashtags. | +| | mastodon-search--trending-statuses | Display a list of statuses trending on your instance. | +| | mastodon-search--trending-tags | Display a list of tags trending on your instance. | +| B | mastodon-tl--block-user | Query for USER-HANDLE from current status and block that user. | +| | mastodon-tl--disable-notify-user-posts | Query for USER-HANDLE and disable notifications when they post. | +| | mastodon-tl--dm-user | Query for USER-HANDLE from current status and compose a message to that user. | +| | mastodon-tl--do-link-action | Do the action of the link at point. | +| | mastodon-tl--do-link-action-at-point | Do the action of the link at POSITION. | +| | mastodon-tl--enable-notify-user-posts | Query for USER-HANDLE and enable notifications when they post. | +| | mastodon-tl--filter-user-user-posts-by-language | Query for USER-HANDLE and enable notifications when they post. | +| | mastodon-tl--follow-tag | Prompt for a tag and follow it. | +| W | mastodon-tl--follow-user | Query for USER-HANDLE from current status and follow that user. | +| C-: | mastodon-tl--followed-tags-timeline | Open a timeline of all your followed tags. | +| F | mastodon-tl--get-federated-timeline | Open federated timeline. | +| H | mastodon-tl--get-home-timeline | Open home timeline. | +| L | mastodon-tl--get-local-timeline | Open local timeline. | +| # | mastodon-tl--get-tag-timeline | Prompt for tag and opens its timeline. | +| | mastodon-tl--goto-next-item | Jump to next item, e.g. filter or follow request. | +| C-, n | mastodon-tl--goto-next-toot | Jump to next toot header. | +| | mastodon-tl--goto-prev-item | Jump to previous item, e.g. filter or follow request. | +| C-, p | mastodon-tl--goto-prev-toot | Jump to last toot header. | +| : | mastodon-tl--list-followed-tags | List followed tags. View timeline of tag user choses. | +| C- | mastodon-tl--mpv-play-video-at-point | Play the video or gif at point with an mpv process. | +| | mastodon-tl--mpv-play-video-from-byline | Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post. | +| | mastodon-tl--mute-thread | Mute the thread displayed in the current buffer. | +| M | mastodon-tl--mute-user | Query for USER-HANDLE from current status and mute that user. | +| TAB, M-n | mastodon-tl--next-tab-item | Move to the next interesting item. | +| v | mastodon-tl--poll-vote | If there is a poll at point, prompt user for OPTION to vote on it. | +| S-TAB, | mastodon-tl--previous-tab-item | Move to the previous interesting item. | +| Z | mastodon-tl--report-to-mods | Report the author of the toot at point to your instance moderators. | +| | mastodon-tl--single-toot | View toot at point in separate buffer. | +| | mastodon-tl--some-followed-tags-timeline | Prompt for some tags, and open a timeline for them. | +| T | mastodon-tl--thread | Open thread buffer for toot at point or with ID. | +| c | mastodon-tl--toggle-spoiler-text-in-toot | Toggle the visibility of the spoiler text in the current toot. | +| C-S-b | mastodon-tl--unblock-user | Query for USER-HANDLE from list of blocked users and unblock that user. | +| | mastodon-tl--unfollow-tag | Prompt for a followed tag, and unfollow it. | +| C-S-w | mastodon-tl--unfollow-user | Query for USER-HANDLE from current status and unfollow that user. | +| | mastodon-tl--unmute-thread | Mute the thread displayed in the current buffer. | +| S-RET | mastodon-tl--unmute-user | Query for USER-HANDLE from list of muted users and unmute that user. | +| u, g | mastodon-tl--update | Update timeline with new toots. | +| | mastodon-tl--view-whole-thread | From a thread view, view entire thread. | +| t | mastodon-toot | Update instance with new toot. Content is captured in a new buffer. | +| C-c C-a | mastodon-toot--attach-media | Prompt for an attachment FILE with DESCRIPTION. | +| C-c C-k | mastodon-toot--cancel | Kill new-toot buffer/window. Does not POST content to Mastodon. | +| C-c C-v | mastodon-toot--change-visibility | Change the current visibility to the next valid value. | +| C-c ! | mastodon-toot--clear-all-attachments | Remove all attachments from a toot draft. | +| | mastodon-toot--copy-toot-text | Copy text of toot at point. | +| C | mastodon-toot--copy-toot-url | Copy URL of toot at point. | +| C-c C-p | mastodon-toot--create-poll | Prompt for new poll options and return as a list. | +| | mastodon-toot--delete-all-drafts | Delete all drafts. | +| D | mastodon-toot--delete-and-redraft-toot | Delete and redraft user's toot at point synchronously. | +| | mastodon-toot--delete-draft-toot | Prompt for a draft toot and delete it. | +| d | mastodon-toot--delete-toot | Delete user's toot at point synchronously. | +| | mastodon-toot--download-custom-emoji | Download `mastodon-instance-url's custom emoji. | +| e | mastodon-toot--edit-toot-at-point | Edit the user's toot at point. | +| | mastodon-toot--enable-custom-emoji | Add `mastodon-instance-url's custom emoji to `emojify'. | +| C-c C-e | mastodon-toot--insert-emoji | Prompt to insert an emoji. | +| . | mastodon-toot--list-toot-boosters | List the boosters of toot at point. | +| , | mastodon-toot--list-toot-favouriters | List the favouriters of toot at point. | +| | mastodon-toot--open-draft-toot | Prompt for a draft and compose a toot with it. | +| i | mastodon-toot--pin-toot-toggle | Pin or unpin user's toot at point. | +| r | mastodon-toot--reply | Reply to toot at `point'. | +| | mastodon-toot--save-draft | Save the current compose toot text as a draft. | +| C-c C-s | mastodon-toot--schedule-toot | Read a date (+ time) in the minibuffer and schedule the current toot. | +| C-c C-c | mastodon-toot--send | POST contents of new-toot buffer to Mastodon instance and kill buffer. | +| | mastodon-toot--set-default-visibility | Set the default visibility for toots on the server. | +| C-c C-l | mastodon-toot--set-toot-language | Prompt for a language and set `mastodon-toot--language'. | +| k | mastodon-toot--toggle-bookmark | Bookmark or unbookmark toot at point. | +| b | mastodon-toot--toggle-boost | Boost/unboost toot at `point'. | +| f | mastodon-toot--toggle-favourite | Favourite/unfavourite toot at `point'. | +| C-c C-n | mastodon-toot--toggle-nsfw | Toggle `mastodon-toot--content-nsfw'. | +| C-c C-w | mastodon-toot--toggle-warning | Toggle `mastodon-toot--content-warning'. | +| a | mastodon-toot--translate-toot-text | Translate text of toot at point. | +| E | mastodon-toot--view-toot-edits | View editing history of the toot at point in a popup buffer. | +| | mastodon-toot-mode | Minor mode to capture Mastodon toots. | +| | mastodon-turn-on-discover | Turns on discover support | +| | mastodon-url-lookup | If a URL resembles a mastodon link, try to load in `mastodon.el'. | +| | mastodon-views--add-account-to-list | Prompt for a list and for an account, add account to list. | +| | mastodon-views--add-account-to-list-at-point | Prompt for account and add to list at point. | +| | mastodon-views--add-toot-account-at-point-to-list | Prompt for a list, and add the account of the toot at point to it. | +| | mastodon-views--cancel-scheduled-toot | Cancel the scheduled toot at point. | +| | mastodon-views--copy-scheduled-toot-text | Copy the text of the scheduled toot at point. | +| | mastodon-views--create-filter | Create a filter for a word. | +| | mastodon-views--create-list | Create a new list. | +| | mastodon-views--delete-filter | Delete filter at point. | +| | mastodon-views--delete-list | Prompt for a list and delete it. | +| | mastodon-views--delete-list-at-point | Delete list at point. | +| | mastodon-views--edit-list | Prompt for a list and edit the name and replies policy. | +| | mastodon-views--edit-list-at-point | Edit list at point. | +| | mastodon-views--edit-scheduled-as-new | Edit scheduled status as new toot. | +| | mastodon-views--remove-account-from-list | Prompt for a list, select an account and remove from list. | +| | mastodon-views--remove-account-from-list-at-point | Prompt for account and remove from list at point. | +| | mastodon-views--reschedule-toot | Reschedule the scheduled toot at point. | +| I | mastodon-views--view-filters | View the user's filters in a new buffer. | +| R | mastodon-views--view-follow-requests | Open a new buffer displaying the user's follow requests. | +| G | mastodon-views--view-follow-suggestions | Display a buffer of suggested accounts to follow. | +| ; | mastodon-views--view-instance-description | View the details of the instance the current post's author is on. | +| | mastodon-views--view-instance-description-brief | View brief details of the instance the current post's author is on. | +| | mastodon-views--view-list-timeline | Prompt for a list and view its timeline. | +| X | mastodon-views--view-lists | Show the user's lists in a new buffer. | +| | mastodon-views--view-own-instance | View details of your own instance. | +| | mastodon-views--view-own-instance-brief | View brief details of your own instance. | +| S | mastodon-views--view-scheduled-toots | Show the user's scheduled toots in a new buffer. | +| | mastodon-views--view-timeline-list-at-point | View timeline of list at point. | + +* mastodon custom variables index + +#+BEGIN_SRC emacs-lisp :results table :colnames '("Custom variable" "Description") :exports results + (let ((rows)) + (mapatoms + (lambda (symbol) + (when (and (string-match "^mastodon" + (symbol-name symbol)) + (custom-variable-p symbol)) + (let* ((doc (car (split-string + (or (get (indirect-variable symbol) + 'variable-documentation) + (get symbol 'variable-documentation) + "") + "\n")))) + (push `(,symbol ,doc) rows) + rows)))) + (sort rows (lambda (x y) (string-lessp (car x) (car y))))) +#+end_src + +#+RESULTS: +| Custom variable | Description | +|----------------------------------------------------+----------------------------------------------------------------------| +| mastodon-active-user | Username of the active user. | +| mastodon-async-mode-hook | Hook run after entering or leaving `mastodon-async-mode'. | +| mastodon-client--token-file | File path where Mastodon access tokens are stored. | +| mastodon-instance-url | Base URL for the Mastodon instance you want to be active. | +| mastodon-media--avatar-height | Height of the user avatar images (if shown). | +| mastodon-media--enable-image-caching | Whether images should be cached. | +| mastodon-media--preview-max-height | Max height of any media attachment preview to be shown in timelines. | +| mastodon-mode-hook | Hook run when entering Mastodon mode. | +| mastodon-profile-mode-hook | Hook run after entering or leaving `mastodon-profile-mode'. | +| mastodon-profile-update-mode-hook | Hook run after entering or leaving `mastodon-profile-update-mode'. | +| mastodon-tl--display-caption-not-url-when-no-media | Display an image's caption rather than URL. | +| mastodon-tl--enable-proportional-fonts | Nonnil to enable using proportional fonts when rendering HTML. | +| mastodon-tl--enable-relative-timestamps | Whether to show relative (to the current time) timestamps. | +| mastodon-tl--hide-replies | Whether to hide replies from the timelines. | +| mastodon-tl--show-avatars | Whether to enable display of user avatars in timelines. | +| mastodon-tl--show-stats | Whether to show toot stats (faves, boosts, replies counts). | +| mastodon-tl--symbols | A set of symbols (and fallback strings) to be used in timeline. | +| mastodon-tl--timeline-posts-count | Number of posts to display when loading a timeline. | +| mastodon-tl-position-after-update | Defines where `point' should be located after a timeline update. | +| mastodon-toot--attachment-height | Height of the attached images preview in the toot draft buffer. | +| mastodon-toot--completion-style-for-mentions | The company completion style to use for mentions. | +| mastodon-toot--default-media-directory | The default directory when prompting for a media file to upload. | +| mastodon-toot--default-reply-visibility | Default visibility settings when replying. | +| mastodon-toot--enable-completion | Whether to enable completion of mentions and hashtags. | +| mastodon-toot--enable-custom-instance-emoji | Whether to enable your instance's custom emoji by default. | +| mastodon-toot--proportional-fonts-compose | Nonnil to enable using proportional fonts in the compose buffer. | +| mastodon-toot--use-company-for-completion | Whether to enable company for completion. | +| mastodon-toot-display-orig-in-reply-buffer | Display a copy of the toot replied to in the compose buffer. | +| mastodon-toot-mode-hook | Hook run after entering or leaving `mastodon-toot-mode'. | +| mastodon-toot-orig-in-reply-length | Length to crop toot replied to in the compose buffer to. | +| mastodon-toot-timestamp-format | Format to use for timestamps. | -- cgit v1.2.3 From 333109f2a312933e053dd4f6364093e30e2ba682 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 20 May 2023 10:50:45 +0200 Subject: readme re index --- README.org | 5 ++++ mastodon.info | 82 ++++++++++++++++++++++++++++++++++------------------------- mastodon.texi | 7 +++++ 3 files changed, 59 insertions(+), 35 deletions(-) diff --git a/README.org b/README.org index 7bc75db..f5e0237 100644 --- a/README.org +++ b/README.org @@ -335,6 +335,10 @@ See =M-x customize-group RET mastodon= to view all customize options. - Display toot being replied to - Set default reply visibility +*** Commands and variables index + +An index of all user-facing commands and custom variables is available here: [[file:mastodon-index.org][mastodon-index.org]]. + *** Alternative timeline layout The incomparable Nicholas Rougier has written an alternative timeline layout @@ -379,6 +383,7 @@ to your translator function as its text argument. Here's what #+end_src *** bookmarks and =mastodon.el= + =mastodon.el= doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we implement them, you can get bookmarks going immediately by using [[https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el][bookmark+.el]]. diff --git a/mastodon.info b/mastodon.info index 12f5da4..6ab20b4 100644 --- a/mastodon.info +++ b/mastodon.info @@ -38,6 +38,7 @@ Usage * Composing toots:: * Other commands and account settings:: * Customization:: +* commands and variables index:: * Alternative timeline layout:: * Live-updating timelines mastodon-async-mode:: * Translating toots:: @@ -161,6 +162,7 @@ File: mastodon.info, Node: Usage, Next: Dependencies, Prev: Installation, Up * Composing toots:: * Other commands and account settings:: * Customization:: +* commands and variables index:: * Alternative timeline layout:: * Live-updating timelines mastodon-async-mode:: * Translating toots:: @@ -424,7 +426,7 @@ and should work without first loading ‘mastodon.el’: posts are marked as sensitive (nsfw) by default.  -File: mastodon.info, Node: Customization, Next: Alternative timeline layout, Prev: Other commands and account settings, Up: Usage +File: mastodon.info, Node: Customization, Next: commands and variables index, Prev: Other commands and account settings, Up: Usage 1.2.5 Customization ------------------- @@ -449,9 +451,18 @@ See ‘M-x customize-group RET mastodon’ to view all customize options. • Set default reply visibility  -File: mastodon.info, Node: Alternative timeline layout, Next: Live-updating timelines mastodon-async-mode, Prev: Customization, Up: Usage +File: mastodon.info, Node: commands and variables index, Next: Alternative timeline layout, Prev: Customization, Up: Usage -1.2.6 Alternative timeline layout +1.2.6 commands and variables index +---------------------------------- + +An index of all user-facing commands and custom variables is available +here: mastodon-index.org (mastodon-index.org). + + +File: mastodon.info, Node: Alternative timeline layout, Next: Live-updating timelines mastodon-async-mode, Prev: commands and variables index, Up: Usage + +1.2.7 Alternative timeline layout --------------------------------- The incomparable Nicholas Rougier has written an alternative timeline @@ -463,7 +474,7 @@ layout for ‘mastodon.el’.  File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Alternative timeline layout, Up: Usage -1.2.7 Live-updating timelines: ‘mastodon-async-mode’ +1.2.8 Live-updating timelines: ‘mastodon-async-mode’ ---------------------------------------------------- (code taken from mastodon-future @@ -482,7 +493,7 @@ Then you can view a timeline with one of the commands that begin with  File: mastodon.info, Node: Translating toots, Next: bookmarks and mastodonel, Prev: Live-updating timelines mastodon-async-mode, Up: Usage -1.2.8 Translating toots +1.2.9 Translating toots ----------------------- You can translate toots with ‘mastodon-toot--translate-toot-text’ (‘a’ @@ -509,8 +520,8 @@ looks like:  File: mastodon.info, Node: bookmarks and mastodonel, Prev: Translating toots, Up: Usage -1.2.9 bookmarks and ‘mastodon.el’ ---------------------------------- +1.2.10 bookmarks and ‘mastodon.el’ +---------------------------------- ‘mastodon.el’ doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we @@ -645,34 +656,35 @@ File: mastodon.info, Node: Contributors, Prev: Supporting mastodonel, Up: REA  Tag Table: Node: Top210 -Node: README911 -Node: Installation1327 -Node: MELPA1863 -Node: Emoji2231 -Node: Discover2563 -Node: Usage3115 -Node: Logging in to your instance3525 -Node: Timelines4522 -Ref: Keybindings4997 -Ref: Toot byline legend9570 -Node: Composing toots9879 -Ref: Keybindings (1)11118 -Ref: autocompletion of mentions and tags11636 -Ref: Draft toots12349 -Node: Other commands and account settings12820 -Node: Customization15978 -Node: Alternative timeline layout16764 -Node: Live-updating timelines mastodon-async-mode17154 -Node: Translating toots18006 -Node: bookmarks and mastodonel19188 -Node: Dependencies19658 -Node: Network compatibility20264 -Node: Contributing20750 -Node: Bug reports21039 -Node: Fixes and features21945 -Node: Coding style22428 -Node: Supporting mastodonel23052 -Node: Contributors23574 +Node: README944 +Node: Installation1360 +Node: MELPA1896 +Node: Emoji2264 +Node: Discover2596 +Node: Usage3148 +Node: Logging in to your instance3591 +Node: Timelines4588 +Ref: Keybindings5063 +Ref: Toot byline legend9636 +Node: Composing toots9945 +Ref: Keybindings (1)11184 +Ref: autocompletion of mentions and tags11702 +Ref: Draft toots12415 +Node: Other commands and account settings12886 +Node: Customization16044 +Node: commands and variables index16831 +Node: Alternative timeline layout17151 +Node: Live-updating timelines mastodon-async-mode17556 +Node: Translating toots18408 +Node: bookmarks and mastodonel19590 +Node: Dependencies20062 +Node: Network compatibility20668 +Node: Contributing21154 +Node: Bug reports21443 +Node: Fixes and features22349 +Node: Coding style22832 +Node: Supporting mastodonel23456 +Node: Contributors23978  End Tag Table diff --git a/mastodon.texi b/mastodon.texi index 1850844..f1de236 100644 --- a/mastodon.texi +++ b/mastodon.texi @@ -52,6 +52,7 @@ Usage * Composing toots:: * Other commands and account settings:: * Customization:: +* commands and variables index:: * Alternative timeline layout:: * Live-updating timelines @samp{mastodon-async-mode}:: * Translating toots:: @@ -163,6 +164,7 @@ Or, with @samp{use-package}: * Composing toots:: * Other commands and account settings:: * Customization:: +* commands and variables index:: * Alternative timeline layout:: * Live-updating timelines @samp{mastodon-async-mode}:: * Translating toots:: @@ -593,6 +595,11 @@ Set default reply visibility @end itemize @end itemize +@node commands and variables index +@subsection commands and variables index + +An index of all user-facing commands and custom variables is available here: @uref{mastodon-index.org, mastodon-index.org}. + @node Alternative timeline layout @subsection Alternative timeline layout -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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 281c00c1102fd116675b35680a293f312a61f530 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 25 May 2023 20:12:03 +0200 Subject: FIX boosting unlisted allowed, private not allowed --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 59b8364..88ee34b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -361,7 +361,7 @@ TYPE is a symbol, either `favourite' or `boost.'" (visibility (mastodon-tl--field 'visibility toot-json))) (if byline-region (if (and (or (equal visibility "direct") - (equal visibility "unlisted")) + (equal visibility "private")) boost-p) (message "You cant boost posts with visibility: %s" visibility) (cond ;; actually there's nothing wrong with faving/boosting own toots! -- 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(+) 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 e97dc9dbf258d3cee1f0a0a0d1bfa1e733aa0f62 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 26 May 2023 09:21:11 +0200 Subject: rough rendering for 404 html error responses. --- lisp/mastodon-http.el | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 5dd4fda..dc007f3 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -87,7 +87,6 @@ RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - ;; 404 sometimes returns http response so --process-json fails: (if (string-prefix-p "404" status) (message "Error %s: page not found" status) (let ((json-response (with-current-buffer response @@ -181,6 +180,15 @@ Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." (car (mastodon-http--process-response :no-headers))) +(defun mastodon-http--render-html-err (string) + "Render STRING as HTML in a temp buffer. +STRING should be a HTML for a 404 errror." + (with-temp-buffer + (insert json-string) + (shr-render-buffer (current-buffer)) + (view-mode) ; for 'q' to kill buffer and window + (error ""))) ; stop subsequent processing + (defun mastodon-http--process-response (&optional no-headers vector) "Process http response. Return a cons of JSON list and http response headers. @@ -201,9 +209,14 @@ Callback to `mastodon-http--get-response-async', usually (kill-buffer) (cond ((or (string-empty-p json-string) (null json-string)) nil) - ;; if no json, maybe we have a plain string error message (misskey - ;; does this, but there are probably better ways to do this): - ;; FIXME: friendica at least sends plain html if endpoint not found. + ;; if we get html, just render it and error: + ;; ideally we should handle the status code in here rather than + ;; this crappy hack? + ((string-prefix-p "\n Date: Fri, 26 May 2023 11:27:33 +0200 Subject: tiny cleanup of view-instance-description (uncallable code) --- lisp/mastodon-views.el | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 7d5ac1e..9809365 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -724,10 +724,7 @@ INSTANCE is an instance domain name." (interactive) (if user (let ((response (mastodon-http--get-json - (mastodon-http--api "instance") - nil ; params - nil ; silent - :vector))) + (mastodon-http--api "instance") nil nil :vector))) (mastodon-views--instance-response-fun response brief instance)) (mastodon-tl--do-if-toot (let* ((toot (if (mastodon-tl--profile-buffer-p) @@ -755,12 +752,7 @@ INSTANCE is an instance domain name." (alist-get 'username account))) (instance (mastodon-views--get-instance-url url username instance)) (response (mastodon-http--get-json - (if user - (mastodon-http--api "instance") - (concat instance "/api/v1/instance")) - nil ; params - nil ; silent - :vector))) + (concat instance "/api/v1/instance") nil nil :vector))) (mastodon-views--instance-response-fun response brief instance))))) (defun mastodon-views--instance-response-fun (response brief instance) -- cgit v1.2.3 From f0670d18c38051b6b950d6569aa61c9f54f35df8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 30 May 2023 13:06:55 +0200 Subject: don't dbl quote video overlay font --- lisp/mastodon-media.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 12d51a1..5ccc3c4 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -284,7 +284,7 @@ Replace them with the referenced image." (propertize "" 'help-echo "Video" 'face - '((:height 3.5 :inherit 'font-lock-comment-face)))))) + '((:height 3.5 :inherit font-lock-comment-face)))))) ;; (cl-pushnew ov mastodon-media--overlays))) (defun mastodon-media--get-avatar-rendering (avatar-url) -- 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(-) 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 b304f59945aaadd9b7bd3a37e704a2193f43d3d6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 5 Jun 2023 10:25:22 +0200 Subject: dm-user binding --- lisp/mastodon.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 8b76320..ce72f34 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -180,6 +180,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "v") #'mastodon-tl--poll-vote) (define-key map (kbd "E") #'mastodon-toot--view-toot-edits) (define-key map (kbd "T") #'mastodon-tl--thread) + (define-key map (kbd "m") #'mastodon-tl--dm-user) (when (require 'lingva nil :no-error) (define-key map (kbd "a") #'mastodon-toot--translate-toot-text)) (define-key map (kbd ",") #'mastodon-toot--list-toot-favouriters) -- cgit v1.2.3 From e010954eb2b50fbc151e0cea5c2db11a530556d2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 10 Jun 2023 14:15:57 +0200 Subject: profile: switch followed-by/following display --- lisp/mastodon-profile.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index d9d8a4c..b8ac8be 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -621,9 +621,9 @@ HEADERS means also fetch link headers for pagination." (if followsp (mastodon-tl--set-face (concat (when (equal .following 't) - " | FOLLOWS YOU") - (when (equal .followed_by 't) " | FOLLOWED BY YOU") + (when (equal .followed_by 't) + " | FOLLOWS YOU") (when (equal .requested_by 't) " | REQUESTED TO FOLLOW YOU") "\n\n") -- cgit v1.2.3 From fc63be8f3f1e8bc9d2097f92bb7b4f28fe07b949 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 10 Jun 2023 14:16:25 +0200 Subject: add lemmy post regex to masto-url-p --- lisp/mastodon.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index ce72f34..a76bdf1 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -367,7 +367,8 @@ not, just browse the URL in the normal fashion." (string-match "^/profile/[[:alpha:]]+$" query) (string-match "^/p/[[:alpha:]]+/[[:digit:]]+$" query) (string-match "^/[[:alpha:]]+$" query) - (string-match "^/u/[[:alpha:]]+$" query))))) + (string-match "^/u/[[:alpha:]]+$" query) + (string-match "^/post/[[:digit:]]+$" query))))) (defun mastodon-live-buffers () "Return a list of open mastodon buffers. -- cgit v1.2.3 From 961ade55072028055ab7532d5f0976713a0dbe3a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 11 Jun 2023 18:40:03 +0200 Subject: tag bindings on ' and ", not overloading : --- lisp/mastodon-discover.el | 3 ++- lisp/mastodon.el | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 57c4bd1..c1d28f3 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -79,7 +79,8 @@ ("Views" ("h/?" "View mode help/keybindings" describe-mode) ("#" "Tag search" mastodon-tl--get-tag-timeline) - (":" "List followed tags" mastodon-tl--list-followed-tags) + ("\"" "List followed tags" mastodon-tl--list-followed-tags) + ("'" "Followed tags timeline" mastodon-tl--followed-tags-timeline) ("F" "Federated" mastodon-tl--get-federated-timeline) ("H" "Home" mastodon-tl--get-home-timeline) ("L" "Local" mastodon-tl--get-local-timeline) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a76bdf1..a991726 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -155,8 +155,8 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "l") #'recenter-top-bottom) ;; navigation between timelines (define-key map (kbd "#") #'mastodon-tl--get-tag-timeline) - (define-key map (kbd ":") #'mastodon-tl--list-followed-tags) - (define-key map (kbd "C-:") #'mastodon-tl--followed-tags-timeline) + (define-key map (kbd "\"") #'mastodon-tl--list-followed-tags) + (define-key map (kbd "'") #'mastodon-tl--followed-tags-timeline) (define-key map (kbd "A") #'mastodon-profile--get-toot-author) (define-key map (kbd "F") #'mastodon-tl--get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl--get-home-timeline) -- 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(-) 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(-) 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 3e58a9c2afd5c96409e4ab5a73504384ca1e60c2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 20 Jun 2023 10:42:15 +0200 Subject: update mastodon-index.org --- mastodon-index.org | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/mastodon-index.org b/mastodon-index.org index 45c444f..361a94e 100644 --- a/mastodon-index.org +++ b/mastodon-index.org @@ -49,19 +49,8 @@ | Binding | Command | Description | |------------------+---------------------------------------------------+--------------------------------------------------------------------------------| | | mastodon | Connect Mastodon client to `mastodon-instance-url' instance. | -| | mastodon-async--display-buffer | Display the async user facing buffer. | -| | mastodon-async--stop-http | Stop the http processs and close the async and http buffer. | -| | mastodon-async--stream-federated | Open a stream of Federated. | -| | mastodon-async--stream-home | Open a stream of the home timeline. | -| | mastodon-async--stream-local | Open a stream of Local. | -| | mastodon-async--stream-notifications | Open a stream of user notifications. | | | mastodon-async-mode | Async Mastodon. | | | mastodon-discover | Plug Mastodon functionality into `discover'. | -| | mastodon-inspect--get-search-account | Return JSON for a single account after search QUERY. | -| | mastodon-inspect--get-search-result | Inspect function for a search result for QUERY. | -| | mastodon-inspect--toot | Find next toot and dump its meta data into new buffer. | -| | mastodon-inspect--view-single-toot | View the toot/status represented by TOOT-ID. | -| | mastodon-inspect--view-single-toot-source | View the ess source of a toot/status represented by TOOT-ID. | | C-M-q | mastodon-kill-all-buffers | Kill any and all open mastodon buffers, hopefully. | | | mastodon-mode | Major mode for Mastodon, the federated microblogging network. | | | mastodon-notifications--clear-all | Clear all notifications. | @@ -108,14 +97,14 @@ | | mastodon-search--trending-tags | Display a list of tags trending on your instance. | | B | mastodon-tl--block-user | Query for USER-HANDLE from current status and block that user. | | | mastodon-tl--disable-notify-user-posts | Query for USER-HANDLE and disable notifications when they post. | -| | mastodon-tl--dm-user | Query for USER-HANDLE from current status and compose a message to that user. | +| m | mastodon-tl--dm-user | Query for USER-HANDLE from current status and compose a message to that user. | | | mastodon-tl--do-link-action | Do the action of the link at point. | | | mastodon-tl--do-link-action-at-point | Do the action of the link at POSITION. | | | mastodon-tl--enable-notify-user-posts | Query for USER-HANDLE and enable notifications when they post. | | | mastodon-tl--filter-user-user-posts-by-language | Query for USER-HANDLE and enable notifications when they post. | | | mastodon-tl--follow-tag | Prompt for a tag and follow it. | | W | mastodon-tl--follow-user | Query for USER-HANDLE from current status and follow that user. | -| C-: | mastodon-tl--followed-tags-timeline | Open a timeline of all your followed tags. | +| ' | mastodon-tl--followed-tags-timeline | Open a timeline of all your followed tags. | | F | mastodon-tl--get-federated-timeline | Open federated timeline. | | H | mastodon-tl--get-home-timeline | Open home timeline. | | L | mastodon-tl--get-local-timeline | Open local timeline. | @@ -124,7 +113,7 @@ | C-, n | mastodon-tl--goto-next-toot | Jump to next toot header. | | | mastodon-tl--goto-prev-item | Jump to previous item, e.g. filter or follow request. | | C-, p | mastodon-tl--goto-prev-toot | Jump to last toot header. | -| : | mastodon-tl--list-followed-tags | List followed tags. View timeline of tag user choses. | +| " | mastodon-tl--list-followed-tags | List followed tags. View timeline of tag user choses. | | C- | mastodon-tl--mpv-play-video-at-point | Play the video or gif at point with an mpv process. | | | mastodon-tl--mpv-play-video-from-byline | Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post. | | | mastodon-tl--mute-thread | Mute the thread displayed in the current buffer. | @@ -232,7 +221,6 @@ | Custom variable | Description | |----------------------------------------------------+----------------------------------------------------------------------| | mastodon-active-user | Username of the active user. | -| mastodon-async-mode-hook | Hook run after entering or leaving `mastodon-async-mode'. | | mastodon-client--token-file | File path where Mastodon access tokens are stored. | | mastodon-instance-url | Base URL for the Mastodon instance you want to be active. | | mastodon-media--avatar-height | Height of the user avatar images (if shown). | -- cgit v1.2.3 From 796896086d92a266de13f70443189106c1241d85 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 20 Jun 2023 10:43:50 +0200 Subject: update info pages --- mastodon.info | 14 +++++++------- mastodon.texi | 8 ++++---- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/mastodon.info b/mastodon.info index 6ab20b4..7801b69 100644 --- a/mastodon.info +++ b/mastodon.info @@ -38,7 +38,7 @@ Usage * Composing toots:: * Other commands and account settings:: * Customization:: -* commands and variables index:: +* Commands and variables index:: * Alternative timeline layout:: * Live-updating timelines mastodon-async-mode:: * Translating toots:: @@ -162,7 +162,7 @@ File: mastodon.info, Node: Usage, Next: Dependencies, Prev: Installation, Up * Composing toots:: * Other commands and account settings:: * Customization:: -* commands and variables index:: +* Commands and variables index:: * Alternative timeline layout:: * Live-updating timelines mastodon-async-mode:: * Translating toots:: @@ -426,7 +426,7 @@ and should work without first loading ‘mastodon.el’: posts are marked as sensitive (nsfw) by default.  -File: mastodon.info, Node: Customization, Next: commands and variables index, Prev: Other commands and account settings, Up: Usage +File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Other commands and account settings, Up: Usage 1.2.5 Customization ------------------- @@ -451,16 +451,16 @@ See ‘M-x customize-group RET mastodon’ to view all customize options. • Set default reply visibility  -File: mastodon.info, Node: commands and variables index, Next: Alternative timeline layout, Prev: Customization, Up: Usage +File: mastodon.info, Node: Commands and variables index, Next: Alternative timeline layout, Prev: Customization, Up: Usage -1.2.6 commands and variables index +1.2.6 Commands and variables index ---------------------------------- An index of all user-facing commands and custom variables is available here: mastodon-index.org (mastodon-index.org).  -File: mastodon.info, Node: Alternative timeline layout, Next: Live-updating timelines mastodon-async-mode, Prev: commands and variables index, Up: Usage +File: mastodon.info, Node: Alternative timeline layout, Next: Live-updating timelines mastodon-async-mode, Prev: Commands and variables index, Up: Usage 1.2.7 Alternative timeline layout --------------------------------- @@ -672,7 +672,7 @@ Ref: autocompletion of mentions and tags11702 Ref: Draft toots12415 Node: Other commands and account settings12886 Node: Customization16044 -Node: commands and variables index16831 +Node: Commands and variables index16831 Node: Alternative timeline layout17151 Node: Live-updating timelines mastodon-async-mode17556 Node: Translating toots18408 diff --git a/mastodon.texi b/mastodon.texi index f1de236..c962985 100644 --- a/mastodon.texi +++ b/mastodon.texi @@ -52,7 +52,7 @@ Usage * Composing toots:: * Other commands and account settings:: * Customization:: -* commands and variables index:: +* Commands and variables index:: * Alternative timeline layout:: * Live-updating timelines @samp{mastodon-async-mode}:: * Translating toots:: @@ -164,7 +164,7 @@ Or, with @samp{use-package}: * Composing toots:: * Other commands and account settings:: * Customization:: -* commands and variables index:: +* Commands and variables index:: * Alternative timeline layout:: * Live-updating timelines @samp{mastodon-async-mode}:: * Translating toots:: @@ -595,8 +595,8 @@ Set default reply visibility @end itemize @end itemize -@node commands and variables index -@subsection commands and variables index +@node Commands and variables index +@subsection Commands and variables index An index of all user-facing commands and custom variables is available here: @uref{mastodon-index.org, mastodon-index.org}. -- cgit v1.2.3 From ae51f4c0bfca79559965ee253e82f45388d83fae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 20 Jun 2023 18:58:26 +0200 Subject: fix html render on error in process-json --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index dc007f3..4a8e76a 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -184,7 +184,7 @@ Callback to `mastodon-http--get-json-async', usually "Render STRING as HTML in a temp buffer. STRING should be a HTML for a 404 errror." (with-temp-buffer - (insert json-string) + (insert string) (shr-render-buffer (current-buffer)) (view-mode) ; for 'q' to kill buffer and window (error ""))) ; stop subsequent processing @@ -212,7 +212,7 @@ Callback to `mastodon-http--get-response-async', usually ;; if we get html, just render it and error: ;; ideally we should handle the status code in here rather than ;; this crappy hack? - ((string-prefix-p "\n Date: Tue, 20 Jun 2023 18:58:46 +0200 Subject: add a lemmy community URL to url-p --- lisp/mastodon.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a991726..bb316e9 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -368,6 +368,7 @@ not, just browse the URL in the normal fashion." (string-match "^/p/[[:alpha:]]+/[[:digit:]]+$" query) (string-match "^/[[:alpha:]]+$" query) (string-match "^/u/[[:alpha:]]+$" query) + (string-match "^/c/[[:alnum:]]+$" query) (string-match "^/post/[[:digit:]]+$" query))))) (defun mastodon-live-buffers () -- 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(-) 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 30b14bb52c852e1faa521e2d6e58d6aef01bdf71 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 26 Jun 2023 17:30:17 +0200 Subject: readme --- README.org | 4 ++-- mastodon.info | 4 ++-- mastodon.texi | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/README.org b/README.org index f5e0237..c16fd33 100644 --- a/README.org +++ b/README.org @@ -236,7 +236,7 @@ value of that hook is as follows: | =C-c C-l= | Set toot language | |---------+----------------------------------| -**** autocompletion of mentions and tags +**** Autocompletion of mentions and tags Autocompletion of mentions and tags is provided by =completion-at-point-functions= (capf) backends. @@ -382,7 +382,7 @@ to your translator function as its text argument. Here's what (message "No toot to translate?")))) #+end_src -*** bookmarks and =mastodon.el= +*** Bookmarks and =mastodon.el= =mastodon.el= doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we implement them, diff --git a/mastodon.info b/mastodon.info index 7801b69..caae4d9 100644 --- a/mastodon.info +++ b/mastodon.info @@ -334,7 +334,7 @@ is as follows: ‘C-c C-p’ Create a poll ‘C-c C-l’ Set toot language - 2. autocompletion of mentions and tags + 2. Autocompletion of mentions and tags Autocompletion of mentions and tags is provided by ‘completion-at-point-functions’ (capf) backends. @@ -668,7 +668,7 @@ Ref: Keybindings5063 Ref: Toot byline legend9636 Node: Composing toots9945 Ref: Keybindings (1)11184 -Ref: autocompletion of mentions and tags11702 +Ref: Autocompletion of mentions and tags11702 Ref: Draft toots12415 Node: Other commands and account settings12886 Node: Customization16044 diff --git a/mastodon.texi b/mastodon.texi index c962985..1f2cd14 100644 --- a/mastodon.texi +++ b/mastodon.texi @@ -418,7 +418,7 @@ value of that hook is as follows: @end multitable @item -@anchor{autocompletion of mentions and tags}autocompletion of mentions and tags +@anchor{Autocompletion of mentions and tags}Autocompletion of mentions and tags Autocompletion of mentions and tags is provided by -- 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(-) 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(+) 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 ad00253d714a128e95faa9baebfb5322c3fcc378 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 6 Jul 2023 16:59:12 +0200 Subject: add lemmy comment url form to masto-url-p --- lisp/mastodon.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 8eac782..53986cf 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -370,7 +370,8 @@ not, just browse the URL in the normal fashion." (string-match "^/[[:alpha:]]+$" query) (string-match "^/u/[[:alpha:]]+$" query) (string-match "^/c/[[:alnum:]]+$" query) - (string-match "^/post/[[:digit:]]+$" query))))) + (string-match "^/post/[[:digit:]]+$" query) + (string-match "^/comment/[[:digit:]]+$" query))))) ; lemmy (defun mastodon-live-buffers () "Return a list of open mastodon buffers. -- 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(-) 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 349e73b0807c8113088014ddd05d4e412cf9cece Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 6 Jul 2023 18:58:51 +0200 Subject: update mastodon-index --- mastodon-index.org | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/mastodon-index.org b/mastodon-index.org index 361a94e..ef5bc14 100644 --- a/mastodon-index.org +++ b/mastodon-index.org @@ -110,9 +110,9 @@ | L | mastodon-tl--get-local-timeline | Open local timeline. | | # | mastodon-tl--get-tag-timeline | Prompt for tag and opens its timeline. | | | mastodon-tl--goto-next-item | Jump to next item, e.g. filter or follow request. | -| C-, n | mastodon-tl--goto-next-toot | Jump to next toot header. | +| n, C- | mastodon-tl--goto-next-toot | Jump to next toot header. | | | mastodon-tl--goto-prev-item | Jump to previous item, e.g. filter or follow request. | -| C-, p | mastodon-tl--goto-prev-toot | Jump to last toot header. | +| p, C- | mastodon-tl--goto-prev-toot | Jump to last toot header. | | " | mastodon-tl--list-followed-tags | List followed tags. View timeline of tag user choses. | | C- | mastodon-tl--mpv-play-video-at-point | Play the video or gif at point with an mpv process. | | | mastodon-tl--mpv-play-video-from-byline | Run `mastodon-tl--mpv-play-video-at-point' on first moving image in post. | @@ -122,6 +122,7 @@ | v | mastodon-tl--poll-vote | If there is a poll at point, prompt user for OPTION to vote on it. | | S-TAB, | mastodon-tl--previous-tab-item | Move to the previous interesting item. | | Z | mastodon-tl--report-to-mods | Report the author of the toot at point to your instance moderators. | +| SPC | mastodon-tl--scroll-up-command | Call `scroll-up-command', loading more toots if necessary. | | | mastodon-tl--single-toot | View toot at point in separate buffer. | | | mastodon-tl--some-followed-tags-timeline | Prompt for some tags, and open a timeline for them. | | T | mastodon-tl--thread | Open thread buffer for toot at point or with ID. | -- cgit v1.2.3 From f62545ecd00d23968f214479a8111c538d54cf86 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 12 Jul 2023 18:05:52 +0200 Subject: message wait/done to attachment uploads, to avoid issues. See #478. --- lisp/mastodon-http.el | 6 +----- lisp/mastodon-toot.el | 3 ++- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 4a8e76a..64f59ca 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -338,11 +338,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." (when data (push (alist-get 'id data) mastodon-toot--media-attachment-ids) ; add ID to list - (message "%s file %s with id %S and caption '%s' uploaded!" - (capitalize (alist-get 'type data)) - file - (alist-get 'id data) - (alist-get 'description data)) + (message "Uploading %s... (done)" file) (mastodon-toot--update-status-fields)))) :error (cl-function (lambda (&key error-thrown &allow-other-keys) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 88ee34b..14b9d68 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1172,7 +1172,8 @@ which is used to attach it to a toot when posting." (let* ((filename (expand-file-name (alist-get :filename attachment))) (caption (alist-get :description attachment)) (url (concat mastodon-instance-url "/api/v2/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) + (message "Uploading %s... (please wait before starting further uploads)" + (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) (defun mastodon-toot--refresh-attachments-display () -- cgit v1.2.3 From 973a035eb0a70d5fa2bb5331f677a0dbfede4a13 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 13 Jul 2023 09:42:26 +0200 Subject: give mastodon-auth--get-browser-login-url a proper alist. --- lisp/mastodon-auth.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 96bf877..4d43962 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -85,10 +85,10 @@ We apologize for the inconvenience. "Return properly formed browser login url." (mastodon-http--concat-params-to-url (concat mastodon-instance-url "/oauth/authorize/") - `(("response_type" "code") - ("redirect_uri" ,mastodon-client-redirect-uri) - ("scope" ,mastodon-client-scopes) - ("client_id" ,(plist-get (mastodon-client) :client_id))))) + `(("response_type" . "code") + ("redirect_uri" . ,mastodon-client-redirect-uri) + ("scope" . ,mastodon-client-scopes) + ("client_id" . ,(plist-get (mastodon-client) :client_id))))) (defvar mastodon-auth--explanation (format -- 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(-) 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 From 5f095822e92872ddcb76fc9fe98c0cf985849f3b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 13 Jul 2023 10:23:11 +0200 Subject: fix indent of media attachments --- lisp/mastodon-http.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 64f59ca..551d4fd 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -347,10 +347,10 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." ;; because the '=' test below fails for them ;; they have the form (error . error message 24) ((not (proper-list-p error-thrown)) ; not dotted list - (message "Got error: %s. Shit went south." (cdr error-thrown))) + (message "Got error: %s. Shit went south." (cdr error-thrown))) ;; handle mastodon api errors ;; they have the form (error http 401) - ((= (car (last error-thrown)) 401) + ((= (car (last error-thrown)) 401) (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) ((= (car (last error-thrown)) 422) -- cgit v1.2.3