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') 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') 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 9987d32bcf0c920cebdd99e26c135295351bb259 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:51:04 +0200 Subject: audit first 1000 loc of toot.el. these are the uncontroversial edits --- lisp/mastodon-toot.el | 202 +++++++++++++++++++++++++------------------------- 1 file changed, 99 insertions(+), 103 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1269516..75b0f28 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -268,6 +268,12 @@ data about the item boosted or favourited." (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs (mastodon-tl--property 'item-json))) +(defun mastodon-toot--inc-or-dec (count subtract) + "If SUBTRACT, decrement COUNT, else increment." + (if subtract + (1- count) + (1+ count))) + ;;; MACRO @@ -349,12 +355,12 @@ JSON is added to the string as its item-json." (let ((inhibit-read-only t) (bol (car byline-region)) (eol (cdr byline-region)) - (at-byline-p (eq (mastodon-tl--property 'byline :no-move) t))) + (at-byline-p (eq t (mastodon-tl--property 'byline :no-move)))) (save-excursion (when remove (goto-char bol) (beginning-of-line) ;; The marker is not part of the byline - (if (search-forward (format "(%s) " marker) eol t) + (if (search-forward (format "(%s) " marker) eol :no-error) (replace-match "") (user-error "Oops: could not find marker '(%s)'" marker))) (unless remove @@ -415,9 +421,10 @@ ACTION is a symbol, either `favourite' or `boost.'" (get-text-property (car byline-region) 'favourited-p))) (str-api (if boost-p "reblog" action-str)) (action-str-api (mastodon-toot--str-negify str-api faved boosted)) - (action-pp (concat (mastodon-toot--str-negify action-str faved boosted) - (if boost-p "ed" "d"))) - (remove (if boost-p (when boosted t) (when faved t)))) + (action-pp (concat + (mastodon-toot--str-negify action-str faved boosted) + (if boost-p "ed" "d"))) + (remove-p (if boost-p boosted faved))) (mastodon-toot--action action-str-api (lambda (_) @@ -427,9 +434,9 @@ ACTION is a symbol, either `favourite' or `boost.'" (if boost-p (list 'boosted-p (not boosted)) (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action action remove) + (mastodon-toot--update-stats-on-action action remove-p) (mastodon-toot--action-success (mastodon-tl--symbol action) - byline-region remove item-json)) + byline-region remove-p item-json)) (message "%s #%s" action-pp id))))))))) (defun mastodon-toot--str-negify (str faved boosted) @@ -438,33 +445,29 @@ ACTION is a symbol, either `favourite' or `boost.'" (concat "un" str) str)) -(defun mastodon-toot--inc-or-dec (count subtract) - "If SUBTRACT, decrement COUNT, else increment." - (if subtract - (1- count) - (1+ count))) - (defun mastodon-toot--update-stats-on-action (action &optional subtract) "Increment the toot stats display upon ACTION. ACTION is a symbol, either `favourite' or `boost'. SUBTRACT means we are un-favouriting or unboosting, so we decrement." - (let* ((count-prop (if (eq action 'favourite) - 'favourites-count - 'boosts-count)) - (count-prop-range (mastodon-tl--find-property-range count-prop (point))) - (count (get-text-property (car count-prop-range) count-prop)) - (inhibit-read-only 1)) - ;; TODO another way to implement this would be to async fetch counts again - ;; and re-display from count-properties - (add-text-properties (car count-prop-range) - (cdr count-prop-range) - (list 'display - (number-to-string - (mastodon-toot--inc-or-dec count subtract)) - ;; update the count prop - ;; we rely on this for any subsequent actions: - count-prop - (mastodon-toot--inc-or-dec count subtract))))) + (if (not (symbolp action)) + (error "Invalid argument: symbolp %s" action) + (let* ((count-prop (if (eq action 'favourite) + 'favourites-count + 'boosts-count)) + (count-range (mastodon-tl--find-property-range count-prop (point))) + (count (get-text-property (car count-range) count-prop)) + (inhibit-read-only 1)) + ;; TODO another way to implement this would be to async fetch counts again + ;; and re-display from count-properties + (add-text-properties (car count-range) + (cdr count-range) + (list 'display + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) + ;; update the count prop + ;; we rely on this for any subsequent actions: + count-prop + (mastodon-toot--inc-or-dec count subtract)))))) (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." @@ -508,17 +511,17 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." byline-region bookmarked-p item-json) (message "%s #%s" message id)))))))))) -(defun mastodon-toot--list-toot-boosters () +(defun mastodon-toot--list-boosters () "List the boosters of toot at point." (interactive) - (mastodon-toot--list-toot-boosters-or-favers)) + (mastodon-toot--list-boosters-or-favers)) -(defun mastodon-toot--list-toot-favouriters () +(defun mastodon-toot--list-favouriters () "List the favouriters of toot at point." (interactive) - (mastodon-toot--list-toot-boosters-or-favers :favourite)) + (mastodon-toot--list-boosters-or-favers :favourite)) -(defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) +(defun mastodon-toot--list-boosters-or-favers (&optional favourite) "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." (mastodon-toot--with-toot-item @@ -598,13 +601,12 @@ Uses `lingva.el'." (interactive) (let* ((toot (mastodon-toot--base-toot-or-item-json)) (pinnable-p (mastodon-toot--own-toot-p toot)) - (pinned-p (equal (alist-get 'pinned toot) t)) + (pinned-p (eq t (alist-get 'pinned toot))) (action (if pinned-p "unpin" "pin")) - (msg (if pinned-p "unpinned" "pinned")) - (msg-y-or-n (if pinned-p "Unpin" "Pin"))) + (msg (if pinned-p "unpinned" "pinned"))) (if (not pinnable-p) (user-error "You can only pin your own toots") - (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (when (y-or-n-p (format "%s this toot? " (capitalize action))) (mastodon-toot--action action (lambda (_) (when mastodon-tl--buffer-spec @@ -627,28 +629,26 @@ NO-REDRAFT means delete toot only." (let* ((toot (mastodon-toot--base-toot-or-item-json)) (id (mastodon-tl--as-string (mastodon-tl--item-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) - (toot-cw (alist-get 'spoiler_text toot)) - (toot-visibility (alist-get 'visibility toot)) - (reply-id (alist-get 'in_reply_to_id toot)) (pos (point))) - (if (not (mastodon-toot--own-toot-p toot)) - (user-error "You can only delete (and redraft) your own toots") - (when (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda (_) - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile pos)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - reply-id - toot-visibility - toot-cw))))))))) + (let-alist toot + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only delete (and redraft) your own toots") + (when (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda (_) + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile pos)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + .in_reply_to_id + .visibility + .spoiler_text)))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -659,12 +659,13 @@ NO-REDRAFT means delete toot only." ;;; REDRAFT -(defun mastodon-toot--redraft (response &optional reply-id toot-visibility toot-cw) +(defun mastodon-toot--redraft (response &optional reply-id toot-visibility + toot-cw) "Opens a new toot compose buffer using values from RESPONSE buffer. REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (with-current-buffer response - (let* ((json-response (mastodon-http--process-json)) - (content (alist-get 'text json-response))) + (let* ((response (mastodon-http--process-json)) + (content (alist-get 'text response))) (mastodon-toot--compose-buffer) (goto-char (point-max)) (insert content) @@ -726,11 +727,10 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." "Kill new-toot buffer/window. Does not POST content. If toot is not empty, prompt to save text as a draft." (interactive) - (if (mastodon-toot--empty-p) - (mastodon-toot--kill) - (when (y-or-n-p "Save draft toot?") - (mastodon-toot--save-draft)) - (mastodon-toot--kill))) + (when (and (not (mastodon-toot--empty-p)) + (y-or-n-p "Save draft toot?")) + (mastodon-toot--save-draft)) + (mastodon-toot--kill)) (defun mastodon-toot--save-draft () "Save the current compose toot text as a draft. @@ -872,9 +872,9 @@ instance to edit a toot." (scheduled mastodon-toot--scheduled-for) (scheduled-id mastodon-toot--scheduled-id) (edit-id mastodon-toot--edit-item-id) - (endpoint (if edit-id ; we are sending an edit: - (mastodon-http--api (format "statuses/%s" edit-id)) - (mastodon-http--api "statuses"))) + (endpoint (mastodon-http--api (if edit-id ; we are sending an edit: + (format "statuses/%s" edit-id) + "statuses"))) (args-no-media (append `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -912,9 +912,10 @@ instance to edit a toot." ((mastodon-toot--empty-p) (user-error "Empty toot. Cowardly refusing to post this")) (t - (let ((response (if edit-id ; we are sending an edit: - (mastodon-http--put endpoint args) - (mastodon-http--post endpoint args)))) + (let ((response (funcall (if edit-id ; we are sending an edit: + #'mastodon-http--put + #'mastodon-http--post) + endpoint args))) (mastodon-http--triage response (lambda (_) @@ -927,13 +928,10 @@ instance to edit a toot." scheduled-id :no-confirm)) ;; window config: (mastodon-toot--restore-previous-window-config prev-window-config) - ;; reload previous view in certain cases: - ;; we reload: - when we have been editing - ;; - when we are in thread view - ;; - ? - ;; (we don't necessarily want to reload in every posting case - ;; as it can sometimes be slow and we may still lose our place - ;; in a timeline.) + ;; reload: - when we have been editing + ;; - when we are in thread view + ;; (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))) (let ((pos (marker-position (cadr prev-window-config)))) @@ -1003,7 +1001,6 @@ instance to edit a toot." (defun mastodon-toot--insert-toot-iter (it) "Insert iteration IT of toot." (let ((content (alist-get 'content it))) - ;; (account (alist-get 'account it)) ;; TODO: handle polls, media (mastodon-tl--render-text content))) @@ -1029,8 +1026,10 @@ eg. \"yourusername\" -> \"\" eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"." (cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct ((string= (mastodon-auth--user-acct) acct) "") ; your acct - (t (concat "@" acct "@" ; local acct - (cadr (split-string mastodon-instance-url "/" t)))))) + (t + (concat "@" acct "@" ; local acct + (cadr + (split-string mastodon-instance-url "/" :omit-nulls)))))) ;;; COMPLETION (TAGS, MENTIONS) @@ -1066,19 +1065,19 @@ Federated user: `username@host.co`." The candidates are calculated according to currently active `emojify-emoji-styles'. Hacked off `emojify--get-completing-read-candidates'." - (let ((styles ;'("ascii" "unicode" "github") - (mapcar #'symbol-name emojify-emoji-styles))) + (let ((styles (mapcar #'symbol-name emojify-emoji-styles))) (let ((emojis '())) - (emojify-emojis-each (lambda (key value) - (when (seq-position styles (ht-get value "style")) - (push (cons key - (format "%s (%s)" - (ht-get value "name") - (ht-get value "style"))) - emojis)))) + (emojify-emojis-each + (lambda (key value) + (when (seq-position styles (ht-get value "style")) + (push (cons key + (format "%s (%s)" + (ht-get value "name") + (ht-get value "style"))) + emojis)))) emojis))) -(defun mastodon-toot--fetch-completion-candidates (start end &optional type) +(defun mastodon-toot--fetch-candidates (start end &optional type) "Search for a completion prefix from buffer positions START to END. Return a list of candidates. TYPE is the candidate type, it may be :tags, :handles, or :emoji." @@ -1101,7 +1100,7 @@ TYPE is the candidate type, it may be :tags, :handles, or :emoji." (defun mastodon-toot--make-capf (regex annot-fun type) "Build a completion backend for `completion-at-point-functions'. REGEX is the regex to match preceding text. -TYPE is a keyword symbol for `mastodon-toot--fetch-completion-candidates'. +TYPE is a keyword symbol for `mastodon-toot--fetch-candidates'. ANNOT-FUN is a function returning an annotatation from a single arg, a candidate." (let* ((bounds (mastodon-toot--get-bounds regex)) @@ -1115,7 +1114,7 @@ arg, a candidate." ;; Interruptible candidate computation, from minad/d mendler, thanks! (let ((result (while-no-input - (mastodon-toot--fetch-completion-candidates + (mastodon-toot--fetch-candidates start end type)))) (and (consp result) result)))) :exclusive 'no @@ -1458,9 +1457,7 @@ Sets `mastodon-toot-poll' to nil." expiry-seconds-from-now)) (expiry-human (car (mastodon-tl--human-duration expiry-seconds-from-now))) (options (mastodon-tl--map-alist 'title .options)) - (multiple (if (eq :json-false .multiple) - nil - t))) + (multiple (if (eq :json-false .multiple) nil t))) (setq mastodon-toot-poll `( :options ,options :expiry-readable ,expiry-human :expiry ,expiry-str :multi ,multiple))))) @@ -1677,7 +1674,8 @@ The default is given by `mastodon-toot--default-reply-visibility'." (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) mastodon-toot-visibility-list))) (if (member (intern reply-visibility) less-restrictive) - mastodon-toot--default-reply-visibility reply-visibility)))) + mastodon-toot--default-reply-visibility + reply-visibility)))) (defun mastodon-toot--fill-buffer () "Mark buffer, call `fill-region'." @@ -1688,7 +1686,6 @@ The default is given by `mastodon-toot--default-reply-visibility'." (defun mastodon-toot--render-reply-region-str (str) "Refill STR and prefix all lines with >, as reply-quote text." (with-temp-buffer - ;; (switch-to-buffer (current-buffer)) (insert str) ;; unfill first: (let ((fill-column (point-max))) @@ -1699,8 +1696,7 @@ The default is given by `mastodon-toot--default-reply-visibility'." (save-match-data (while (re-search-forward "^" nil t) (replace-match " > "))) - (buffer-substring-no-properties (point-min) - (point-max)))) + (buffer-substring-no-properties (point-min) (point-max)))) (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json reply-region) -- cgit v1.2.3 From 7636931151fda918f5303e28aa75f22c12cbc354 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:51:47 +0200 Subject: toot: re-write mentions-to-string --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 75b0f28..7af0fa3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1013,9 +1013,9 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." (defun mastodon-toot--mentions-to-string (mentions) "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. Remove empty string (self) from result and joins the sequence with whitespace." - (mapconcat (lambda (mention) mention) - (remove "" (mapcar #'mastodon-toot--process-local mentions)) - " ")) + (let ((mentions (remove "" + (mapcar #'mastodon-toot--process-local mentions)))) + (mapconcat #'identity mentions " "))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". -- cgit v1.2.3 From 0575324cd5ec2737b0a6fa9896d26d71362a3094 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:52:01 +0200 Subject: toot: re-write --mentions --- lisp/mastodon-toot.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7af0fa3..7358316 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1039,10 +1039,7 @@ eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"." The mentioned users look like this: Local user (including the logged in): `username`. Federated user: `username@host.co`." - (let* ((boosted (mastodon-tl--field 'reblog status)) - (mentions (if boosted - (alist-get 'mentions (alist-get 'reblog status)) - (alist-get 'mentions status)))) + (let* ((mentions (mastodon-tl--field 'mentions status))) ;; reverse does not work on vectors in 24.5 (mastodon-tl--map-alist 'acct (reverse mentions)))) -- cgit v1.2.3 From dcf0747052ce07a368292fd45f75b21502fded90 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:52:35 +0200 Subject: toot: re-write --reply --- lisp/mastodon-toot.el | 27 ++++++++++----------------- 1 file changed, 10 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7358316..00f7ce7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1177,26 +1177,19 @@ prefixed by >." (alist-get 'account toot))))) (mastodon-toot--compose-buffer (when user - (if booster - (if (and (not (equal user booster)) - (not (member booster mentions))) - ;; different booster, user and mentions: - (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) - ;; booster is either user or in mentions: - (if (not (member user mentions)) - ;; user not already in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user already in mentions: - (mastodon-toot--mentions-to-string (copy-sequence mentions)))) - ;; ELSE no booster: + (if (and booster + ;; (if + (and (not (equal user booster)) + (not (member booster mentions)))) + ;; different booster, user and mentions: + (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) + ;; booster is either user or in mentions or nil: (if (not (member user mentions)) - ;; user not in mentions: + ;; user not already in mentions: (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user in mentions already: + ;; user already in mentions: (mastodon-toot--mentions-to-string (copy-sequence mentions))))) - id - toot - quote)))) + id toot quote)))) ;;; COMPOSE TOOT SETTINGS -- cgit v1.2.3 From 1c1085a321a0885431e7eac5f720b6b0bedd797e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 18:53:09 +0200 Subject: toot: re-write view-toot-edits --- lisp/mastodon-toot.el | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 00f7ce7..166f08b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -975,28 +975,29 @@ instance to edit a toot." "View editing history of the toot at point in a popup buffer." (interactive) (let ((id (mastodon-tl--property 'base-item-id)) - (history (mastodon-tl--property 'edit-history)) + (history (mastodon-tl--property 'edit-history)) ;; at byline (buf "*mastodon-toot-edits*")) - (with-mastodon-buffer buf #'special-mode :other-window - (let ((count 1)) - (mapc (lambda (x) - (insert (propertize (if (= count 1) - (format "%s [original]:\n" count) - (format "%s:\n" count)) - 'face 'font-lock-comment-face) - (mastodon-toot--insert-toot-iter x) - "\n") - (cl-incf count)) - history)) - (setq-local header-line-format - (propertize - (format "Edits to toot by %s:" - (alist-get 'username - (alist-get 'account (car history)))) - 'face 'font-lock-comment-face)) - (mastodon-tl--set-buffer-spec (buffer-name (current-buffer)) - (format "statuses/%s/history" id) - nil)))) + (if (not history) + (user-error "No editing history for this toot") + (with-mastodon-buffer buf #'special-mode :other-window + (cl-loop for count from 1 + for x in history + do (insert (propertize (if (= count 1) + (format "%s [original]:\n" count) + (format "%s:\n" count)) + 'face 'font-lock-comment-face) + (mastodon-toot--insert-toot-iter x) + "\n")) + (goto-char (point-min)) + (setq-local header-line-format + (propertize + (format "Edits to toot by %s:" + (alist-get 'username + (alist-get 'account (car history)))) + 'face 'font-lock-comment-face)) + (mastodon-tl--set-buffer-spec (buffer-name (current-buffer)) + (format "statuses/%s/history" id) + nil))))) (defun mastodon-toot--insert-toot-iter (it) "Insert iteration IT of toot." -- cgit v1.2.3 From 731f7b5295e7169f51b2cebf767bb3acefbcda96 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 20:38:11 +0200 Subject: re-write --reply again with a cond. --- lisp/mastodon-toot.el | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 166f08b..277b9c4 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1167,7 +1167,6 @@ prefixed by >." (let* ((quote (when (region-active-p) (buffer-substring (region-beginning) (region-end)))) - ;; no-move arg for base toot: don't try next toot (toot (mastodon-toot--base-toot-or-item-json)) (account (mastodon-tl--field 'account toot)) (user (alist-get 'acct account)) @@ -1175,22 +1174,20 @@ prefixed by >." (boosted (mastodon-tl--field 'reblog toot)) (booster (when boosted (alist-get 'acct - (alist-get 'account toot))))) - (mastodon-toot--compose-buffer - (when user - (if (and booster - ;; (if - (and (not (equal user booster)) - (not (member booster mentions)))) - ;; different booster, user and mentions: - (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) - ;; booster is either user or in mentions or nil: - (if (not (member user mentions)) - ;; user not already in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user already in mentions: - (mastodon-toot--mentions-to-string (copy-sequence mentions))))) - id toot quote)))) + (alist-get 'account toot)))) + (mentions + (cond ((and booster ;; different booster, user and mentions: + (and (not (equal user booster)) + (not (member booster mentions)))) + (mastodon-toot--mentions-to-string + (append (list user booster) mentions nil))) + ((not (member user mentions)) ;; user not in mentions: + (mastodon-toot--mentions-to-string + (append (list user) mentions nil))) + (t ;; user already in mentions: + (mastodon-toot--mentions-to-string + (copy-sequence mentions)))))) + (mastodon-toot--compose-buffer mentions id toot quote)))) ;;; COMPOSE TOOT SETTINGS -- cgit v1.2.3 From 6dda2522d2a5ea57f88898e0f043760e68c7309d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 21:31:59 +0200 Subject: toot: attach-media: get max attachments from instance, y-or-n-p views: get-own-instance (for max attachs) --- lisp/mastodon-toot.el | 47 +++++++++++++++++++++++++++++------------------ lisp/mastodon-views.el | 8 ++++++-- 2 files changed, 35 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 277b9c4..f7799c2 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -97,6 +97,7 @@ (autoload 'mastodon-tl--get-buffer-type "mastodon-tl") (autoload 'mastodon-tl--human-duration "mastodon-tl") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-views--get-own-instance "mastodon-views") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -1245,33 +1246,43 @@ Return its two letter ISO 639 1 code." (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields)) +(defun mastodon-toot--get-instance-max-attachments () + "Return the maximum attachments from `mastodon-active-user's instance." + ;; FIXME: this likely various for other server types: + (let ((config (alist-get 'statuses + (alist-get 'configuration + (mastodon-views--get-own-instance))))) + (alist-get 'max_media_attachments config))) + (defun mastodon-toot--attach-media (file description) "Prompt for an attachment FILE with DESCRIPTION. A preview is displayed in the new toot buffer, and the file is uploaded asynchronously using `mastodon-toot--upload-attached-media'. File is actually attached to the toot upon posting." (interactive "fFilename: \nsDescription: ") - (when (>= (length mastodon-toot--media-attachments) 4) - ;; Only a max. of 4 attachments are allowed, so pop the oldest one. - (pop mastodon-toot--media-attachments)) - (if (file-directory-p file) - (user-error "Looks like you chose a directory not a file") - (setq mastodon-toot--media-attachments - (nconc mastodon-toot--media-attachments - `(((:contents . ,(mastodon-http--read-file-as-string file)) - (:description . ,description) - (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display) - ;; upload only most recent attachment: - (mastodon-toot--upload-attached-media - (car (last mastodon-toot--media-attachments))))) + (let ((max-attachments (mastodon-toot--get-instance-max-attachments))) + (when (>= (length mastodon-toot--media-attachments) + (or max-attachments 4)) + ;; warn + pop the oldest one: + (when (y-or-n-p + (format "Maximum attachments (%s) reached: remove first one?" + max-attachments)) + (pop mastodon-toot--media-attachments))) + (if (file-directory-p file) + (user-error "Looks like you chose a directory not a file") + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:description . ,description) + (:filename . ,file))))) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media + (car (last mastodon-toot--media-attachments)))))) (defun mastodon-toot--attachment-descriptions () "Return a list of image descriptions for current attachments." - (mastodon-tl--map-alist :description - ;; (mapcar (lambda (a) - ;; (alist-get :description a)) - mastodon-toot--media-attachments)) + (mastodon-tl--map-alist :description mastodon-toot--media-attachments)) (defun mastodon-toot--attachment-from-desc (desc) "Return an attachment based on its description DESC." diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 775b96b..e956ccd 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -738,6 +738,11 @@ If INSTANCE is given, use that." (string-remove-suffix (concat "/@" username) url)))) +(defun mastodon-views--get-own-instance () + "Return JSON of `mastodon-active-user's instance." + (mastodon-http--get-json + (mastodon-http--api "instance" "v2") nil nil :vector)) + (defun mastodon-views--view-instance-description (&optional user brief instance misskey) "View the details of the instance the current post's author is on. @@ -747,8 +752,7 @@ INSTANCE is an instance domain name. MISSKEY means the instance is a Misskey or derived server." (interactive) (if user - (let ((response (mastodon-http--get-json - (mastodon-http--api "instance" "v2") nil nil :vector))) + (let ((response (mastodon-views--get-own-instance))) (mastodon-views--instance-response-fun response brief instance)) (mastodon-tl--do-if-item (let* ((toot (if (mastodon-tl--profile-buffer-p) -- cgit v1.2.3 From 72d4d0e77faa891bd249cefca1375c82b0e6dc62 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Aug 2024 21:43:50 +0200 Subject: toot: re-write format-attachments --- lisp/mastodon-toot.el | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f7799c2..3728bc8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1320,30 +1320,30 @@ which is used to attach it to a toot when posting." 'toot-attachments (point-min))) (display-specs (mastodon-toot--format-attachments))) (dotimes (i (- (cdr attachments-region) (car attachments-region))) - (add-text-properties (+ (car attachments-region) i) - (+ (car attachments-region) i 1) + (add-text-properties (+ i (car attachments-region)) + (+ i 1 (car attachments-region)) (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () "Format the attachment previews for display in toot draft buffer." - (or (let ((counter 0) - (image-options (when (or (image-type-available-p 'imagemagick) - (image-transforms-p)) - `(:height ,mastodon-toot--attachment-height)))) - (mapcan (lambda (attachment) - (let* ((data (alist-get :contents attachment)) - (image (apply #'create-image data - (if (version< emacs-version "27.1") - (when image-options 'imagemagick) - nil) ; inbuilt scaling in 27.1 - t image-options)) - (description (alist-get :description attachment))) - (setq counter (1+ counter)) - (list (format "\n %d: " counter) - image - (format " \"%s\"" description)))) - mastodon-toot--media-attachments)) - (list "None"))) + (or + (let ((image-options (when (or (image-type-available-p 'imagemagick) + (image-transforms-p)) + `(:height ,mastodon-toot--attachment-height)))) + (cl-loop for count from 1 + for att in mastodon-toot--media-attachments + nconc + (let* ((data (alist-get :contents att)) + (image (apply #'create-image data + (if (version< emacs-version "27.1") + (when image-options 'imagemagick) + nil) ; inbuilt scaling in 27.1 + t image-options)) + (desc (alist-get :description att))) + (list (format "\n %d: " count) + image + (format " \"%s\"" desc))))) + (list "None"))) ;;; POLL -- cgit v1.2.3 From fe7ae6ecb2445b84563debd5bb0ad9d37ee291b0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 3 Aug 2024 10:07:44 +0200 Subject: max attachments: move fallback into our get max fun --- lisp/mastodon-toot.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3728bc8..0b28538 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1247,12 +1247,17 @@ Return its two letter ISO 639 1 code." (mastodon-toot--update-status-fields)) (defun mastodon-toot--get-instance-max-attachments () - "Return the maximum attachments from `mastodon-active-user's instance." + "Return the maximum attachments from `mastodon-active-user's instance. +If that fails, return 4 as a fallback" ;; FIXME: this likely various for other server types: - (let ((config (alist-get 'statuses - (alist-get 'configuration - (mastodon-views--get-own-instance))))) - (alist-get 'max_media_attachments config))) + ;; pleroma doesn't advertise this on "api/v1/instance" (checked + ;; fe.disroot.org) + (or + (let ((config (alist-get 'statuses + (alist-get 'configuration + (mastodon-views--get-own-instance))))) + (alist-get 'max_media_attachments config)) + 4)) ; mastodon default as fallback (defun mastodon-toot--attach-media (file description) "Prompt for an attachment FILE with DESCRIPTION. @@ -1262,7 +1267,7 @@ File is actually attached to the toot upon posting." (interactive "fFilename: \nsDescription: ") (let ((max-attachments (mastodon-toot--get-instance-max-attachments))) (when (>= (length mastodon-toot--media-attachments) - (or max-attachments 4)) + max-attachments) ;; warn + pop the oldest one: (when (y-or-n-p (format "Maximum attachments (%s) reached: remove first one?" -- cgit v1.2.3 From 99c78081abce141e6eb950b5017f9da7a4ab60b6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 3 Aug 2024 10:19:30 +0200 Subject: toot: audit poll code --- lisp/mastodon-toot.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0b28538..521dbf8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1403,10 +1403,11 @@ MAX is the maximum number set by their instance." (defun mastodon-toot--read-poll-options (count length) "Read a list of options for poll with COUNT options. LENGTH is the maximum character length allowed for a poll option." - (let* ((choices (cl-loop for x from 1 to count - collect (read-string - (format "Poll option [%s/%s] [max %s chars]: " - x count length)))) + (let* ((choices + (cl-loop for x from 1 to count + collect (read-string + (format "Poll option [%s/%s] [max %s chars]: " + x count length)))) (longest (apply #'max (mapcar #'length choices)))) (if (> longest length) (progn @@ -1450,16 +1451,15 @@ Sets `mastodon-toot-poll' to nil." (defun mastodon-toot--server-poll-to-local (json) "Convert server poll data JSON to a `mastodon-toot-poll' plist." (let-alist json - (let* ((expiry-seconds-from-now + (let* ((expiry-seconds-rel (time-to-seconds (time-subtract (encode-time (parse-time-string .expires_at)) (current-time)))) - (expiry-str - (format-time-string "%s" - expiry-seconds-from-now)) - (expiry-human (car (mastodon-tl--human-duration expiry-seconds-from-now))) + (expiry-str (format-time-string "%s" expiry-seconds-rel)) + (expiry-human (car + (mastodon-tl--human-duration expiry-seconds-rel))) (options (mastodon-tl--map-alist 'title .options)) (multiple (if (eq :json-false .multiple) nil t))) (setq mastodon-toot-poll -- cgit v1.2.3 From 3c0099ff7da42b6a3ed2f1a9901a382e2f099abd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 3 Aug 2024 10:23:24 +0200 Subject: toot: audit schedule code --- lisp/mastodon-toot.el | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 521dbf8..3095bb1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1485,28 +1485,29 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (ts (when reschedule (alist-get 'scheduled_at (mastodon-tl--property 'scheduled-json :no-move)))) - (time-value (org-read-date t t nil "Schedule toot:" - ;; default to scheduled timestamp if already set: - (mastodon-toot--iso-to-org - ;; we are rescheduling without editing: - (or ts - ;; we are maybe editing the scheduled toot: - mastodon-toot--scheduled-for)))) + (time-value + (org-read-date t t nil "Schedule toot:" + ;; default to scheduled timestamp if already set: + (mastodon-toot--iso-to-org + ;; we are rescheduling without editing: + (or ts + ;; we are maybe editing the scheduled toot: + mastodon-toot--scheduled-for)))) (iso8601-str (format-time-string "%FT%T%z" time-value)) (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) (if (not reschedule) (progn (setq-local mastodon-toot--scheduled-for iso8601-str) - (message (format "Toot scheduled for %s." msg-str))) + (message "Toot scheduled for %s." msg-str)) (let* ((args `(("scheduled_at" . ,iso8601-str))) (url (mastodon-http--api (format "scheduled_statuses/%s" id))) (response (mastodon-http--put url args))) - (mastodon-http--triage response - (lambda (_) - ;; reschedule means we are in scheduled toots view: - (mastodon-views--view-scheduled-toots) - (message - (format "Toot rescheduled for %s." msg-str)))))))))) + (mastodon-http--triage + response + (lambda (_) + ;; reschedule means we are in scheduled toots view: + (mastodon-views--view-scheduled-toots) + (message "Toot rescheduled for %s." msg-str))))))))) (defun mastodon-toot--iso-to-human (ts) "Format an ISO8601 timestamp TS to be more human-readable." @@ -1516,8 +1517,9 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (defun mastodon-toot--iso-to-org (ts) "Convert ISO8601 timestamp TS to something `org-read-date' can handle." - (when ts (let* ((decoded (iso8601-parse ts))) - (encode-time decoded)))) + (when ts + (let* ((decoded (iso8601-parse ts))) + (encode-time decoded)))) ;;; DISPLAY KEYBINDINGS -- cgit v1.2.3 From b3a4709d5316d2c7322c49671a9f266db1708614 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 4 Aug 2024 09:36:45 +0200 Subject: toot: audit rest of file. --- lisp/mastodon-toot.el | 49 +++++++++++++++++++++++++------------------------ 1 file changed, 25 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3095bb1..f0895db 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1524,13 +1524,14 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;;; DISPLAY KEYBINDINGS -(defun mastodon-toot--get-mode-kbinds () +(defun mastodon-toot--get-kbinds () "Get a list of the keybindings in the `mastodon-toot-mode'." (let* ((binds (copy-tree mastodon-toot-mode-map)) (prefix (car (cadr binds))) - (bindings (remove nil (mapcar (lambda (i) - (when (listp i) i)) - (cadr binds))))) + (bindings (remove nil + (mapcar (lambda (i) + (when (listp i) i)) + (cadr binds))))) (mapcar (lambda (b) (setf (car b) (vector prefix (car b))) b) @@ -1585,7 +1586,7 @@ LONGEST is the length of the longest binding." (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest)) (reverse mastodon-toot--kbinds-pairs)) -(defun mastodon-toot--formatted-kbinds-longest (kbinds-list) +(defun mastodon-toot--kbinds-longest (kbinds-list) "Return the length of the longest item in KBINDS-LIST." (let ((lengths (mapcar #'length kbinds-list))) (car (sort lengths #'>)))) @@ -1594,19 +1595,20 @@ LONGEST is the length of the longest binding." ;;; DISPLAY DOCS (defun mastodon-toot--make-mode-docs () - "Create formatted documentation text for the `mastodon-toot-mode'." - (let* ((kbinds (mastodon-toot--get-mode-kbinds)) - (longest-kbind (mastodon-toot--formatted-kbinds-longest - (mastodon-toot--format-kbinds kbinds)))) + "Create formatted documentation text for `mastodon-toot-mode'." + (let* ((kbinds (mastodon-toot--get-kbinds)) + (formatted (mastodon-toot--format-kbinds kbinds)) + (longest-kbind (mastodon-toot--kbinds-longest + formatted))) (concat - (mastodon-toot--comment " Compose a new toot here. The following keybindings are available:") - (mapconcat #'identity - (mastodon-toot--formatted-kbinds-pairs - (mastodon-toot--format-kbinds kbinds) - longest-kbind) - nil)))) - -(defun mastodon-toot--format-reply-in-compose-string (reply-text) + (mastodon-toot--comment + " Compose a new toot here. The following keybindings are available:") + (mapconcat + #'identity + (mastodon-toot--formatted-kbinds-pairs formatted longest-kbind) + nil)))) + +(defun mastodon-toot--format-reply-in-compose (reply-text) "Format a REPLY-TEXT for display in compose buffer docs." (let* ((rendered (mastodon-tl--render-text reply-text)) (no-props (substring-no-properties rendered)) @@ -1662,7 +1664,7 @@ REPLY-TEXT is the text of the toot being replied to." "\n" (if reply-text (propertize - (mastodon-toot--format-reply-in-compose-string reply-text) + (mastodon-toot--format-reply-in-compose reply-text) 'toot-reply t) "") divider) @@ -1755,16 +1757,13 @@ REPLY-REGION is a string to be injected into the buffer." (mastodon-toot--apply-fields-props vis-region (format "%s" - (if (equal - mastodon-toot--visibility - "private") + (if (equal "private" mastodon-toot--visibility) "followers-only" mastodon-toot--visibility))) (mastodon-toot--apply-fields-props lang-region (if mastodon-toot--language - (format "Lang: %s ⋅" - mastodon-toot--language) + (format "Lang: %s ⋅" mastodon-toot--language) "")) (mastodon-toot--apply-fields-props sched-region @@ -1806,6 +1805,8 @@ REPLY-REGION is a string to be injected into the buffer." URLs always = 23, and domain names of handles are not counted. This is how mastodon does it. CW is the content warning, which contributes to the character count." + ;; FIXME: URL chars is avail at /api/v1/instance + ;; for masto, it's .statuses.characters_reserved_per_url (let* ((url-replacement (make-string 23 ?x)) (count-str (replace-regexp-in-string ; handle @handles mastodon-toot-handle-regex "\2" @@ -1854,7 +1855,7 @@ Added to `after-change-functions' in new toot buffers." "Prompt for a draft toot and delete it." (interactive) (if (not (multisession-value mastodon-toot-draft-toots-list)) - (message "No drafts to delete.") + (user-error "No drafts to delete") (let ((draft (completing-read "Select draft to delete: " (multisession-value mastodon-toot-draft-toots-list) -- cgit v1.2.3 From 88df0c117538024f4557e68b4c8d04a44a4b7c84 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 5 Aug 2024 09:59:16 +0200 Subject: commentary <> for url --- lisp/mastodon.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 82a2491..347e253 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -33,7 +33,7 @@ ;; API. See . ;; For set up and usage details, see the Info documentation, or the readme -;; file at https://codeberg.org/martianh/mastodon.el. +;; file at . ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon -- cgit v1.2.3 From d73dd4c48fc5c32aacdde06126c7c5e399856235 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 5 Aug 2024 10:37:22 +0200 Subject: audit notifications.el --- lisp/mastodon-notifications.el | 93 ++++++++++++++++-------------------------- 1 file changed, 35 insertions(+), 58 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 5806893..eca520b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -115,32 +115,31 @@ With no argument, the request is accepted. Argument REJECT means reject the request. Can be called in notifications view or in follow-requests view." (if (not (mastodon-tl--find-property-range 'item-json (point))) - (message "No follow request at point?") + (user-error "No follow request at point?") (let* ((item-json (mastodon-tl--property 'item-json)) (f-reqs-view-p (string= "follow_requests" (plist-get mastodon-tl--buffer-spec 'endpoint))) (f-req-p (or (string= "follow_request" (alist-get 'type item-json)) ;notifs f-reqs-view-p))) (if (not f-req-p) - (message "No follow request at point?") + (user-error "No follow request at point?") (let-alist (or (alist-get 'account item-json) ;notifs item-json) ;f-reqs - (if .id - (let ((response - (mastodon-http--post - (concat - (mastodon-http--api "follow_requests") - (format "/%s/%s" .id (if reject "reject" "authorize")))))) - (mastodon-http--triage response - (lambda (_) - (if f-reqs-view-p - (mastodon-views--view-follow-requests) - (mastodon-tl--reload-timeline-or-profile)) - (message "Follow request of %s (@%s) %s!" - .username .acct (if reject - "rejected" - "accepted"))))) - (message "No account result at point?"))))))) + (if (not .id) + (user-error "No account result at point?") + (let ((response + (mastodon-http--post + (mastodon-http--api + (format "follow_requests/%s/%s" + .id (if reject "reject" "authorize")))))) + (mastodon-http--triage + response + (lambda (_) + (if f-reqs-view-p + (mastodon-views--view-follow-requests) + (mastodon-tl--reload-timeline-or-profile)) + (message "Follow request of %s (@%s) %s!" + .username .acct (if reject "rejected" "accepted"))))))))))) (defun mastodon-notifications--follow-request-accept () "Accept a follow request. @@ -191,7 +190,6 @@ Status notifications are given when (defun mastodon-notifications--comment-note-text (str) "Add comment face to all text in STR with `shr-text' face only." (with-temp-buffer - (switch-to-buffer (current-buffer)) (insert str) (goto-char (point-min)) (let (prop) @@ -214,7 +212,7 @@ Status notifications are given when str)))) (status (mastodon-tl--field 'status note)) (follower (alist-get 'username (alist-get 'account note)))) - (mastodon-notifications--insert-status + (mastodon-tl--insert-status ;; toot (cond ((or (equal type 'follow) (equal type 'follow-request)) @@ -237,24 +235,22 @@ Status notifications are given when (mastodon-tl--content status)))))) (cond ((or (eq type 'follow) (eq type 'follow-request)) - (propertize - (if (equal type 'follow) - (propertize - "Congratulations, you have a new follower!" - 'face 'default) - (concat - (propertize - (format "You have a follow request from... %s" - follower) - 'face 'default) - (when mastodon-notifications--profile-note-in-foll-reqs - (concat - ":\n" - (mastodon-notifications--comment-note-text body))))))) + (if (equal type 'follow) + (propertize "Congratulations, you have a new follower!" + 'face 'default) + (concat + (propertize + (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)) + "")))) ((or (eq type 'favourite) (eq type 'boost)) - (mastodon-notifications--comment-note-text - body)) + (mastodon-notifications--comment-note-text body)) (t body))) ;; author-byline (if (or (equal type 'follow) @@ -288,28 +284,9 @@ Status notifications are given when (equal type 'boost)) status)))) -(defun mastodon-notifications--insert-status - (toot body author-byline action-byline id &optional base-toot) - "Display the content and byline of timeline element TOOT. -BODY will form the section of the toot above the byline. - -AUTHOR-BYLINE is an optional function for adding the author -portion of the byline that takes one variable. By default it is -`mastodon-tl--byline-author'. - -ACTION-BYLINE is also an optional function for adding an action, -such as boosting favouriting and following to the byline. It also -takes a single function. By default it is -`mastodon-tl--byline-boosted'. - -ID is the notification's own id, which is attached as a property. -If the status is a favourite or a boost, BASE-TOOT is the JSON -of the toot responded to." - (when toot ; handle rare blank notif server bug - (mastodon-tl--insert-status toot body author-byline action-byline id base-toot))) - (defun mastodon-notifications--by-type (note) - "Filters NOTE for those listed in `mastodon-notifications--types-alist'." + "Filter NOTE for those listed in `mastodon-notifications--types-alist'. +Call its function in that list on NOTE." (let* ((type (mastodon-tl--field 'type note)) (fun (cdr (assoc type mastodon-notifications--types-alist))) (start-pos (point))) @@ -321,7 +298,7 @@ of the toot responded to." (defun mastodon-notifications--timeline (json) "Format JSON in Emacs buffer." (if (seq-empty-p json) - (message "Looks like you have no (more) notifications for the moment.") + (user-error "Looks like you have no (more) notifications for now") (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -- cgit v1.2.3 From 649887d61818bf6acc19a1b426dcd915f53dbcdd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 5 Aug 2024 20:01:09 +0200 Subject: http: move concat params to url --- lisp/mastodon-http.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d6abac4..51b144e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -137,6 +137,13 @@ Used for API form data parameters that take an array." (cl-loop for x in array collect (cons param-str x))) +(defun mastodon-http--concat-params-to-url (url params) + "Build a query string with PARAMS and concat to URL." + (if params + (concat url "?" + (mastodon-http--build-params-string params)) + url)) + (defun mastodon-http--post (url &optional params headers unauthenticated-p json) "POST synchronously to URL, optionally with PARAMS and HEADERS. @@ -165,13 +172,6 @@ the request data. If it is :raw, just use the plain params." (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) -(defun mastodon-http--concat-params-to-url (url params) - "Build a query string with PARAMS and concat to URL." - (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url)) - (defun mastodon-http--get (url &optional params silent) "Make synchronous GET request to URL. PARAMS is an alist of any extra parameters to send with the request. -- cgit v1.2.3 From c2b0e8ff1d07d3f50778ddc5bcd997ee70ab8f37 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 5 Aug 2024 21:32:37 +0200 Subject: audit profile.el up to remove-note-header --- lisp/mastodon-profile.el | 58 ++++++++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index de16b7d..81c51b2 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -242,11 +242,10 @@ MAX-ID is a flag to include the max_id pagination parameter." (defun mastodon-profile--add-account-to-list () "Add account of current profile buffer to a list." (interactive) - (when mastodon-profile--account - (let* ((profile mastodon-profile--account) - (id (alist-get 'id profile)) - (handle (alist-get 'acct profile))) - (mastodon-views--add-account-to-list nil id handle)))) + (if (not mastodon-profile--account) + (user-error "No profile to add?") + (let-alist mastodon-profile--account + (mastodon-views--add-account-to-list nil .id .acct)))) (defun mastodon-profile--account-search (query) "Run a statuses search QUERY for the currently viewed account." @@ -258,43 +257,50 @@ MAX-ID is a flag to include the max_id pagination parameter." ;;; ACCOUNT PREFERENCES -(defun mastodon-profile--get-json-value (val) - "Fetch current VAL ue from account." - (let* ((response (mastodon-return-credential-account))) - (if (eq (alist-get val response) :json-false) - nil - (alist-get val response)))) +(defun mastodon-profile--get-account-value (key function) + "Fetch KEY from data returned by FUNCTION. +If value is :json-false, return nil." + (let* ((response (funcall function)) + (value (alist-get key response))) + (if (eq value :json-false) nil value))) + +(defun mastodon-profile--get-json-value (key) + "Fetch value for KEY from account. +Account details are from `mastodon-return-credential-account'. +If value is :json-false, return nil." + (mastodon-profile--get-account-value + key #'mastodon-return-credential-account)) (defun mastodon-profile--get-source-values () "Return the \"source\" preferences from the server." (mastodon-profile--get-json-value 'source)) (defun mastodon-profile--get-source-value (pref) - "Return account PREF erence from the \"source\" section on the server." - (let ((source (mastodon-profile--get-source-values))) - (if (eq (alist-get pref source) :json-false) - nil - (alist-get pref source)))) + "Return PREF erence from the account's \"source\" field." + (mastodon-profile--get-account-value + pref #'mastodon-profile--get-source-values)) (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." (interactive) - (let* ((json (mastodon-return-credential-account)) - (source (alist-get 'source json)) + (let* ((source (mastodon-profile--get-source-values)) (note (alist-get 'note source)) (buffer (get-buffer-create "*mastodon-update-profile*")) (inhibit-read-only t) - (msg-str (substitute-command-keys - "Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel."))) + (msg-str + (substitute-command-keys + "Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel."))) (switch-to-buffer-other-window buffer) (text-mode) - (mastodon-tl--set-buffer-spec (buffer-name buffer) "accounts/verify_credentials" nil) + (mastodon-tl--set-buffer-spec (buffer-name buffer) + "accounts/verify_credentials" nil) (setq-local header-line-format msg-str) (mastodon-profile-update-mode t) - (insert (propertize (concat (propertize "0" - 'note-counter t - 'display nil) - "/500 characters") + (insert (propertize (concat + (propertize "0" + 'note-counter t + 'display nil) + "/500 characters") 'read-only t 'face 'font-lock-comment-face 'note-header t) @@ -327,7 +333,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (mastodon-kill-window))) (defun mastodon-profile--note-remove-header () - "Get the body of a toot from the current compose buffer." + "Get the profile note, without the buffer header." (let ((header-region (mastodon-tl--find-property-range 'note-header (point-min)))) (buffer-substring (cdr header-region) (point-max)))) -- cgit v1.2.3 From 2b8bf77ee00c25885cdc6ebed3ea3b0897dd245f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 10:17:22 +0200 Subject: audit profile.el --- lisp/mastodon-profile.el | 155 ++++++++++++++++++++++++----------------------- 1 file changed, 80 insertions(+), 75 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 81c51b2..9461f02 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -82,6 +82,7 @@ (autoload 'mastodon-return-credential-account "mastodon") (autoload 'mastodon-tl--buffer-property "mastodon-tl") (autoload 'mastodon-search--query "mastodon-search") +(autoload 'mastodon-tl--field-status "mastodon-tl") (defvar mastodon-tl--horiz-bar) (defvar mastodon-tl--update-point) @@ -157,6 +158,8 @@ MAX-ID is a flag to include the max_id pagination parameter." account "statuses" #'mastodon-tl--timeline no-reblogs nil no-replies only-media tag max-id)) +;;; PROFILE VIEW COMMANDS + ;; TODO: we shd just load all views' data then switch coz this is slow af: (defun mastodon-profile--account-view-cycle () "Cycle through profile view: toots, toot sans boosts, followers, and following." @@ -461,9 +464,11 @@ Current settings are fetched from the server." (defun mastodon-profile--make-meta-fields-params (fields) "Construct a parameter query string from metadata alist FIELDS. Returns an alist." - (let ((keys (cl-loop for count from 1 to 5 - collect (cons (format "fields_attributes[%s][name]" count) - (format "fields_attributes[%s][value]" count))))) + (let ((keys + (cl-loop + for count from 1 to 5 + collect (cons (format "fields_attributes[%s][name]" count) + (format "fields_attributes[%s][value]" count))))) (cl-loop for a-pair in keys for b-pair in fields append (list (cons (car a-pair) (car b-pair)) @@ -486,8 +491,7 @@ Returns an alist." "Prompt for new metadata fields information. Returns the results as an alist." (let ((fields-old (mastodon-profile--fields-get - nil - ;; we must fetch the plaintext version: + nil ;; we must fetch the plaintext version: (mastodon-profile--get-source-value 'fields)))) ;; offer empty fields if user currently has less than four filled: (while (< (length fields-old) 4) @@ -530,12 +534,11 @@ The endpoint only holds a few preferences. For others, see (buf (get-buffer-create "*mastodon-preferences*"))) (with-mastodon-buffer buf #'special-mode :other-window (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil) - (while response - (let ((el (pop response))) - (insert (format "%-30s %s" - (prin1-to-string (car el)) - (prin1-to-string (cdr el))) - "\n\n"))) + (while-let ((el (pop response))) + (insert (format "%-30s %s" + (prin1-to-string (car el)) + (prin1-to-string (cdr el))) + "\n\n")) (goto-char (point-min))))) @@ -543,10 +546,10 @@ The endpoint only holds a few preferences. For others, see (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." - (let* ((their-id id) - (args `(("id[]" . ,their-id))) + (let* ((args `(("id[]" . ,id))) (url (mastodon-http--api "accounts/relationships"))) - (car (mastodon-http--get-json url args)))) ; API takes array, just get 1st + ;; FIXME: API takes array, we just get 1st + (car (mastodon-http--get-json url args)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -598,9 +601,8 @@ FIELDS means provide a fields vector fetched by other means." "Return a propertized string of badges for ROLES." (mapconcat (lambda (role) - (propertize - (alist-get 'name role) - 'face `(:box t :foreground ,(alist-get 'color role)))) + (propertize (alist-get 'name role) + 'face `(:box t :foreground ,(alist-get 'color role)))) roles)) (defun mastodon-profile--make-profile-buffer-for @@ -617,8 +619,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (let* ((max-id-str (when max-id (mastodon-tl--buffer-property 'max-id))) (args `(("limit" . ,mastodon-tl--timeline-posts-count) - ,(when max-id - `("max_id" . ,max-id-str)))) + ,(when max-id `("max_id" . ,max-id-str)))) (args (cond (no-reblogs (push '("exclude_reblogs" . "t") args)) (no-replies @@ -627,8 +628,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (push '("only_media" . "t") args)) (tag (push `("tagged" . ,tag) args)) - (t - args))) + (t args))) (endpoint (format "accounts/%s/%s" .id endpoint-type)) (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" .acct "-" @@ -655,22 +655,20 @@ MAX-ID is a flag to include the max_id pagination parameter." (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header args nil max-id-str) (let* ((inhibit-read-only t) - (is-statuses (string= endpoint-type "statuses")) - (is-followers (string= endpoint-type "followers")) - (is-following (string= endpoint-type "following")) - (endpoint-name (cond - (is-statuses (cond (no-reblogs - " TOOTS (no boosts)") - (no-replies - " TOOTS (no replies)") - (only-media - " TOOTS (media only)") - (tag - (format " TOOTS (containing #%s)" tag)) - (t - " TOOTS "))) - (is-followers " FOLLOWERS ") - (is-following " FOLLOWING ")))) + (endpoint-name + (cond ((string= endpoint-type "statuses") + (cond (no-reblogs + " TOOTS (no boosts)") + (no-replies + " TOOTS (no replies)") + (only-media + " TOOTS (media only)") + (tag + (format " TOOTS (containing #%s)" tag)) + (t + " TOOTS "))) + ((string= endpoint-type "followers") " FOLLOWERS ") + ((string= endpoint-type "following") " FOLLOWING ")))) (insert (propertize (concat @@ -685,7 +683,7 @@ MAX-ID is a flag to include the max_id pagination parameter." (mastodon-profile--render-roles .roles))) "\n" (propertize (concat "@" .acct) 'face 'default) - (if (equal .locked t) + (if (eq .locked t) (concat " " (mastodon-tl--symbol 'locked)) "") "\n " mastodon-tl--horiz-bar "\n" @@ -719,18 +717,16 @@ MAX-ID is a flag to include the max_id pagination parameter." (rels (mastodon-profile--relationships-get .id)) (langs-filtered (if-let ((langs (alist-get 'languages rels))) (concat " (" - (mapconcat #'identity - langs - " ") + (mapconcat #'identity langs " ") ")") ""))) (if followsp (mastodon-tl--set-face - (concat (when (equal .following 't) + (concat (when (eq .following t) (format " | FOLLOWED BY YOU%s" langs-filtered)) - (when (equal .followed_by 't) + (when (eq .followed_by t) " | FOLLOWS YOU") - (when (equal .requested_by 't) + (when (eq .requested_by t) " | REQUESTED TO FOLLOW YOU") "\n\n") 'success) @@ -784,7 +780,7 @@ IMG-TYPE is the JSON key from the account data." (list (if (and (not (mastodon-tl--profile-buffer-p)) (not (mastodon-tl--property 'item-json :no-move))) - (message "Looks like there's no toot or user at point?") + (user-error "Looks like there's no toot or user at point?") (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--item-json)))) (completing-read "View profile of user [choose or enter any handle]: " @@ -795,14 +791,14 @@ IMG-TYPE is the JSON key from the account data." (equal user-handle (mastodon-auth--get-account-name)) (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'item-json :no-move))) - (message "Looks like there's no toot or user at point?") + (user-error "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--item-json)))) - (if account - (progn - (message "Loading profile of user %s..." user-handle) - (mastodon-profile--make-author-buffer account)) - (message "Cannot find a user with handle %S" user-handle))))) + (if (not account) + (user-error "Cannot find a user with handle %S" user-handle) + (progn + (message "Loading profile of user %s..." user-handle) + (mastodon-profile--make-author-buffer account)))))) (defun mastodon-profile--my-profile () "Show the profile of the currently signed in user." @@ -821,13 +817,14 @@ Used to view a user's followers and those they're following." (mapc (lambda (toot) (let ((start-pos (point))) - (insert "\n" - (propertize - (mastodon-tl--byline-author `((account . ,toot)) :avatar) - 'byline 't - 'item-id (alist-get 'id toot) - 'base-item-id (mastodon-tl--item-id toot) - 'item-json toot)) + (insert + "\n" + (propertize + (mastodon-tl--byline-author `((account . ,toot)) :avatar) + 'byline 't + 'item-id (alist-get 'id toot) + 'base-item-id (mastodon-tl--item-id toot) + 'item-json toot)) (mastodon-media--inline-images start-pos (point)) (insert "\n" (propertize @@ -847,9 +844,9 @@ If the handle does not match a search return then retun NIL." (result (mastodon-http--get-json (mastodon-http--api-search) args)) (matching-account (seq-remove (lambda (x) - (not (string= (alist-get 'acct x) handle))) + (not (string= handle (alist-get 'acct x)))) (alist-get 'accounts result)))) - (when (equal 1 (length matching-account)) + (when (eq 1 (length matching-account)) (elt matching-account 0)))) (defun mastodon-profile--account-from-id (user-id) @@ -863,10 +860,8 @@ These include the author, author of reblogged entries and any user mentioned." (when status (let ((this-account (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) - (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) - (alist-get 'reblog status)))) + (mentions (mastodon-tl--field-status 'mentions status)) + (reblog (mastodon-tl--field-status 'reblog status))) (seq-filter #'stringp (seq-uniq (seq-concatenate @@ -893,16 +888,17 @@ These include the author, author of reblogged entries and any user mentioned." (t (mastodon-profile--search-account-by-handle handle))))) +;;; REMOVE + (defun mastodon-profile--remove-user-from-followers (&optional id) "Remove a user from your followers. Optionally provide the ID of the account to remove." (interactive) (let* ((account (unless id (mastodon-tl--property 'item-json :no-move))) (id (or id (alist-get 'id account))) - (handle (if account - (alist-get 'acct account) - (let ((account (mastodon-profile--account-from-id id))) - (alist-get 'acct account)))) + (handle (let ((account (or account + (mastodon-profile--account-from-id id)))) + (alist-get 'acct account))) (url (mastodon-http--api (format "accounts/%s/remove_from_followers" id)))) (when (y-or-n-p (format "Remove follower %s? " handle)) @@ -916,7 +912,7 @@ Optionally provide the ID of the account to remove." (interactive) (let* ((handles (mastodon-profile--extract-users-handles (mastodon-profile--item-json))) - (handle (completing-read "Remove from followers: " handles nil)) + (handle (completing-read "Remove from followers: " handles)) (account (mastodon-profile--lookup-account-in-status handle (mastodon-profile--item-json))) (id (alist-get 'id account))) @@ -936,6 +932,8 @@ Currently limited to 100 handles. If not found, try (id (alist-get choice handles))) (mastodon-profile--remove-user-from-followers id))) +;;; PRIVATE NOTES + (defun mastodon-profile--add-private-note-to-account () "Add a private note to an account. Can be called from a profile page or normal timeline. @@ -948,8 +946,9 @@ Send an empty note to clear an existing one." (defun mastodon-profile--post-private-note-to-account (id handle note-old) "POST a private note onto an account ID with user HANDLE on the server. NOTE-OLD is the text of any existing note." - (let* ((note (read-string (format "Add private note to account %s: " handle) - note-old)) + (let* ((note (read-string + (format "Add private note to account %s: " handle) + note-old)) (params `(("comment" . ,note))) (url (mastodon-http--api (format "accounts/%s/note" id))) (response (mastodon-http--post url params))) @@ -973,13 +972,15 @@ NOTE-OLD is the text of any existing note." (defun mastodon-profile--profile-json () "Return the profile-json property if we are in a profile buffer." - (when (mastodon-tl--profile-buffer-p) + (if (not (mastodon-tl--profile-buffer-p)) + (error "Not viewing a profile") (save-excursion (goto-char (point-min)) (or (mastodon-tl--property 'profile-json :no-move) (error "No profile data found"))))) -(defun mastodon-profile--add-or-view-private-note (action-fun &optional message view) +(defun mastodon-profile--add-or-view-private-note (action-fun + &optional message view) "Add or view a private note for an account. ACTION-FUN does the adding or viewing, MESSAGE is a prompt for `mastodon-tl--user-handles-get', VIEW is a flag." @@ -995,10 +996,14 @@ ACTION-FUN does the adding or viewing, MESSAGE is a prompt for (note (alist-get 'note relationships))) (if view (if (string-empty-p note) - (message "No private note for %s" handle) + (user-error "No private note for %s" handle) + ;; `mastodon-profile--display-private-note' takes 1 arg: (funcall action-fun note)) + ;; `mastodon-profile--post-private-note-to-account' takes 3 args: (funcall action-fun id handle note)))) +;;; FAMILIAR FOLLOWERS + (defun mastodon-profile--show-familiar-followers () "Show a list of familiar followers. Familiar followers are accounts that you follow, and that follow @@ -1024,7 +1029,7 @@ the given account." (accounts (alist-get 'accounts (car json))) ; first id (handles (mastodon-tl--map-alist 'acct accounts))) (if (null handles) - (message "Looks like there are no familiar followers for this account") + (user-error "Looks like there are no familiar followers for this account") (let ((choice (completing-read "Show profile of user: " handles))) (mastodon-profile--show-user choice))))) -- 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') 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 7043349b2a5bbb621712fe596086f3d82b65a580 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 10:18:12 +0200 Subject: views add account to list: unless handle clauses to prevent unneeded requests --- lisp/mastodon-views.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index e956ccd..5ec2642 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -393,8 +393,11 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (completing-read list-prompt (mastodon-views--get-lists-names) nil t))) (list-id (or id (mastodon-views--get-list-id list-name))) - (followings (mastodon-views--get-users-followings)) - (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id followings)) + (followings (unless handle + (mastodon-views--get-users-followings))) + (handles (unless handle + (mastodon-tl--map-alist-vals-to-alist + 'acct 'id followings))) (account (or handle (completing-read "Account to add: " handles nil t))) (account-id (or account-id (alist-get account handles))) -- cgit v1.2.3 From 6b70ee39efcb958c3bc300498a009b04bee06e84 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 11:08:20 +0200 Subject: audit views.el --- lisp/mastodon-views.el | 46 +++++++++++++++++----------------------------- 1 file changed, 17 insertions(+), 29 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 5ec2642..4b29115 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -75,7 +75,7 @@ ;; switch to timlines without closing the minor view. ;; copying the mode map however means we need to avoid/unbind/override any -;; functions that might cause interfere with the minor view. +;; functions that might interfere with the minor view. ;; this is not redundant, as while the buffer -init function calls ;; `mastodon-mode', it gets overridden in some but not all cases. @@ -121,6 +121,7 @@ (define-key map (kbd "a") #'mastodon-views--add-account-to-list-at-point) (define-key map (kbd "r") #'mastodon-views--remove-account-from-list-at-point) (define-key map (kbd "e") #'mastodon-views--edit-list-at-point) + (define-key map (kbd "g") #'mastodon-views--view-lists) map) "Keymap for when point is on list name.") @@ -131,6 +132,7 @@ (define-key map (kbd "c") #'mastodon-views--cancel-scheduled-toot) (define-key map (kbd "e") #'mastodon-views--edit-scheduled-as-new) (define-key map (kbd "RET") #'mastodon-views--edit-scheduled-as-new) + (define-key map (kbd "g") #'mastodon-views--view-scheduled-toots) map) "Keymap for when point is on a scheduled toot.") @@ -158,15 +160,9 @@ request. This function is used as the update-function to `mastodon-tl--init-sync', which initializes a buffer for us and provides the JSON data." - ;; FIXME: this is not an update function as it inserts a heading and - ;; possible bindings string - ;; either it should go in init-sync, or possibly in each view function - ;; but either way, this function does almost nothing for us. - ;; could we call init-sync in here pehaps? - ;; (mastodon-search--insert-heading view-name) - ;; (when bindings-string - ;; (insert (mastodon-tl--set-face (concat "[" bindings-string "]\n\n") - ;; 'font-lock-comment-face))) + ;; FIXME not tecnically an update-fun for init-sync, but just a simple way + ;; to set up the empty buffer or else call the insert-fun. not sure if we cd + ;; improve by eg calling init-sync in here, making this a real view function. (if (seq-empty-p data) (insert (propertize (format "Looks like you have no %s for now." view-name) @@ -326,8 +322,7 @@ If ID is provided, use that list." (name (mastodon-views--get-list-name id)) (buffer-name (format "list-%s" name))) (mastodon-tl--init buffer-name endpoint - 'mastodon-tl--timeline - nil + 'mastodon-tl--timeline nil `(("limit" . ,mastodon-tl--timeline-posts-count))))) (defun mastodon-views--create-list () @@ -432,8 +427,7 @@ If ID is provided, use that list." (list-id (or id (mastodon-views--get-list-id list-name))) (accounts (mastodon-views--accounts-in-list list-id)) (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts)) - (account (completing-read "Account to remove: " - handles nil t)) + (account (completing-read "Account to remove: " handles nil t)) (account-id (alist-get account handles)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) @@ -537,7 +531,7 @@ If ID, just return that toot." (interactive) (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) - (message "no scheduled toot at point?") + (user-error "no scheduled toot at point?") (mastodon-toot--schedule-toot :reschedule)))) (defun mastodon-views--copy-scheduled-toot-text () @@ -555,7 +549,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (interactive) (let ((id (or id (mastodon-tl--property 'id :no-move)))) (if (null id) - (message "no scheduled toot at point?") + (user-error "no scheduled toot at point?") (when (or no-confirm (y-or-n-p "Cancel scheduled toot?")) (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) @@ -571,7 +565,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (interactive) (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) - (message "no scheduled toot at point?") + (user-error "no scheduled toot at point?") (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) (scheduled (alist-get 'scheduled_at toot))) (let-alist (alist-get 'params toot) @@ -646,9 +640,8 @@ Prompt for a context, must be a list containting at least one of \"home\", (contexts-processed (if (equal nil contexts) (user-error "You must select at least one context for a filter") - (mapcar (lambda (x) - (cons "context[]" x)) - contexts))) + (cl-loop for c in contexts + collect (cons "context[]" c)))) (response (mastodon-http--post url (push `("phrase" . ,word) contexts-processed)))) @@ -726,8 +719,7 @@ BRIEF means show fewer details." "Return an instance base url from a user account URL. USERNAME is the name to cull. If INSTANCE is given, use that." - (cond (instance - (concat "https://" instance)) + (cond (instance (concat "https://" instance)) ;; pleroma URL is https://instance.com/users/username ((string-suffix-p "users/" (url-basepath url)) (string-remove-suffix "/users/" @@ -758,13 +750,9 @@ MISSKEY means the instance is a Misskey or derived server." (let ((response (mastodon-views--get-own-instance))) (mastodon-views--instance-response-fun response brief instance)) (mastodon-tl--do-if-item - (let* ((toot (if (mastodon-tl--profile-buffer-p) - ;; we may be on profile description itself: - (or (mastodon-tl--property 'profile-json) - ;; or on profile account listings, or just toots: - (mastodon-tl--property 'item-json)) - ;; normal timeline/account listing: - (mastodon-tl--property 'item-json))) + (let* ((toot (or (and (mastodon-tl--profile-buffer-p) + (mastodon-tl--property 'profile-json)) ; either profile + (mastodon-tl--property 'item-json)) ; or toot or user listing (reblog (alist-get 'reblog toot)) (account (or (alist-get 'account reblog) (alist-get 'account toot) -- cgit v1.2.3 From 299b72043a61d6e500d04c45221fd21adb94eef8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 12:38:01 +0200 Subject: refactor mastodon-profile--user-profile-send-updated --- lisp/mastodon-profile.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 9461f02..8249641 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -347,10 +347,8 @@ Ask for confirmation if length > 500 characters." (interactive) (let* ((note (mastodon-profile--note-remove-header)) (url (mastodon-http--api "accounts/update_credentials"))) - (if (> (mastodon-toot--count-toot-chars note) 500) - (when (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?") - (quit-window 'kill) - (mastodon-profile--user-profile-send-updated-do url note)) + (when (or (not (> (mastodon-toot--count-toot-chars note) 500)) + (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?")) (quit-window 'kill) (mastodon-profile--user-profile-send-updated-do url note)))) -- cgit v1.2.3 From 486d71724752537f89e6e598231a863012c73c4e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 12:50:10 +0200 Subject: mastodon.el: re-write mastodon-return-credential-account --- lisp/mastodon.el | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 347e253..23168b2 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -309,30 +309,25 @@ See `mastodon-toot-display-orig-in-reply-buffer'.") (defvar mastodon-profile-credential-account nil) ;; TODO: the get request in mastodon-http--get-response often returns nil -;; after waking pc from sleep, not sure how to fix, or if just my pc +;; after waking from sleep, not sure how to fix, or if just my pc. ;; interestingly it only happens with this function tho. -;;we have to use :force to update the credential-account object in case things -;; have been changed via another client. (defun mastodon-return-credential-account (&optional force) "Return the CredentialAccount entity. Either from `mastodon-profile-credential-account' or from the -server. -FORCE means to fetch from the server and update +server if that var is nil. +FORCE means to fetch from the server in any case and update `mastodon-profile-credential-account'." - (let ((req '(mastodon-http--get-json - (mastodon-http--api "accounts/verify_credentials") - nil :silent))) - (if force - (setq mastodon-profile-credential-account - ;; TODO: we should also signal a quit condition after like 5 - ;; secs here - (condition-case nil - (eval req) - (t ; req fails, return old value - mastodon-profile-credential-account))) - (or mastodon-profile-credential-account - (setq mastodon-profile-credential-account - (eval req)))))) + (if (or force (not mastodon-profile-credential-account)) + (setq mastodon-profile-credential-account + ;; TODO: we should signal a quit condition after 5 secs here + (condition-case nil + (mastodon-http--get-json + (mastodon-http--api "accounts/verify_credentials") + nil :silent) + (t ; req fails, return old value + mastodon-profile-credential-account))) + ;; else just return the var: + mastodon-profile-credential-account)) ;;;###autoload (defun mastodon-toot (&optional user reply-to-id reply-json) -- cgit v1.2.3 From f832ad6a57406a44dc11a683bcf9369a0587cb4a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 13:04:54 +0200 Subject: re-write mastodon-switch-to-buffer --- lisp/mastodon.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 23168b2..7ac980c 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -454,12 +454,10 @@ Calls `mastodon-tl--get-buffer-type', which see." (defun mastodon-switch-to-buffer () "Switch to a live mastodon buffer." (interactive) - (let ((choice (read-buffer - "Switch to mastodon buffer: " nil t - (lambda (cand) - (with-current-buffer - (if (stringp cand) cand (car cand)) - (mastodon-tl--get-buffer-type)))))) + (let ((choice (completing-read + "Switch to mastodon buffer: " + (mapcar #'buffer-name (mastodon-live-buffers)) + nil :match))) (switch-to-buffer choice))) (defun mastodon--url-at-point () -- cgit v1.2.3 From efd5b6c82c109e2bc10bb15d0ffc9952bb4e5437 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 13:05:23 +0200 Subject: mastodon (function): only return cred acc if loading new tl if we find an existing buffer, just pop to it without getting cred acc. if user already running mastodon.el, no need to update cred acc. --- lisp/mastodon.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 7ac980c..8a4fc07 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -298,9 +298,11 @@ See `mastodon-toot-display-orig-in-reply-buffer'.") (string-prefix-p "*mastodon-" (buffer-name x)) (get-buffer x))) (buffer-list))))) ; catch any other masto buffer - (mastodon-return-credential-account :force) (if buffer (pop-to-buffer buffer '(display-buffer-same-window)) + ;; we need to update credential-account in case setting have been changed + ;; outside mastodon.el in the meantime: + (mastodon-return-credential-account :force) (mastodon-tl--get-home-timeline) (message "Loading fediverse account %s on %s..." (mastodon-auth--user-acct) -- cgit v1.2.3 From 88c39b1fdda40596c72dfeefc6c8db5103bc015e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 13:06:45 +0200 Subject: audit mastodon.el --- lisp/mastodon.el | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 8a4fc07..e027ad3 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -282,7 +282,9 @@ See `mastodon-toot-display-orig-in-reply-buffer'.") ;;;###autoload (defun mastodon () - "Connect client to `mastodon-instance-url' instance." + "Connect client to `mastodon-instance-url' instance. +If there are any open mastodon.el buffers, switch to one instead. +Prority in switching is given to timeline views." (interactive) (let* ((tls (list "home" "local" @@ -294,8 +296,8 @@ See `mastodon-toot-display-orig-in-reply-buffer'.") (get-buffer (concat "*mastodon-" el "*"))) tls) ; return first buff that exists (cl-some (lambda (x) - (when - (string-prefix-p "*mastodon-" (buffer-name x)) + (when (string-prefix-p "*mastodon-" + (buffer-name x)) (get-buffer x))) (buffer-list))))) ; catch any other masto buffer (if buffer @@ -348,20 +350,19 @@ BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. FORCE means do not try to update an existing buffer, but fetch from the server and load anew." (interactive) - (let ((buffer (if buffer-name - (concat "*mastodon-" buffer-name "*") - "*mastodon-notifications*"))) - (if (and (not force) - (get-buffer buffer)) + (let ((buffer-name (or buffer-name "notifications")) + (buffer (concat "*mastodon-" buffer-name "*"))) + (if (and (not force) (get-buffer buffer)) (progn (pop-to-buffer buffer '(display-buffer-same-window)) (mastodon-tl--update)) (message "Loading your notifications...") - (mastodon-tl--init-sync (or buffer-name "notifications") - "notifications" - 'mastodon-notifications--timeline - type - (when max-id - `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))) + (mastodon-tl--init-sync + buffer-name + "notifications" + 'mastodon-notifications--timeline + type + (when max-id + `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))) (with-current-buffer buffer (use-local-map mastodon-notifications--map))))) @@ -369,8 +370,8 @@ from the server and load anew." ;;;###autoload (defun mastodon-url-lookup (&optional query-url force) - "If a URL resembles a mastodon link, try to load in `mastodon.el'. -Does a WebFinger lookup. + "If a URL resembles a fediverse link, try to load in `mastodon.el'. +Does a WebFinger lookup on the server. URL can be arg QUERY-URL, or URL at point, or provided by the user. If a status or account is found, load it in `mastodon.el', if not, just browse the URL in the normal fashion." @@ -382,24 +383,24 @@ not, just browse the URL in the normal fashion." (if (and (not force) (not (mastodon--fedi-url-p query))) ;; (shr-browse-url query) ; doesn't work (keep our shr keymap) - (browse-url query) + (progn (message "Using external browser") + (browse-url query)) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) (params `(("q" . ,query) ("resolve" . "t"))) ; webfinger (response (mastodon-http--get-json url params :silent))) - (cond ((not (seq-empty-p - (alist-get 'statuses response))) + (cond ((not (seq-empty-p (alist-get 'statuses response))) (let* ((statuses (assoc 'statuses response)) (status (seq-first (cdr statuses))) (status-id (alist-get 'id status))) (mastodon-tl--thread status-id))) - ((not (seq-empty-p - (alist-get 'accounts response))) + ((not (seq-empty-p (alist-get 'accounts response))) (let* ((accounts (assoc 'accounts response)) (account (seq-first (cdr accounts)))) (mastodon-profile--make-author-buffer account))) (t + (message "Lookup failed. Using external browser") (browse-url query))))))) (defun mastodon-url-lookup-force () -- cgit v1.2.3 From eca58804642fbb2f4a90a190610da641e0ef4915 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 14:44:46 +0200 Subject: search.el: re-write search-accounts-query --- lisp/mastodon-search.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index f862f3c..7ebd88e 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -64,11 +64,13 @@ Returns a nested list containing user handle, display name, and URL." (let* ((url (mastodon-http--api "accounts/search")) (response - (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-json - url `(("q" . ,query) ("following" . "true")) - :silent) - (mastodon-http--get-json url `(("q" . ,query)) :silent)))) + (mastodon-http--get-json + url + `(("q" . ,query) ;; NB: nil can break params (but works for me) + ,(when (equal "following" + mastodon-toot--completion-style-for-mentions) + '("following" . "true"))) + :silent))) (mapcar #'mastodon-search--get-user-info-@ response))) ;; functions for tags completion: -- cgit v1.2.3 From 20d0f4ae848a2b8bc3bf8a63c409871d0e7991ff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 6 Aug 2024 14:45:15 +0200 Subject: audit 1/2 of search.el --- lisp/mastodon-search.el | 35 +++++++++++------------------------ 1 file changed, 11 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 7ebd88e..00681c6 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -102,8 +102,7 @@ QUERY is the string to search." "Display a list of tags trending on your instance. 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))) + (let* ((url (mastodon-http--api (format "trends/%s" type))) ;; max for statuses = 40, for others = 20 (limit (if (equal type "statuses") '("limit" . "40") @@ -115,8 +114,7 @@ PRINT-FUN is the function used to print the data from the response." (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec (buffer-name buffer) (format "trends/%s" type) - print-fun nil - params) + print-fun nil params) (mastodon-search--insert-heading "trending" type) (funcall print-fun data) (unless (equal type "statuses") @@ -143,9 +141,8 @@ Optionally add string TYPE after HEADING." (defvar mastodon-search-types '("statuses" "accounts" "hashtags")) -(defun mastodon-search--query (query - &optional type limit - following account-id offset) +(defun mastodon-search--query (query &optional type limit + following account-id offset) "Prompt for a search QUERY and return accounts, statuses, and hashtags. TYPE is a member of `mastodon-search-types'. LIMIT is a number as string, up to 40, with 40 the default. @@ -157,15 +154,13 @@ is used for pagination." ;; TODO: handle no results (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api-search)) - (following (when (or following - (equal current-prefix-arg '(4))) + (following (when (or following (equal current-prefix-arg '(4))) "true")) (type (or type (if (equal current-prefix-arg '(4)) "accounts" ; if FOLLOWING, must be "accounts" (completing-read "Search type: " - mastodon-search-types - nil t)))) + mastodon-search-types nil :match)))) (limit (or limit "40")) (offset (or offset "0")) (buffer (format "*mastodon-search-%s-%s*" type query)) @@ -177,26 +172,20 @@ is used for pagination." ,(when following `("following" . ,following)) ,(when account-id `("account_id" . ,account-id))))) (response (mastodon-http--get-json url params)) - (accts (when (equal type "accounts") - (alist-get 'accounts response))) - (tags (when (equal type "hashtags") - (alist-get 'hashtags response))) - (statuses (when (equal type "statuses") - (alist-get 'statuses response)))) + (items (alist-get (intern type) response))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-search-mode) (mastodon-search--insert-heading type) - ;; user results: (cond ((equal type "accounts") - (mastodon-search--render-response accts type buffer params + (mastodon-search--render-response items type buffer params 'mastodon-views--insert-users-propertized-note 'mastodon-views--insert-users-propertized-note)) ((equal type "hashtags") - (mastodon-search--render-response tags type buffer params + (mastodon-search--render-response items type buffer params 'mastodon-search--print-tags 'mastodon-search--print-tags)) ((equal type "statuses") - (mastodon-search--render-response statuses type buffer params + (mastodon-search--render-response items type buffer params #'mastodon-tl--timeline #'mastodon-tl--timeline))) (goto-char (point-min)) @@ -218,10 +207,8 @@ BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'." (if (not data) (mastodon-search-insert-no-results type) (funcall insert-fun data)) - ;; (mapc #'mastodon-tl--toot data)) (mastodon-tl--set-buffer-spec buffer "search" - update-fun - nil params)) + update-fun nil params)) (defun mastodon-search--buf-type () "Return search buffer type, a member of `mastodon-search-types'." -- 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') 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 67cce4e38c334884f08ddb3a5b550226702c2edc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 7 Aug 2024 10:03:27 +0200 Subject: audit media.el --- lisp/mastodon-media.el | 40 ++++++++++++++++++---------------------- 1 file changed, 18 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8f8937c..8c035be 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -288,10 +288,9 @@ with the image." (search-forward "\n\n") (buffer-substring (point) (point-max)))) (image (when data - (apply #'create-image data - (if (version< emacs-version "27.1") - (when image-options 'imagemagick) - nil) ; inbuilt scaling in 27.1 + (apply #'create-image data ;; inbuilt scaling in 27.1: + (when (version< emacs-version "27.1") + (when image-options 'imagemagick)) t image-options)))) (when mastodon-media--enable-image-caching (unless (url-is-cached url) ; cache if not already cached @@ -307,7 +306,8 @@ with the image." ;; We only set the image to display if we could load ;; it; we already have set a default image when we ;; added the tag. - (mastodon-media--display-image-or-sensitive marker region-length image)) + (mastodon-media--display-image-or-sensitive + marker region-length image)) ;; We are done with the marker; release it: (set-marker marker nil))) (kill-buffer url-buffer)))))) @@ -318,7 +318,7 @@ MARKER, REGION-LENGTH and IMAGE are from `mastodon-media--process-image-response'. If the image is marked sensitive, the image is stored in image-data prop so it can be toggled." - (if (or (not (equal t (get-text-property marker 'sensitive))) + (if (or (not (eq t (get-text-property marker 'sensitive))) (not mastodon-media--hide-sensitive-media)) ;; display image (put-text-property marker (+ marker region-length) @@ -327,9 +327,9 @@ image-data prop so it can be toggled." (add-text-properties marker (+ marker region-length) `(display ;; (image :type png :data ,mastodon-media--sensitive-image-data) - ,(create-image mastodon-media--sensitive-image-data nil t) - sensitive-state hidden - image-data ,image)))) + ,(create-image + mastodon-media--sensitive-image-data nil t) + sensitive-state hidden image-data ,image)))) (defun mastodon-media--process-full-sized-image-response (status-plist url) ;; FIXME: refactor this with but not into @@ -338,7 +338,7 @@ image-data prop so it can be toggled." URL is a full-sized image URL attached to a timeline image. STATUS-PLIST is a plist of status events as per `url-retrieve'." (if-let (error-response (plist-get status-plist :error)) - (message "error in loading image: %S" error-response) + (user-error "error in loading image: %S" error-response) (when mastodon-media--enable-image-caching (unless (url-is-cached url) ;; cache if not already cached (url-store-in-cache))) @@ -347,8 +347,6 @@ STATUS-PLIST is a plist of status events as per `url-retrieve'." (let* ((handle (mm-dissect-buffer t)) (image (mm-get-image handle)) (str (image-property image :data))) - ;; (setf (image-property image :max-width) - ;; (window-pixel-width)) (with-current-buffer (get-buffer-create "*masto-image*") (let ((inhibit-read-only t)) (erase-buffer) @@ -375,11 +373,9 @@ REGION-LENGTH is the range from start to propertize." (marker (copy-marker start)) (url-show-status nil)) ; stop url.el from spamming us about connecting (condition-case nil - ;; catch any errors in url-retrieve so as to not abort - ;; whatever called us + ;; catch errors in url-retrieve to not break our caller (if (and mastodon-media--enable-image-caching - (url-is-cached url)) - ;; if image url is cached, decompress and use it + (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)) @@ -441,7 +437,6 @@ Replace them with the referenced image." (media-type (cadr (cdr line-details))) (type (get-text-property start 'mastodon-media-type)) (image-url (get-text-property start 'media-url))) - ;; (sensitive (get-text-property start 'sensitive))) (if (not (mastodon-media--valid-link-p image-url)) ;; mark it at least as not needing loading any more (put-text-property start end 'media-state 'invalid-url) @@ -482,11 +477,12 @@ START and END are the beginning and end of the media item to overlay." 'media-url avatar-url 'media-state 'needs-loading 'media-type 'avatar - 'display (apply #'create-image mastodon-media--generic-avatar-data - (if (version< emacs-version "27.1") - (when image-options 'imagemagick) - nil) ; inbuilt scaling in 27.1 - t image-options)) + 'display + (apply #'create-image mastodon-media--generic-avatar-data + ;; inbuilt scaling in 27.1 + (when (version< emacs-version "27.1") + (when image-options 'imagemagick)) + t image-options)) " "))) (defun mastodon-media--get-media-link-rendering -- cgit v1.2.3 From f1543079813dbf04ea198aae8cfbf511c1309269 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 7 Aug 2024 20:29:59 +0200 Subject: fix mastodon-notifications-get --- lisp/mastodon.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index e027ad3..782ed09 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -350,8 +350,8 @@ BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. FORCE means do not try to update an existing buffer, but fetch from the server and load anew." (interactive) - (let ((buffer-name (or buffer-name "notifications")) - (buffer (concat "*mastodon-" buffer-name "*"))) + (let* ((buffer-name (or buffer-name "notifications")) + (buffer (concat "*mastodon-" buffer-name "*"))) (if (and (not force) (get-buffer buffer)) (progn (pop-to-buffer buffer '(display-buffer-same-window)) (mastodon-tl--update)) -- cgit v1.2.3 From e2d45428b2d562d23bec543eaf81c597ffadc61e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 10:16:20 +0200 Subject: audit the rest of search.el --- lisp/mastodon-search.el | 46 ++++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index b54e8f3..306e7c8 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -195,7 +195,7 @@ is used for pagination." (defun mastodon-search-insert-no-results (&optional thing) "Insert a no results message for object THING." - (let ((thing (or thing "nothing"))) + (let ((thing (or thing "items"))) (insert (propertize (format "Looks like search returned no %s." thing) 'face 'font-lock-comment-face)))) @@ -307,26 +307,29 @@ If NOTE is non-nil, include user's profile note. This is also (list (alist-get 'name tag) (alist-get 'url tag))) -(defun mastodon-search--get-status-info (status) - "Get ID, timestamp, content, and spoiler from STATUS." - (list (alist-get 'id status) - (alist-get 'created_at status) - (alist-get 'spoiler_text status) - (alist-get 'content status))) - -(defun mastodon-search--id-from-status (status) - "Fetch the id from a STATUS returned by a search call to the server. -We use this to fetch the complete status from the server." - (alist-get 'id status)) - -(defun mastodon-search--full-status-from-id (id) - "Fetch the full status with id ID from the server. -This allows us to access the full account etc. details and to -render them properly." - (let* ((url (concat mastodon-instance-url "/api/v1/statuses/" (mastodon-tl--as-string id))) - (json (mastodon-http--get-json url))) - json)) - +;; These functions are all unused! + +;; (defun mastodon-search--get-status-info (status) +;; "Get ID, timestamp, content, and spoiler from STATUS." +;; (list (alist-get 'id status) +;; (alist-get 'created_at status) +;; (alist-get 'spoiler_text status) +;; (alist-get 'content status))) + +;; (defun mastodon-search--id-from-status (status) +;; "Fetch the id from a STATUS returned by a search call to the server. +;; We use this to fetch the complete status from the server." +;; (alist-get 'id status)) + +;; (defun mastodon-search--full-status-from-id (id) +;; "Fetch the full status with id ID from the server. +;; This allows us to access the full account etc. details and to +;; render them properly." +;; (let* ((url (mastodon-http--api (format "statuses/%s" id))) +;; ;; (concat mastodon-instance-url "/api/v1/statuses/" +;; ;; (mastodon-tl--as-string id))) +;; (json (mastodon-http--get-json url))) +;; json)) (defvar mastodon-search-mode-map (let ((map (make-sparse-keymap))) @@ -343,6 +346,5 @@ This minor mode is used for mastodon search pages to adds a keybinding." :group 'mastodon :global nil) - (provide 'mastodon-search) ;;; mastodon-search.el ends here -- 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') 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') 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') 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') 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 b68a82b47206e6bb9b61e2326f6e0de299c57e96 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 8 Aug 2024 12:35:42 +0200 Subject: fix mode map --- lisp/mastodon.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 782ed09..2f2f637 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -200,8 +200,8 @@ while emojify,el has this feature and mastodon.el implements it.") (define-key map (kbd "m") #'mastodon-tl--dm-user) (when (require 'lingva nil :no-error) (define-key map (kbd "a") #'mastodon-toot--translate-toot-text)) - (define-key map (kbd ",") #'mastodon-toot--list-toot-favouriters) - (define-key map (kbd ".") #'mastodon-toot--list-toot-boosters) + (define-key map (kbd ",") #'mastodon-toot--list-favouriters) + (define-key map (kbd ".") #'mastodon-toot--list-boosters) (define-key map (kbd ";") #'mastodon-views--view-instance-description) ;; override special mode binding (define-key map (kbd "g") #'undefined) -- 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') 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') 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') 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') 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') 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') 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') 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') 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 3bd81ee203d880ca83e3ec22172c0a2508c4d78e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 9 Aug 2024 14:13:24 +0200 Subject: apply filters to notifications. #575. --- lisp/mastodon-notifications.el | 150 ++++++++++++++++++++++------------------- 1 file changed, 79 insertions(+), 71 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index f43a9b3..1b93f1b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -212,77 +212,85 @@ Status notifications are given when (string-limit str mastodon-notifications--profile-note-in-foll-reqs-max-length) str)))) (status (mastodon-tl--field 'status note)) - (follower (alist-get 'username (alist-get 'account note)))) - (mastodon-tl--insert-status - ;; toot - (cond ((or (equal type 'follow) - (equal 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)) - note) - (t - status)) - ;; body - (let ((body (mastodon-tl--clean-tabs-and-nl - (if (mastodon-tl--has-spoiler status) - (mastodon-tl--spoiler status) - (if (equal '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) - (propertize "Congratulations, you have a new follower!" - 'face 'default) - (concat - (propertize - (format "You have a follow request from... %s" - follower) - 'face 'default) - (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)) - (t body))) - ;; author-byline - (if (or (equal type 'follow) - (equal type 'follow-request) - (equal 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) - "Boosted") - ((equal type 'favourite) - "Favourited") - ((equal type 'follow-request) - "Requested to follow") - ((equal type 'follow) - "Followed") - ((equal type 'mention) - "Mentioned") - ((equal type 'status) - "Posted") - ((equal type 'poll) - "Posted a poll") - ((equal type 'edit) - "Edited")))) - id - ;; base toot - (when (or (equal type 'favourite) - (equal type 'boost)) - status)))) + (follower (alist-get 'username (alist-get 'account note))) + (toot (alist-get 'status note)) + (filtered (mastodon-tl--field 'filtered toot)) + (filters (when filtered + (mastodon-tl--current-filters filtered)))) + (if (and filtered (assoc "hide" filters)) + nil + (mastodon-tl--insert-status + ;; toot + (cond ((or (equal type 'follow) + (equal 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)) + note) + (t + status)) + ;; body + (let ((body (if-let ((match (assoc "warn" filters))) + (mastodon-tl--spoiler toot (cadr match)) + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (if (equal '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) + (propertize "Congratulations, you have a new follower!" + 'face 'default) + (concat + (propertize + (format "You have a follow request from... %s" + follower) + 'face 'default) + (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)) + (t body))) + ;; author-byline + (if (or (equal type 'follow) + (equal type 'follow-request) + (equal 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) + "Boosted") + ((equal type 'favourite) + "Favourited") + ((equal type 'follow-request) + "Requested to follow") + ((equal type 'follow) + "Followed") + ((equal type 'mention) + "Mentioned") + ((equal type 'status) + "Posted") + ((equal type 'poll) + "Posted a poll") + ((equal type 'edit) + "Edited")))) + id + ;; base toot + (when (or (equal type 'favourite) + (equal type 'boost)) + status))))) (defun mastodon-notifications--by-type (note) "Filter NOTE for those listed in `mastodon-notifications--types-alist'. -- 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') 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') 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 dccf84397d43135e2c2fd15ab918e887ff0eed9d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 08:59:52 +0200 Subject: create-filter v2 --- lisp/mastodon-views.el | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 1ddb769..f0b9cbf 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -629,30 +629,38 @@ JSON is the filters data." Prompt for a context, must be a list containting at least one of \"home\", \"notifications\", \"public\", \"thread\"." (interactive) - (let* ((url (mastodon-http--api "filters")) - (word (read-string - (format "Word(s) to filter (%s): " (or (current-word) "")) - nil nil (or (current-word) ""))) + ;; FIXME: implement "keywords_attributes[][whole_word]" boolean for each + ;; term + (let* ((url (mastodon-http--api "filters" "v2")) + (title (read-string "Filter name: ")) + (terms (read-string "Terms to filter (space separated): ")) + (terms-split (split-string terms "[ ]")) + (terms-processed + (if (not terms) + (user-error "You must select at least one term to filter") + (mastodon-http--build-array-params-alist + "keywords_attributes[][keyword]" terms-split))) + (warn-or-hide + (completing-read "Warn (like CW) or hide? " + '("warn" "hide") nil :match)) (contexts - (if (string-empty-p word) - (user-error "You must select at least one word for a filter") - (completing-read-multiple - "Contexts to filter [TAB for options]: " - mastodon-views--filter-types - nil t))) + (completing-read-multiple "Filter contexts [TAB for options]: " + mastodon-views--filter-types nil :match)) (contexts-processed - (if (equal nil contexts) + (if (not contexts) (user-error "You must select at least one context for a filter") - (cl-loop for c in contexts - collect (cons "context[]" c)))) - (response (mastodon-http--post url (push - `("phrase" . ,word) - contexts-processed)))) + (mastodon-http--build-array-params-alist "context[]" contexts))) + (params (append `(("title" . ,title) + ("filter_action" . ,warn-or-hide)) + ;; ("keywords_attributes[][whole_word]" . "false")) + terms-processed + contexts-processed)) + (response (mastodon-http--post url params))) (mastodon-http--triage response (lambda (_) (when (mastodon-tl--buffer-type-eq 'filters) (mastodon-views--view-filters)) - (message "Filter created for %s!" word))))) + (message "Filter %s created!" title))))) (defun mastodon-views--delete-filter () "Delete filter at point." -- 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') 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 348eb4fba78e0e19f1c3d8784228f174b95979e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:27:40 +0200 Subject: v basic display/delete v2 filters --- lisp/mastodon-views.el | 58 +++++++++++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index f0b9cbf..cbe1e46 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -589,7 +589,7 @@ NO-CONFIRM means there is no ask or message, there is only do." nil nil nil "current filters" "c - create filter\n d - delete filter at point\n\ - n/p - go to next/prev filter") + n/p - go to next/prev filter" "v2") (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) @@ -608,18 +608,31 @@ JSON is the filters data." (defun mastodon-views--insert-filter-string (filter) "Insert a single FILTER." - (let* ((phrase (alist-get 'phrase filter)) - (contexts (alist-get 'context filter)) - (id (alist-get 'id filter)) - (filter-string (concat "- \"" phrase "\" filtered in: " - (mapconcat #'identity contexts ", ")))) + (let-alist filter (insert - (propertize filter-string - 'item-id id ;for goto-next-filter compat - 'item-type 'filter - 'phrase phrase - 'byline t) ;for goto-next-filter compat - "\n\n"))) + (mastodon-tl--set-face + (concat "\n " mastodon-tl--horiz-bar "\n " + (propertize (upcase .title) + 'item-id .id + 'item-type 'filter + 'filter-title .title + 'byline t) + " " "\n" + " " mastodon-tl--horiz-bar "\n") + 'success)) + (insert "Context: " + (mapconcat #'identity .context ", ")) + (insert "\n\nType: " .filter_action) + (if (not .keywords) + "" + (insert "\n\nTerms:") + (mapc (lambda (kw) + (insert + (concat (format "\n %s \"%s\"" + (if (char-displayable-p ?―) "―" "-") + (alist-get 'keyword kw))))) + .keywords)) + (insert "\n"))) (defvar mastodon-views--filter-types '("home" "notifications" "public" "thread" "profile")) @@ -633,8 +646,8 @@ Prompt for a context, must be a list containting at least one of \"home\", ;; term (let* ((url (mastodon-http--api "filters" "v2")) (title (read-string "Filter name: ")) - (terms (read-string "Terms to filter (space separated): ")) - (terms-split (split-string terms "[ ]")) + (terms (read-string "Terms to filter (comma or space separated): ")) + (terms-split (split-string terms "[, ]")) (terms-processed (if (not terms) (user-error "You must select at least one term to filter") @@ -644,8 +657,9 @@ Prompt for a context, must be a list containting at least one of \"home\", (completing-read "Warn (like CW) or hide? " '("warn" "hide") nil :match)) (contexts - (completing-read-multiple "Filter contexts [TAB for options]: " - mastodon-views--filter-types nil :match)) + (completing-read-multiple + "Filter contexts [TAB for options, comma separated]: " + mastodon-views--filter-types nil :match)) (contexts-processed (if (not contexts) (user-error "You must select at least one context for a filter") @@ -665,17 +679,17 @@ Prompt for a context, must be a list containting at least one of \"home\", (defun mastodon-views--delete-filter () "Delete filter at point." (interactive) - (let* ((filter-id (mastodon-tl--property 'item-id :no-move)) - (phrase (mastodon-tl--property 'phrase :no-move)) - (url (mastodon-http--api (format "filters/%s" filter-id)))) - (if (null phrase) + (let* ((id (mastodon-tl--property 'item-id :no-move)) + (title (mastodon-tl--property 'filter-title :no-move)) + (url (mastodon-http--api (format "filters/%s" id) "v2"))) + (if (null id) (user-error "No filter at point?") - (when (y-or-n-p (format "Delete filter %s? " phrase)) + (when (y-or-n-p (format "Delete filter %s? " title)) (let ((response (mastodon-http--delete url))) (mastodon-http--triage response (lambda (_) (mastodon-views--view-filters) - (message "Filter for \"%s\" deleted!" phrase)))))))) + (message "Filter \"%s\" deleted!" title)))))))) ;;; FOLLOW SUGGESTIONS -- cgit v1.2.3 From d619c096de763075a52c3836a8d0a617bedec19b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:27:53 +0200 Subject: instance desc - missing paren --- lisp/mastodon-views.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index cbe1e46..a363ef0 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -777,7 +777,7 @@ MISSKEY means the instance is a Misskey or derived server." (mastodon-tl--do-if-item (let* ((toot (or (and (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'profile-json)) ; either profile - (mastodon-tl--property 'item-json)) ; or toot or user listing + (mastodon-tl--property 'item-json))) ; or toot or user listing (reblog (alist-get 'reblog toot)) (account (or (alist-get 'account reblog) (alist-get 'account toot) -- cgit v1.2.3 From 08a9357e33d80554108e28e57de3d50f6710914e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:27:53 +0200 Subject: instance desc - missing paren --- lisp/mastodon-views.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4b29115..4b6978d 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -752,7 +752,7 @@ MISSKEY means the instance is a Misskey or derived server." (mastodon-tl--do-if-item (let* ((toot (or (and (mastodon-tl--profile-buffer-p) (mastodon-tl--property 'profile-json)) ; either profile - (mastodon-tl--property 'item-json)) ; or toot or user listing + (mastodon-tl--property 'item-json))) ; or toot or user listing (reblog (alist-get 'reblog toot)) (account (or (alist-get 'account reblog) (alist-get 'account toot) -- 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') 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 7eb3e40bab8282b9f20522e466f02d505dca8200 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:32:34 +0200 Subject: intent toot.el --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7c5472b..5f4116f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -225,7 +225,7 @@ Takes its form from `window-configuration-to-register'.") "The text of the toot being composed.") (persist-defvar mastodon-toot-draft-toots-list nil - "A list of toots that have been saved as drafts. + "A list of toots that have been saved as drafts. For the moment we just put all composed toots in here, as we want to also capture toots that are \"sent\" but that don't successfully send.") -- cgit v1.2.3 From da13c9a3eafa97fce47fcc9978469c2338f2f85c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:33:31 +0200 Subject: indent profile.el --- lisp/mastodon-profile.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0a17a25..093e0a8 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -127,7 +127,7 @@ It contains details of the current user's account.") "Keymap for `mastodon-profile-update-mode'.") (persist-defvar mastodon-profile-account-settings nil - "An alist of account settings saved from the server. + "An alist of account settings saved from the server. Other clients can change these settings on the server at any time, so this list is not the canonical source for settings. It is updated on entering mastodon mode and on toggle any setting it @@ -319,13 +319,13 @@ If value is :json-false, return nil." (defun mastodon-profile--update-note-count (&rest _args) "Display the character count of the profile note buffer." (let* ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'note-header + (header-region (mastodon-tl--find-property-range 'note-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'note-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'note-counter - (point-min))) - (count (number-to-string (mastodon-toot--count-toot-chars - (buffer-substring-no-properties - (cdr header-region) (point-max)))))) + (count (number-to-string (mastodon-toot--count-toot-chars + (buffer-substring-no-properties + (cdr header-region) (point-max)))))) (add-text-properties (car count-region) (cdr count-region) (list 'display count)))) -- cgit v1.2.3 From caf694e383a3382bdd8bf712d86acbe1e50f00ef Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:37:29 +0200 Subject: flymake views.el --- lisp/mastodon-views.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index a363ef0..b23d364 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -531,7 +531,7 @@ If ID, just return that toot." (interactive) (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) - (user-error "no scheduled toot at point?") + (user-error "No scheduled toot at point?") (mastodon-toot--schedule-toot :reschedule)))) (defun mastodon-views--copy-scheduled-toot-text () @@ -549,7 +549,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (interactive) (let ((id (or id (mastodon-tl--property 'id :no-move)))) (if (null id) - (user-error "no scheduled toot at point?") + (user-error "No scheduled toot at point?") (when (or no-confirm (y-or-n-p "Cancel scheduled toot?")) (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) @@ -565,7 +565,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (interactive) (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) - (user-error "no scheduled toot at point?") + (user-error "No scheduled toot at point?") (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) (scheduled (alist-get 'scheduled_at toot))) (let-alist (alist-get 'params toot) -- cgit v1.2.3 From ba364e75dcab736770fc8b6a60f7f7b4ff611f34 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:44:10 +0200 Subject: do-if-item for scheduled toots --- lisp/mastodon-views.el | 58 +++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index b23d364..160de47 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -513,7 +513,7 @@ JSON is the data returned by the server." 'item-type 'scheduled ; so we nav here 'face 'font-lock-comment-face 'keymap mastodon-views--scheduled-map - 'scheduled-json toot + 'item-json toot 'id .id) "\n"))) @@ -529,10 +529,8 @@ If ID, just return that toot." (defun mastodon-views--reschedule-toot () "Reschedule the scheduled toot at point." (interactive) - (let ((id (mastodon-tl--property 'id :no-move))) - (if (null id) - (user-error "No scheduled toot at point?") - (mastodon-toot--schedule-toot :reschedule)))) + (mastodon-tl--do-if-item + (mastodon-toot--schedule-toot :reschedule))) (defun mastodon-views--copy-scheduled-toot-text () "Copy the text of the scheduled toot at point." @@ -547,36 +545,34 @@ If ID, just return that toot." ID is that of the scheduled toot to cancel. NO-CONFIRM means there is no ask or message, there is only do." (interactive) - (let ((id (or id (mastodon-tl--property 'id :no-move)))) - (if (null id) - (user-error "No scheduled toot at point?") - (when (or no-confirm - (y-or-n-p "Cancel scheduled toot?")) - (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) - (response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda (_) - (mastodon-views--view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!"))))))))) + (mastodon-tl--do-if-item + (when (or no-confirm + (y-or-n-p "Cancel scheduled toot?")) + (let* ((id (or id (mastodon-tl--property 'id :no-move))) + (url (mastodon-http--api (format "scheduled_statuses/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda (_) + (mastodon-views--view-scheduled-toots) + (unless no-confirm + (message "Toot cancelled!")))))))) (defun mastodon-views--edit-scheduled-as-new () "Edit scheduled status as new toot." (interactive) - (let ((id (mastodon-tl--property 'id :no-move))) - (if (null id) - (user-error "No scheduled toot at point?") - (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) - (scheduled (alist-get 'scheduled_at toot))) - (let-alist (alist-get 'params toot) - ;; TODO: preserve polls - ;; (poll (alist-get 'poll params)) - (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) - (goto-char (point-max)) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties - .in_reply_to_id .visibility .spoiler_text .language - scheduled id (alist-get 'media_attachments toot))))))) + (mastodon-tl--do-if-item + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) + (id (mastodon-tl--property 'id :no-move)) + (scheduled (alist-get 'scheduled_at toot))) + (let-alist (alist-get 'params toot) + ;; TODO: preserve polls + ;; (poll (alist-get 'poll params)) + (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) + (goto-char (point-max)) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility .spoiler_text .language + scheduled id (alist-get 'media_attachments toot)))))) ;;; FILTERS -- cgit v1.2.3 From e8d8f6307628a4fedc2836fe5bd3f58dc9d0c61f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 13 Aug 2024 09:44:10 +0200 Subject: do-if-item for scheduled toots --- lisp/mastodon-views.el | 58 +++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4b6978d..54f829d 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -513,7 +513,7 @@ JSON is the data returned by the server." 'item-type 'scheduled ; so we nav here 'face 'font-lock-comment-face 'keymap mastodon-views--scheduled-map - 'scheduled-json toot + 'item-json toot 'id .id) "\n"))) @@ -529,10 +529,8 @@ If ID, just return that toot." (defun mastodon-views--reschedule-toot () "Reschedule the scheduled toot at point." (interactive) - (let ((id (mastodon-tl--property 'id :no-move))) - (if (null id) - (user-error "no scheduled toot at point?") - (mastodon-toot--schedule-toot :reschedule)))) + (mastodon-tl--do-if-item + (mastodon-toot--schedule-toot :reschedule))) (defun mastodon-views--copy-scheduled-toot-text () "Copy the text of the scheduled toot at point." @@ -547,36 +545,34 @@ If ID, just return that toot." ID is that of the scheduled toot to cancel. NO-CONFIRM means there is no ask or message, there is only do." (interactive) - (let ((id (or id (mastodon-tl--property 'id :no-move)))) - (if (null id) - (user-error "no scheduled toot at point?") - (when (or no-confirm - (y-or-n-p "Cancel scheduled toot?")) - (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) - (response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda (_) - (mastodon-views--view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!"))))))))) + (mastodon-tl--do-if-item + (when (or no-confirm + (y-or-n-p "Cancel scheduled toot?")) + (let* ((id (or id (mastodon-tl--property 'id :no-move))) + (url (mastodon-http--api (format "scheduled_statuses/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda (_) + (mastodon-views--view-scheduled-toots) + (unless no-confirm + (message "Toot cancelled!")))))))) (defun mastodon-views--edit-scheduled-as-new () "Edit scheduled status as new toot." (interactive) - (let ((id (mastodon-tl--property 'id :no-move))) - (if (null id) - (user-error "no scheduled toot at point?") - (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) - (scheduled (alist-get 'scheduled_at toot))) - (let-alist (alist-get 'params toot) - ;; TODO: preserve polls - ;; (poll (alist-get 'poll params)) - (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) - (goto-char (point-max)) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties - .in_reply_to_id .visibility .spoiler_text .language - scheduled id (alist-get 'media_attachments toot))))))) + (mastodon-tl--do-if-item + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) + (id (mastodon-tl--property 'id :no-move)) + (scheduled (alist-get 'scheduled_at toot))) + (let-alist (alist-get 'params toot) + ;; TODO: preserve polls + ;; (poll (alist-get 'poll params)) + (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) + (goto-char (point-max)) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility .spoiler_text .language + scheduled id (alist-get 'media_attachments toot)))))) ;;; FILTERS -- 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') 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 5f1fd9564dbf8e4d68d37be9ea4bd62991483749 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 14 Aug 2024 13:55:27 +0200 Subject: add http--api-v2 --- lisp/mastodon-http.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 51b144e..2635eef 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -53,6 +53,10 @@ Optionally specify VERSION in format vX." (concat mastodon-instance-url "/api/" (or version mastodon-http--api-version) "/" endpoint)) +(defun mastodon-http--api-v2 (endpoint) + "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)) -- cgit v1.2.3 From d18f86a0e21b17eb67685c4c0500819e864d4427 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 14 Aug 2024 13:56:24 +0200 Subject: clean up filters code --- lisp/mastodon-views.el | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 160de47..0d0277e 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -594,17 +594,32 @@ NO-CONFIRM means there is no ask or message, there is only do." JSON is what is returned by by the server." (mastodon-views--minor-view "filters" - #'mastodon-views--insert-filter-string-set + #'mastodon-views--insert-filters json)) -(defun mastodon-views--insert-filter-string-set (json) +(defun mastodon-views--insert-filters (json) "Insert a filter string plus a blank line. JSON is the filters data." - (mapc #'mastodon-views--insert-filter-string json)) - -(defun mastodon-views--insert-filter-string (filter) + (mapc #'mastodon-views--insert-filter json)) + +(defun mastodon-views--insert-filter-kws (kws) + "Insert filter keywords KWS." + (mapc (lambda (kw) + (let ((whole (alist-get 'whole_word kw))) + (insert + (propertize (concat + (format "\n %s \"%s\" | whole word: %s" + (if (char-displayable-p ?―) "―" "-") + (alist-get 'keyword kw) + whole)) + 'kw-id (alist-get 'id kw) + 'whole-word whole)))) + kws)) + +(defun mastodon-views--insert-filter (filter) "Insert a single FILTER." (let-alist filter + ;; heading: (insert (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " @@ -616,18 +631,16 @@ JSON is the filters data." " " "\n" " " mastodon-tl--horiz-bar "\n") 'success)) + ;; context: (insert "Context: " (mapconcat #'identity .context ", ")) + ;; type (warn or hide): (insert "\n\nType: " .filter_action) + ;; terms list: (if (not .keywords) "" (insert "\n\nTerms:") - (mapc (lambda (kw) - (insert - (concat (format "\n %s \"%s\"" - (if (char-displayable-p ?―) "―" "-") - (alist-get 'keyword kw))))) - .keywords)) + (mastodon-views--insert-filter-kws \.keywords)) (insert "\n"))) (defvar mastodon-views--filter-types @@ -677,7 +690,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (interactive) (let* ((id (mastodon-tl--property 'item-id :no-move)) (title (mastodon-tl--property 'filter-title :no-move)) - (url (mastodon-http--api (format "filters/%s" id) "v2"))) + (url (mastodon-http--api-v2 (format "filters/%s" id)))) (if (null id) (user-error "No filter at point?") (when (y-or-n-p (format "Delete filter %s? " title)) -- cgit v1.2.3 From 5e2e14b1f9aee068d3b59c4d319fa923114b9f71 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 14 Aug 2024 13:57:24 +0200 Subject: get filter kw, update filter kw --- lisp/mastodon-views.el | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 0d0277e..8c36f27 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -700,6 +700,33 @@ Prompt for a context, must be a list containting at least one of \"home\", (mastodon-views--view-filters) (message "Filter \"%s\" deleted!" title)))))))) +(defun mastodon-views--get-filter-kw (&optional id) + "GET filter with ID." + (let* ((id (or id (mastodon-tl--property 'kw-id :no-move))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--get-json url))) + resp)) + +(defun mastodon-views--update-filter-kw () + "Update filter keyword at point. +Prmopt to change the term, and the whole words option. +When t, whole words means only match whole words." + (interactive) + (let* ((id (mastodon-tl--property 'kw-id :no-move)) + (kw (mastodon-views--get-filter-kw id)) + (keyword (read-string "Keyword: " (alist-get 'keyword kw))) + (whole-word (if (y-or-n-p "Match whole words only? ") + "true" + "false")) + (params `(("keyword" . ,keyword) + ("whole_word" . ,whole-word))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--put url params))) + (mastodon-http--triage + resp + (lambda (resp) + (message (format "Keyword %s updated!" keyword)))))) + ;;; FOLLOW SUGGESTIONS ;; No pagination: max 80 results -- cgit v1.2.3 From c58e69b4d6e327603d868b98745e032d2436bafa Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 14 Aug 2024 14:27:29 +0200 Subject: fix insert-filter-kws --- lisp/mastodon-views.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 8c36f27..2a0d248 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -604,11 +604,15 @@ JSON is the filters data." (defun mastodon-views--insert-filter-kws (kws) "Insert filter keywords KWS." + ;; FIXME: make this a table (ideally upatable) + (insert "\n\nTerms: | whole words only:") (mapc (lambda (kw) - (let ((whole (alist-get 'whole_word kw))) + (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) + "nil" + "t"))) (insert (propertize (concat - (format "\n %s \"%s\" | whole word: %s" + (format "\n %s \"%s\" | %s" (if (char-displayable-p ?―) "―" "-") (alist-get 'keyword kw) whole)) @@ -637,10 +641,9 @@ JSON is the filters data." ;; type (warn or hide): (insert "\n\nType: " .filter_action) ;; terms list: - (if (not .keywords) + (if (not .keywords) ;; poss to have a filter sans keywords "" - (insert "\n\nTerms:") - (mastodon-views--insert-filter-kws \.keywords)) + (mastodon-views--insert-filter-kws .keywords)) (insert "\n"))) (defvar mastodon-views--filter-types -- cgit v1.2.3 From 0be17ad84990dc2d9bd0042680eca06ec5433297 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 10:33:09 +0200 Subject: rough table display of filter keywords --- lisp/mastodon-views.el | 42 ++++++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 2a0d248..9d46279 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -605,20 +605,31 @@ JSON is the filters data." (defun mastodon-views--insert-filter-kws (kws) "Insert filter keywords KWS." ;; FIXME: make this a table (ideally upatable) - (insert "\n\nTerms: | whole words only:") - (mapc (lambda (kw) - (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) - "nil" - "t"))) - (insert - (propertize (concat - (format "\n %s \"%s\" | %s" - (if (char-displayable-p ?―) "―" "-") - (alist-get 'keyword kw) - whole)) - 'kw-id (alist-get 'id kw) - 'whole-word whole)))) - kws)) + (insert "\n\n") + (let ((beg (point)) + (whole-str "whole-words-only:")) + (insert (concat "Terms: | " whole-str "\n")) + (mapc (lambda (kw) + (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) + "nil" + "t"))) + (insert + (propertize (concat + (format "\"%s\" | %s\n" + (alist-get 'keyword kw) whole)) + 'kw-id (alist-get 'id kw) + 'whole-word whole)))) + kws) + ;; table display of kws: + (table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str))) + (table-justify-column 'center) + (table-forward-cell) ;; col 2 + (table-justify-column 'center) + (while (re-search-forward ;; goto end of table: + (concat table-cell-horizontal-chars + (make-string 1 table-cell-intersection-char) + "\n") + nil :no-error)))) (defun mastodon-views--insert-filter (filter) "Insert a single FILTER." @@ -643,8 +654,7 @@ JSON is the filters data." ;; terms list: (if (not .keywords) ;; poss to have a filter sans keywords "" - (mastodon-views--insert-filter-kws .keywords)) - (insert "\n"))) + (mastodon-views--insert-filter-kws .keywords)))) (defvar mastodon-views--filter-types '("home" "notifications" "public" "thread" "profile")) -- cgit v1.2.3 From 5256df1189a787d09eb6b80d2206c198648f52e4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 15:40:05 +0200 Subject: add add/remove filter kw, plus some propertizing and cleanup. #578. --- lisp/mastodon-views.el | 87 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 62 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 9d46279..8b5d975 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -589,14 +589,6 @@ NO-CONFIRM means there is no ask or message, there is only do." (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) -(defun mastodon-views--insert-filters (json) - "Insert the user's current filters. -JSON is what is returned by by the server." - (mastodon-views--minor-view - "filters" - #'mastodon-views--insert-filters - json)) - (defun mastodon-views--insert-filters (json) "Insert a filter string plus a blank line. JSON is the filters data." @@ -618,6 +610,8 @@ JSON is the filters data." (format "\"%s\" | %s\n" (alist-get 'keyword kw) whole)) 'kw-id (alist-get 'id kw) + 'item-json kw + 'mastodon-tab-stop t 'whole-word whole)))) kws) ;; table display of kws: @@ -636,21 +630,28 @@ JSON is the filters data." (let-alist filter ;; heading: (insert - (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n " - (propertize (upcase .title) - 'item-id .id - 'item-type 'filter - 'filter-title .title - 'byline t) - " " "\n" - " " mastodon-tl--horiz-bar "\n") - 'success)) - ;; context: - (insert "Context: " - (mapconcat #'identity .context ", ")) - ;; type (warn or hide): - (insert "\n\nType: " .filter_action) + (propertize + (concat + (mastodon-tl--set-face + (concat "\n " mastodon-tl--horiz-bar "\n " + (propertize (upcase .title) + 'item-id .id + 'item-type 'filter + 'filter-title .title + 'byline t) + " " "\n" + " " mastodon-tl--horiz-bar "\n") + 'success) + ;; context: + (concat "Context: " + (mapconcat #'identity .context ", ")) + ;; type (warn or hide): + (concat "\n\nType: " .filter_action)) + 'item-json filter + 'item-id .id + 'item-type 'filter)) + + ;; FIXME: return a string so we can propertize/insert in here: ;; terms list: (if (not .keywords) ;; poss to have a filter sans keywords "" @@ -704,7 +705,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (let* ((id (mastodon-tl--property 'item-id :no-move)) (title (mastodon-tl--property 'filter-title :no-move)) (url (mastodon-http--api-v2 (format "filters/%s" id)))) - (if (null id) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) (user-error "No filter at point?") (when (y-or-n-p (format "Delete filter %s? " title)) (let ((response (mastodon-http--delete url))) @@ -737,9 +738,45 @@ When t, whole words means only match whole words." (resp (mastodon-http--put url params))) (mastodon-http--triage resp - (lambda (resp) + (lambda (_resp) (message (format "Keyword %s updated!" keyword)))))) +(defun mastodon-views--add-filter-kw () + "Add a keyword to filter at point." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((kw (read-string "Keyword: ")) + (id (mastodon-tl--property 'item-id :no-move)) + (whole-word (if (y-or-n-p "Match whole words only? ") + "true" + "false")) + (params `(("keyword" . ,kw) + ("whole_word" . ,whole-word))) + (url (mastodon-http--api-v2 (format "filters/%s/keywords" id))) + (resp (mastodon-http--post url params))) + (mastodon-http--triage + resp + (lambda (_resp) + (message (format "Keyword %s added!" kw))))))) + +(defun mastodon-views--remove-filter-kw () + "Remove keyword from filter at point." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((kws (alist-get 'keywords + (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))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--delete url))) + (mastodon-http--triage + resp + (lambda (_resp) + (message (format "Keyword %s removed!" choice))))))) + ;;; FOLLOW SUGGESTIONS ;; No pagination: max 80 results -- cgit v1.2.3 From 96e7d2e5815e2d05ffff4ab6ee2188fc496c8ca9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 17:21:47 +0200 Subject: re-write update filter kw, refactor filter triage. #578 --- lisp/mastodon-views.el | 71 ++++++++++++++++++++++++++------------------------ 1 file changed, 37 insertions(+), 34 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 8b5d975..31bb6f0 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -646,7 +646,7 @@ JSON is the filters data." (concat "Context: " (mapconcat #'identity .context ", ")) ;; type (warn or hide): - (concat "\n\nType: " .filter_action)) + (concat "\nType: " .filter_action)) 'item-json filter 'item-id .id 'item-type 'filter)) @@ -693,11 +693,8 @@ Prompt for a context, must be a list containting at least one of \"home\", terms-processed contexts-processed)) (response (mastodon-http--post url params))) - (mastodon-http--triage response - (lambda (_) - (when (mastodon-tl--buffer-type-eq 'filters) - (mastodon-views--view-filters)) - (message "Filter %s created!" title))))) + (mastodon-views--filters-triage + (message "Filter %s created!" title)))) (defun mastodon-views--delete-filter () "Delete filter at point." @@ -708,11 +705,10 @@ Prompt for a context, must be a list containting at least one of \"home\", (if (not (eq 'filter (mastodon-tl--property 'item-type))) (user-error "No filter at point?") (when (y-or-n-p (format "Delete filter %s? " title)) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage - response (lambda (_) - (mastodon-views--view-filters) - (message "Filter \"%s\" deleted!" title)))))))) + (let ((resp (mastodon-http--delete url))) + (mastodon-views--filters-triage + resp + (message "Filter \"%s\" deleted!" title))))))) (defun mastodon-views--get-filter-kw (&optional id) "GET filter with ID." @@ -722,24 +718,36 @@ Prompt for a context, must be a list containting at least one of \"home\", resp)) (defun mastodon-views--update-filter-kw () - "Update filter keyword at point. + "Update filter keyword. Prmopt to change the term, and the whole words option. When t, whole words means only match whole words." (interactive) - (let* ((id (mastodon-tl--property 'kw-id :no-move)) - (kw (mastodon-views--get-filter-kw id)) - (keyword (read-string "Keyword: " (alist-get 'keyword kw))) - (whole-word (if (y-or-n-p "Match whole words only? ") - "true" - "false")) - (params `(("keyword" . ,keyword) - ("whole_word" . ,whole-word))) - (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) - (resp (mastodon-http--put url params))) - (mastodon-http--triage - resp - (lambda (_resp) - (message (format "Keyword %s updated!" keyword)))))) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((kws (alist-get 'keywords + (mastodon-tl--property 'item-json :no-move))) + (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws)) + (choice (completing-read "Update keyword: " alist)) + (updated (read-string "Keyword: " choice)) + (whole-word (if (y-or-n-p "Match whole words only? ") + "true" + "false")) + (params `(("keyword" . ,updated) + ("whole_word" . ,whole-word))) + (id (cdr (assoc choice alist #'equal))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--put url params))) + (mastodon-views--filters-triage resp + (format "Keyword %s updated!" updated))))) + +(defun mastodon-views--filters-triage (resp msg-str) + "Triage filter action response RESP, reload filters, message MSG-STR." + (mastodon-http--triage + resp + (lambda (_resp) + (when (mastodon-tl--buffer-type-eq 'filters) + (mastodon-views--view-filters)) + (message msg-str)))) (defun mastodon-views--add-filter-kw () "Add a keyword to filter at point." @@ -755,10 +763,8 @@ When t, whole words means only match whole words." ("whole_word" . ,whole-word))) (url (mastodon-http--api-v2 (format "filters/%s/keywords" id))) (resp (mastodon-http--post url params))) - (mastodon-http--triage - resp - (lambda (_resp) - (message (format "Keyword %s added!" kw))))))) + (mastodon-views--filters-triage resp + (format "Keyword %s added!" kw))))) (defun mastodon-views--remove-filter-kw () "Remove keyword from filter at point." @@ -772,10 +778,7 @@ When t, whole words means only match whole words." (id (cdr (assoc choice alist #'equal))) (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) (resp (mastodon-http--delete url))) - (mastodon-http--triage - resp - (lambda (_resp) - (message (format "Keyword %s removed!" choice))))))) + (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice))))) ;;; FOLLOW SUGGESTIONS -- cgit v1.2.3 From 70dff6c4a70822bfc7502010682d3ab0a5002839 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 20:23:21 +0200 Subject: filters cleanup --- lisp/mastodon-views.el | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 31bb6f0..c1a6054 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -594,9 +594,10 @@ NO-CONFIRM means there is no ask or message, there is only do." JSON is the filters data." (mapc #'mastodon-views--insert-filter json)) +(require 'table) + (defun mastodon-views--insert-filter-kws (kws) "Insert filter keywords KWS." - ;; FIXME: make this a table (ideally upatable) (insert "\n\n") (let ((beg (point)) (whole-str "whole-words-only:")) @@ -628,10 +629,10 @@ JSON is the filters data." (defun mastodon-views--insert-filter (filter) "Insert a single FILTER." (let-alist filter - ;; heading: (insert (propertize (concat + ;; heading: (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " (propertize (upcase .title) @@ -650,8 +651,6 @@ JSON is the filters data." 'item-json filter 'item-id .id 'item-type 'filter)) - - ;; FIXME: return a string so we can propertize/insert in here: ;; terms list: (if (not .keywords) ;; poss to have a filter sans keywords "" @@ -665,8 +664,6 @@ JSON is the filters data." Prompt for a context, must be a list containting at least one of \"home\", \"notifications\", \"public\", \"thread\"." (interactive) - ;; FIXME: implement "keywords_attributes[][whole_word]" boolean for each - ;; term (let* ((url (mastodon-http--api "filters" "v2")) (title (read-string "Filter name: ")) (terms (read-string "Terms to filter (comma or space separated): ")) @@ -692,8 +689,9 @@ Prompt for a context, must be a list containting at least one of \"home\", ;; ("keywords_attributes[][whole_word]" . "false")) terms-processed contexts-processed)) - (response (mastodon-http--post url params))) + (resp (mastodon-http--post url params))) (mastodon-views--filters-triage + resp (message "Filter %s created!" title)))) (defun mastodon-views--delete-filter () -- cgit v1.2.3 From a72f227f2c371f838f189c12ea79442fd5572de0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 21:06:40 +0200 Subject: add update filter. #578 --- lisp/mastodon-views.el | 49 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index c1a6054..608d13f 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -659,14 +659,17 @@ JSON is the filters data." (defvar mastodon-views--filter-types '("home" "notifications" "public" "thread" "profile")) -(defun mastodon-views--create-filter () +(defun mastodon-views--create-filter (&optional id title context type terms) "Create a filter for a word. Prompt for a context, must be a list containting at least one of \"home\", -\"notifications\", \"public\", \"thread\"." +\"notifications\", \"public\", \"thread\". +Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (interactive) - (let* ((url (mastodon-http--api "filters" "v2")) - (title (read-string "Filter name: ")) - (terms (read-string "Terms to filter (comma or space separated): ")) + (let* ((url (if id + (mastodon-http--api-v2 (format "filters/%s" id)) + (mastodon-http--api-v2 "filters"))) + (title (or title (read-string "Filter name: "))) + (terms (or terms (read-string "Terms to filter (comma or space separated): "))) (terms-split (split-string terms "[, ]")) (terms-processed (if (not terms) @@ -674,12 +677,14 @@ Prompt for a context, must be a list containting at least one of \"home\", (mastodon-http--build-array-params-alist "keywords_attributes[][keyword]" terms-split))) (warn-or-hide - (completing-read "Warn (like CW) or hide? " - '("warn" "hide") nil :match)) + (or type + (completing-read "Warn (like CW) or hide? " + '("warn" "hide") nil :match))) (contexts - (completing-read-multiple - "Filter contexts [TAB for options, comma separated]: " - mastodon-views--filter-types nil :match)) + (or context + (completing-read-multiple + "Filter contexts [TAB for options, comma separated]: " + mastodon-views--filter-types nil :match))) (contexts-processed (if (not contexts) (user-error "You must select at least one context for a filter") @@ -689,11 +694,33 @@ Prompt for a context, must be a list containting at least one of \"home\", ;; ("keywords_attributes[][whole_word]" . "false")) terms-processed contexts-processed)) - (resp (mastodon-http--post url params))) + (resp (if id + (mastodon-http--put url params) + (mastodon-http--post url params)))) (mastodon-views--filters-triage resp (message "Filter %s created!" title)))) +(defun mastodon-views--update-filter () + "Update filter at point." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((filter (mastodon-tl--property 'item-json)) + (id (mastodon-tl--property 'item-id)) + (name (read-string "Name: " (alist-get 'title filter))) + (contexts (completing-read-multiple + "Filter contexts [TAB for options, comma separated]: " + mastodon-views--filter-types nil :match + (mapconcat #'identity + (alist-get 'context filter) ","))) + (type (completing-read "Warn (like CW) or hide? " + '("warn" "hide") nil :match + (alist-get 'type filter))) + (terms (read-string "Terms to add (comma or space separated): "))) + (mastodon-views--create-filter id name contexts type terms)))) + + (defun mastodon-views--delete-filter () "Delete filter at point." (interactive) -- cgit v1.2.3 From 8226df7623a4697ec85d92bd0d508ad4c1bb4a0d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 21:13:07 +0200 Subject: filter kw table: en dashes if possible --- lisp/mastodon-views.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 608d13f..411d2d2 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -600,6 +600,9 @@ JSON is the filters data." "Insert filter keywords KWS." (insert "\n\n") (let ((beg (point)) + (table-cell-horizontal-chars (if (char-displayable-p ?–) ; ?– ?-) + "–" + "-")) (whole-str "whole-words-only:")) (insert (concat "Terms: | " whole-str "\n")) (mapc (lambda (kw) -- cgit v1.2.3 From a1b42fe543fbe952907c5b0a4fae71b2501d7f44 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 15 Aug 2024 22:06:02 +0200 Subject: add filter crud bindings --- lisp/mastodon-views.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 411d2d2..f033d3c 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -92,6 +92,11 @@ (define-key map (kbd "d") #'mastodon-views--delete-filter) (define-key map (kbd "c") #'mastodon-views--create-filter) (define-key map (kbd "g") #'mastodon-views--view-filters) + (define-key map (kbd "u") #'mastodon-views--update-filter) + (define-key map (kbd "k") #'mastodon-views--delete-filter) + (define-key map (kbd "a") #'mastodon-views--add-filter-kw) + (define-key map (kbd "r") #'mastodon-views--remove-filter-kw) + (define-key map (kbd "U") #'mastodon-views--update-filter-kw) map) "Keymap for viewing filters.") @@ -584,8 +589,9 @@ NO-CONFIRM means there is no ask or message, there is only do." 'mastodon-views--insert-filters nil nil nil "current filters" - "c - create filter\n d - delete filter at point\n\ - n/p - go to next/prev filter" "v2") + "c - create filter | d/k - delete filter at point\n\ + u - update filter\n a/r/U - add/remove/Update filter keyword\n + n/p - next/prev filter" "v2") (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) @@ -604,7 +610,7 @@ JSON is the filters data." "–" "-")) (whole-str "whole-words-only:")) - (insert (concat "Terms: | " whole-str "\n")) + (insert (concat "Keywords: | " whole-str "\n")) (mapc (lambda (kw) (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) "nil" -- cgit v1.2.3 From 83cfe439a4e66f0ccb79d46db35948275329db28 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 17 Aug 2024 10:28:06 +0200 Subject: process-image-response (change args order) --- lisp/mastodon-media.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index d386462..ce2f8f5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -273,7 +273,7 @@ IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==") "The PNG data for a sensitive image placeholder.") (defun mastodon-media--process-image-response - (status-plist marker image-options region-length url) + (status-plist url marker image-options region-length) "Callback function processing the url retrieve response for URL. STATUS-PLIST is the usual plist of status events as per `url-retrieve'. IMAGE-OPTIONS are the precomputed options to apply to the image. @@ -390,7 +390,7 @@ REGION-LENGTH is the range from start to propertize." (mastodon-media--image-or-cached url #'mastodon-media--process-image-response - (list nil marker image-options region-length url)) + (list nil url marker image-options region-length)) (error (with-current-buffer buffer ;; TODO: Add retries (put-text-property marker (+ marker region-length) -- cgit v1.2.3 From 45b3843f38e1052b088e33ba8fe1fc0a5faef0d2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 17 Aug 2024 10:28:24 +0200 Subject: image-or-cached, apply not funcall. FIX #577. --- lisp/mastodon-media.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index ce2f8f5..620aa51 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -359,7 +359,8 @@ STATUS-PLIST is a plist of status events as per `url-retrieve'." (defun mastodon-media--image-or-cached (url process-fun args) "Fetch URL from cache or fro host. -Call PROCESS-FUN on it with ARGS." +Call PROCESS-FUN on it with ARGS, a list of callback args as +specified by `url-retrieve'." (if (and mastodon-media--enable-image-caching (url-is-cached url)) ;; if cached, decompress and use: (with-current-buffer (url-fetch-from-cache url) @@ -367,8 +368,9 @@ Call PROCESS-FUN on it with ARGS." (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 + (apply process-fun args)) ;; no status-plist arg from cache + ;; fetch as usual and process-image-response will cache it: + ;; cbargs fun will be called with status-plist by url-retrieve: (url-retrieve url process-fun (cdr args)))) (defun mastodon-media--load-image-from-url (url media-type start region-length) -- cgit v1.2.3 From 1adb3e8583f8ec851cb2420c8cfede1192d017b7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 17 Aug 2024 10:28:06 +0200 Subject: process-image-response (change args order) --- lisp/mastodon-media.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index d386462..ce2f8f5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -273,7 +273,7 @@ IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==") "The PNG data for a sensitive image placeholder.") (defun mastodon-media--process-image-response - (status-plist marker image-options region-length url) + (status-plist url marker image-options region-length) "Callback function processing the url retrieve response for URL. STATUS-PLIST is the usual plist of status events as per `url-retrieve'. IMAGE-OPTIONS are the precomputed options to apply to the image. @@ -390,7 +390,7 @@ REGION-LENGTH is the range from start to propertize." (mastodon-media--image-or-cached url #'mastodon-media--process-image-response - (list nil marker image-options region-length url)) + (list nil url marker image-options region-length)) (error (with-current-buffer buffer ;; TODO: Add retries (put-text-property marker (+ marker region-length) -- cgit v1.2.3 From aa9b4a7dd180bd27bc7ebb43bd2ca58c9b01de7f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 17 Aug 2024 10:28:24 +0200 Subject: image-or-cached, apply not funcall. FIX #577. --- lisp/mastodon-media.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index ce2f8f5..620aa51 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -359,7 +359,8 @@ STATUS-PLIST is a plist of status events as per `url-retrieve'." (defun mastodon-media--image-or-cached (url process-fun args) "Fetch URL from cache or fro host. -Call PROCESS-FUN on it with ARGS." +Call PROCESS-FUN on it with ARGS, a list of callback args as +specified by `url-retrieve'." (if (and mastodon-media--enable-image-caching (url-is-cached url)) ;; if cached, decompress and use: (with-current-buffer (url-fetch-from-cache url) @@ -367,8 +368,9 @@ Call PROCESS-FUN on it with ARGS." (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 + (apply process-fun args)) ;; no status-plist arg from cache + ;; fetch as usual and process-image-response will cache it: + ;; cbargs fun will be called with status-plist by url-retrieve: (url-retrieve url process-fun (cdr args)))) (defun mastodon-media--load-image-from-url (url media-type start region-length) -- 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') 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') 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 8b82c650c5ec3286aa05b3a04d8ae09350c9d26e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 11:52:17 +0200 Subject: filters binding string / newlines --- lisp/mastodon-views.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index f033d3c..c3c372d 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -589,8 +589,8 @@ NO-CONFIRM means there is no ask or message, there is only do." 'mastodon-views--insert-filters nil nil nil "current filters" - "c - create filter | d/k - delete filter at point\n\ - u - update filter\n a/r/U - add/remove/Update filter keyword\n + "c/u - create/update filter | d/k - delete filter\ + at point\n a/r/U - add/remove/Update filter keyword\n\ n/p - next/prev filter" "v2") (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) @@ -604,7 +604,7 @@ JSON is the filters data." (defun mastodon-views--insert-filter-kws (kws) "Insert filter keywords KWS." - (insert "\n\n") + (insert "\n") (let ((beg (point)) (table-cell-horizontal-chars (if (char-displayable-p ?–) ; ?– ?-) "–" -- cgit v1.2.3 From 248eead48f10f96dafa21463064a297809df6ca9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 11:57:28 +0200 Subject: create filter cleanup --- lisp/mastodon-views.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index c3c372d..5480e09 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -674,11 +674,11 @@ Prompt for a context, must be a list containting at least one of \"home\", \"notifications\", \"public\", \"thread\". Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (interactive) - (let* ((url (if id - (mastodon-http--api-v2 (format "filters/%s" id)) - (mastodon-http--api-v2 "filters"))) + (let* ((url (mastodon-http--api-v2 + (if id (format "filters/%s" id) "filters"))) (title (or title (read-string "Filter name: "))) - (terms (or terms (read-string "Terms to filter (comma or space separated): "))) + (terms (or terms + (read-string "Terms to filter (comma or space separated): "))) (terms-split (split-string terms "[, ]")) (terms-processed (if (not terms) @@ -708,7 +708,7 @@ Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (mastodon-http--post url params)))) (mastodon-views--filters-triage resp - (message "Filter %s created!" title)))) + (message "Filter %s %s!" title (if id "updated" "created"))))) (defun mastodon-views--update-filter () "Update filter at point." -- cgit v1.2.3 From c0714fdc408b0c6e482967d1eb5b2c5f26216215 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 12:05:22 +0200 Subject: filter props --- lisp/mastodon-views.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 5480e09..cdebc6e 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -645,9 +645,6 @@ JSON is the filters data." (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " (propertize (upcase .title) - 'item-id .id - 'item-type 'filter - 'filter-title .title 'byline t) " " "\n" " " mastodon-tl--horiz-bar "\n") @@ -659,6 +656,7 @@ JSON is the filters data." (concat "\nType: " .filter_action)) 'item-json filter 'item-id .id + 'filter-title .title 'item-type 'filter)) ;; terms list: (if (not .keywords) ;; poss to have a filter sans keywords -- cgit v1.2.3 From 9ba2b21fc391a1d732689e1dd06fe66fd0c6d8af Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 18:35:14 +0200 Subject: filters: fix no keywords check --- lisp/mastodon-views.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index cdebc6e..e47e0dc 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -659,8 +659,7 @@ JSON is the filters data." 'filter-title .title 'item-type 'filter)) ;; terms list: - (if (not .keywords) ;; poss to have a filter sans keywords - "" + (when .keywords ;; poss to have no keywords (mastodon-views--insert-filter-kws .keywords)))) (defvar mastodon-views--filter-types -- cgit v1.2.3 From 404f004a2ad9b81542571ec785fdbd948b9b2ee1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 18:35:24 +0200 Subject: filters: hack to fix nav --- lisp/mastodon-views.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index e47e0dc..cce43fc 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -639,22 +639,26 @@ JSON is the filters data." "Insert a single FILTER." (let-alist filter (insert + ;; FIXME: awful hack to fix nav: exclude horiz-bar from propertize then + ;; propertize rest of the filter text. if we add only byline prop to + ;; title, point will move to end of title, because at that byline-prop + ;; change, item-type prop is present. + (mastodon-tl--set-face + (concat "\n " mastodon-tl--horiz-bar "\n ") + 'success) (propertize (concat ;; heading: (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n " - (propertize (upcase .title) - 'byline t) - " " "\n" - " " mastodon-tl--horiz-bar "\n") + (concat (upcase .title) " " "\n " + mastodon-tl--horiz-bar "\n") 'success) ;; context: - (concat "Context: " - (mapconcat #'identity .context ", ")) + (concat "Context: " (mapconcat #'identity .context ", ")) ;; type (warn or hide): (concat "\nType: " .filter_action)) 'item-json filter + 'byline t 'item-id .id 'filter-title .title 'item-type 'filter)) -- cgit v1.2.3 From 0007f7daf8c6acf8611e3203e125c4785f58f4cd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 18 Aug 2024 18:45:46 +0200 Subject: tiny audit of filters v2 code --- lisp/mastodon-views.el | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index cce43fc..ef91bd0 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -606,10 +606,10 @@ JSON is the filters data." "Insert filter keywords KWS." (insert "\n") (let ((beg (point)) - (table-cell-horizontal-chars (if (char-displayable-p ?–) ; ?– ?-) + (table-cell-horizontal-chars (if (char-displayable-p ?–) "–" "-")) - (whole-str "whole-words-only:")) + (whole-str "whole words only:")) (insert (concat "Keywords: | " whole-str "\n")) (mapc (lambda (kw) (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) @@ -675,6 +675,7 @@ Prompt for a context, must be a list containting at least one of \"home\", \"notifications\", \"public\", \"thread\". Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (interactive) + ;; ID non-nil = we are updating (let* ((url (mastodon-http--api-v2 (if id (format "filters/%s" id) "filters"))) (title (or title (read-string "Filter name: "))) @@ -682,26 +683,23 @@ Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (read-string "Terms to filter (comma or space separated): "))) (terms-split (split-string terms "[, ]")) (terms-processed - (if (not terms) - (user-error "You must select at least one term to filter") + (if (not terms) ;; well actually it is poss to have no terms + (user-error "You must select at least one term") (mastodon-http--build-array-params-alist "keywords_attributes[][keyword]" terms-split))) (warn-or-hide - (or type - (completing-read "Warn (like CW) or hide? " - '("warn" "hide") nil :match))) + (or type (completing-read "Warn (like CW) or hide? " + '("warn" "hide") nil :match))) (contexts - (or context - (completing-read-multiple - "Filter contexts [TAB for options, comma separated]: " - mastodon-views--filter-types nil :match))) + (or context (completing-read-multiple + "Filter contexts [TAB for options, comma separated]: " + mastodon-views--filter-types nil :match))) (contexts-processed (if (not contexts) - (user-error "You must select at least one context for a filter") + (user-error "You must select at least one context") (mastodon-http--build-array-params-alist "context[]" contexts))) (params (append `(("title" . ,title) ("filter_action" . ,warn-or-hide)) - ;; ("keywords_attributes[][whole_word]" . "false")) terms-processed contexts-processed)) (resp (if id @@ -730,7 +728,6 @@ Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." (terms (read-string "Terms to add (comma or space separated): "))) (mastodon-views--create-filter id name contexts type terms)))) - (defun mastodon-views--delete-filter () "Delete filter at point." (interactive) -- cgit v1.2.3 From ffcd7553d708c775127946dfe638cba0cda34312 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 19 Aug 2024 12:08:53 +0200 Subject: comment re instance JSON error --- lisp/mastodon-http.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1b624ee..39c1036 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -249,6 +249,10 @@ Callback to `mastodon-http--get-response-async', usually (string-prefix-p "\n[" json-string))) (error "%s" json-string)) (t + ;; instance may return error in JSON e.g. ((error . "Record not + ;; found")) for a null endpoint. but we don't error here because + ;; sometimes we just want to check for such an error in an + ;; if/cond. `(,(json-read-from-string json-string) . ,headers)))))) (defun mastodon-http--process-headers () -- 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') 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') 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') 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') 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') 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') 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') 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 9d3a301dc8f80fdf2c07d32d2c3e416b560a33f4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 24 Aug 2024 21:00:23 +0200 Subject: autoload image-trans-check. FIX #584. --- lisp/mastodon-toot.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 762c313..832d03f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -99,6 +99,7 @@ (autoload 'mastodon-tl--human-duration "mastodon-tl") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (autoload 'mastodon-views--get-own-instance "mastodon-views") +(autoload 'mastodon-tl--image-trans-check "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") -- 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') 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') 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') 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') 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 From e2ba94796e3a4e0ae26673d1ddd8d47e9e2269f1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 20 Sep 2024 15:09:27 +0200 Subject: url-lookup regex: add a GTS match --- lisp/mastodon.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 2f2f637..3eff126 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -432,6 +432,7 @@ not, just browse the URL in the normal fashion." (string-match "^/c/[[:alnum:]_]+$" query) (string-match "^/post/[[:digit:]]+$" query) (string-match "^/comment/[[:digit:]]+$" query) ; lemmy + (string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS (string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown (string-match "^/notes/[[:alnum:]]+$" query))))) ; misskey post -- cgit v1.2.3