From 254402b0d3109556eee0c50e8eb1a98cf6eeaee8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:20:30 +0200 Subject: tl--byline: handle showing edits for notifs and for TL boosts. --- lisp/mastodon-tl.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8c00418..941fe50 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -697,7 +697,8 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." 'help-echo (format "You have %s this status." help-string))))) -(defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p domain) +(defun mastodon-tl--byline (toot author-byline action-byline + &optional detailed-p domain base-toot) "Generate byline for TOOT. AUTHOR-BYLINE is a function for adding the author portion of the byline that takes one variable. @@ -716,14 +717,16 @@ When DOMAIN, force inclusion of user's domain in their handle." ;; (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))) + (faved (eq t (mastodon-tl--field 'favourited toot))) + (boosted (eq t (mastodon-tl--field 'reblogged toot))) + (bookmarked (eq t (mastodon-tl--field 'bookmarked toot))) (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)) + (base-toot-maybe (or base-toot ;; show edits for notifs + (mastodon-tl--toot-or-base toot))) ;; for boosts + (edited-time (alist-get 'edited_at base-toot-maybe)) (edited-parsed (when edited-time (date-to-time edited-time)))) (concat ;; Boosted/favourited markers are not technically part of the byline, so @@ -811,7 +814,8 @@ When DOMAIN, force inclusion of user's domain in their handle." 'bookmarked-p bookmarked 'edited edited-time 'edit-history (when edited-time - (mastodon-toot--get-toot-edits (alist-get 'id toot))) + (mastodon-toot--get-toot-edits + (alist-get 'id base-toot-maybe))) 'byline t)))) @@ -1563,7 +1567,7 @@ NO-BYLINE means just insert toot body, used for folding." (if no-byline "" (mastodon-tl--byline toot author-byline action-byline - detailed-p domain))) + detailed-p domain base-toot))) 'item-type 'toot 'item-id (or id ; notification's own id (alist-get 'id toot)) ; toot id -- cgit v1.2.3 From 2977abb1e13fc8a367f2e5a7bc1493a107803bc8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:21:06 +0200 Subject: tl: use mastodon-toot--base-toot-or-item-json --- lisp/mastodon-tl.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 941fe50..a3cbd60 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2464,8 +2464,7 @@ ARGS is an alist of any parameters to send with the request." (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 'item-json :no-move))) + (let* ((toot (mastodon-toot--base-toot-or-item-json)) (tags (mastodon-tl--field 'tags toot))) (mastodon-tl--map-alist 'name tags))) -- cgit v1.2.3 From 6f4c51e34f7d8c153b5b9a1954d007cd161cd90e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 10:17:40 +0200 Subject: add mastodon-tl--field-status --- lisp/mastodon-tl.el | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a3cbd60..5e56dc3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1997,6 +1997,12 @@ Return value from boosted content if available." (or (alist-get field (alist-get 'reblog toot)) (alist-get field toot))) +(defun mastodon-tl--field-status (field toot) + "Return FIELD from TOOT. +Return value from status field if available." + (or (alist-get field (alist-get 'status toot)) + (alist-get field toot))) + (defun mastodon-tl--remove-html (toot) "Remove unrendered tags from TOOT." (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) -- cgit v1.2.3 From 994b4e9a938d17d35462a8da3929fea267563c70 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 17:53:47 +0200 Subject: re-write all (if x y "") clauses as (when x y), if poss. we can use when inside concat, but not inside insert, nor in strings/args headed for format or propertize. --- lisp/mastodon-media.el | 5 ++-- lisp/mastodon-notifications.el | 9 +++---- lisp/mastodon-profile.el | 14 +++++----- lisp/mastodon-search.el | 7 +++-- lisp/mastodon-tl.el | 59 +++++++++++++++++++----------------------- lisp/mastodon-toot.el | 10 +++---- 6 files changed, 47 insertions(+), 57 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9dc8517..8f8937c 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -500,9 +500,8 @@ SENSITIVE is a flag from the item's JSON data." (substitute-command-keys (concat "\\`RET'/\\`i': load full image (prefix: copy URL), \\`+'/\\`-': zoom,\ \\`r': rotate, \\`o': save preview" - (if (not (eq sensitive :json-false)) - ", \\`S': toggle sensitive media" - "")))) + (when (not (eq sensitive :json-false)) + ", \\`S': toggle sensitive media")))) (help-echo (if caption (concat help-echo-base "\n\"" caption "\"") diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index eca520b..070d23f 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -243,11 +243,10 @@ Status notifications are given when (format "You have a follow request from... %s" follower) 'face 'default) - (if mastodon-notifications--profile-note-in-foll-reqs - (concat - ":\n" - (mastodon-notifications--comment-note-text body)) - "")))) + (when mastodon-notifications--profile-note-in-foll-reqs + (concat + ":\n" + (mastodon-notifications--comment-note-text body)))))) ((or (eq type 'favourite) (eq type 'boost)) (mastodon-notifications--comment-note-text body)) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 8249641..0a17a25 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -681,18 +681,16 @@ MAX-ID is a flag to include the max_id pagination parameter." (mastodon-profile--render-roles .roles))) "\n" (propertize (concat "@" .acct) 'face 'default) - (if (eq .locked t) - (concat " " (mastodon-tl--symbol 'locked)) - "") + (when (eq .locked t) + (concat " " (mastodon-tl--symbol 'locked))) "\n " mastodon-tl--horiz-bar "\n" ;; profile note: (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)) - "") + (when fields + (concat "\n" (mastodon-tl--set-face + (mastodon-profile--fields-insert fields) + 'success))) "\n" ;; Joined date: (propertize diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 00681c6..b54e8f3 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -134,7 +134,7 @@ Optionally add string TYPE after HEADING." (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " (upcase str) " " - (if type (upcase type) "") "\n" + (when type (upcase type)) "\n" " " mastodon-tl--horiz-bar (unless no-newline "\n")) 'success)) @@ -266,9 +266,8 @@ If NOTE is non-nil, include user's profile note. This is also 'mastodon-handle (concat "@" (cadr user)) 'help-echo (concat "Browse user profile of @" (cadr user))) " : \n" - (if note - (mastodon-tl--render-text (cadddr user) acct) - "") + (when note + (mastodon-tl--render-text (cadddr user) acct)) "\n") 'item-json acct))) ; for compat w other processing functions diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5e56dc3..6607bbd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -614,11 +614,10 @@ When DOMAIN, force inclusion of user's domain in their handle." ;; handle: " (" (propertize (concat "@" .account.acct - (if domain - (concat "@" - (url-host - (url-generic-parse-url .account.url))) - "")) + (when domain + (concat "@" + (url-host + (url-generic-parse-url .account.url))))) 'face 'mastodon-handle-face 'mouse-face 'highlight 'mastodon-tab-stop 'user-handle @@ -788,26 +787,24 @@ When DOMAIN, force inclusion of user's domain in their handle." '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))) - "") + (when 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 (and mastodon-tl--show-stats - (not (member type '("follow" "follow_request")))) - (mastodon-tl--toot-stats toot) - "") + (when (and mastodon-tl--show-stats + (not (member type '("follow" "follow_request")))) + (mastodon-tl--toot-stats toot)) "\n") 'favourited-p faved 'boosted-p boosted @@ -1149,7 +1146,8 @@ message is a link which unhides/hides the main body." ;;; MEDIA (defun mastodon-tl--media (toot) - "Retrieve a media attachment link for TOOT if one exists." + "Retrieve a media attachment link for TOOT if one exists. +Else return an empty string." (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) (sensitive (mastodon-tl--field 'sensitive toot)) (media-string (mapconcat @@ -1291,8 +1289,7 @@ LENGTH is of the longest option, for formatting." (format "%s people | " .voters_count))) (.vote_count (format "%s votes | " .vote_count)) - (t - "")) + (t "")) 'face 'font-lock-comment-face) (let ((str (if (eq .expired :json-false) (if (eq .expires_at nil) @@ -1547,10 +1544,9 @@ NO-BYLINE means just insert toot body, used for folding." (concat "\n" ;; relpy symbol (broken): - (if (and after-reply-status-p thread) - (concat (mastodon-tl--symbol 'replied) - "\n") - "") + (when (and after-reply-status-p thread) + (concat (mastodon-tl--symbol 'replied) + "\n")) ;; actual body: (let ((bar (mastodon-tl--symbol 'reply-bar)) (body (if (and toot-foldable (not unfolded)) @@ -1564,8 +1560,7 @@ NO-BYLINE means just insert toot body, used for folding." 'toot-body t) ;; includes newlines etc. for folding ;; byline: "\n" - (if no-byline - "" + (unless no-byline (mastodon-tl--byline toot author-byline action-byline detailed-p domain base-toot))) 'item-type 'toot diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index ae88d68..2232cc8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1659,11 +1659,10 @@ REPLY-TEXT is the text of the toot being replied to." (propertize "None " 'toot-attachments t) "\n" - (if reply-text - (propertize - (mastodon-toot--format-reply-in-compose reply-text) - 'toot-reply t) - "") + (when reply-text + (propertize + (mastodon-toot--format-reply-in-compose reply-text) + 'toot-reply t)) divider) 'face 'mastodon-toot-docs-face 'read-only "Edit your message below." @@ -1757,6 +1756,7 @@ REPLY-REGION is a string to be injected into the buffer." (if (equal "private" mastodon-toot--visibility) "followers-only" mastodon-toot--visibility))) + ;; WHEN clauses don't work here, we need "" as display arg: (mastodon-toot--apply-fields-props lang-region (if mastodon-toot--language -- cgit v1.2.3 From bf1c648b219d54aaa1b9fccd61a4bd91226eb96b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 10:52:21 +0200 Subject: cl-remove nils rather than push for poss nil params --- lisp/mastodon-tl.el | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6607bbd..4e678f6 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -456,15 +456,16 @@ If LOCAL, get only local timeline. With a single PREFIX arg, hide-replies. With a double PREFIX arg, only show posts with media." (interactive "p") - (let ((params `(("limit" . ,mastodon-tl--timeline-posts-count)))) - ;; avoid adding 'nil' to our params alist: - (when (eq prefix 16) - (push '("only_media" . "true") params)) - (when local - (push '("local" . "true") params)) - (when max-id - (push `("max_id" . ,(mastodon-tl--buffer-property 'max-id)) - params)) + (let ((params + (cl-remove + nil + `(("limit" . ,mastodon-tl--timeline-posts-count) + ,(when (eq prefix 16) + '("only_media" . "true")) + ,(when local + '("local" . "true")) + ,(when max-id + `("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) (message "Loading federated timeline...") (mastodon-tl--init (if local "local" "federated") "timelines/public" 'mastodon-tl--timeline nil @@ -549,12 +550,14 @@ With a double PREFIX arg, limit results to your own instance." If TAG is a list, show a timeline for all tags. With a single PREFIX arg, only show posts with media. With a double PREFIX arg, limit results to your own instance." - (let ((params `(("limit" . ,mastodon-tl--timeline-posts-count)))) - ;; avoid adding 'nil' to our params alist: - (when (eq prefix 4) - (push '("only_media" . "true") params)) - (when (eq prefix 16) - (push '("local" . "true") params)) + (let ((params + (cl-remove + nil + `(("limit" . ,mastodon-tl--timeline-posts-count) + ,(when (eq prefix 4) + '("only_media" . "true")) + ,(when (eq prefix 16) + '("local" . "true")))))) (when (listp tag) (let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag)))) (while list -- cgit v1.2.3 From 21090d643515ad076c9900d601a1a901f464ccc9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 10:52:52 +0200 Subject: tl: condition-case for next/prev funs --- lisp/mastodon-tl.el | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4e678f6..80c1e42 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -401,21 +401,16 @@ Optionally start from POS." ;; FIXME: we need to fix item-type? ;; 'item-type ; breaks nav to last item in a view? 'byline - (current-buffer)))) + (current-buffer))) + (max-lisp-eval-depth 4)) ;; clamp down on endless loops (if npos - (if (not - (get-text-property npos 'item-type)) ; generic + (if (not (get-text-property npos 'item-type)) ; generic ;; FIXME let's make refresh &optional and only call refresh/recur ;; if non-nil: (mastodon-tl--goto-item-pos find-pos refresh npos) (goto-char npos) ;; force display of help-echo on moving to a toot byline: (mastodon-tl--message-help-echo)) - ;; FIXME: doesn't work, the funcall doesn't return if in an endless - ;; refresh loop. - ;; either let-bind `max-lisp-eval-depth' and try to error handle when it - ;; errors, or else set up a counter, and error when it gets to high - ;; (like >2 would already be too much) (condition-case nil (funcall refresh) (error "No more items"))))) @@ -426,26 +421,28 @@ Load more items it no next item. NO-REFRESH means do no not try to load more items if no next item found." (interactive) - (mastodon-tl--goto-item-pos 'next-single-property-change - (unless no-refresh 'mastodon-tl--more))) + (condition-case err + (mastodon-tl--goto-item-pos 'next-single-property-change + (unless no-refresh 'mastodon-tl--more)) + (t (error "No more items")))) (defun mastodon-tl--goto-prev-item () "Jump to previous item. Update if no previous items" (interactive) - (mastodon-tl--goto-item-pos 'previous-single-property-change - 'mastodon-tl--update)) + (condition-case err + (mastodon-tl--goto-item-pos 'previous-single-property-change + 'mastodon-tl--update) + (t (error "No more items")))) (defun mastodon-tl--goto-first-item () "Jump to first toot or item in buffer. Used on initializing a timeline or thread." - ;; goto-next-item assumes we already have items, and is therefore - ;; incompatible with any view where it is possible to have no items. - ;; when that is the case the call to goto-toot-pos loops infinitely (goto-char (point-min)) - (mastodon-tl--goto-item-pos 'next-single-property-change - 'next-line)) -;; (mastodon-tl--goto-next-item)) + (condition-case err + (mastodon-tl--goto-item-pos 'next-single-property-change + 'next-line) + (t (error "No item")))) ;;; TIMELINES -- cgit v1.2.3 From 881ee6ab4133e63c4debc1b6e716d5e4bdb446aa Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 11:05:05 +0200 Subject: factor out image-trans-check. --- lisp/mastodon-media.el | 8 +++----- lisp/mastodon-tl.el | 14 ++++++++------ lisp/mastodon-toot.el | 3 +-- 3 files changed, 12 insertions(+), 13 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8c035be..570be02 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -363,15 +363,14 @@ MEDIA-TYPE is a symbol and either `avatar' or `media-link'. START is the position where we start loading the image. REGION-LENGTH is the range from start to propertize." (let ((image-options - (when (or (image-type-available-p 'imagemagick) - (image-transforms-p)) ; inbuilt scaling in 27.1 + (when (mastodon-tl--image-trans-check) (cond ((eq media-type 'avatar) `(:height ,mastodon-media--avatar-height)) ((eq media-type 'media-link) `(:max-height ,mastodon-media--preview-max-height))))) (buffer (current-buffer)) (marker (copy-marker start)) - (url-show-status nil)) ; stop url.el from spamming us about connecting + (url-show-status nil)) ; stop url.el from spamming us about connecting (condition-case nil ;; catch errors in url-retrieve to not break our caller (if (and mastodon-media--enable-image-caching @@ -469,8 +468,7 @@ START and END are the beginning and end of the media item to overlay." ;; We use just an empty space as the textual representation. ;; This is what a user will see on a non-graphical display ;; where not showing an avatar at all is preferable. - (let ((image-options (when (or (image-type-available-p 'imagemagick) - (image-transforms-p)) ; inbuilt scaling in 27.1 + (let ((image-options (when (mastodon-tl--image-trans-check) `(:height ,mastodon-media--avatar-height)))) (concat (propertize " " diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 80c1e42..0c9670b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -591,9 +591,7 @@ When DOMAIN, force inclusion of user's domain in their handle." (when (and avatar ; used by `mastodon-profile--format-user' mastodon-tl--show-avatars mastodon-tl--display-media-p - (if (version< emacs-version "27.1") - (image-type-available-p 'imagemagick) - (image-transforms-p))) + (mastodon-tl--image-trans-check)) (mastodon-media--get-avatar-rendering .account.avatar)) ;; username: (propertize (if (not (string-empty-p .account.display_name)) @@ -696,6 +694,12 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." 'help-echo (format "You have %s this status." help-string))))) +(defun mastodon-tl--image-trans-check () + "Call `image-transforms-p', or `image-type-available-p' 'imagemagick." + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + (defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p domain base-toot) "Generate byline for TOOT. @@ -748,9 +752,7 @@ When DOMAIN, force inclusion of user's domain in their handle." ;; with `mastodon-tl--goto-next-item': (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-tl--image-trans-check)) (mastodon-media--get-avatar-rendering avatar-url)) (propertize (concat diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 2232cc8..7c5472b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1329,8 +1329,7 @@ which is used to attach it to a toot when posting." (defun mastodon-toot--format-attachments () "Format the attachment previews for display in toot draft buffer." (or - (let ((image-options (when (or (image-type-available-p 'imagemagick) - (image-transforms-p)) + (let ((image-options (when (mastodon-tl--image-trans-check) `(:height ,mastodon-toot--attachment-height)))) (cl-loop for count from 1 for att in mastodon-toot--media-attachments -- cgit v1.2.3 From 13dcc7d624001fb0befe16c284b28c183329058a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 11:11:15 +0200 Subject: audit first 900 lines of tl.el --- lisp/mastodon-tl.el | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0c9670b..be71b4d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -221,7 +221,6 @@ respects the user's `browse-url' settings." See `mastodon-tl--get-remote-local-timeline' for view remote local domains." :type '(repeat string)) - (defcustom mastodon-tl--fold-toots-at-length 1200 "Length, in characters, to fold a toot at. Longer toots will be folded and the remainder replaced by a @@ -294,7 +293,7 @@ types of mastodon links and not just shr.el-generated ones.") (define-key map [remap shr-previous-link] #'mastodon-tl--previous-tab-item) ;; browse-url loads the preview only, we want browse-image ;; on RET to browse full sized image URL - (define-key map [remap shr-browse-url] #'mastodon-tl--view-full-image-or-play-video) ;#'shr-browse-image) + (define-key map [remap shr-browse-url] #'mastodon-tl--view-full-image-or-play-video) ;; remove shr's u binding, as it the maybe-probe-and-copy-url ;; is already bound to w also (define-key map (kbd "u") #'mastodon-tl--update) @@ -314,6 +313,7 @@ types of mastodon links and not just shr.el-generated ones.") (let ((map (make-sparse-keymap))) (define-key map (kbd "") #'mastodon-tl--mpv-play-video-from-byline) (define-key map (kbd "RET") #'mastodon-profile--get-toot-author) + (define-key map (kbd "S") #'mastodon-tl--toggle-sensitive-image) map)) "The keymap to be set for the author byline. It is active where point is placed by `mastodon-tl--goto-next-item.'") @@ -344,7 +344,7 @@ than `pop-to-buffer'." (declare (debug t)) `(if (and (not (mastodon-tl--profile-buffer-p)) (not (mastodon-tl--property 'item-json))) ; includes users but not tags - (message "Looks like there's no item at point?") + (user-error "Looks like there's no item at point?") ,@body)) @@ -354,7 +354,7 @@ than `pop-to-buffer'." "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))) + (if (not (eq (point) (point-max))) (scroll-up-command) (mastodon-tl--more) (scroll-up-command))) @@ -362,7 +362,7 @@ If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." (defun mastodon-tl--next-tab-item (&optional previous) "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. +Don't move if nothing 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. PREVIOUS means move to previous item." (interactive) @@ -378,7 +378,7 @@ PREVIOUS means move to previous item." ;; do nothing, all the action is in the while condition ) (if (null next-range) - (message "Nothing else here.") + (user-error "Nothing else here") (goto-char (car next-range)) (message "%s" (mastodon-tl--property 'help-echo :no-move))))) @@ -562,9 +562,7 @@ With a double PREFIX arg, limit results to your own instance." (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))) + 'mastodon-tl--timeline nil params))) ;;; BYLINES, etc. @@ -643,8 +641,9 @@ Used when point is at the start of a byline, i.e. where toot) (alist-get 'reblog toot) ; boosts toot)) ; everything else - (fol-req-p (or (string= (alist-get 'type toot-to-count) "follow") - (string= (alist-get 'type toot-to-count) "follow_request")))) + (fol-req-p (let ((type (alist-get 'type toot-to-count))) + (or (string= type "follow") + (string= type "follow_request"))))) (unless fol-req-p (let* ((media-types (mastodon-tl--get-media-types toot)) (format-media (when media-types @@ -653,8 +652,8 @@ Used when point is at the start of a byline, i.e. where (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)))))) + " | C-RET to view with mpv"))) + (concat format-media format-media-binding))))) (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." @@ -664,12 +663,12 @@ Used when point is at the start of a byline, i.e. where (defun mastodon-tl--get-attachments-for-byline (toot) "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))) + (let ((media (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))) + media))) (defun mastodon-tl--byline-boosted (toot) "Add byline for boosted data from TOOT." @@ -766,14 +765,17 @@ When DOMAIN, force inclusion of user's domain in their handle." ((equal visibility "private") (propertize (concat " " (mastodon-tl--symbol 'private)) 'help-echo visibility))) + ;;action byline: (funcall action-byline toot) " " + ;; timestamp: (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)) + ;; detailed: (when detailed-p (let* ((app (alist-get 'application toot)) (app-name (alist-get 'name app)) @@ -789,6 +791,7 @@ When DOMAIN, force inclusion of user's domain in their handle." 'shr-url app-url 'help-echo app-url 'keymap mastodon-tl--shr-map-replacement))))) + ;; edited: (when edited-time (concat " " @@ -804,6 +807,7 @@ When DOMAIN, force inclusion of user's domain in their handle." edited-parsed)))) (propertize (concat "\n " mastodon-tl--horiz-bar) 'face 'default) + ;; stats: (when (and mastodon-tl--show-stats (not (member type '("follow" "follow_request")))) (mastodon-tl--toot-stats toot)) -- cgit v1.2.3 From 499c03aa783628ff5937b77cb48d3aeaa83f0ae3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 14:05:10 +0200 Subject: refactor process-image-or-cached --- lisp/mastodon-media.el | 38 +++++++++++++++++++++----------------- lisp/mastodon-tl.el | 16 ++++------------ 2 files changed, 25 insertions(+), 29 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 570be02..d386462 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -357,6 +357,20 @@ STATUS-PLIST is a plist of status events as per `url-retrieve'." (switch-to-buffer-other-window (current-buffer)) (image-transform-fit-both)))))) +(defun mastodon-media--image-or-cached (url process-fun args) + "Fetch URL from cache or fro host. +Call PROCESS-FUN on it with ARGS." + (if (and mastodon-media--enable-image-caching + (url-is-cached url)) ;; if cached, decompress and use: + (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)) + (funcall process-fun url args)) + ;; fetch as usual and process-image-response will cache it + (url-retrieve url process-fun (cdr args)))) + (defun mastodon-media--load-image-from-url (url media-type start region-length) "Take a URL and MEDIA-TYPE and load the image asynchronously. MEDIA-TYPE is a symbol and either `avatar' or `media-link'. @@ -373,24 +387,14 @@ REGION-LENGTH is the range from start to propertize." (url-show-status nil)) ; stop url.el from spamming us about connecting (condition-case nil ;; catch errors in url-retrieve to not break our caller - (if (and mastodon-media--enable-image-caching - (url-is-cached url)) ;; if cached, decompress and use: - (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)) - ;; else fetch as usual and process-image-response will cache it - (url-retrieve url #'mastodon-media--process-image-response - (list marker image-options region-length url))) + (mastodon-media--image-or-cached + url + #'mastodon-media--process-image-response + (list nil marker image-options region-length url)) (error (with-current-buffer buffer - ;; TODO: Consider adding retries - (put-text-property marker - (+ marker region-length) - 'media-state - 'loading-failed) + ;; TODO: Add retries + (put-text-property marker (+ marker region-length) + 'media-state 'loading-failed) :loading-failed))))) (defun mastodon-media--select-next-media-line (end-pos) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index be71b4d..375f7e4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1222,18 +1222,10 @@ SENSITIVE is a flag from the item's JSON data." (let* ((url (mastodon-tl--property 'image-url))) (if (not mastodon-tl--load-full-sized-images-in-emacs) (shr-browse-image) - (if (and mastodon-media--enable-image-caching - (url-is-cached url)) - ;; if image url is cached, decompress and use it - (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-full-sized-image-response nil url)) - ;; else fetch and load: - (url-retrieve url #'mastodon-media--process-full-sized-image-response - `(,url))))))) + (mastodon-media--image-or-cached + url + #'mastodon-media--process-full-sized-image-response + `(nil ,url)))))) (defvar mastodon-media--sensitive-image-data) -- cgit v1.2.3 From 5cb54813a2c85403ded7afe45cf8e55d4dd277f4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 14:21:40 +0200 Subject: audit tl.el up to ;;; POLLS --- lisp/mastodon-tl.el | 154 +++++++++++++++++++++++++--------------------------- 1 file changed, 74 insertions(+), 80 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 375f7e4..8158073 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -98,13 +98,13 @@ (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) +(defvar mastodon-mode-map) (defvar mastodon-instance-url) (defvar mastodon-toot-timestamp-format) (defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this (defvar mastodon-media--enable-image-caching) (defvar mastodon-media--generic-broken-image-data) - -(defvar mastodon-mode-map) +(defvar mastodon-media--sensitive-image-data) ;;; CUSTOMIZES @@ -889,23 +889,19 @@ START and END are the boundaries of the link in the toot." (url-host toot-url)) mastodon-instance-url)) (link-str (buffer-substring-no-properties start end)) - (maybe-hashtag (mastodon-tl--extract-hashtag-from-url + (maybe-hashtag (mastodon-tl--hashtag-from-url url toot-instance-url)) (maybe-userhandle (if (proper-list-p toot) ; fails for profile buffers? (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)))) - (cond (;; Hashtags: - maybe-hashtag + (mastodon-tl--userhandle-from-url url link-str)) + (mastodon-tl--userhandle-from-url url link-str)))) + (cond (maybe-hashtag (setq mastodon-tab-stop-type 'hashtag keymap mastodon-tl--link-keymap help-echo (concat "Browse tag #" maybe-hashtag) extra-properties (list 'mastodon-tag maybe-hashtag))) - (;; User handles: - maybe-userhandle - ;; this fails on mentions in profile notes: + (maybe-userhandle ;; fails on mentions in profile notes: (let ((maybe-userid (when (proper-list-p toot) (mastodon-tl--extract-userid-toot toot link-str)))) @@ -916,8 +912,7 @@ START and END are the boundaries of the link in the toot." (list 'mastodon-handle maybe-userhandle) (when maybe-userid (list 'account-id maybe-userid)))))) - ;; Anything else: - (t ; Leave it as a url handled by shr.el. + (t ;; Anything else (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) @@ -932,19 +927,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." - (mastodon-tl--extract-el-from-mentions 'acct toot link)) + (mastodon-tl--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." - (mastodon-tl--extract-el-from-mentions 'id toot link)) + (mastodon-tl--el-from-mentions 'id toot link)) -(defun mastodon-tl--extract-el-from-mentions (el toot link) +(defun mastodon-tl--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." - ;; Must return nil if nothing found! - (let ((mentions (append (alist-get 'mentions toot) nil))) + (let ((mentions (alist-get 'mentions toot))) (when mentions (let* ((mention (pop mentions)) (name (substring-no-properties link 1 (length link))) ; cull @ @@ -955,24 +949,26 @@ Return nil if no matching element." (setq mention (pop mentions))) return)))) -(defun mastodon-tl--extract-userhandle-from-url (url buffer-text) +(defun mastodon-tl--userhandle-from-url (url buffer-text) "Return the user hande the URL points to or nil if it is not a profile link. BUFFER-TEXT is the text covered by the link with URL, for a user profile this should be of the form , e.g. \"@Gargon\"." (let* ((parsed-url (url-generic-parse-url url)) + (host (url-host parsed-url)) (local-p (string= (url-host (url-generic-parse-url mastodon-instance-url)) - (url-host parsed-url)))) + host)) + (path (url-filename parsed-url))) (when (and (string= "@" (substring buffer-text 0 1)) ;; don't error on domain only url (rare): - (not (string= "" (url-filename parsed-url))) + (not (string= "" path)) (string= (downcase buffer-text) - (downcase (substring (url-filename parsed-url) 1)))) + (downcase (substring path 1)))) (if local-p buffer-text ; no instance suffix for local mention - (concat buffer-text "@" (url-host parsed-url)))))) + (concat buffer-text "@" host))))) -(defun mastodon-tl--extract-hashtag-from-url (url instance-url) +(defun mastodon-tl--hashtag-from-url (url instance-url) "Return the hashtag that URL points to or nil if URL is not a tag link. INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing @@ -1005,39 +1001,38 @@ LINK-TYPE is the type of link to produce." '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. +(defun mastodon-tl--do-link-action-at-point (pos) + "Do the action of the link at POS. Used for hitting RET on a given link." (interactive "d") - (let ((link-type (get-text-property position 'mastodon-tab-stop))) + (let ((link-type (get-text-property pos 'mastodon-tab-stop))) (cond ((eq link-type 'content-warning) - (mastodon-tl--toggle-spoiler-text position)) + (mastodon-tl--toggle-spoiler-text pos)) ((eq link-type 'hashtag) (mastodon-tl--show-tag-timeline - nil (get-text-property position 'mastodon-tag))) + nil (get-text-property pos '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)) - (account-id (get-text-property position 'account-id))) + (let ((account-json (get-text-property pos 'account)) + (account-id (get-text-property pos 'account-id))) (cond (account-json - (mastodon-profile--make-author-buffer - account-json)) + (mastodon-profile--make-author-buffer account-json)) (account-id (mastodon-profile--make-author-buffer (mastodon-profile--account-from-id account-id))) (t - (let ((account - (mastodon-profile--search-account-by-handle - (get-text-property position 'mastodon-handle)))) + (let ((account (mastodon-profile--search-account-by-handle + (get-text-property pos 'mastodon-handle)))) ;; never call make-author-buffer on nil account: - (if account - (mastodon-profile--make-author-buffer account) - ;; optional webfinger lookup: - (if (y-or-n-p - "Search for account returned nothing. Perform URL lookup?") - (mastodon-url-lookup (get-text-property position 'shr-url)) - (message "Unable to find account.")))))))) + (cond (account + (mastodon-profile--make-author-buffer account)) + ;; optional webfinger lookup: + ((y-or-n-p + "Search for account returned nothing. Perform URL lookup?") + (mastodon-url-lookup (get-text-property pos 'shr-url))) + (t + (error "Unable to find account")))))))) ((eq link-type 'read-more) (mastodon-tl--unfold-post)) (t @@ -1062,13 +1057,13 @@ content should be hidden." (defun mastodon-tl--toggle-spoiler-text (position) "Toggle the visibility of the spoiler text at/after POSITION." (let ((inhibit-read-only t) - (spoiler-text-region (mastodon-tl--find-property-range - 'mastodon-content-warning-body position nil))) - (if (not spoiler-text-region) - (message "No spoiler text here") - (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) + (spoiler-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil))) + (if (not spoiler-region) + (user-error "No spoiler text here") + (add-text-properties (car spoiler-region) (cdr spoiler-region) (list 'invisible - (not (get-text-property (car spoiler-text-region) + (not (get-text-property (car spoiler-region) 'invisible))))))) (defun mastodon-tl--toggle-spoiler-text-in-toot () @@ -1083,10 +1078,10 @@ content should be hidden." 'mastodon-content-warning-body (car toot-range))))) (cond ((null toot-range) - (message "No toot here")) + (user-error "No toot here")) ((or (null spoiler-range) (> (car spoiler-range) (cdr toot-range))) - (message "No content warning text here")) + (user-error "No content warning text here")) (t (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) @@ -1106,10 +1101,6 @@ content should be hidden." (when (not (equal "" cw)) (mastodon-tl--toggle-spoiler-text-in-toot)))))))) -(defun mastodon-tl--clean-tabs-and-nl (string) - "Remove tabs and newlines from STRING." - (replace-regexp-in-string "[\t\n ]*\\'" "" string)) - (defun mastodon-tl--spoiler (toot) "Render TOOT with spoiler message. This assumes TOOT is a toot with a spoiler message. @@ -1154,35 +1145,36 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists. Else return an empty string." - (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) + (let* ((attachments (mastodon-tl--field 'media_attachments toot)) (sensitive (mastodon-tl--field 'sensitive toot)) (media-string (mapconcat (lambda (x) (mastodon-tl--media-attachment x sensitive)) - media-attachments ""))) + attachments ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) -(defun mastodon-tl--media-attachment (media-attachment sensitive) - "Return a propertized string for MEDIA-ATTACHMENT. +(defun mastodon-tl--media-attachment (attachment sensitive) + "Return a propertized string for ATTACHMENT. SENSITIVE is a flag from the item's JSON data." - (let-alist media-attachment + (let-alist attachment (let ((display-str - (if (and mastodon-tl--display-caption-not-url-when-no-media - .description) - (concat "Media:: " .description) - (concat "Media:: " .preview_url)))) + (concat "Media:: " + (if (and mastodon-tl--display-caption-not-url-when-no-media + .description) + .description) + .preview_url))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering ; placeholder: "[img]" - .preview_url (or .remote_url .url) .type .description sensitive) ; 2nd arg for shr-browse-url + .preview_url (or .remote_url .url) ; for shr-browse-url + .type .description sensitive) ;; 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 .description sensitive) + display-str 'shr-link .description sensitive) "\n"))))) (defun mastodon-tl--propertize-img-str-or-url @@ -1227,8 +1219,6 @@ SENSITIVE is a flag from the item's JSON data." #'mastodon-media--process-full-sized-image-response `(nil ,url)))))) -(defvar mastodon-media--sensitive-image-data) - (defun mastodon-tl--toggle-sensitive-image () "Toggle dislay of sensitive image at point." (interactive) @@ -1237,17 +1227,17 @@ SENSITIVE is a flag from the item's JSON data." (let ((data (mastodon-tl--property 'image-data :no-move)) (inhibit-read-only t) (end (next-single-property-change (point) 'sensitive-state))) - (if (equal 'hidden (mastodon-tl--property 'sensitive-state :no-move)) - ;; display sensitive image: - (add-text-properties (point) end - `(display ,data - sensitive-state showing)) - ;; hide sensitive image: - (add-text-properties (point) end - `( sensitive-state hidden - display - ,(create-image - mastodon-media--sensitive-image-data nil t))))))) + (add-text-properties + (point) end + (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move)) + ;; display: + `( display ,data + sensitive-state showing)) + ;; hide: + `( sensitive-state hidden + display + ,(create-image + mastodon-media--sensitive-image-data nil t)))))) ;; POLLS @@ -1955,6 +1945,10 @@ timeline." ;;; UTILITIES +(defun mastodon-tl--clean-tabs-and-nl (string) + "Remove tabs and newlines from STRING." + (replace-regexp-in-string "[\t\n ]*\\'" "" string)) + (defun mastodon-tl--map-alist (key alists &optional testfn) "Return a list of values extracted from ALISTS with KEY. Key is a symbol, as with `alist-get', or else compatible with TESTFN. -- cgit v1.2.3 From f6a17c02f2a7655b38b8dcf41912f89a5d952368 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 14:21:52 +0200 Subject: re-write hashtag-from-url --- lisp/mastodon-tl.el | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8158073..e86cb84 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -973,15 +973,11 @@ this should be of the form , e.g. \"@Gargon\"." INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing the toot)." - (cond - ;; Mastodon type tag link: - ((string-prefix-p (concat instance-url "/tags/") url) - (substring url (length (concat instance-url "/tags/")))) - ;; Link from some other ostatus site we've encountered: - ((string-prefix-p (concat instance-url "/tag/") url) - (substring url (length (concat instance-url "/tag/")))) - ;; If nothing matches we assume it is not a hashtag link: - (t nil))) + (let* ((parsed (url-generic-parse-url url)) + (path (url-filename parsed)) + (split (string-split path "/"))) + (when (string-prefix-p "/tag" path) ;; "/tag/" or "/tags/" + (nth 2 split)))) ;;; HYPERLINKS -- cgit v1.2.3 From 2ac021fbc1f7bf55be5d2cbc93f982fd3c1623dd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 17:27:10 +0200 Subject: re-write tl--is-reply --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e86cb84..2c457b0 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1696,8 +1696,8 @@ To disable showing the stats, customize (defun mastodon-tl--is-reply (toot) "Check if the TOOT is a reply to another one (and not boosted)." - (and (null (mastodon-tl--field 'in_reply_to_id toot)) - (not (mastodon-tl--field 'rebloged toot)))) + (and (mastodon-tl--field 'in_reply_to_id toot) + (eq :json-false (mastodon-tl--field 'reblogged toot)))) (defun mastodon-tl--toot (toot &optional detailed-p thread domain unfolded no-byline) -- cgit v1.2.3 From 92c1c26056ae16bb4774943f0045b8c10aaa0d92 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 17:27:33 +0200 Subject: re-write stats-for-toot --- lisp/mastodon-tl.el | 51 +++++++++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 26 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2c457b0..7e10c8d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1668,34 +1668,33 @@ To disable showing the stats, customize (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 faves - 'favourited-p (eq 't .favourited) - 'favourites-field t - 'help-echo (format "%s favourites" .favourites_count) - 'face 'font-lock-comment-face) - (propertize " | " 'face 'font-lock-comment-face) - (propertize boosts - 'boosted-p (eq 't .reblogged) - 'boosts-field t - '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) - 'face 'font-lock-comment-face))) - (status - (concat - (propertize " " - 'display - `(space :align-to (- right ,(+ (length status) 7)))) - status))) - status))) + (stats (concat + (propertize faves + 'favourited-p (eq 't .favourited) + 'favourites-field t + 'help-echo (format "%s favourites" .favourites_count) + 'face 'font-lock-comment-face) + (propertize " | " 'face 'font-lock-comment-face) + (propertize boosts + 'boosted-p (eq 't .reblogged) + 'boosts-field t + '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) + 'face 'font-lock-comment-face))) + (right-spacing + (propertize " " + 'display + `(space :align-to (- right ,(+ (length stats) 7)))))) + (concat right-spacing stats)))) (defun mastodon-tl--is-reply (toot) - "Check if the TOOT is a reply to another one (and not boosted)." + "Check if the TOOT is a reply to another one (and not boosted). +Used as a predicate in `mastodon-tl--timeline'." (and (mastodon-tl--field 'in_reply_to_id toot) (eq :json-false (mastodon-tl--field 'reblogged toot)))) -- cgit v1.2.3 From 8064fbfc8955ef3524391e33a790bb002b307b6c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 17:30:21 +0200 Subject: audit tl.el up to ;;; THREADS --- lisp/mastodon-tl.el | 257 ++++++++++++++++++++++++++-------------------------- 1 file changed, 128 insertions(+), 129 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7e10c8d..fd5c52d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1238,11 +1238,11 @@ SENSITIVE is a flag from the item's JSON data." ;; POLLS -(defun mastodon-tl--format-poll-option (option option-counter length) - "Format poll OPTION. OPTION-COUNTER is just a counter. +(defun mastodon-tl--format-poll-option (option counter length) + "Format poll OPTION. COUNTER is a counter. LENGTH is of the longest option, for formatting." (format "%s: %s%s%s\n" - option-counter + counter (propertize (alist-get 'title option) 'face 'success) (make-string (1+ (- length @@ -1255,22 +1255,21 @@ LENGTH is of the longest option, for formatting." (defun mastodon-tl--format-poll (poll) "From json poll data POLL, return a display string." (let-alist poll - (let* ((option-titles (mastodon-tl--map-alist 'title .options)) - (longest (car (sort (mapcar #'length option-titles) #'>))) - (option-counter 0)) + (let* ((options (mastodon-tl--map-alist 'title .options)) + (longest (car (sort (mapcar #'length options ) #'>))) + (counter 0)) (concat "\nPoll: \n\n" (mapconcat (lambda (option) - (setq option-counter (1+ option-counter)) + (setq counter (1+ counter)) (mastodon-tl--format-poll-option - option option-counter longest)) + option counter longest)) .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))) + (format "%s %s | " .voters_count + (if (= .voters_count 1) "person" "people"))) (.vote_count (format "%s votes | " .vote_count)) (t "")) @@ -1284,7 +1283,7 @@ LENGTH is of the longest option, for formatting." "\n")))) (defconst mastodon-tl--time-units - '("sec" 60.0 ;Use a float to convert `n' to float. + '("sec" 60.0 ;; Use a float to convert `n' to float. "min" 60 "hour" 24 "day" 7 @@ -1293,8 +1292,9 @@ LENGTH is of the longest option, for formatting." "year")) (defun mastodon-tl--format-poll-expiry (timestamp) - "Convert poll expiry TIMESTAMP into a descriptive string." - ;; FIXME: Could we document the format of TIMESTAMP here? + "Convert poll expiry TIMESTAMP into a descriptive string. +TIMESTAMP is from the expires_at field of a poll's JSON data, and +is in ISO 8601 Datetime format." (let* ((ts (encode-time (parse-time-string timestamp))) (seconds (time-to-seconds (time-subtract ts nil)))) ;; FIXME: Use the `cdr' to update poll expiry times? @@ -1342,47 +1342,50 @@ displayed when the duration is smaller than a minute)." n2 unit2 (if (> n2 1) "s" "")) (max res2 resolution)))))) +(defun mastodon-tl--format-read-poll-option (options) + "Format poll OPTIONS for `completing-read'. +OPTIONS is an alist." + ;; we display option number and the option title + ;; but also store both as a cons cell as the cdr, as we need it later + (cl-loop for cell in options + collect (cons (format "%s | %s" (car cell) (cdr cell)) + cell))) + (defun mastodon-tl--read-poll-option () "Read a poll option to vote on a poll." (let* ((toot (mastodon-tl--property 'item-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))) + (titles (mastodon-tl--map-alist 'title options)) + (number-seq (number-sequence 1 (length options))) + (numbers (mapcar #'number-to-string number-seq)) + (options-alist (cl-mapcar #'cons numbers titles)) + + (candidates (mastodon-tl--format-read-poll-option options-alist)) + (choice (completing-read "Poll option to vote for: " + candidates nil :match))) (if (null poll) (user-error "No poll here") - (list - ;; var "option" = just the cdr, a cons of option number and desc - (cdr (assoc (completing-read "Poll option to vote for: " - candidates - nil t) ; require match - candidates)))))) + (list (cdr (assoc choice 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)) - (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'item-json))) - (user-error "No poll here") - (let* ((toot (mastodon-tl--property 'item-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))))))) + (let ((toot (mastodon-tl--property 'item-json))) + (if (null (mastodon-tl--field 'poll toot)) + (user-error "No poll here") + (let* ((poll (mastodon-tl--field 'poll toot)) + (id (alist-get 'id poll)) + (url (mastodon-http--api (format "polls/%s/votes" id))) + ;; zero-index our option: + (option-arg (number-to-string + (1- (string-to-number (car option))))) + (arg `(("choices[]" . ,option-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 @@ -1407,19 +1410,19 @@ displayed when the duration is smaller than a minute)." (type (plist-get video :type))) (mastodon-tl--mpv-play-video-at-point url type))) -(defun mastodon-tl--view-full-image-or-play-video () +(defun mastodon-tl--view-full-image-or-play-video (_pos) "View full sized version of image at point, or try to play video." - (interactive) + (interactive "d") (if (mastodon-tl--media-video-p) (mastodon-tl--mpv-play-video-at-point) (mastodon-tl--view-full-image))) -(defun mastodon-tl--click-image-or-video (_event) - "Click to play video with `mpv.el'." +(defun mastodon-tl--click-image-or-video (event) + "Click to play video with `mpv.el'. +EVENT is a mouse-click arg." (interactive "e") - (if (mastodon-tl--media-video-p) - (mastodon-tl--mpv-play-video-at-point) - (mastodon-tl--view-full-image))) + (mastodon-tl--view-full-image-or-play-video + (posn-point (event-end event)))) (defun mastodon-tl--media-video-p (&optional type) "T if mastodon-media-type prop is \"gifv\" or \"video\". @@ -1435,20 +1438,15 @@ in which case play first video or gif from current toot." (interactive) (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 (mastodon-tl--media-video-p type) - (progn - (message "'q' to kill mpv.") - (condition-case x - (mpv-start "--loop" url) - (void-function - (message "Looks like mpv.el not installed. Error: %s" - (error-message-string x))))) - (message "no moving image here?")) - (message "no moving image here?")))) + (if (or (not url) + (not (mastodon-tl--media-video-p type))) + (user-error "No moving image here?") + (message "'q' to kill mpv.") + (condition-case x + (mpv-start "--loop" url) + (void-function + (message "Looks like mpv.el not installed. Error: %s" + (error-message-string x))))))) (defun mastodon-tl--copy-image-caption () "Copy the caption of the image at point." @@ -1480,8 +1478,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (let* ((prev-change (save-excursion (previous-single-property-change (point) 'base-item-id))) - (prev-pos - (when prev-change (1- prev-change)))) + (prev-pos (when prev-change (1- prev-change)))) (when prev-pos (get-text-property prev-pos 'base-item-id)))) @@ -1490,9 +1487,9 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (let ((prev-id (mastodon-tl--prev-item-id))) (string= reply-to-id prev-id))) -(defun mastodon-tl--insert-status (toot body author-byline action-byline - &optional id base-toot detailed-p - thread domain unfolded no-byline) +(defun mastodon-tl--insert-status + (toot body author-byline action-byline &optional id base-toot + detailed-p thread domain unfolded no-byline) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author @@ -1522,9 +1519,9 @@ NO-BYLINE means just insert toot body, used for folding." (and mastodon-tl--fold-toots-at-length (length> body mastodon-tl--fold-toots-at-length)))) (insert - (propertize + (propertize ;; body + byline: (concat - (propertize + (propertize ;; body only: (concat "\n" ;; relpy symbol (broken): @@ -1562,9 +1559,54 @@ NO-BYLINE means just insert toot body, used for folding." 'toot-foldable toot-foldable 'toot-folded (and toot-foldable (not unfolded))) (if no-byline "" "\n")) + ;; media: (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) +(defun mastodon-tl--is-reply (toot) + "Check if the TOOT is a reply to another one (and not boosted). +Used as a predicate in `mastodon-tl--timeline'." + (and (mastodon-tl--field 'in_reply_to_id toot) + (eq :json-false (mastodon-tl--field 'reblogged toot)))) + +(defun mastodon-tl--toot (toot &optional detailed-p thread domain + unfolded no-byline) + "Format TOOT and insert it into the buffer. +DETAILED-P means display more detailed info. For now +this just means displaying toot client. +THREAD means the status will be displayed in a thread view. +When DOMAIN, force inclusion of user's domain in their handle. +UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. +NO-BYLINE means just insert toot body, used for folding." + (mastodon-tl--insert-status + toot + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler toot) + (mastodon-tl--spoiler toot) + (mastodon-tl--content toot))) + 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted + nil nil detailed-p thread domain unfolded no-byline)) + +(defun mastodon-tl--timeline (toots &optional thread domain) + "Display each toot in TOOTS. +This function removes replies if user required. +THREAD means the status will be displayed in a thread view. +When DOMAIN, force inclusion of user's domain in their handle." + (mapc (lambda (toot) + (mastodon-tl--toot toot nil thread domain)) + ;; hack to *not* filter replies on profiles: + (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) + toots + (if (or ; we were called via --more*: + (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) + toots))) + (goto-char (point-min))) + +;;; FOLDING + (defun mastodon-tl--fold-body (body) "Fold toot BODY if it is very long. Folding decided by `mastodon-tl--fold-toots-at-length'." @@ -1579,7 +1621,7 @@ Folding decided by `mastodon-tl--fold-toots-at-length'." (defun mastodon-tl--unfold-post (&optional fold) "Unfold the toot at point if it is folded (read-more). -FOLD means to fold it instead" +FOLD means to fold it instead." (interactive) (let ((at-byline (mastodon-tl--property 'byline :no-move))) (if (save-excursion @@ -1599,16 +1641,13 @@ FOLD means to fold it instead" (point-after-fold (> last-point (+ beg mastodon-tl--fold-toots-at-length)))) ;; save-excursion here useless actually: - ;; FIXME: because point goes to top of item, the screen gets scrolled ;; by insertion (goto-char beg) (delete-region beg end) (delete-char 1) ;; prevent newlines accumulating ;; insert toot body: - (mastodon-tl--toot toot nil nil nil - (not fold) ;; (if fold :folded :unfolded) - :no-byline) + (mastodon-tl--toot toot nil nil nil (not fold) :no-byline) ;; set toot-folded prop on entire toot (not just body): (let ((toot-range ;; post fold action range: (mastodon-tl--find-property-range 'item-json @@ -1618,20 +1657,19 @@ FOLD means to fold it instead" `(toot-folded ,fold))) ;; try to leave point somewhere sane: (cond ((or at-byline - (and fold - point-after-fold)) ;; point was in area now folded - (ignore-errors (forward-line -1)) ;; in case we are btw + (and fold point-after-fold)) ;; point was in area now folded + (ignore-errors (forward-line -1)) ;; in case we are between (mastodon-tl--goto-next-item)) ;; goto byline (t (goto-char last-point) (when point-after-fold ;; point was in READ MORE heading: (beginning-of-line)))) - (message (format "%s" (if fold "Fold" "Unfold"))))))) + (message (format "%s toot" (if fold "Fold" "Unfold"))))))) (defun mastodon-tl--fold-post () "Fold post at point, if it is too long." (interactive) - (mastodon-tl--unfold-post t)) + (mastodon-tl--unfold-post :fold)) (defun mastodon-tl--fold-post-toggle () "Toggle the folding status of the toot at point." @@ -1639,7 +1677,9 @@ FOLD means to fold it instead" (let* ((folded (mastodon-tl--property 'toot-folded :no-move))) (mastodon-tl--unfold-post (not folded)))) -;; from mastodon-alt.el: +;;; TOOT STATS + +;; calqued off 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." @@ -1692,47 +1732,6 @@ To disable showing the stats, customize `(space :align-to (- right ,(+ (length stats) 7)))))) (concat right-spacing stats)))) -(defun mastodon-tl--is-reply (toot) - "Check if the TOOT is a reply to another one (and not boosted). -Used as a predicate in `mastodon-tl--timeline'." - (and (mastodon-tl--field 'in_reply_to_id toot) - (eq :json-false (mastodon-tl--field 'reblogged toot)))) - -(defun mastodon-tl--toot (toot &optional detailed-p thread domain - unfolded no-byline) - "Format TOOT and insert it into the buffer. -DETAILED-P means display more detailed info. For now -this just means displaying toot client. -THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle. -UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. -NO-BYLINE means just insert toot body, used for folding." - (mastodon-tl--insert-status - toot - (mastodon-tl--clean-tabs-and-nl (if (mastodon-tl--has-spoiler toot) - (mastodon-tl--spoiler toot) - (mastodon-tl--content toot))) - 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted - nil nil detailed-p thread domain unfolded no-byline)) - -(defun mastodon-tl--timeline (toots &optional thread domain) - "Display each toot in TOOTS. -This function removes replies if user required. -THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle." - (mapc (lambda (toot) - (mastodon-tl--toot toot nil thread domain)) - ;; hack to *not* filter replies on profiles: - (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) - toots - (if (or ; we were called via --more*: - (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) - toots))) - (goto-char (point-min))) - ;;; BUFFER SPEC @@ -1817,7 +1816,7 @@ to be set. It is set for almost all buffers, but you still have to call this function after it is set or use something else." (let ((buffer-name (mastodon-tl--buffer-name nil :no-error))) (cond (mastodon-toot-mode - ;; composing/editing: + ;; composing/editing (no buffer spec): (if (string= "*edit toot*" (buffer-name)) 'edit-toot 'new-toot)) @@ -1871,11 +1870,11 @@ call this function after it is set or use something else." 'preferences) ;; search ((mastodon-tl--search-buffer-p) - (cond ((equal (mastodon-search--buf-type) "accounts") + (cond ((equal "accounts" (mastodon-search--buf-type)) 'search-accounts) - ((equal (mastodon-search--buf-type) "hashtags") + ((equal "hashtags" (mastodon-search--buf-type)) 'search-hashtags) - ((equal (mastodon-search--buf-type) "statuses") + ((equal "statuses" (mastodon-search--buf-type)) 'search-statuses))) ;; trends ((mastodon-tl--endpoint-str-= "trends/statuses") @@ -2023,7 +2022,7 @@ 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" + (t (error "Numeric: %s must be either a string or a number" numeric)))) (defun mastodon-tl--item-id (json) -- cgit v1.2.3 From 806253ee26d3fd5741c1495265c8fb8d54010859 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 18:22:37 +0200 Subject: flymake tl.el --- lisp/mastodon-tl.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fd5c52d..948ee37 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -91,6 +91,8 @@ (autoload 'mastodon-search--trending-statuses "mastodon-search") (autoload 'mastodon-search--format-heading "mastodon-search") (autoload 'mastodon-toot--with-toot-item "mastodon-toot") +(autoload 'mastodon-media--image-or-cached "mastodon-media") +(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) @@ -421,7 +423,7 @@ Load more items it no next item. NO-REFRESH means do no not try to load more items if no next item found." (interactive) - (condition-case err + (condition-case nil (mastodon-tl--goto-item-pos 'next-single-property-change (unless no-refresh 'mastodon-tl--more)) (t (error "No more items")))) @@ -430,7 +432,7 @@ found." "Jump to previous item. Update if no previous items" (interactive) - (condition-case err + (condition-case nil (mastodon-tl--goto-item-pos 'previous-single-property-change 'mastodon-tl--update) (t (error "No more items")))) @@ -439,7 +441,7 @@ Update if no previous items" "Jump to first toot or item in buffer. Used on initializing a timeline or thread." (goto-char (point-min)) - (condition-case err + (condition-case nil (mastodon-tl--goto-item-pos 'next-single-property-change 'next-line) (t (error "No item")))) @@ -694,7 +696,7 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." help-string))))) (defun mastodon-tl--image-trans-check () - "Call `image-transforms-p', or `image-type-available-p' 'imagemagick." + "Call `image-transforms-p', or `image-type-available-p' imagemagick." (if (version< emacs-version "27.1") (image-type-available-p 'imagemagick) (image-transforms-p))) @@ -709,7 +711,8 @@ 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. -When DOMAIN, force inclusion of user's domain in their handle." +When DOMAIN, force inclusion of user's domain in their handle. +BASE-TOOT is JSON for the base toot, if any." (let* ((created-time ;; bosts and faves in notifs view ;; (makes timestamps be for the original toot not the boost/fave): @@ -968,11 +971,12 @@ this should be of the form , e.g. \"@Gargon\"." buffer-text ; no instance suffix for local mention (concat buffer-text "@" host))))) -(defun mastodon-tl--hashtag-from-url (url instance-url) +(defun mastodon-tl--hashtag-from-url (url _instance-url) "Return the hashtag that URL points to or nil if URL is not a tag link. INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing the toot)." + ;; FIXME: do we rly need to check it against instance-url? (let* ((parsed (url-generic-parse-url url)) (path (url-filename parsed)) (split (string-split path "/"))) -- cgit v1.2.3 From 8594adb38659bc7e823dea9c379f50c1f35b2969 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 9 Aug 2024 11:52:06 +0200 Subject: basic apply filters. #575. --- lisp/mastodon-notifications.el | 1 + lisp/mastodon-tl.el | 125 +++++++++++++++++++++++++++++------------ lisp/mastodon-views.el | 9 ++- 3 files changed, 95 insertions(+), 40 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 070d23f..f43a9b3 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -201,6 +201,7 @@ Status notifications are given when (defun mastodon-notifications--format-note (note type) "Format for a NOTE of TYPE." + ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' (let* ((id (alist-get 'id note)) (profile-note (when (equal 'follow-request type) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 948ee37..a4d6ec0 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1101,12 +1101,13 @@ content should be hidden." (when (not (equal "" cw)) (mastodon-tl--toggle-spoiler-text-in-toot)))))))) -(defun mastodon-tl--spoiler (toot) +(defun mastodon-tl--spoiler (toot &optional filter) "Render TOOT with spoiler message. This assumes TOOT is a toot with a spoiler message. The main body gets hidden and only the spoiler text and the content warning message are displayed. The content warning -message is a link which unhides/hides the main body." +message is a link which unhides/hides the main body. +FILTER is a string to use as a filter warning spoiler instead." (let* ((spoiler (mastodon-tl--field 'spoiler_text toot)) (string (mastodon-tl--set-face (mastodon-tl--clean-tabs-and-nl @@ -1114,7 +1115,9 @@ message is a link which unhides/hides the main body." 'default)) (message (concat " " mastodon-tl--horiz-bar "\n " (mastodon-tl--make-link - (concat "CW: " string) + (if filter + (concat "Filtered: " filter) + (concat "CW: " string)) 'content-warning) "\n " mastodon-tl--horiz-bar "\n")) @@ -1123,20 +1126,22 @@ message is a link which unhides/hides the main body." cw (propertize (mastodon-tl--content toot) 'invisible - (let ((cust mastodon-tl--expand-content-warnings)) - (cond ((eq t cust) - nil) - ((eq nil cust) - t) - ((eq 'server cust) - (unless (eq t - ;; If something goes wrong reading prefs, - ;; just return nil so CWs show by default. - (condition-case nil - (mastodon-profile--get-preferences-pref - 'reading:expand:spoilers) - (error nil))) - t)))) + (if filter + t + (let ((cust mastodon-tl--expand-content-warnings)) + (cond ((eq t cust) + nil) + ((eq nil cust) + t) + ((eq 'server cust) + (unless (eq t + ;; If something goes wrong reading prefs, + ;; just return nil so CWs show by default. + (condition-case nil + (mastodon-profile--get-preferences-pref + 'reading:expand:spoilers) + (error nil))) + t))))) 'mastodon-content-warning-body t)))) @@ -1573,6 +1578,42 @@ Used as a predicate in `mastodon-tl--timeline'." (and (mastodon-tl--field 'in_reply_to_id toot) (eq :json-false (mastodon-tl--field 'reblogged toot)))) +(defun mastodon-tl--filters-alist (filters) + "Parse filter data for FILTERS. +For each filter, return a list of action (warn or hide), filter +title, and context." + (cl-loop for x in filters ;; includes non filter elts! + for f = (alist-get 'filter x) + collect (list (alist-get 'filter_action f) + (alist-get 'title f) + (alist-get 'context f)))) + +(defun mastodon-tl--filter-by-context (context filters) + "Remove FILTERS that don't apply to the current CONTEXT." + (cl-remove-if-not + (lambda (x) + (member context (nth 2 x))) + filters)) + +(defun mastodon-tl--filters-context () + "Return a string of the current buffer's filter context. +Returns a member of `mastodon-views--filter-types'." + (let ((buf (mastodon-tl--get-buffer-type))) + (cond ((or (eq buf 'local) (eq buf 'federated)) + "public") + ((mastodon-tl--profile-buffer-p) + "profile") + (t ;; thread, notifs, home: + (symbol-name buf))))) + +(defun mastodon-tl--current-filters (filters) + "Return the filters from FILTERS data that apply in the current context. +For each filter, return a list of action (warn or hide), filter +title, and context." + (let ((context (mastodon-tl--filters-context)) + (filters-no-context (mastodon-tl--filters-alist filters))) + (mastodon-tl--filter-by-context context filters-no-context))) + (defun mastodon-tl--toot (toot &optional detailed-p thread domain unfolded no-byline) "Format TOOT and insert it into the buffer. @@ -1582,32 +1623,42 @@ THREAD means the status will be displayed in a thread view. When DOMAIN, force inclusion of user's domain in their handle. UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. NO-BYLINE means just insert toot body, used for folding." - (mastodon-tl--insert-status - toot - (mastodon-tl--clean-tabs-and-nl - (if (mastodon-tl--has-spoiler toot) - (mastodon-tl--spoiler toot) - (mastodon-tl--content toot))) - 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted - nil nil detailed-p thread domain unfolded no-byline)) + (let* ((filtered (mastodon-tl--field 'filtered toot)) + (filters (when filtered + (mastodon-tl--current-filters filtered))) + (spoiler-or-content (if-let ((match (assoc "warn" filters))) + (mastodon-tl--spoiler toot (cadr match)) + (if (mastodon-tl--has-spoiler toot) + (mastodon-tl--spoiler toot) + (mastodon-tl--content toot))))) + ;; If any filters are "hide", then we hide, + ;; even though item may also have a "warn" filter: + (if (and filtered (assoc "hide" filters)) + nil ;; no insert + (mastodon-tl--insert-status + toot + (mastodon-tl--clean-tabs-and-nl spoiler-or-content) + 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted + nil nil detailed-p thread domain unfolded no-byline)))) (defun mastodon-tl--timeline (toots &optional thread domain) "Display each toot in TOOTS. This function removes replies if user required. THREAD means the status will be displayed in a thread view. When DOMAIN, force inclusion of user's domain in their handle." - (mapc (lambda (toot) - (mastodon-tl--toot toot nil thread domain)) - ;; hack to *not* filter replies on profiles: - (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) - toots - (if (or ; we were called via --more*: - (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) - toots))) - (goto-char (point-min))) + (let ((toots ;; hack to *not* filter replies on profiles: + (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) + toots + (if (or ; we were called via --more*: + (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) + toots)))) + (mapc (lambda (toot) + (mastodon-tl--toot toot nil thread domain)) + toots) + (goto-char (point-min)))) ;;; FOLDING diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4b29115..1ddb769 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -621,6 +621,9 @@ JSON is the filters data." 'byline t) ;for goto-next-filter compat "\n\n"))) +(defvar mastodon-views--filter-types + '("home" "notifications" "public" "thread" "profile")) + (defun mastodon-views--create-filter () "Create a filter for a word. Prompt for a context, must be a list containting at least one of \"home\", @@ -635,7 +638,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (user-error "You must select at least one word for a filter") (completing-read-multiple "Contexts to filter [TAB for options]: " - '("home" "notifications" "public" "thread") + mastodon-views--filter-types nil t))) (contexts-processed (if (equal nil contexts) @@ -647,9 +650,9 @@ Prompt for a context, must be a list containting at least one of \"home\", contexts-processed)))) (mastodon-http--triage response (lambda (_) - (message "Filter created for %s!" word) (when (mastodon-tl--buffer-type-eq 'filters) - (mastodon-views--view-filters)))))) + (mastodon-views--view-filters)) + (message "Filter created for %s!" word))))) (defun mastodon-views--delete-filter () "Delete filter at point." -- cgit v1.2.3 From ca4ac2e568690b7c1c0a2a1b3ebf11be2a963aa8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 9 Aug 2024 18:08:20 +0200 Subject: fix read-poll option check --- lisp/mastodon-tl.el | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 948ee37..6c6307d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1358,19 +1358,18 @@ OPTIONS is an alist." (defun mastodon-tl--read-poll-option () "Read a poll option to vote on a poll." (let* ((toot (mastodon-tl--property 'item-json)) - (poll (mastodon-tl--field 'poll toot)) - (options (mastodon-tl--field 'options poll)) - (titles (mastodon-tl--map-alist 'title options)) - (number-seq (number-sequence 1 (length options))) - (numbers (mapcar #'number-to-string number-seq)) - (options-alist (cl-mapcar #'cons numbers titles)) - - (candidates (mastodon-tl--format-read-poll-option options-alist)) - (choice (completing-read "Poll option to vote for: " - candidates nil :match))) + (poll (mastodon-tl--field 'poll toot))) (if (null poll) (user-error "No poll here") - (list (cdr (assoc choice candidates)))))) + (let* ((options (mastodon-tl--field 'options poll)) + (titles (mastodon-tl--map-alist 'title options)) + (number-seq (number-sequence 1 (length options))) + (numbers (mapcar #'number-to-string number-seq)) + (options-alist (cl-mapcar #'cons numbers titles)) + (candidates (mastodon-tl--format-read-poll-option options-alist)) + (choice (completing-read "Poll option to vote for: " + candidates nil :match))) + (list (cdr (assoc choice 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 33f6feaf767a7a4b9ed49e28895daf753bd1d44e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 12 Aug 2024 15:49:45 +0200 Subject: fix toggle sensitive media --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6c6307d..9218037 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1232,12 +1232,12 @@ SENSITIVE is a flag from the item's JSON data." (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move)) ;; display: `( display ,data - sensitive-state showing)) + sensitive-state showing) ;; hide: `( sensitive-state hidden display ,(create-image - mastodon-media--sensitive-image-data nil t)))))) + mastodon-media--sensitive-image-data nil t))))))) ;; POLLS -- cgit v1.2.3 From 25ab62e57f67e3b8edc7702f7c601856dd5ad7bf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:00:21 +0200 Subject: init-sync - add endpoint version arg (for v2 filters) --- lisp/mastodon-tl.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a4d6ec0..5088212 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -3117,7 +3117,8 @@ JSON and http headers, without it just the JSON." (defun mastodon-tl--init-sync (buffer-name endpoint update-function - &optional note-type params headers view-name binding-str) + &optional note-type params headers view-name binding-str + endpoint-version) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. Runs synchronously. @@ -3133,7 +3134,7 @@ BINDING-STR is a string explaining any bindins in the view." (mastodon-http--build-array-params-alist "exclude_types[]" exclude-types))) (params (append notes-params params)) - (url (mastodon-http--api endpoint)) + (url (mastodon-http--api endpoint endpoint-version)) (buffer (concat "*mastodon-" buffer-name "*")) (response (mastodon-http--get-response url params)) (json (car response)) -- cgit v1.2.3 From 7c73068dd2400ceae3f789571a781c41561c3b44 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:32:16 +0200 Subject: indent tl.el --- lisp/mastodon-tl.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9218037..21aa1c4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1233,11 +1233,11 @@ SENSITIVE is a flag from the item's JSON data." ;; display: `( display ,data sensitive-state showing) - ;; hide: - `( sensitive-state hidden - display - ,(create-image - mastodon-media--sensitive-image-data nil t))))))) + ;; hide: + `( sensitive-state hidden + display + ,(create-image + mastodon-media--sensitive-image-data nil t))))))) ;; POLLS @@ -2345,7 +2345,7 @@ LANGS is the accumulated array param alist if we re-run recursively." (car user-handles) (completing-read (cond ((or ; TODO: make this "enable/disable notifications" (equal action "disable") - (equal action "enable")) + (equal action "enable")) (format "%s notifications when user posts: " action)) ((string-suffix-p "boosts" action) (format "%s by user: " action)) -- cgit v1.2.3 From e1e44d43daf78c5fc83a8bcc8d29613d4fc56175 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 15:08:27 +0200 Subject: fix a bunch of tests --- lisp/mastodon-tl.el | 12 ++++++++---- test/mastodon-search-tests.el | 18 +++++++++--------- test/mastodon-tl-tests.el | 34 +++++++++++++++++----------------- 3 files changed, 34 insertions(+), 30 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 21aa1c4..944e662 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -971,16 +971,20 @@ this should be of the form , e.g. \"@Gargon\"." buffer-text ; no instance suffix for local mention (concat buffer-text "@" host))))) -(defun mastodon-tl--hashtag-from-url (url _instance-url) +(defun mastodon-tl--hashtag-from-url (url instance-url) "Return the hashtag that URL points to or nil if URL is not a tag link. INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing the toot)." - ;; FIXME: do we rly need to check it against instance-url? - (let* ((parsed (url-generic-parse-url url)) + ;; TODO: do we rly need to check it against instance-url? + ;; test suggests we might + (let* ((instance-host (url-host + (url-generic-parse-url instance-url))) + (parsed (url-generic-parse-url url)) (path (url-filename parsed)) (split (string-split path "/"))) - (when (string-prefix-p "/tag" path) ;; "/tag/" or "/tags/" + (when (and (string= instance-host (url-host parsed)) + (string-prefix-p "/tag" path)) ;; "/tag/" or "/tags/" (nth 2 split)))) diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el index 8dc597a..c736c35 100644 --- a/test/mastodon-search-tests.el +++ b/test/mastodon-search-tests.el @@ -139,12 +139,12 @@ '("TeamBringBackVisibleScrollbars" "https://todon.nl/tags/TeamBringBackVisibleScrollbars")))) -(ert-deftest mastodon-search--get-status-info () - "Should return a list of ID, timestamp, content, and spoiler." - (should - (equal - (mastodon-search--get-status-info mastodon-search--test-single-status) - '("107230316503209282" - "2021-11-06T13:19:40.628Z" - "" - "

This is a nice test toot, for testing purposes. Thank you.

")))) +;; (ert-deftest mastodon-search--get-status-info () +;; "Should return a list of ID, timestamp, content, and spoiler." +;; (should +;; (equal +;; (mastodon-search--get-status-info mastodon-search--test-single-status) +;; '("107230316503209282" +;; "2021-11-06T13:19:40.628Z" +;; "" +;; "

This is a nice test toot, for testing purposes. Thank you.

")))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 02e1157..6d9ab9a 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -41,9 +41,9 @@ (following_count . 13) (statuses_count . 101) (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) + (media_attachments . ()) + (mentions . ()) + (tags . ()) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") (url . "https://example.space/users/acct42/updates/123456789") (content . "

Just some text

") @@ -70,9 +70,9 @@ (following_count . 13) (statuses_count . 101) (note . "E")) - (media_attachments . []) - (mentions . []) - (tags . []) + (media_attachments . ()) + (mentions . ()) + (tags . ()) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") (url . "https://example.space/users/acct42/updates/123456789") (reblogs_count . 0) @@ -95,12 +95,12 @@ (following_count . 1) (statuses_count . 1) (note . "Other account")) - (media_attachments . []) - (mentions . [((url . "https://mastodon.social/@johnson") + (media_attachments . ()) + (mentions . (((url . "https://mastodon.social/@johnson") (acct . "acct42") (id . 42) - (username . "acct42"))]) - (tags . []) + (username . "acct42")))) + (tags . ()) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") (content . "

@acct42 boost

") (url . "https://example.space/users/acct42/updates/123456789") @@ -1014,27 +1014,27 @@ constant." (ert-deftest mastodon-tl--extract-hashtag-from-url-mastodon-link () "Should extract the hashtag from a tags url." - (should (equal (mastodon-tl--extract-hashtag-from-url + (should (equal (mastodon-tl--hashtag-from-url "https://example.org/tags/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-other-link () "Should extract the hashtag from a tag url." - (should (equal (mastodon-tl--extract-hashtag-from-url + (should (equal (mastodon-tl--hashtag-from-url "https://example.org/tag/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-wrong-instance () "Should not find a tag when the instance doesn't match." - (should (null (mastodon-tl--extract-hashtag-from-url + (should (null (mastodon-tl--hashtag-from-url "https://example.org/tags/foo" "https://other.example.org")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-not-tag () "Should not find a hashtag when not a tag url" - (should (null (mastodon-tl--extract-hashtag-from-url + (should (null (mastodon-tl--hashtag-from-url "https://example.org/@userid" "https://example.org")))) @@ -1063,20 +1063,20 @@ constant." (ert-deftest mastodon-tl--extract-userhandle-from-url-correct-case () "Should extract the user handle from url." - (should (equal (mastodon-tl--extract-userhandle-from-url + (should (equal (mastodon-tl--userhandle-from-url "https://example.org/@someuser" "@SomeUser") "@SomeUser@example.org"))) (ert-deftest mastodon-tl--extract-userhandle-from-url-missing-at-in-text () "Should not extract a user handle from url if the text is wrong." - (should (null (mastodon-tl--extract-userhandle-from-url + (should (null (mastodon-tl--userhandle-from-url "https://example.org/@someuser" "SomeUser")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-query-in-url () "Should not extract a user handle from url if there is a query param." - (should (null (mastodon-tl--extract-userhandle-from-url + (should (null (mastodon-tl--userhandle-from-url "https://example.org/@someuser?shouldnot=behere" "SomeUser")))) -- cgit v1.2.3 From 0a6040242293d60f65975c6d085dda994980ed57 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 17 Aug 2024 11:57:30 +0200 Subject: fix mute or unmute: use top level id to check if we posted --- lisp/mastodon-tl.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0d5d8a9..91f42d0 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2183,7 +2183,7 @@ Note that you can only (un)mute threads you have posted in." (mastodon-tl--mute-or-unmute-thread)) (defun mastodon-tl--unmute-thread () - "Mute the thread displayed in the current buffer. + "Unmute the thread displayed in the current buffer. Note that you can only (un)mute threads you have posted in." (interactive) (mastodon-tl--mute-or-unmute-thread :unmute)) @@ -2196,23 +2196,23 @@ If UNMUTE, unmute it." (when (or (mastodon-tl--buffer-type-eq 'thread) (mastodon-tl--buffer-type-eq 'notifications)) (let* ((id + ;; if in a thread, the id to call `mastodon-tl--user-in-thread-p' on + ;; really ought to be the top level item (if (mastodon-tl--buffer-type-eq 'notifications) - (get-text-property (point) 'base-item-id) - (save-match-data - (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" - endpoint) - (match-string 2 endpoint)))) + (mastodon-tl--property 'base-item-id :no-move) + (save-excursion + (mastodon-tl--goto-first-item) + (mastodon-tl--property 'base-item-id :no-move)))) (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.") + (user-error "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!"))))))))))) + (mastodon-http--triage + response + (lambda (_) + (message (format "Thread %sd!" mute-str))))))))))) (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 1cd94d7ee146b14c8fc97420ff57aa2205bc2e58 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 11:43:46 +0200 Subject: mastodon-http--api-search -> mastodon-http--api-v2 --- lisp/mastodon-http.el | 4 ---- lisp/mastodon-search.el | 4 ++-- lisp/mastodon-tl.el | 15 +++++++++------ 3 files changed, 11 insertions(+), 12 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 2635eef..1b624ee 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -57,10 +57,6 @@ Optionally specify VERSION in format vX." "Return Mastodon API v2 URL for ENDPOINT." (mastodon-http--api endpoint "v2")) -(defun mastodon-http--api-search () - "Return Mastodon API url for the /search endpoint (v2)." - (format "%s/api/v2/search" mastodon-instance-url)) - (defun mastodon-http--response () "Capture response buffer content as string." (with-current-buffer (current-buffer) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 306e7c8..0c7f746 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -78,7 +78,7 @@ Returns a nested list containing user handle, display name, and URL." (defun mastodon-search--search-tags-query (query) "Return an alist containing tag strings plus their URLs. QUERY is the string to search." - (let* ((url (mastodon-http--api-search)) + (let* ((url (mastodon-http--api-v2 "search")) (params `(("q" . ,query) ("type" . "hashtags"))) (response (mastodon-http--get-json url params :silent)) (tags (alist-get 'hashtags response))) @@ -153,7 +153,7 @@ OFFSET is a number as string, means to skip that many results. It is used for pagination." ;; TODO: handle no results (interactive "sSearch mastodon for: ") - (let* ((url (mastodon-http--api-search)) + (let* ((url (mastodon-http--api-v2 "search")) (following (when (or following (equal current-prefix-arg '(4))) "true")) (type (or type diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7a22c47..b83a20f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2687,9 +2687,11 @@ PARAMS is used to send any parameters needed to correctly update the current view." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) (args (if params (push (car args) params) args)) - (url (if (string-suffix-p "search" endpoint) - (mastodon-http--api-search) - (mastodon-http--api endpoint)))) + (url + (mastodon-http--api + endpoint + (when (string-suffix-p "search" endpoint) + "v2")))) (apply #'mastodon-http--get-json-async url args callback cbargs))) (defun mastodon-tl--more-json-async-offset (endpoint &optional params @@ -2710,9 +2712,10 @@ Then run CALLBACK with arguments CBARGS." (+ limit ; limit + old offset = new offset (string-to-number (alist-get "offset" params nil nil #'equal))))) - (url (if (string-suffix-p "search" endpoint) - (mastodon-http--api-search) - (mastodon-http--api endpoint)))) + (url (mastodon-http--api + endpoint + (when (string-suffix-p "search" endpoint) + "v2")))) ;; increment: (setf (alist-get "offset" params nil nil #'equal) offset) (apply #'mastodon-http--get-json-async url params callback cbargs))) -- cgit v1.2.3 From f9e8522ae3ef3bd022ae81893acb414e9741b905 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 19 Aug 2024 15:34:22 +0200 Subject: remove old call to http--api-search --- lisp/mastodon-profile.el | 3 ++- lisp/mastodon-search.el | 1 - lisp/mastodon-tl.el | 1 - 3 files changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 093e0a8..5f33ce2 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -837,7 +837,8 @@ If the handle does not match a search return then retun NIL." handle)) (args `(("q" . ,handle) ("type" . "accounts"))) - (result (mastodon-http--get-json (mastodon-http--api-search) args)) + (result (mastodon-http--get-json + (mastodon-http--api-v2 "search") args)) (matching-account (seq-remove (lambda (x) (not (string= handle (alist-get 'acct x)))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 0c7f746..f51247b 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -44,7 +44,6 @@ (autoload 'mastodon-tl--timeline "mastodon-tl") (autoload 'mastodon-tl--toot "mastodon-tl") (autoload 'mastodon-tl--buffer-property "mastodon-tl") -(autoload 'mastodon-http--api-search "mastodon-http") (defvar mastodon-toot--completion-style-for-mentions) (defvar mastodon-instance-url) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b83a20f..ac4347b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -83,7 +83,6 @@ (autoload 'mastodon-toot--set-toot-properties "mastodon-toot") (autoload 'mastodon-toot--update-status-fields "mastodon-toot") (autoload 'mastodon-search--buf-type "mastodon-search") -(autoload 'mastodon-http--api-search "mastodon-http") (autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination (autoload 'mastodon-http--get-response "mastodon-http") (autoload 'mastodon-search--insert-heading "mastodon-search") -- cgit v1.2.3 From a2e1b56bfc9ef1158ed228b744e6449ff0baba61 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 19 Aug 2024 15:36:45 +0200 Subject: more auditing of -tl.el --- lisp/mastodon-tl.el | 207 +++++++++++++++++++++++----------------------------- 1 file changed, 91 insertions(+), 116 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ac4347b..73d82bf 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2154,26 +2154,25 @@ view all branches of a thread." (user-error "Error: %s" (cdar toot)) (when (member (alist-get 'type toot) '("reblog" "favourite")) (setq toot (alist-get 'status toot))) - (if (> (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))) - 0) - ;; if we have a thread: - (with-mastodon-buffer buffer #'mastodon-mode nil - (let ((marker (make-marker))) - (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread) - (mastodon-tl--timeline (alist-get 'ancestors context) :thread) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p :thread) - (mastodon-tl--timeline (alist-get 'descendants context) - :thread) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl--goto-next-item))) - ;; else just print the lone toot: - (mastodon-tl--single-toot id)))))))) + (if (not (< 0 (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))))) + ;; just print the lone toot: + (mastodon-tl--single-toot id) + ;; we have a thread: + (with-mastodon-buffer buffer #'mastodon-mode nil + (let ((marker (make-marker))) + (mastodon-tl--set-buffer-spec buffer endpoint + #'mastodon-tl--thread) + (mastodon-tl--timeline (alist-get 'ancestors context) :thread) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p :thread) + (mastodon-tl--timeline (alist-get 'descendants context) + :thread) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl--goto-next-item)))))))))) (defun mastodon-tl--mute-thread () "Mute the thread displayed in the current buffer. @@ -2190,13 +2189,12 @@ 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)) - (mute-str (if unmute "unmute" "mute"))) + (let ((mute-str (if unmute "unmute" "mute"))) (when (or (mastodon-tl--buffer-type-eq 'thread) (mastodon-tl--buffer-type-eq 'notifications)) (let* ((id - ;; if in a thread, the id to call `mastodon-tl--user-in-thread-p' on - ;; really ought to be the top level item + ;; the id for `mastodon-tl--user-in-thread-p' ought to be the + ;; top-level item: (if (mastodon-tl--buffer-type-eq 'notifications) (mastodon-tl--property 'base-item-id :no-move) (save-excursion @@ -2246,8 +2244,7 @@ LANGS is an array parameters alist of languages to filer user's posts by. REBLOGS is a boolean string like NOTIFY, enabling or disabling display of the user's boosts in your timeline. JSON is a flag arg for `mastodon-http--post'." - (interactive - (list (mastodon-tl--user-handles-get "follow"))) + (interactive (list (mastodon-tl--user-handles-get "follow"))) (mastodon-tl--do-if-item (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify langs reblogs json))) @@ -2255,22 +2252,19 @@ JSON is a flag arg for `mastodon-http--post'." ;; TODO: make this action "enable/disable notifications" (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." - (interactive - (list (mastodon-tl--user-handles-get "enable"))) + (interactive (list (mastodon-tl--user-handles-get "enable"))) (mastodon-tl--do-if-item (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--user-handles-get "disable"))) + (interactive (list (mastodon-tl--user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) (defun mastodon-tl--follow-user-disable-boosts (user-handle) "Prompt for a USER-HANDLE, and disable display of boosts in home timeline. If they are also not yet followed, follow them." - (interactive - (list (mastodon-tl--user-handles-get "disable boosts"))) + (interactive (list (mastodon-tl--user-handles-get "disable boosts"))) (mastodon-tl--follow-user user-handle nil nil "false")) (defun mastodon-tl--follow-user-enable-boosts (user-handle) @@ -2278,8 +2272,7 @@ If they are also not yet followed, follow them." If they are also not yet followed, follow them. You only need to call this if you have previously disabled display of boosts." - (interactive - (list (mastodon-tl--user-handles-get "enable boosts"))) + (interactive (list (mastodon-tl--user-handles-get "enable boosts"))) (mastodon-tl--follow-user user-handle nil nil "true")) (defun mastodon-tl--filter-user-user-posts-by-language (user-handle) @@ -2288,8 +2281,7 @@ If they are not already followed, they will be too. To be filtered, a post has to be marked as in the language given. This may mean that you will not see posts that are in your desired language if they are not marked as such (or as anything)." - (interactive - (list (mastodon-tl--user-handles-get "filter by language"))) + (interactive (list (mastodon-tl--user-handles-get "filter by language"))) (let ((langs (mastodon-tl--read-filter-langs))) (mastodon-tl--do-if-item (if (equal "" (cdar langs)) @@ -2300,8 +2292,7 @@ desired language if they are not marked as such (or as anything)." "Remove any language filters for USER-HANDLE. This means you will receive posts of theirs marked as being in any or no language." - (interactive - (list (mastodon-tl--user-handles-get "filter by language"))) + (interactive (list (mastodon-tl--user-handles-get "filter by language"))) (let ((langs "languages[]")) (mastodon-tl--do-if-item ;; we need "languages[]" as a param, with no "=" and not json-encoded as @@ -2327,45 +2318,39 @@ 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--user-handles-get "unfollow"))) + (interactive (list (mastodon-tl--user-handles-get "unfollow"))) (mastodon-tl--do-if-item (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--user-handles-get "block"))) + (interactive (list (mastodon-tl--user-handles-get "block"))) (mastodon-tl--do-if-item (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--get-blocks-or-mutes-list "unblock"))) + (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unblock"))) (if (not user-handle) - (message "Looks like you have no blocks to unblock!") + (user-error "Looks like you have no blocks to unblock!") (mastodon-tl--do-user-action-and-response user-handle "unblock" t))) (defun mastodon-tl--mute-user (user-handle) "Query for USER-HANDLE from current status and mute that user." - (interactive - (list (mastodon-tl--user-handles-get "mute"))) + (interactive (list (mastodon-tl--user-handles-get "mute"))) (mastodon-tl--do-if-item (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--get-blocks-or-mutes-list "unmute"))) + (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unmute"))) (if (not user-handle) - (message "Looks like you have no mutes to unmute!") + (user-error "Looks like you have no mutes to unmute!") (mastodon-tl--do-user-action-and-response user-handle "unmute" t))) (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--user-handles-get "message"))) + (interactive (list (mastodon-tl--user-handles-get "message"))) (mastodon-tl--do-if-item (mastodon-toot--compose-buffer (concat "@" user-handle)) (setq mastodon-toot--visibility "direct") @@ -2398,8 +2383,8 @@ LANGS is the accumulated array param alist if we re-run recursively." (if (eq 1 (length user-handles)) (car user-handles) (completing-read (cond ((or ; TODO: make this "enable/disable notifications" - (equal action "disable") - (equal action "enable")) + (string= action "disable") + (string= action "enable")) (format "%s notifications when user posts: " action)) ((string-suffix-p "boosts" action) (format "%s by user: " action)) @@ -2412,16 +2397,16 @@ LANGS is the accumulated array param alist if we re-run recursively." (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") + (let* ((endpoint (cond ((string= action "unblock") "blocks") - ((equal action "unmute") + ((string= action "unmute") "mutes"))) (url (mastodon-http--api endpoint)) (json (mastodon-http--get-json url)) (accts (mastodon-tl--map-alist 'acct json))) (when accts (completing-read (format "Handle of user to %s: " action) - accts nil t)))) ; require match + accts nil :match)))) (defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify langs reblogs json) @@ -2436,13 +2421,13 @@ display of the user's boosts in your timeline." (let* ((account (if negp ;; 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)) - ;; muting/blocking, select from handles in current status - (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--item-json))))) + (mastodon-profile--lookup-account-in-status + user-handle + (if (mastodon-tl--profile-buffer-p) + ;; profile view, use 'profile-json as status: + (mastodon-profile--profile-json) + ;; muting/blocking, select from handles in current status + (mastodon-profile--item-json))))) (user-id (alist-get 'id account)) (name (if (string-empty-p (alist-get 'display_name account)) (alist-get 'username account) @@ -2452,12 +2437,12 @@ display of the user's boosts in your timeline." (reblogs `(("reblogs" . ,reblogs))) (t nil))) (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) - (if account - (if (equal action "follow") ; y-or-n for all but follow - (mastodon-tl--do-user-action-function url name user-handle action notify args reblogs json) - (when (y-or-n-p (format "%s user %s? " action name)) - (mastodon-tl--do-user-action-function url name user-handle action args))) - (message "Cannot find a user with handle %S" user-handle)))) + (if (not account) + (user-error "Cannot find a user with handle %S" user-handle) + (when (or (string= action "follow") ;; y-or-n for all but follow + (y-or-n-p (format "%s user %s? " action name))) + (mastodon-tl--do-user-action-function + url name user-handle action notify args reblogs json))))) (defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify args reblogs json) @@ -2472,24 +2457,24 @@ ARGS is an alist of any parameters to send with the request." (let ((json (with-current-buffer response (mastodon-http--process-json)))) ;; TODO: when > if, with failure msg - (cond ((string-equal notify "true") - (when (equal 't (alist-get 'notifying json)) + (cond ((string= notify "true") + (when (eq 't (alist-get 'notifying json)) (message "Receiving notifications for user %s (@%s)!" name user-handle))) - ((string-equal notify "false") - (when (equal :json-false (alist-get 'notifying json)) + ((string= notify "false") + (when (eq :json-false (alist-get 'notifying json)) (message "Not receiving notifications for user %s (@%s)!" name user-handle))) - ((string-equal reblogs "true") - (when (equal 't (alist-get 'showing_reblogs json)) + ((string= reblogs "true") + (when (eq 't (alist-get 'showing_reblogs json)) (message "Receiving boosts by user %s (@%s)!" name user-handle))) - ((string-equal reblogs "false") - (when (equal :json-false (alist-get 'showing_reblogs json)) + ((string= reblogs "false") + (when (eq :json-false (alist-get 'showing_reblogs json)) (message "Not receiving boosts by user %s (@%s)!" name user-handle))) - ((or (string-equal action "mute") - (string-equal action "unmute")) + ((or (string= action "mute") + (string= action "unmute")) (message "User %s (@%s) %sd!" name user-handle action)) ((equal args "languages[]") (message "User %s language filters removed!" name)) @@ -2519,8 +2504,9 @@ If TAG provided, follow it." (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)))) + (when (eq 'hashtag + (mastodon-tl--property 'mastodon-tab-stop :no-move)) + (mastodon-tl--property 'mastodon-tag :no-move)))) (tag (or tag (completing-read (format "Tag to follow [%s]: " tag-at-point) tags nil nil nil nil tag-at-point))) @@ -2556,7 +2542,7 @@ PREFIX is sent to `mastodon-tl--get-tag-timeline', which see." (tags (mastodon-tl--map-alist 'name followed-tags-json)) (tag (completing-read "Tag: " tags nil))) (if (null tag) - (message "You have to follow some tags first.") + (user-error "You have to follow some tags first") (mastodon-tl--get-tag-timeline prefix tag)))) (defun mastodon-tl--followed-tags-timeline (&optional prefix) @@ -2610,24 +2596,17 @@ ACCOUNT and TOOT are the data to use." "Build the parameters alist based on user responses. ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from `mastodon-tl--report-params', which see." - (let ((params `(("account_id" . ,account-id) - ,(when comment - `("comment" . ,comment)) - ,(when item-id - `("status_ids[]" . ,item-id)) - ,(when forward-p - `("forward" . ,forward-p)) - ,(when cat - `("category" . ,cat))))) + (let ((params (cl-remove + nil + `(("account_id" . ,account-id) + ,(when comment `("comment" . ,comment)) + ,(when item-id `("status_ids[]" . ,item-id)) + ,(when forward-p `("forward" . ,forward-p)) + ,(when cat `("category" . ,cat)))))) (when rules (let ((alist (mastodon-http--build-array-params-alist "rule_ids[]" rules))) - (mapc (lambda (x) - (push x params)) - alist))) - ;; FIXME: the above approach adds nils to your params. - (setq params (delete nil params)) - params)) + (append alist params))))) (defun mastodon-tl--report-to-mods () "Report the author of the toot at point to your instance moderators. @@ -2652,10 +2631,7 @@ report the account for spam." (defun mastodon-tl--map-rules-alist (rules) "Convert RULES text and id fields into an alist." - (mapcar (lambda (x) - (let-alist x - (cons .text .id))) - rules)) + (mastodon-tl--map-alist-vals-to-alist 'text 'id rules)) (defun mastodon-tl--read-rules-ids () "Prompt for a list of instance rules and return a list of selected ids." @@ -2666,7 +2642,7 @@ report the account for spam." "rules [TAB for options, | to separate]: " alist nil t))) (mapcar (lambda (x) - (alist-get x alist nil nil #'equal)) + (alist-get x alist nil nil #'string=)) choices))) @@ -2685,12 +2661,11 @@ Then run CALLBACK with arguments CBARGS. PARAMS is used to send any parameters needed to correctly update the current view." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push (car args) params) args)) - (url - (mastodon-http--api - endpoint - (when (string-suffix-p "search" endpoint) - "v2")))) + (args (append args params)) + (url (mastodon-http--api + endpoint + (when (string-suffix-p "search" endpoint) + "v2")))) (apply #'mastodon-http--get-json-async url args callback cbargs))) (defun mastodon-tl--more-json-async-offset (endpoint &optional params @@ -2703,20 +2678,19 @@ PARAMS are the update parameters, see `mastodon-tl--update-params'. These (\"limit\" and \"offset\") must be set in `mastodon-tl--buffer-spec' for pagination to work. Then run CALLBACK with arguments CBARGS." - (let* ((params (or params - (mastodon-tl--update-params))) + (let* ((params (or params (mastodon-tl--update-params))) (limit (string-to-number - (alist-get "limit" params nil nil #'equal))) + (alist-get "limit" params nil nil #'string=))) (offset (number-to-string (+ limit ; limit + old offset = new offset (string-to-number - (alist-get "offset" params nil nil #'equal))))) + (alist-get "offset" params nil nil #'string=))))) (url (mastodon-http--api endpoint (when (string-suffix-p "search" endpoint) "v2")))) ;; increment: - (setf (alist-get "offset" params nil nil #'equal) offset) + (setf (alist-get "offset" params nil nil #'string=) offset) (apply #'mastodon-http--get-json-async url params callback cbargs))) (defun mastodon-tl--updated-json (endpoint id &optional params) @@ -2724,7 +2698,7 @@ Then run CALLBACK with arguments CBARGS." PARAMS is used to send any parameters needed to correctly update the current view." (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push (car args) params) args)) + (args (append args params)) (url (mastodon-http--api endpoint))) (mastodon-http--get-json url args))) @@ -3131,7 +3105,8 @@ Optional arg NOTE-TYPE means only get that type of notification. PARAMS is an alist of any params to include in the request. HEADERS are any headers to send in the request. VIEW-NAME is a string, to be used as a heading for the view. -BINDING-STR is a string explaining any bindins in the view." +BINDING-STR is a string explaining any bindins in the view. +ENDPOINT-VERSION is a string, format Vx, e.g. V2." ;; Used by `mastodon-notifications-get' and in views.el (let* ((exclude-types (when note-type (mastodon-notifications--filter-types-list note-type))) -- cgit v1.2.3 From 64e39969c0f49d227817ac0fec4593e7eba5db53 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 19 Aug 2024 16:22:44 +0200 Subject: audit remainder of tl.el --- lisp/mastodon-tl.el | 183 ++++++++++++++++++++++++++++------------------------ 1 file changed, 98 insertions(+), 85 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 73d82bf..62064a7 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1832,24 +1832,26 @@ If NO-ERROR is non-nil, do not error when property is empty." (defun mastodon-tl--set-buffer-spec (buffer endpoint update-fun - &optional link-header update-params hide-replies max-id) + &optional link-header update-params hide-replies max-id + thread-item-id) "Set `mastodon-tl--buffer-spec' for the current buffer. BUFFER is buffer name, ENDPOINT is buffer's enpoint, 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. -MAX-ID is the pagination parameter." +MAX-ID is the pagination parameter. +THREAD-ITEM-ID is the ID of the item in thread that we opened the thread with." (setq mastodon-tl--buffer-spec - `(account ,(cons mastodon-active-user - mastodon-instance-url) - buffer-name ,buffer - endpoint ,endpoint - update-function ,update-fun - link-header ,link-header - update-params ,update-params - hide-replies ,hide-replies - max-id ,max-id))) + `( account ,(cons mastodon-active-user mastodon-instance-url) + buffer-name ,buffer + endpoint ,endpoint + update-function ,update-fun + link-header ,link-header + update-params ,update-params + hide-replies ,hide-replies + max-id ,max-id + thread-item-id ,thread-item-id))) ;;; BUFFERS @@ -2162,7 +2164,8 @@ view all branches of a thread." (with-mastodon-buffer buffer #'mastodon-mode nil (let ((marker (make-marker))) (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread) + #'mastodon-tl--thread + nil nil nil nil id) (mastodon-tl--timeline (alist-get 'ancestors context) :thread) (goto-char (point-max)) (move-marker marker (point)) @@ -2186,6 +2189,12 @@ Note that you can only (un)mute threads you have posted in." (interactive) (mastodon-tl--mute-or-unmute-thread :unmute)) +(defun mastodon-tl--thread-parent-id () + "Return the ID of the top item in a thread." + (save-excursion + (mastodon-tl--goto-first-item) + (mastodon-tl--property 'base-item-id :no-move))) + (defun mastodon-tl--mute-or-unmute-thread (&optional unmute) "Mute a thread. If UNMUTE, unmute it." @@ -2197,9 +2206,7 @@ If UNMUTE, unmute it." ;; top-level item: (if (mastodon-tl--buffer-type-eq 'notifications) (mastodon-tl--property 'base-item-id :no-move) - (save-excursion - (mastodon-tl--goto-first-item) - (mastodon-tl--property 'base-item-id :no-move)))) + (mastodon-tl--thread-parent-id))) (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) @@ -2728,10 +2735,9 @@ Aims to respect any pagination in effect." (goto-char (point-min)) (mastodon-profile--get-toot-author max-id))) ((eq type 'thread) - (save-match-data - (let ((endpoint (mastodon-tl--endpoint))) - (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" endpoint) - (mastodon-tl--thread (match-string 2 endpoint)))))) + (let ((id (mastodon-tl--buffer-property + 'thread-item-id (current-buffer) :no-error))) + (mastodon-tl--thread id)))) ;; 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. @@ -2772,17 +2778,17 @@ and profile pages when showing followers or accounts followed." ;; "prev" type! (let ((link-header (mastodon-tl--link-header))) (if (> 2 (length link-header)) - (message "No next page") + (user-error "No next page") (let* ((next (car link-header)) ;;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) - (mastodon-http--get-response-async url nil 'mastodon-tl--more* (current-buffer) - (point) :headers)))) - (cond ( ; no paginate + (mastodon-http--get-response-async + url nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) + (cond (;; no paginate (or (mastodon-tl--buffer-type-eq 'follow-suggestions) (mastodon-tl--buffer-type-eq 'filters) (mastodon-tl--buffer-type-eq 'lists)) - (message "No more results")) + (user-error "No more results")) ;; offset paginate (search, trending, user lists, ...?): ((or (string-prefix-p "*mastodon-trending-" (buffer-name)) (mastodon-tl--search-buffer-p)) @@ -2790,7 +2796,7 @@ and profile pages when showing followers or accounts followed." (mastodon-tl--endpoint) (mastodon-tl--update-params) 'mastodon-tl--more* (current-buffer) (point))) - (t;; max_id paginate (timelines, items with ids/timestamps): + (t ;; max_id paginate (timelines, items with ids/timestamps): (let ((max-id (mastodon-tl--oldest-id))) (mastodon-tl--more-json-async (mastodon-tl--endpoint) @@ -2798,7 +2804,8 @@ and profile pages when showing followers or accounts followed." (mastodon-tl--update-params) 'mastodon-tl--more* (current-buffer) (point) nil max-id)))))) -(defun mastodon-tl--more* (response buffer point-before &optional headers max-id) +(defun mastodon-tl--more* (response buffer point-before + &optional headers max-id) "Append older toots to timeline, asynchronously. Runs the timeline's update function on RESPONSE, in BUFFER. When done, places point at POINT-BEFORE. @@ -2806,24 +2813,26 @@ HEADERS is the http headers returned in the response, if any. MAX-ID is the pagination parameter, a string." (with-current-buffer buffer (if (not response) - (message "No more results") + (user-error "No more results") (let* ((inhibit-read-only t) (json (if headers (car response) response)) ;; FIXME: max-id pagination works for statuses only, not other ;; search results pages: - (json (if (mastodon-tl--search-buffer-p) - (cond ((equal "statuses" (mastodon-search--buf-type)) + (json (if (not (mastodon-tl--search-buffer-p)) + json + (let ((type (mastodon-search--buf-type))) + (cond ((string= "statuses" type) (cdr ; avoid repeat of last status (alist-get 'statuses response))) - ((equal "hashtags" (mastodon-search--buf-type)) + ((string= "hashtags" type) (alist-get 'hashtags response)) - ((equal "accounts" (mastodon-search--buf-type)) - (alist-get 'accounts response))) - json)) + ((string= "accounts" type) + (alist-get 'accounts response)))))) (headers (if headers (cdr response) nil)) - (link-header (mastodon-tl--get-link-header-from-response headers))) + (link-header + (mastodon-tl--get-link-header-from-response headers))) (goto-char (point-max)) - (if (eq (mastodon-tl--get-buffer-type) 'thread) + (if (eq 'thread (mastodon-tl--get-buffer-type)) ;; if thread view, call --thread with parent ID (progn (goto-char (point-min)) (mastodon-tl--goto-next-item) @@ -2831,7 +2840,7 @@ MAX-ID is the pagination parameter, a string." (goto-char point-before) (message "Loaded full thread.")) (if (not json) - (message "No more results.") + (user-error "No more results") (funcall (mastodon-tl--update-function) json) (goto-char point-before) ;; update buffer spec to new link-header or max-id: @@ -2839,8 +2848,7 @@ MAX-ID is the pagination parameter, a string." (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) (mastodon-tl--endpoint) (mastodon-tl--update-function) - link-header - nil nil max-id) + link-header nil nil max-id) (message "Loading... done."))))))) (defun mastodon-tl--find-property-range (property start-point @@ -2853,17 +2861,18 @@ before (non-nil) or after (nil)" (if (get-text-property start-point property) ;; We are within a range, so look backwards for the start: (cons (previous-single-property-change - (if (equal start-point (point-max)) start-point (1+ start-point)) + (if (eq start-point (point-max)) start-point (1+ start-point)) property nil (point-min)) (next-single-property-change start-point property nil (point-max))) (if search-backwards (let* ((end (or (previous-single-property-change - (if (equal start-point (point-max)) - start-point (1+ start-point)) + (if (eq start-point (point-max)) + start-point + (1+ start-point)) property) ;; we may either be just before the range or there ;; is nothing at all - (and (not (equal start-point (point-min))) + (and (not (eq start-point (point-min))) (get-text-property (1- start-point) property) start-point))) (start (and end (previous-single-property-change @@ -2884,20 +2893,21 @@ from the value at START-POINT if that is set). Return nil if no such range exists. If SEARCH-BACKWARDS is non-nil it find a region before START-POINT otherwise after START-POINT." - (if (get-text-property start-point property) - ;; We are within a range, we need to start the search from - ;; before/after this range: - (let ((current-range (mastodon-tl--find-property-range property start-point))) - (if search-backwards - (unless (equal (car current-range) (point-min)) - (mastodon-tl--find-property-range - property (1- (car current-range)) search-backwards)) - (unless (equal (cdr current-range) (point-max)) + (if (not (get-text-property start-point property)) + ;; If we are not within a range, we can just defer to + ;; mastodon-tl--find-property-range directly. + (mastodon-tl--find-property-range property start-point search-backwards) + ;; We are within a range, we need to start the search from + ;; before/after this range: + (let ((current-range + (mastodon-tl--find-property-range property start-point))) + (if search-backwards + (unless (eq (car current-range) (point-min)) (mastodon-tl--find-property-range - property (1+ (cdr current-range)) search-backwards)))) - ;; If we are not within a range, we can just defer to - ;; mastodon-tl--find-property-range directly. - (mastodon-tl--find-property-range property start-point search-backwards))) + property (1- (car current-range)) search-backwards)) + (unless (eq (cdr current-range) (point-max)) + (mastodon-tl--find-property-range + property (1+ (cdr current-range)) search-backwards)))))) (defun mastodon-tl--consider-timestamp-for-updates (timestamp) "Take note that TIMESTAMP is used in buffer and ajust timers as needed. @@ -3007,7 +3017,7 @@ This location is defined by a non-nil value of "Update timeline with new toots." (interactive) ;; FIXME: actually these buffers should just reload by calling their own - ;; load function: + ;; load function (actually g is mostly mapped as such): (if (or (mastodon-tl--buffer-type-eq 'trending-statuses) (mastodon-tl--buffer-type-eq 'trending-tags) (mastodon-tl--buffer-type-eq 'follow-suggestions) @@ -3015,33 +3025,35 @@ This location is defined by a non-nil value of (mastodon-tl--buffer-type-eq 'filters) (mastodon-tl--buffer-type-eq 'scheduled-statuses) (mastodon-tl--search-buffer-p)) - (message "update not available in this view.") + (user-error "Update not available in this view") ;; FIXME: handle update for search and trending buffers (let* ((endpoint (mastodon-tl--endpoint)) (update-function (mastodon-tl--update-function))) ;; update a thread, without calling `mastodon-tl--updated-json': (if (mastodon-tl--buffer-type-eq 'thread) - (let ((thread-id (mastodon-tl--property 'item-id))) - (funcall update-function thread-id)) + ;; load whole thread whole thread + (let ((thread-id (mastodon-tl--thread-parent-id))) + (funcall update-function thread-id) + (message "Loaded full thread.")) ;; update other timelines: (let* ((id (mastodon-tl--newest-id)) (params (mastodon-tl--update-params)) (json (mastodon-tl--updated-json endpoint id params))) - (if json - (let ((inhibit-read-only t)) - (mastodon-tl--set-after-update-marker) - (goto-char (or mastodon-tl--update-point (point-min))) - (funcall update-function json) - (when mastodon-tl--after-update-marker - (goto-char mastodon-tl--after-update-marker))) - (message "nothing to update"))))))) + (if (not json) + (user-error "Nothing to update") + (let ((inhibit-read-only t)) + (mastodon-tl--set-after-update-marker) + (goto-char (or mastodon-tl--update-point (point-min))) + (funcall update-function json) + (when mastodon-tl--after-update-marker + (goto-char mastodon-tl--after-update-marker))))))))) ;;; LOADING TIMELINES -(defun mastodon-tl--init (buffer-name endpoint update-function - &optional headers params hide-replies - instance) +(defun mastodon-tl--init + (buffer-name endpoint update-function &optional headers params + hide-replies instance) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots. HEADERS means to also collect the response headers. Used for paginating @@ -3086,18 +3098,19 @@ JSON and http headers, without it just the JSON." (user-error "Looks like the server bugged out: \"%s\"" (cdar json))) (t (let* ((headers (if headers (cdr response) nil)) - (link-header (mastodon-tl--get-link-header-from-response headers))) + (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 - ;; awful hack to fix multiple reloads: - (alist-get "max_id" update-params nil nil #'equal)) + (mastodon-tl--set-buffer-spec + buffer endpoint update-function + link-header update-params hide-replies + ;; awful hack to fix multiple reloads: + (alist-get "max_id" update-params nil nil #'string=)) (mastodon-tl--do-init json update-function instance))))))) (defun mastodon-tl--init-sync - (buffer-name endpoint update-function - &optional note-type params headers view-name binding-str - endpoint-version) + (buffer-name endpoint update-function &optional note-type params + headers view-name binding-str endpoint-version) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. Runs synchronously. @@ -3128,10 +3141,11 @@ ENDPOINT-VERSION is a string, format Vx, e.g. V2." (when binding-str (insert (mastodon-tl--set-face (concat "[" binding-str "]\n\n") 'font-lock-comment-face))) - (mastodon-tl--set-buffer-spec buffer endpoint update-function - link-header params nil - ;; awful hack to fix multiple reloads: - (alist-get "max_id" params nil nil #'equal)) + (mastodon-tl--set-buffer-spec + buffer endpoint update-function + link-header params nil + ;; awful hack to fix multiple reloads: + (alist-get "max_id" params nil nil #'string=)) (mastodon-tl--do-init json update-function) buffer))) @@ -3140,7 +3154,7 @@ ENDPOINT-VERSION is a string, format Vx, e.g. V2." JSON is the data to call UPDATE-FUN on. When DOMAIN, force inclusion of user's domain in their handle." (remove-overlays) ; video overlays - (if domain + (if domain ;; maybe our update-fun doesn't always have 3 args...: (funcall update-fun json nil domain) (funcall update-fun json)) (setq @@ -3169,8 +3183,7 @@ When DOMAIN, force inclusion of user's domain in their handle." RECORD is the bookmark record." (let ((id (bookmark-prop-get record 'id))) ;; we need to handle thread and single toot for starters - (pop-to-buffer - (mastodon-tl--thread id)))) + (pop-to-buffer (mastodon-tl--thread id)))) (defun mastodon-tl--bookmark-make-record () "Return a bookmark record for the current mastodon buffer." -- cgit v1.2.3 From 377c2ecb0a423ff676f7f2a3695bcb7a7883df57 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 19 Aug 2024 16:22:53 +0200 Subject: tl--init: funcall get-response-async or get-json async --- lisp/mastodon-tl.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 62064a7..2c1ef43 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -3066,16 +3066,16 @@ a timeline from." (concat "https://" instance "/api/v1/" endpoint) (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 instance)))) - -(defun mastodon-tl--init* (response buffer endpoint update-function - &optional headers update-params hide-replies instance) + (funcall + (if headers + #'mastodon-http--get-response-async + #'mastodon-http--get-json-async) + url params 'mastodon-tl--init* + buffer endpoint update-function headers params hide-replies instance))) + +(defun mastodon-tl--init* + (response buffer endpoint update-function &optional headers + update-params hide-replies instance) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by -- cgit v1.2.3 From beeb8f3b2ebe25e8e3fb92e6f030cec39b818cec Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 22 Aug 2024 11:06:07 +0200 Subject: eq for symbols, string= for strings --- lisp/mastodon-async.el | 16 +++++++------- lisp/mastodon-auth.el | 4 ++-- lisp/mastodon-client.el | 2 +- lisp/mastodon-http.el | 2 +- lisp/mastodon-media.el | 4 ++-- lisp/mastodon-notifications.el | 40 ++++++++++++++++----------------- lisp/mastodon-profile.el | 8 +++---- lisp/mastodon-search.el | 28 +++++++++++------------ lisp/mastodon-tl.el | 50 +++++++++++++++++++++--------------------- lisp/mastodon-toot.el | 34 ++++++++++++++-------------- lisp/mastodon-views.el | 8 +++---- 11 files changed, 98 insertions(+), 98 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 0c70560..317be93 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -88,7 +88,7 @@ (delete-process (get-buffer-process mastodon-async--http-buffer)) (kill-buffer mastodon-async--http-buffer) (setq mastodon-async--http-buffer "") - (when (not (equal "" mastodon-async--queue)) ; error handle on kill async buffer + (when (not (string= "" mastodon-async--queue)) ; error handle on kill async buffer (kill-buffer mastodon-async--queue)))) (defun mastodon-async--stream-notifications () @@ -207,8 +207,8 @@ ENDPOINT is the endpoint for the stream and timeline." ;; if user stream, we need "timelines/home" not "timelines/user" ;; if notifs, we need "notifications" not "timelines/notifications" (endpoint (cond - ((equal name "notifications") "notifications") - ((equal name "home") "timelines/home") + ((string= name "notifications") "notifications") + ((string= name "home") "timelines/home") (t (format "timelines/%s" endpoint))))) (mastodon-async--set-local-variables buffer-name http-buffer buffer-name queue-name) @@ -218,7 +218,7 @@ ENDPOINT is the endpoint for the stream and timeline." (make-local-variable 'mastodon-tl--enable-relative-timestamps) (make-local-variable 'mastodon-tl--display-media-p) (message (mastodon-http--api endpoint)) - (if (equal name "notifications") + (if (string= name "notifications") (mastodon-notifications--timeline (mastodon-http--get-json (mastodon-http--api "notifications"))) @@ -227,7 +227,7 @@ ENDPOINT is the endpoint for the stream and timeline." (mastodon-mode) (mastodon-tl--set-buffer-spec buffer-name endpoint - (if (equal name "notifications") + (if (string= name "notifications") 'mastodon-notifications--timeline 'mastodon-tl--timeline)) (setq-local mastodon-tl--enable-relative-timestamps nil) @@ -275,7 +275,7 @@ NAME is used for the queue and display buffer." (car split-strings))) (data (replace-regexp-in-string "^data: " "" (cadr split-strings)))) - (when (equal "update" event-type) + (when (string= "update" event-type) ;; in some casses the data is not fully formed ;; for now return nil if malformed using `ignore-errors' (ignore-errors (json-read-from-string data))))))) @@ -289,7 +289,7 @@ NAME is used for the queue and display buffer." (car split-strings))) (data (replace-regexp-in-string "^data: " "" (cadr split-strings)))) - (when (equal "notification" event-type) + (when (string= "notification" event-type) ;; in some casses the data is not fully formed ;; for now return nil if malformed using `ignore-errors' (ignore-errors (json-read-from-string data))))) @@ -324,7 +324,7 @@ NAME is used for the queue and display buffer." mastodon-instance-url "*")) (mastodon-notifications--timeline (list toot)) (mastodon-tl--timeline (list toot))) - (if (equal previous 1) + (if (eq previous 1) (goto-char 1) (goto-char (+ previous (- (point-max) old-max))))))))) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 404dd57..3796b7e 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -173,13 +173,13 @@ When ASK is absent return nil." Generate/save token if none known yet." (cond (mastodon-auth--token-alist ;; user variables are known and initialised. - (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil #'equal)) + (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil #'string=)) ((plist-get (mastodon-client--active-user) :access_token) ;; 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)) + (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil #'string=)) ((null mastodon-active-user) ;; user not aware of 2FA-related changes and has not set ;; `mastodon-active-user'. Make user aware and error out. diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 493f9df..6e55829 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -174,7 +174,7 @@ Otherwise return nil." (let ((username (mastodon-client--form-user-from-vars)) (user-details (mastodon-client--general-read "active-user"))) (when (and user-details - (equal (plist-get user-details :username) username)) + (string= (plist-get user-details :username) username)) user-details))) (defun mastodon-client--active-user () diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 39c1036..fbae8a7 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -365,7 +365,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." ;; this is how the mangane akkoma web client does it ;; and it seems easier than the other options! (when (and caption - (not (equal caption (alist-get 'description data)))) + (not (string= caption (alist-get 'description data)))) (let ((url (mastodon-http--api (format "media/%s" id)))) ;; (message "PUTting image description") (mastodon-http--put url desc))) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 620aa51..2ec498e 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -449,8 +449,8 @@ 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)) - (when (or (equal type "gifv") - (equal type "video")) + (when (or (string= type "gifv") + (string= type "video")) (mastodon-media--moving-image-overlay start end)))))))) ;; (defvar-local mastodon-media--overlays nil diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 1b93f1b..1c2aad7 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -204,7 +204,7 @@ Status notifications are given when ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' (let* ((id (alist-get 'id note)) (profile-note - (when (equal 'follow-request type) + (when (eq 'follow-request type) (let ((str (mastodon-tl--field 'note (mastodon-tl--field 'account note)))) @@ -221,15 +221,15 @@ Status notifications are given when nil (mastodon-tl--insert-status ;; toot - (cond ((or (equal type 'follow) - (equal type 'follow-request)) + (cond ((or (eq type 'follow) + (eq type 'follow-request)) ;; Using reblog with an empty id will mark this as something ;; non-boostable/non-favable. (cons '(reblog (id . nil)) note)) ;; reblogs/faves use 'note' to process their own json ;; not the toot's. this ensures following etc. work on such notifs - ((or (equal type 'favourite) - (equal type 'boost)) + ((or (eq type 'favourite) + (eq type 'boost)) note) (t status)) @@ -239,12 +239,12 @@ Status notifications are given when (mastodon-tl--clean-tabs-and-nl (if (mastodon-tl--has-spoiler status) (mastodon-tl--spoiler status) - (if (equal 'follow-request type) + (if (eq 'follow-request type) (mastodon-tl--render-text profile-note) (mastodon-tl--content status))))))) (cond ((or (eq type 'follow) (eq type 'follow-request)) - (if (equal type 'follow) + (if (eq type 'follow) (propertize "Congratulations, you have a new follower!" 'face 'default) (concat @@ -261,35 +261,35 @@ Status notifications are given when (mastodon-notifications--comment-note-text body)) (t body))) ;; author-byline - (if (or (equal type 'follow) - (equal type 'follow-request) - (equal type 'mention)) + (if (or (eq type 'follow) + (eq type 'follow-request) + (eq type 'mention)) 'mastodon-tl--byline-author (lambda (_status &rest _args) ; unbreak stuff (mastodon-tl--byline-author note))) ;; action-byline (lambda (_status) (mastodon-notifications--byline-concat - (cond ((equal type 'boost) + (cond ((eq type 'boost) "Boosted") - ((equal type 'favourite) + ((eq type 'favourite) "Favourited") - ((equal type 'follow-request) + ((eq type 'follow-request) "Requested to follow") - ((equal type 'follow) + ((eq type 'follow) "Followed") - ((equal type 'mention) + ((eq type 'mention) "Mentioned") - ((equal type 'status) + ((eq type 'status) "Posted") - ((equal type 'poll) + ((eq type 'poll) "Posted a poll") - ((equal type 'edit) + ((eq type 'edit) "Edited")))) id ;; base toot - (when (or (equal type 'favourite) - (equal type 'boost)) + (when (or (eq type 'favourite) + (eq type 'boost)) status))))) (defun mastodon-notifications--by-type (note) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 5f33ce2..6410591 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -592,7 +592,7 @@ FIELDS means provide a fields vector fetched by other means." "T if you have any relationship with the accounts in LIST." (let (result) (dolist (x list result) - (when (not (equal :json-false x)) + (when (not (eq :json-false x)) (setq result x))))) (defun mastodon-profile--render-roles (roles) @@ -735,7 +735,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (setq mastodon-tl--update-point (point)) (mastodon-media--inline-images (point-min) (point)) ;; insert pinned toots first - (when (and pinned (equal endpoint-type "statuses")) + (when (and pinned (string= endpoint-type "statuses")) (mastodon-profile--insert-statuses-pinned pinned) (setq mastodon-tl--update-point (point))) ; updates after pinned toots (funcall update-function json)) @@ -767,7 +767,7 @@ MAX-ID is a flag to include the max_id pagination parameter." "Return a avatar image from ACCOUNT. IMG-TYPE is the JSON key from the account data." (let ((img (alist-get img-type account))) - (unless (equal img "/avatars/original/missing.png") + (unless (string= img "/avatars/original/missing.png") (mastodon-media--get-media-link-rendering img)))) (defun mastodon-profile--show-user (user-handle) @@ -784,7 +784,7 @@ IMG-TYPE is the JSON key from the account data." nil ; predicate 'confirm))))) (if (not (or ; own profile has no need for item-json test: - (equal user-handle (mastodon-auth--get-account-name)) + (string= user-handle (mastodon-auth--get-account-name)) (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'item-json :no-move))) (user-error "Looks like there's no toot or user at point?") diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index f51247b..7fc4de3 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -66,7 +66,7 @@ Returns a nested list containing user handle, display name, and URL." (mastodon-http--get-json url `(("q" . ,query) ;; NB: nil can break params (but works for me) - ,(when (equal "following" + ,(when (string= "following" mastodon-toot--completion-style-for-mentions) '("following" . "true"))) :silent))) @@ -103,7 +103,7 @@ TYPE is a string, either tags, statuses, or links. PRINT-FUN is the function used to print the data from the response." (let* ((url (mastodon-http--api (format "trends/%s" type))) ;; max for statuses = 40, for others = 20 - (limit (if (equal type "statuses") + (limit (if (string= type "statuses") '("limit" . "40") '("limit" . "20"))) (offset '(("offset" . "0"))) @@ -116,7 +116,7 @@ PRINT-FUN is the function used to print the data from the response." print-fun nil params) (mastodon-search--insert-heading "trending" type) (funcall print-fun data) - (unless (equal type "statuses") + (unless (string= type "statuses") (goto-char (point-min)))))) ;; functions for mastodon search @@ -153,10 +153,10 @@ is used for pagination." ;; TODO: handle no results (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api-v2 "search")) - (following (when (or following (equal current-prefix-arg '(4))) + (following (when (or following (eq current-prefix-arg '(4))) "true")) (type (or type - (if (equal current-prefix-arg '(4)) + (if (eq current-prefix-arg '(4)) "accounts" ; if FOLLOWING, must be "accounts" (completing-read "Search type: " mastodon-search-types nil :match)))) @@ -175,15 +175,15 @@ is used for pagination." (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-search-mode) (mastodon-search--insert-heading type) - (cond ((equal type "accounts") + (cond ((string= type "accounts") (mastodon-search--render-response items type buffer params 'mastodon-views--insert-users-propertized-note 'mastodon-views--insert-users-propertized-note)) - ((equal type "hashtags") + ((string= type "hashtags") (mastodon-search--render-response items type buffer params 'mastodon-search--print-tags 'mastodon-search--print-tags)) - ((equal type "statuses") + ((string= type "statuses") (mastodon-search--render-response items type buffer params #'mastodon-tl--timeline #'mastodon-tl--timeline))) @@ -213,19 +213,19 @@ BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'." "Return search buffer type, a member of `mastodon-search-types'." ;; called in `mastodon-tl--get-buffer-type' (let* ((spec (mastodon-tl--buffer-property 'update-params))) - (alist-get "type" spec nil nil #'equal))) + (alist-get "type" spec nil nil #'string=))) (defun mastodon-search--query-cycle () "Cycle through search types: accounts, hashtags, and statuses." (interactive) (let* ((spec (mastodon-tl--buffer-property 'update-params)) - (type (alist-get "type" spec nil nil #'equal)) - (query (alist-get "q" spec nil nil #'equal))) - (cond ((equal type "hashtags") + (type (alist-get "type" spec nil nil #'string=)) + (query (alist-get "q" spec nil nil #'string=))) + (cond ((string= type "hashtags") (mastodon-search--query query "accounts")) - ((equal type "accounts") + ((string= type "accounts") (mastodon-search--query query "statuses")) - ((equal type "statuses") + ((string= type "statuses") (mastodon-search--query query "hashtags"))))) (defun mastodon-search--query-accounts-followed (query) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2c1ef43..f400cc1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -574,7 +574,7 @@ Do so if type of status at poins is not follow_request/follow." (let ((type (alist-get 'type (mastodon-tl--property 'item-json :no-move))) (echo (mastodon-tl--property 'help-echo :no-move))) - (when (not (equal "" echo)) ; not for followers/following in profile + (when (not (string= "" echo)) ; not for followers/following in profile (unless (or (string= type "follow_request") (string= type "follow")) ; no counts for these (message "%s" echo))))) @@ -682,11 +682,11 @@ The result is added as an attachments property to author-byline." (defun mastodon-tl--format-faved-or-boosted-byline (letter) "Format the byline marker for a boosted or favourited status. LETTER is a string, F for favourited, B for boosted, or K for bookmarked." - (let ((help-string (cond ((equal letter "F") + (let ((help-string (cond ((string= letter "F") "favourited") - ((equal letter "B") + ((string= letter "B") "boosted") - ((equal letter (or "🔖" "K")) + ((string= letter (or "🔖" "K")) "bookmarked")))) (format "(%s) " (propertize letter 'face 'mastodon-boost-fave-face @@ -761,10 +761,10 @@ BASE-TOOT is JSON for the base toot, if any." ;; in `mastodon-tl--byline-author' (funcall author-byline toot nil domain) ;; visibility: - (cond ((equal visibility "direct") + (cond ((string= visibility "direct") (propertize (concat " " (mastodon-tl--symbol 'direct)) 'help-echo visibility)) - ((equal visibility "private") + ((string= visibility "private") (propertize (concat " " (mastodon-tl--symbol 'private)) 'help-echo visibility))) ;;action byline: @@ -1097,11 +1097,11 @@ content should be hidden." (user-error "Not in a thread") (save-excursion (goto-char (point-min)) - (while (not (equal "No more items" ; improve this hack test! + (while (not (string= "No more items" ; improve this hack test! (mastodon-tl--goto-next-item :no-refresh))) (let* ((json (mastodon-tl--property 'item-json :no-move)) (cw (alist-get 'spoiler_text json))) - (when (not (equal "" cw)) + (when (not (string= "" cw)) (mastodon-tl--toggle-spoiler-text-in-toot)))))))) (defun mastodon-tl--spoiler (toot &optional filter) @@ -1439,8 +1439,8 @@ EVENT is a mouse-click arg." "T if mastodon-media-type prop is \"gifv\" or \"video\". TYPE is a mastodon media type." (let ((type (or type (mastodon-tl--property 'mastodon-media-type :no-move)))) - (or (equal type "gifv") - (equal type "video")))) + (or (string= type "gifv") + (string= type "video")))) (defun mastodon-tl--mpv-play-video-at-point (&optional url type) "Play the video or gif at point with an mpv process. @@ -1767,13 +1767,13 @@ To disable showing the stats, customize (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) (stats (concat (propertize faves - 'favourited-p (eq 't .favourited) + 'favourited-p (eq t .favourited) 'favourites-field t 'help-echo (format "%s favourites" .favourites_count) 'face 'font-lock-comment-face) (propertize " | " 'face 'font-lock-comment-face) (propertize boosts - 'boosted-p (eq 't .reblogged) + 'boosted-p (eq t .reblogged) 'boosts-field t 'help-echo (format "%s boosts" .reblogs_count) 'face 'font-lock-comment-face) @@ -1929,11 +1929,11 @@ call this function after it is set or use something else." 'preferences) ;; search ((mastodon-tl--search-buffer-p) - (cond ((equal "accounts" (mastodon-search--buf-type)) + (cond ((string= "accounts" (mastodon-search--buf-type)) 'search-accounts) - ((equal "hashtags" (mastodon-search--buf-type)) + ((string= "hashtags" (mastodon-search--buf-type)) 'search-hashtags) - ((equal "statuses" (mastodon-search--buf-type)) + ((string= "statuses" (mastodon-search--buf-type)) 'search-statuses))) ;; trends ((mastodon-tl--endpoint-str-= "trends/statuses") @@ -1993,7 +1993,7 @@ We hide replies if user explictly set the timeline." (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline (or mastodon-tl--hide-replies ; User configured to hide replies - (equal '(4) prefix)))) ; Timeline called with C-u prefix + (eq '(4) prefix)))) ; Timeline called with C-u prefix ;;; UTILITIES @@ -2107,7 +2107,7 @@ ID is that of the toot to view." (let* ((buffer (format "*mastodon-toot-%s*" id)) (toot (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id))))) - (if (equal (caar toot) 'error) + (if (eq (caar toot) 'error) (user-error "Error: %s" (cdar toot)) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) @@ -2152,7 +2152,7 @@ view all branches of a thread." (mastodon-http--api (concat "statuses/" id)) nil :silent)) (context (mastodon-http--get-json url nil :silent))) - (if (equal (caar toot) 'error) + (if (eq (caar toot) 'error) (user-error "Error: %s" (cdar toot)) (when (member (alist-get 'type toot) '("reblog" "favourite")) (setq toot (alist-get 'status toot))) @@ -2291,7 +2291,7 @@ desired language if they are not marked as such (or as anything)." (interactive (list (mastodon-tl--user-handles-get "filter by language"))) (let ((langs (mastodon-tl--read-filter-langs))) (mastodon-tl--do-if-item - (if (equal "" (cdar langs)) + (if (string= "" (cdar langs)) (mastodon-tl--unfilter-user-languages user-handle) (mastodon-tl--follow-user user-handle nil langs))))) @@ -2465,7 +2465,7 @@ ARGS is an alist of any parameters to send with the request." (mastodon-http--process-json)))) ;; TODO: when > if, with failure msg (cond ((string= notify "true") - (when (eq 't (alist-get 'notifying json)) + (when (eq t (alist-get 'notifying json)) (message "Receiving notifications for user %s (@%s)!" name user-handle))) ((string= notify "false") @@ -2473,7 +2473,7 @@ ARGS is an alist of any parameters to send with the request." (message "Not receiving notifications for user %s (@%s)!" name user-handle))) ((string= reblogs "true") - (when (eq 't (alist-get 'showing_reblogs json)) + (when (eq t (alist-get 'showing_reblogs json)) (message "Receiving boosts by user %s (@%s)!" name user-handle))) ((string= reblogs "false") @@ -2483,14 +2483,14 @@ ARGS is an alist of any parameters to send with the request." ((or (string= action "mute") (string= action "unmute")) (message "User %s (@%s) %sd!" name user-handle action)) - ((equal args "languages[]") + ((string= args "languages[]") (message "User %s language filters removed!" name)) - ((assoc "languages[]" args #'equal) + ((assoc "languages[]" args #'string=) (message "User %s filtered by language(s): %s" name (mapconcat #'cdr args " "))) ((and (eq notify nil) (eq reblogs nil)) - (if (and (equal action "follow") + (if (and (string= action "follow") (eq t (alist-get 'requested json))) (message "Follow requested for user %s (@%s)!" name user-handle) (message "User %s (@%s) %sed!" name user-handle action))))))))) @@ -3092,7 +3092,7 @@ JSON and http headers, without it just the JSON." ;; so as a fallback, load trending statuses: ;; FIXME: this could possibly be a fallback for all timelines not ;; just home? - (when (equal endpoint "timelines/home") + (when (string= endpoint "timelines/home") (mastodon-search--trending-statuses))) ((eq (caar json) 'error) (user-error "Looks like the server bugged out: \"%s\"" (cdar json))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5f4116f..762c313 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -284,7 +284,7 @@ data about the item boosted or favourited." Includes boosts, and notifications that display toots. This macro makes the local variable ID available." (declare (debug t)) - `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) + `(if (not (eq 'toot (mastodon-tl--property 'item-type :no-move))) (user-error "Looks like there's no toot at point?") (mastodon-tl--with-toot-helper (lambda (id) @@ -409,12 +409,12 @@ ACTION is a symbol, either `favourite' or `boost.'" ;; there's nothing wrong with faving/boosting own toots ;; & nothing wrong with faving/boosting own toots from notifs, ;; it boosts/faves the base toot, not the notif status - ((or (equal n-type "follow") - (equal n-type "follow_request")) + ((or (string= n-type "follow") + (string= n-type "follow_request")) (user-error "Can't %s %s notifications" action n-type)) ((and boost-p - (or (equal vis "direct") - (equal vis "private"))) + (or (string= vis "direct") + (string= vis "private"))) (user-error "Can't boost posts with visibility: %s" vis)) (t (let* ((boosted (when byline-region @@ -491,8 +491,8 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (bookmarked-p (when byline-region (get-text-property (car byline-region) 'bookmarked-p))) (action (if bookmarked-p "unbookmark" "bookmark"))) - (cond ((or (equal n-type "follow") - (equal n-type "follow_request")) + (cond ((or (string= n-type "follow") + (string= n-type "follow_request")) (user-error "Can't bookmark %s notifications" n-type)) ((not byline-region) (user-error "Nothing to %s here?!?" action)) @@ -595,8 +595,8 @@ Uses `lingva.el'." ;; this check needs to allow acting on own toots displayed as boosts, so we ;; call `mastodon-tl--toot-or-base'. (let ((json (mastodon-tl--toot-or-base toot))) - (equal (alist-get 'acct (alist-get 'account json)) - (mastodon-auth--user-acct)))) + (string= (alist-get 'acct (alist-get 'account json)) + (mastodon-auth--user-acct)))) (defun mastodon-toot--pin-toot-toggle () "Pin or unpin user's toot at point." @@ -717,7 +717,7 @@ 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))) + mastodon-toot-draft-toots-list :test #'string=))) ;; prevent some weird bug when cancelling a non-empty toot: (delete #'mastodon-toot--save-toot-text after-change-functions) (quit-window 'kill) @@ -931,7 +931,7 @@ instance to edit a toot." ;; (we don't reload in every case as it can be slow and we may ;; lose our place in a timeline.) (when (or edit-id - (equal 'thread (mastodon-tl--get-buffer-type))) + (eq 'thread (mastodon-tl--get-buffer-type))) (let ((pos (marker-position (cadr prev-window-config)))) (mastodon-tl--reload-timeline-or-profile pos)))))))))) @@ -1175,7 +1175,7 @@ prefixed by >." (alist-get 'account toot)))) (mentions (cond ((and booster ;; different booster, user and mentions: - (and (not (equal user booster)) + (and (not (string= user booster)) (not (member booster mentions)))) (mastodon-toot--mentions-to-string (append (list user booster) mentions nil))) @@ -1228,7 +1228,7 @@ Return its two letter ISO 639 1 code." (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)) + (alist-get choice mastodon-iso-639-1 nil nil #'string=)) (message "Language set to %s" choice) (mastodon-toot--update-status-fields))) @@ -1419,7 +1419,7 @@ Return a cons of a human readable string, and a seconds-from-now string." (let* ((options (mastodon-toot--poll-expiry-options-alist)) (response (completing-read "poll ends in [or enter seconds]: " options nil 'confirm))) - (or (assoc response options #'equal) + (or (assoc response options #'string=) (if (< (string-to-number response) 600) (car options))))) ;; min 5 mins @@ -1718,7 +1718,7 @@ REPLY-REGION is a string to be injected into the buffer." (mastodon-toot--render-reply-region-str reply-region) "\n")) (setq mastodon-toot--reply-to-id reply-to-id) - (unless (equal mastodon-toot--visibility reply-visibility) + (unless (string= mastodon-toot--visibility reply-visibility) (setq mastodon-toot--visibility reply-visibility)) (mastodon-toot--set-cw reply-cw)))) @@ -1752,7 +1752,7 @@ REPLY-REGION is a string to be injected into the buffer." (mastodon-toot--apply-fields-props vis-region (format "%s" - (if (equal "private" mastodon-toot--visibility) + (if (string= "private" mastodon-toot--visibility) "followers-only" mastodon-toot--visibility))) ;; WHEN clauses don't work here, we need "" as display arg: @@ -1783,7 +1783,7 @@ REPLY-REGION is a string to be injected into the buffer." (mastodon-toot--apply-fields-props cw-region (if (and mastodon-toot--content-warning - (not (equal "" mastodon-toot--content-warning))) + (not (string= "" mastodon-toot--content-warning))) (format "CW: %s" mastodon-toot--content-warning) " ") ;; hold the blank space 'mastodon-cw-face)))) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index ef91bd0..989a614 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -766,7 +766,7 @@ When t, whole words means only match whole words." "false")) (params `(("keyword" . ,updated) ("whole_word" . ,whole-word))) - (id (cdr (assoc choice alist #'equal))) + (id (cdr (assoc choice alist #'string=))) (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) (resp (mastodon-http--put url params))) (mastodon-views--filters-triage resp @@ -807,7 +807,7 @@ When t, whole words means only match whole words." (mastodon-tl--property 'item-json :no-move))) (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws)) (choice (completing-read "Remove keyword: " alist)) - (id (cdr (assoc choice alist #'equal))) + (id (cdr (assoc choice alist #'string=))) (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) (resp (mastodon-http--delete url))) (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice))))) @@ -1022,9 +1022,9 @@ 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 ((eq (cdr el) :json-false) "no") - ((equal (cdr el) 't) + ((eq (cdr el) t) "yes") (t (cdr el))))) -- cgit v1.2.3 From 4db6e78d5858d6858631a78d786285dca18d68d9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 22 Aug 2024 11:16:21 +0200 Subject: fix return val of --report-build-params when no rules cited --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2c1ef43..b3f0506 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2610,7 +2610,8 @@ ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from ,(when item-id `("status_ids[]" . ,item-id)) ,(when forward-p `("forward" . ,forward-p)) ,(when cat `("category" . ,cat)))))) - (when rules + (if (not rules) + params (let ((alist (mastodon-http--build-array-params-alist "rule_ids[]" rules))) (append alist params))))) -- cgit v1.2.3 From e2cc37b07137879fe9ba1dcf7bb5f05ab5e41bfc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 22 Aug 2024 11:46:52 +0200 Subject: just "just now" for < 1 min rel ts --- lisp/mastodon-tl.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b3f0506..5827886 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -837,7 +837,8 @@ TIMESTAMP is assumed to be in the past." (let* ((time-difference (time-subtract current-time timestamp)) (seconds-difference (float-time time-difference)) (tmp (mastodon-tl--human-duration (max 0 seconds-difference)))) - (cons (concat (car tmp) " ago") + ;; revert to old just now style for < 1 min + (cons (concat (car tmp) (if (string= "just now" (car tmp)) "" " ago")) (time-add current-time (cdr tmp))))) (defun mastodon-tl--relative-time-description (timestamp &optional current-time) @@ -1337,8 +1338,10 @@ displayed when the duration is smaller than a minute)." (if n2 (setq n2 (truncate n2))) (cond ((null n2) - (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) - (max resolution res1))) + ;; revert to old just now style for < 1 min: + (cons "just now" 60)) + ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) + ;; (max resolution res1))) ((< (* res2 n2) resolution) (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) (max resolution res2))) -- cgit v1.2.3 From 3ca71c2e85b6c327c77efcd0b089408b9ff53221 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 15 Sep 2024 10:37:41 +0200 Subject: no with-toot-item macro for --thread. FIX #585. --- lisp/mastodon-tl.el | 81 +++++++++++++++++++++++++++-------------------------- 1 file changed, 41 insertions(+), 40 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ea67f89..3e488f0 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2139,46 +2139,47 @@ view all branches of a thread." (defun mastodon-tl--thread (&optional thread-id) "Open thread buffer for toot at point or with THREAD-ID." (interactive) - (mastodon-toot--with-toot-item - ;; this function's var must not be id as the above macro binds id and even - ;; if we provide the arg (e.g. url-lookup), the macro definition overrides - ;; it, making the optional arg unusable! - (let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move))) - (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) - (if (or (string= type "follow_request") - (string= type "follow")) ; no can thread these - (user-error "No thread") - (let* ((endpoint (format "statuses/%s/context" id)) - (url (mastodon-http--api endpoint)) - (buffer (format "*mastodon-thread-%s*" id)) - (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: - (mastodon-http--api (concat "statuses/" id)) - nil :silent)) - (context (mastodon-http--get-json url nil :silent))) - (if (eq (caar toot) 'error) - (user-error "Error: %s" (cdar toot)) - (when (member (alist-get 'type toot) '("reblog" "favourite")) - (setq toot (alist-get 'status toot))) - (if (not (< 0 (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))))) - ;; just print the lone toot: - (mastodon-tl--single-toot id) - ;; we have a thread: - (with-mastodon-buffer buffer #'mastodon-mode nil - (let ((marker (make-marker))) - (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread - nil nil nil nil id) - (mastodon-tl--timeline (alist-get 'ancestors context) :thread) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p :thread) - (mastodon-tl--timeline (alist-get 'descendants context) - :thread) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl--goto-next-item)))))))))) + ;; no toot-at-point macro here as we can call this programmatically, eg from + ;; `mastodon-url-lookup' + ;; this function's var must not be id as the above macro binds id and even + ;; if we provide the arg (e.g. url-lookup), the macro definition overrides + ;; it, making the optional arg unusable! + (let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) + (if (or (string= type "follow_request") + (string= type "follow")) ; no can thread these + (user-error "No thread") + (let* ((endpoint (format "statuses/%s/context" id)) + (url (mastodon-http--api endpoint)) + (buffer (format "*mastodon-thread-%s*" id)) + (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: + (mastodon-http--api (concat "statuses/" id)) + nil :silent)) + (context (mastodon-http--get-json url nil :silent))) + (if (eq (caar toot) 'error) + (user-error "Error: %s" (cdar toot)) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (not (< 0 (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))))) + ;; just print the lone toot: + (mastodon-tl--single-toot id) + ;; we have a thread: + (with-mastodon-buffer buffer #'mastodon-mode nil + (let ((marker (make-marker))) + (mastodon-tl--set-buffer-spec buffer endpoint + #'mastodon-tl--thread + nil nil nil nil id) + (mastodon-tl--timeline (alist-get 'ancestors context) :thread) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p :thread) + (mastodon-tl--timeline (alist-get 'descendants context) + :thread) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl--goto-next-item))))))))) (defun mastodon-tl--mute-thread () "Mute the thread displayed in the current buffer. -- cgit v1.2.3 From 4a6200be2e98b68e0869400ae21f89f2c1fa618a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 16 Sep 2024 08:54:11 +0200 Subject: filter lists like "home". FIX #575. --- lisp/mastodon-tl.el | 2 ++ lisp/mastodon-views.el | 1 + 2 files changed, 3 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3e488f0..0e98015 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1608,6 +1608,8 @@ Returns a member of `mastodon-views--filter-types'." "public") ((mastodon-tl--profile-buffer-p) "profile") + ((eq buf 'list-timeline) + "home") ;; lists are "home" filter (t ;; thread, notifs, home: (symbol-name buf))))) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 989a614..ac62b1f 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -690,6 +690,7 @@ Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (warn-or-hide (or type (completing-read "Warn (like CW) or hide? " '("warn" "hide") nil :match))) + ;; TODO: display "home (and lists)" but just use "home" for API (contexts (or context (completing-read-multiple "Filter contexts [TAB for options, comma separated]: " -- cgit v1.2.3 From a4b2d0d7fb2fbfed68e80fabaa45aed398aefb4e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 18 Sep 2024 11:30:42 +0200 Subject: add cmd: mastodon-tl--remote-tag-timeline --- lisp/mastodon-tl.el | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0e98015..167e647 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -484,7 +484,7 @@ MAX-ID is a flag to add the max_id pagination parameter." params (when (eq arg 4) t)))) -(defun mastodon-tl--get-remote-local-timeline () +(defun mastodon-tl--get-remote-local-timeline (&optional endpoint) "Prompt for an instance domain and try to display its local timeline. You can enter any working instance domain. Domains that you want to regularly load can be stored in @@ -493,7 +493,8 @@ Note that some instances do not make their local timelines public, in which case this will not work. To interact with any item, you must view it from your own instance, which you can do with -`mastodon-tl--view-item-on-own-instance'." +`mastodon-tl--view-item-on-own-instance'. +Optionally, provide API ENDPOINT." (interactive) (let* ((domain (completing-read "Domain for remote local tl: " mastodon-tl--remote-local-domains)) @@ -509,9 +510,17 @@ instance, which you can do with (y-or-n-p "Domain appears unknown to your instance. Proceed?")) (mastodon-tl--init buf - "timelines/public" 'mastodon-tl--timeline nil + (or endpoint "timelines/public") + 'mastodon-tl--timeline nil params nil domain)))) +(defun mastodon-tl--remote-tag-timeline (&optional tag) + "Call `mastodon-tl--get-remote-local-timeline' but for a TAG timeline." + (interactive) + (let* ((tag (or tag (read-string "Tag: "))) + (endpoint (format "timelines/tag/%s" tag))) + (mastodon-tl--get-remote-local-timeline endpoint))) + (defun mastodon-tl--view-item-on-own-instance () "Load current toot on your own instance. Use this to re-load remote-local items in order to interact with them." -- cgit v1.2.3 From e5048d8dc7ddd604b60821583423fd3689b6af58 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 18 Sep 2024 11:33:52 +0200 Subject: revert an eq call to equal --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 167e647..4058abc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2007,7 +2007,7 @@ We hide replies if user explictly set the timeline." (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline (or mastodon-tl--hide-replies ; User configured to hide replies - (eq '(4) prefix)))) ; Timeline called with C-u prefix + (equal '(4) prefix)))) ; Timeline called with C-u prefix ;;; UTILITIES -- cgit v1.2.3