From ddcaf0e1b2db6097d5e942eb75ffb27b86c6b1cb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 31 May 2024 13:08:09 +0200 Subject: add max-id to buffer-spec, and set when calling tl--more --- lisp/mastodon-tl.el | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aa70507..14603b8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1657,7 +1657,8 @@ If NO-ERROR is non-nil, do not error when property is empty." property))))) (defun mastodon-tl--set-buffer-spec - (buffer endpoint update-fun &optional link-header update-params hide-replies) + (buffer endpoint update-fun + &optional link-header update-params hide-replies max-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. @@ -1672,7 +1673,8 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." update-function ,update-fun link-header ,link-header update-params ,update-params - hide-replies ,hide-replies))) + hide-replies ,hide-replies + max-id ,max-id))) ;;; BUFFERS @@ -2622,13 +2624,14 @@ and profile pages when showing followers or accounts followed." (mastodon-tl--update-params) 'mastodon-tl--more* (current-buffer) (point))) (t;; max_id paginate (timelines, items with ids/timestamps): - (mastodon-tl--more-json-async - (mastodon-tl--endpoint) - (mastodon-tl--oldest-id) - (mastodon-tl--update-params) - 'mastodon-tl--more* (current-buffer) (point)))))) - -(defun mastodon-tl--more* (response buffer point-before &optional headers) + (let ((max-id (mastodon-tl--oldest-id))) + (mastodon-tl--more-json-async + (mastodon-tl--endpoint) + max-id + (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) "Append older toots to timeline, asynchronously. Runs the timeline's update function on RESPONSE, in BUFFER. When done, places point at POINT-BEFORE. @@ -2663,13 +2666,13 @@ HEADERS is the http headers returned in the response, if any." (message "No more results.") (funcall (mastodon-tl--update-function) json) (goto-char point-before) - ;; update buffer spec to new link-header: + ;; update buffer spec to new link-header or max-id: ;; (other values should just remain as they were) - (when headers - (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) - (mastodon-tl--endpoint) - (mastodon-tl--update-function) - link-header)) + (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) + (mastodon-tl--endpoint) + (mastodon-tl--update-function) + link-header + nil nil max-id) (message "Loading... done."))))))) (defun mastodon-tl--find-property-range (property start-point -- cgit v1.2.3 From 2b426fb913b248d161122de9cca5368c60f72cea Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 31 May 2024 14:11:49 +0200 Subject: working max-id arg for hometimeline/reload --- lisp/mastodon-tl.el | 19 ++++++++++++------- lisp/mastodon-toot.el | 2 ++ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 14603b8..070c153 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -460,14 +460,18 @@ With a double PREFIX arg, only show posts with media." params (when (eq prefix 4) t)))) -(defun mastodon-tl--get-home-timeline (&optional arg) +(defun mastodon-tl--get-home-timeline (&optional arg max-id) "Open home timeline. With a single prefix ARG, hide replies." (interactive "p") - (message "Loading home timeline...") - (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil - `(("limit" . ,mastodon-tl--timeline-posts-count)) - (when (eq arg 4) t))) + (let* ((params + `(("limit" . ,mastodon-tl--timeline-posts-count) + ,(when max-id + `("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))) + (message "Loading home timeline...") + (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil + params ;`(("limit" . ,mastodon-tl--timeline-posts-count)) + (when (eq arg 4) t)))) (defun mastodon-tl--get-remote-local-timeline () "Prompt for an instance domain and try to display its local timeline. @@ -2544,10 +2548,11 @@ the current view." (defun mastodon-tl--reload-timeline-or-profile (&optional pos) "Reload the current timeline or profile page. For use after e.g. deleting a toot. -POS is a number, where point will be placed." +POS is a number, where point will be placed. +Aims to respect any pagination in effect." (let ((type (mastodon-tl--get-buffer-type))) (cond ((eq type 'home) - (mastodon-tl--get-home-timeline)) + (mastodon-tl--get-home-timeline nil :max-id)) ((eq type 'federated) (mastodon-tl--get-federated-timeline)) ((eq type 'local) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 654918c..aaff19b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -906,6 +906,7 @@ instance to edit a toot." (mastodon-http--triage response (lambda (_) + ;; kill buffer: (mastodon-toot--kill) (if scheduled (message "Toot scheduled!") @@ -914,6 +915,7 @@ instance to edit a toot." (when scheduled-id (mastodon-views--cancel-scheduled-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 -- cgit v1.2.3 From 06cbc031c78210a4950a748b20142e0008728bef Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 31 May 2024 14:14:50 +0200 Subject: index --- mastodon-index.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mastodon-index.org b/mastodon-index.org index 4dd5ae3..0108fce 100644 --- a/mastodon-index.org +++ b/mastodon-index.org @@ -118,7 +118,7 @@ | F | mastodon-tl--get-federated-timeline | Open federated timeline. | | H | mastodon-tl--get-home-timeline | Open home timeline. | | L | mastodon-tl--get-local-timeline | Open local timeline. | -| | mastodon-tl--get-remote-local-timeline | Prompt for an instance domain and try to display its local timeline. | +| \ | mastodon-tl--get-remote-local-timeline | Prompt for an instance domain and try to display its local timeline. | | # | mastodon-tl--get-tag-timeline | Prompt for tag and opens its timeline. | | n | mastodon-tl--goto-next-item | Jump to next item. | | C- | mastodon-tl--goto-next-toot | | @@ -248,8 +248,8 @@ | mastodon-media--enable-image-caching | Whether images should be cached. | | mastodon-media--preview-max-height | Max height of any media attachment preview to be shown in timelines. | | mastodon-mode-hook | Hook run when entering Mastodon mode. | -| mastodon-notifications--profile-note-in-foll-reqs | When non-nil, show some of a user's profile note in follow | -| mastodon-notifications--profile-note-in-foll-reqs-max-length | The maximum character length for display of user profile note in | +| mastodon-notifications--profile-note-in-foll-reqs | If non-nil, show a user's profile note in follow request notifications. | +| mastodon-notifications--profile-note-in-foll-reqs-max-length | The max character length for user profile note in follow requests. | | mastodon-profile-mode-hook | Hook run after entering or leaving `mastodon-profile-mode'. | | mastodon-profile-update-mode-hook | Hook run after entering or leaving `mastodon-profile-update-mode'. | | mastodon-search-mode-hook | Hook run after entering or leaving `mastodon-search-mode'. | -- cgit v1.2.3 From 06627d5d3dfad265fabf5b80d39ebe82a070d1a9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 1 Jun 2024 10:12:39 +0200 Subject: max-id arg for other -tl.el timelines --- lisp/mastodon-tl.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 070c153..af1ce45 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -442,7 +442,7 @@ Used on initializing a timeline or thread." ;;; TIMELINES -(defun mastodon-tl--get-federated-timeline (&optional prefix local) +(defun mastodon-tl--get-federated-timeline (&optional prefix local max-id) "Open federated timeline. If LOCAL, get only local timeline. With a single PREFIX arg, hide-replies. @@ -454,6 +454,9 @@ With a double PREFIX arg, only show posts with media." (push '("only_media" . "true") params)) (when local (push '("local" . "true") params)) + (when max-id + (push `("max_id" . ,(mastodon-tl--buffer-property 'max-id)) + params)) (message "Loading federated timeline...") (mastodon-tl--init (if local "local" "federated") "timelines/public" 'mastodon-tl--timeline nil @@ -470,7 +473,7 @@ With a single prefix ARG, hide replies." `("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))) (message "Loading home timeline...") (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil - params ;`(("limit" . ,mastodon-tl--timeline-posts-count)) + params (when (eq arg 4) t)))) (defun mastodon-tl--get-remote-local-timeline () @@ -510,13 +513,13 @@ Use this to re-load remote-local items in order to interact with them." (uri (mastodon-tl--field 'uri toot))) (mastodon-url-lookup uri)))) -(defun mastodon-tl--get-local-timeline (&optional prefix) +(defun mastodon-tl--get-local-timeline (&optional prefix max-id) "Open local timeline. With a single PREFIX arg, hide-replies. With a double PREFIX arg, only show posts with media." (interactive "p") (message "Loading local timeline...") - (mastodon-tl--get-federated-timeline prefix :local)) + (mastodon-tl--get-federated-timeline prefix :local max-id)) (defun mastodon-tl--get-tag-timeline (&optional prefix tag) "Prompt for tag and opens its timeline. @@ -2554,9 +2557,9 @@ Aims to respect any pagination in effect." (cond ((eq type 'home) (mastodon-tl--get-home-timeline nil :max-id)) ((eq type 'federated) - (mastodon-tl--get-federated-timeline)) + (mastodon-tl--get-federated-timeline nil nil :max-id)) ((eq type 'local) - (mastodon-tl--get-local-timeline)) + (mastodon-tl--get-local-timeline nil :max-id)) ((eq type 'mentions) (mastodon-notifications--get-mentions)) ((eq type 'notifications) -- cgit v1.2.3 From 073ef686839944abc16f85883be8db84c95592ae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 1 Jun 2024 10:26:37 +0200 Subject: max-id arg/param for notifs-get --- lisp/mastodon-tl.el | 10 +++++----- lisp/mastodon.el | 6 ++++-- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index af1ce45..7ffa96d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2563,7 +2563,7 @@ Aims to respect any pagination in effect." ((eq type 'mentions) (mastodon-notifications--get-mentions)) ((eq type 'notifications) - (mastodon-notifications-get nil nil :force)) + (mastodon-notifications-get nil nil :force :max-id)) ((eq type 'profile-statuses-no-boosts) (mastodon-profile--open-statuses-no-reblogs)) ((eq type 'profile-statuses) @@ -2932,10 +2932,10 @@ JSON and http headers, without it just the JSON." link-header update-params hide-replies) (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) - "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. +(defun mastodon-tl--init-sync + (buffer-name endpoint update-function + &optional note-type params headers view-name binding-str) + "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. Runs synchronously. Optional arg NOTE-TYPE means only get that type of notification. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index da3ffe2..42d9707 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -338,7 +338,7 @@ If REPLY-JSON is the json of the toot being replied to." (mastodon-toot--compose-buffer user reply-to-id reply-json)) ;;;###autoload -(defun mastodon-notifications-get (&optional type buffer-name force) +(defun mastodon-notifications-get (&optional type buffer-name force max-id) "Display NOTIFICATIONS in buffer. Optionally only print notifications of type TYPE, a string. BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. @@ -356,7 +356,9 @@ from the server and load anew." (mastodon-tl--init-sync (or buffer-name "notifications") "notifications" 'mastodon-notifications--timeline - type) + type + (when max-id + `("max_id" . ,(mastodon-tl--buffer-property 'max-id)))) (with-current-buffer buffer (use-local-map mastodon-notifications--map))))) -- cgit v1.2.3 From 13162773b6fcff121bf3449075201a49547f68c4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 1 Jun 2024 10:39:50 +0200 Subject: max-id arg/params for (so far only plain) profile view --- lisp/mastodon-profile.el | 22 +++++++++++++--------- lisp/mastodon-tl.el | 5 ++++- lisp/mastodon.el | 2 +- 3 files changed, 18 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 46a56f6..37a6ec4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -146,7 +146,7 @@ This variable is set from data in (mastodon-tl--property 'item-json)) (defun mastodon-profile--make-author-buffer - (account &optional no-reblogs no-replies only-media tag) + (account &optional no-reblogs no-replies only-media tag max-id) "Take an ACCOUNT json and insert a user account into a new buffer. NO-REBLOGS means do not display boosts in statuses. NO-REPLIES means to exlude replies. @@ -154,7 +154,7 @@ ONLY-MEDIA means show only posts containing attachments. TAG is a hashtag to restrict posts to." (mastodon-profile--make-profile-buffer-for account "statuses" #'mastodon-tl--timeline no-reblogs nil - no-replies only-media tag)) + no-replies only-media tag max-id)) ;; TODO: we shd just load all views' data then switch coz this is slow af: (defun mastodon-profile--account-view-cycle () @@ -594,7 +594,7 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function - &optional no-reblogs headers no-replies only-media tag) + &optional no-reblogs headers no-replies only-media tag max-id) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. NO-REBLOGS means do not display boosts in statuses. HEADERS means also fetch link headers for pagination. @@ -602,7 +602,11 @@ NO-REPLIES means to exlude replies. ONLY-MEDIA means show only posts containing attachments. TAG is a hashtag to restrict posts to." (let-alist account - (let* ((args `(("limit" . ,mastodon-tl--timeline-posts-count))) + (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)))) (args (cond (no-reblogs (push '("exclude_reblogs" . "t") args)) (no-replies @@ -637,9 +641,8 @@ TAG is a hashtag to restrict posts to." (mastodon-profile-mode) (remove-overlays) (setq mastodon-profile--account account) - (mastodon-tl--set-buffer-spec buffer endpoint - update-function link-header - args) + (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")) @@ -748,12 +751,13 @@ the format \"2000-01-31T00:00:00.000Z\"." (format-time-string "Joined: %d %B %Y" (parse-iso8601-time-string joined))) -(defun mastodon-profile--get-toot-author () +(defun mastodon-profile--get-toot-author (&optional max-id) "Open profile of author of toot under point. If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer - (alist-get 'account (mastodon-profile--item-json)))) + (alist-get 'account (mastodon-profile--item-json)) + nil nil nil nil max-id)) (defun mastodon-profile--image-from-account (account img-type) "Return a avatar image from ACCOUNT. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7ffa96d..fe8f9f1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2565,9 +2565,12 @@ Aims to respect any pagination in effect." ((eq type 'notifications) (mastodon-notifications-get nil nil :force :max-id)) ((eq type 'profile-statuses-no-boosts) + ;; TODO: max-id arg needed here also (mastodon-profile--open-statuses-no-reblogs)) ((eq type 'profile-statuses) - (mastodon-profile--my-profile)) + (save-excursion + (goto-char (point-min)) + (mastodon-profile--get-toot-author :max-id))) ((eq type 'thread) (save-match-data (let ((endpoint (mastodon-tl--endpoint))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 42d9707..24a6b4c 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -358,7 +358,7 @@ from the server and load anew." 'mastodon-notifications--timeline type (when max-id - `("max_id" . ,(mastodon-tl--buffer-property 'max-id)))) + `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))) (with-current-buffer buffer (use-local-map mastodon-notifications--map))))) -- cgit v1.2.3 From 9239f652265e0a3f29f73c442a1b2d3d0b3e5c16 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 1 Jun 2024 11:00:44 +0200 Subject: set max-id in buffer spec also after reloading --- lisp/mastodon-tl.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fe8f9f1..28177bc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2932,7 +2932,9 @@ JSON and http headers, without it just the JSON." (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) + link-header update-params hide-replies + ;; awful hack to fix multiple reloads: + (alist-get "max_id" update-params nil nil #'equal)) (mastodon-tl--do-init json update-function instance))))))) (defun mastodon-tl--init-sync @@ -2968,7 +2970,9 @@ BINDING-STR is a string explaining any bindins in the view." (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) + link-header params nil + ;; awful hack to fix multiple reloads: + (alist-get "max_id" params nil nil #'equal)) (mastodon-tl--do-init json update-function) buffer))) -- cgit v1.2.3 From 63a07d2ff4bff73d377ab4931cf0fb1fd7d51146 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 10:51:48 +0200 Subject: flycheck --- lisp/mastodon-notifications.el | 2 +- lisp/mastodon-profile.el | 9 ++++++--- lisp/mastodon-tl.el | 12 ++++++++---- 3 files changed, 15 insertions(+), 8 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index c26d0b0..5806893 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -261,7 +261,7 @@ Status notifications are given when (equal type 'follow-request) (equal type 'mention)) 'mastodon-tl--byline-author - (lambda (_status &rest args) ; unbreak stuff + (lambda (_status &rest _args) ; unbreak stuff (mastodon-tl--byline-author note))) ;; action-byline (lambda (_status) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 37a6ec4..b96caa0 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -151,7 +151,8 @@ This variable is set from data in NO-REBLOGS means do not display boosts in statuses. NO-REPLIES means to exlude replies. ONLY-MEDIA means show only posts containing attachments. -TAG is a hashtag to restrict posts to." +TAG is a hashtag to restrict posts to. +MAX-ID is a flag to include the max_id pagination parameter." (mastodon-profile--make-profile-buffer-for account "statuses" #'mastodon-tl--timeline no-reblogs nil no-replies only-media tag max-id)) @@ -600,7 +601,8 @@ NO-REBLOGS means do not display boosts in statuses. HEADERS means also fetch link headers for pagination. NO-REPLIES means to exlude replies. ONLY-MEDIA means show only posts containing attachments. -TAG is a hashtag to restrict posts to." +TAG is a hashtag to restrict posts to. +MAX-ID is a flag to include the max_id pagination parameter." (let-alist account (let* ((max-id-str (when max-id (mastodon-tl--buffer-property 'max-id))) @@ -753,7 +755,8 @@ the format \"2000-01-31T00:00:00.000Z\"." (defun mastodon-profile--get-toot-author (&optional max-id) "Open profile of author of toot under point. -If toot is a boost, opens the profile of the booster." +If toot is a boost, opens the profile of the booster. +MAX-ID is a flag to include the max_id pagination parameter." (interactive) (mastodon-profile--make-author-buffer (alist-get 'account (mastodon-profile--item-json)) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 28177bc..949414c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -465,7 +465,8 @@ With a double PREFIX arg, only show posts with media." (defun mastodon-tl--get-home-timeline (&optional arg max-id) "Open home timeline. -With a single prefix ARG, hide replies." +With a single prefix ARG, hide replies. +MAX-ID is a flag to add the max_id pagination parameter." (interactive "p") (let* ((params `(("limit" . ,mastodon-tl--timeline-posts-count) @@ -516,7 +517,8 @@ Use this to re-load remote-local items in order to interact with them." (defun mastodon-tl--get-local-timeline (&optional prefix max-id) "Open local timeline. With a single PREFIX arg, hide-replies. -With a double PREFIX arg, only show posts with media." +With a double PREFIX arg, only show posts with media. +MAX-ID is a flag to add the max_id pagination parameter." (interactive "p") (message "Loading local timeline...") (mastodon-tl--get-federated-timeline prefix :local max-id)) @@ -1671,7 +1673,8 @@ 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." +HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer. +MAX-ID is the pagination parameter." (setq mastodon-tl--buffer-spec `(account ,(cons mastodon-active-user mastodon-instance-url) @@ -2646,7 +2649,8 @@ and profile pages when showing followers or accounts followed." "Append older toots to timeline, asynchronously. Runs the timeline's update function on RESPONSE, in BUFFER. When done, places point at POINT-BEFORE. -HEADERS is the http headers returned in the response, if any." +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") -- cgit v1.2.3 From 4aad54dcdff670f38bc0ba5891bca43d679ca46c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 17:12:34 +0200 Subject: get-poll > format-poll --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 949414c..dc1f251 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1232,7 +1232,7 @@ LONGEST-OPTION is the option whose length determines the formatting." (format "[%s votes]" (or (alist-get 'votes_count option) "0")))) -(defun mastodon-tl--get-poll (toot) +(defun mastodon-tl--format-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let-alist (mastodon-tl--field 'poll toot) ; toot or reblog (let* ((option-titles (mastodon-tl--map-alist 'title .options)) @@ -1454,7 +1454,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (media-p (mastodon-tl--field 'media_attachments toot))) (concat (mastodon-tl--render-text content toot) (when poll-p - (mastodon-tl--get-poll toot)) + (mastodon-tl--format-poll toot)) (when media-p (mastodon-tl--media toot))))) -- cgit v1.2.3 From 3303e85db950578d667bc686af7f866a60ba0ec1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 17:25:38 +0200 Subject: display a POLL flag in compose buffer. next step: display/edit/cancel polls --- lisp/mastodon-toot.el | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index aaff19b..d21084b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1387,7 +1387,8 @@ MAX is the maximum number set by their instance." (setq mastodon-toot-poll `(:options ,options :length ,length :multi ,multiple-p :hide ,hide-totals :expiry ,expiry)) - (message "poll created!"))) + (message "poll created!") + (mastodon-toot--update-status-fields))) (defun mastodon-toot--read-poll-options (count length) "Read a list of options for poll with COUNT options. @@ -1609,6 +1610,9 @@ REPLY-TEXT is the text of the toot being replied to." (propertize "CW" 'toot-post-cw-flag t) " " + (propertize "POLL" + 'toot-post-poll-flag t) + " " (propertize "NSFW" 'toot-post-nsfw-flag t) "\n" @@ -1700,6 +1704,8 @@ REPLY-REGION is a string to be injected into the buffer." (point-min))) (scheduled-region (mastodon-tl--find-property-range 'toot-post-scheduled (point-min))) + (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag + (point-min))) (toot-string (buffer-substring-no-properties (cdr header-region) (point-max)))) (add-text-properties (car count-region) (cdr count-region) @@ -1731,11 +1737,16 @@ REPLY-REGION is a string to be injected into the buffer." (add-text-properties (car nsfw-region) (cdr nsfw-region) (list 'display (if mastodon-toot--content-nsfw (if mastodon-toot--media-attachments - "NSFW" "NSFW (for attachments only)") + "NSFW" "NSFW (attachments only)") "") 'face 'mastodon-cw-face)) + (add-text-properties (car poll-region) (cdr poll-region) + (list 'display (if mastodon-toot-poll "POLL" "") + 'face 'mastodon-cw-face)) (add-text-properties (car cw-region) (cdr cw-region) - (list 'invisible (not mastodon-toot--content-warning) + (list 'display (if mastodon-toot--content-warning + "CW" + " ") ;; hold the blank space 'face 'mastodon-cw-face))))) (defun mastodon-toot--count-toot-chars (toot-string &optional cw) -- cgit v1.2.3 From de2937d9fa1a35cbc05e1c3d0dd6856d393b4111 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 17:31:24 +0200 Subject: poll not toot arg for format-poll --- lisp/mastodon-tl.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index dc1f251..89d70a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1232,9 +1232,9 @@ LONGEST-OPTION is the option whose length determines the formatting." (format "[%s votes]" (or (alist-get 'votes_count option) "0")))) -(defun mastodon-tl--format-poll (toot) +(defun mastodon-tl--format-poll (poll) "If TOOT includes a poll, return it as a formatted string." - (let-alist (mastodon-tl--field 'poll toot) ; toot or reblog + (let-alist poll (let* ((option-titles (mastodon-tl--map-alist 'title .options)) (longest-option (car (sort option-titles (lambda (x y) @@ -1454,7 +1454,8 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (media-p (mastodon-tl--field 'media_attachments toot))) (concat (mastodon-tl--render-text content toot) (when poll-p - (mastodon-tl--format-poll toot)) + (mastodon-tl--format-poll + (mastodon-tl--field 'poll toot))) ;; toot or reblog (when media-p (mastodon-tl--media toot))))) -- cgit v1.2.3 From d68cf7104b59e0c98743359bc566d7faf4a07776 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 17:58:13 +0200 Subject: mastodon-toot--clear-poll --- lisp/mastodon-toot.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d21084b..d38b66f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -279,6 +279,7 @@ send.") (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) (define-key map (kbd "C-c C-p") #'mastodon-toot--create-poll) + (define-key map (kbd "C-c C-o") #'mastodon-toot--clear-poll) (define-key map (kbd "C-c C-l") #'mastodon-toot--set-toot-language) (define-key map (kbd "C-c C-s") #'mastodon-toot--schedule-toot) map) @@ -1428,6 +1429,14 @@ LENGTH is the maximum character length allowed for a poll option." ("14 days" . ,(number-to-string (* 60 60 24 14))) ("30 days" . ,(number-to-string (* 60 60 24 30))))) +(defun mastodon-toot--clear-poll () + "Remove poll from toot compose buffer. +Sets `mastodon-toot-poll' to nil." + (interactive) + (if (not mastodon-toot-poll) + (user-error "No poll?") + (setq mastodon-toot-poll nil) + (mastodon-toot--update-status-fields))) ;;; SCHEDULE -- cgit v1.2.3 From f4b9c70d18aabd8f53bd09645cc8f29de599edec Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 19:10:01 +0200 Subject: simply format-poll length formatting --- lisp/mastodon-tl.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 89d70a5..1d9795d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1218,14 +1218,14 @@ SENSITIVE is a flag from the item's JSON data." ;; POLLS -(defun mastodon-tl--format-poll-option (option option-counter longest-option) +(defun mastodon-tl--format-poll-option (option option-counter length) "Format poll OPTION. OPTION-COUNTER is just a counter. LONGEST-OPTION is the option whose length determines the formatting." (format "%s: %s%s%s\n" option-counter (propertize (alist-get 'title option) 'face 'success) - (make-string (1+ (- (length longest-option) + (make-string (1+ (- length (length (alist-get 'title option)))) ?\ ) ;; TODO: disambiguate no votes from hidden votes @@ -1236,16 +1236,13 @@ LONGEST-OPTION is the option whose length determines the formatting." "If TOOT includes a poll, return it as a formatted string." (let-alist poll (let* ((option-titles (mastodon-tl--map-alist 'title .options)) - (longest-option (car (sort option-titles - (lambda (x y) - (> (length x) - (length y)))))) + (longest (car (sort (mapcar #'length option-titles) #'>))) (option-counter 0)) (concat "\nPoll: \n\n" (mapconcat (lambda (option) (setq option-counter (1+ option-counter)) (mastodon-tl--format-poll-option - option option-counter longest-option)) + option option-counter longest)) .options "\n") "\n" -- cgit v1.2.3 From 373d19b6cc6cc604cc34227103d95e8652016bdd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 2 Jun 2024 19:15:59 +0200 Subject: display poll deets in help-echo for display fields flag. --- lisp/mastodon-toot.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d38b66f..f964214 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1437,6 +1437,7 @@ Sets `mastodon-toot-poll' to nil." (user-error "No poll?") (setq mastodon-toot-poll nil) (mastodon-toot--update-status-fields))) + ;;; SCHEDULE @@ -1751,7 +1752,8 @@ REPLY-REGION is a string to be injected into the buffer." 'face 'mastodon-cw-face)) (add-text-properties (car poll-region) (cdr poll-region) (list 'display (if mastodon-toot-poll "POLL" "") - 'face 'mastodon-cw-face)) + 'face 'mastodon-cw-face + 'help-echo (prin1-to-string mastodon-toot-poll))) (add-text-properties (car cw-region) (cdr cw-region) (list 'display (if mastodon-toot--content-warning "CW" -- cgit v1.2.3 From d2c1a90ec48c4d90635c673c782e266fa5dd915e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 3 Jun 2024 10:28:45 +0200 Subject: reload on edit: only send max-id arg if we have one! --- lisp/mastodon-tl.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1d9795d..7345ea3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2554,24 +2554,25 @@ the current view." For use after e.g. deleting a toot. POS is a number, where point will be placed. Aims to respect any pagination in effect." - (let ((type (mastodon-tl--get-buffer-type))) + (let ((type (mastodon-tl--get-buffer-type)) + (max-id (mastodon-tl--buffer-property 'max-id nil :no-error))) (cond ((eq type 'home) - (mastodon-tl--get-home-timeline nil :max-id)) + (mastodon-tl--get-home-timeline nil max-id)) ((eq type 'federated) - (mastodon-tl--get-federated-timeline nil nil :max-id)) + (mastodon-tl--get-federated-timeline nil nil max-id)) ((eq type 'local) - (mastodon-tl--get-local-timeline nil :max-id)) + (mastodon-tl--get-local-timeline nil max-id)) ((eq type 'mentions) (mastodon-notifications--get-mentions)) ((eq type 'notifications) - (mastodon-notifications-get nil nil :force :max-id)) + (mastodon-notifications-get nil nil :force max-id)) ((eq type 'profile-statuses-no-boosts) ;; TODO: max-id arg needed here also (mastodon-profile--open-statuses-no-reblogs)) ((eq type 'profile-statuses) (save-excursion (goto-char (point-min)) - (mastodon-profile--get-toot-author :max-id))) + (mastodon-profile--get-toot-author max-id))) ((eq type 'thread) (save-match-data (let ((endpoint (mastodon-tl--endpoint))) -- cgit v1.2.3 From 0396383c6586dcf5a8f84aa30f597f6dab21d7b8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 3 Jun 2024 10:30:10 +0200 Subject: editing to preserve polls. create poll plist from JSON. still can't edit actual polls, but can view/clear them, which is much better than zilch. --- lisp/mastodon-tl.el | 4 ++-- lisp/mastodon-toot.el | 52 ++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 43 insertions(+), 13 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7345ea3..573c2fa 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1220,7 +1220,7 @@ SENSITIVE is a flag from the item's JSON data." (defun mastodon-tl--format-poll-option (option option-counter length) "Format poll OPTION. OPTION-COUNTER is just a counter. -LONGEST-OPTION is the option whose length determines the formatting." +LENGTH is of the longest option, for formatting." (format "%s: %s%s%s\n" option-counter (propertize (alist-get 'title option) @@ -1233,7 +1233,7 @@ LONGEST-OPTION is the option whose length determines the formatting." "0")))) (defun mastodon-tl--format-poll (poll) - "If TOOT includes a poll, return it as a formatted string." + "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) #'>))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f964214..eec879e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -95,6 +95,8 @@ (autoload 'mastodon-tl--toot-or-base "mastodon-tl") (autoload 'mastodon-profile--get-source-value "mastodon-toot") (autoload 'mastodon-tl--get-buffer-type "mastodon-tl") +(autoload 'mastodon-tl--human-duration "mastodon-tl") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -678,7 +680,7 @@ MEDIA is the media_attachments data for a status from the server." media)) (defun mastodon-toot--set-toot-properties - (reply-id visibility cw lang &optional scheduled scheduled-id media) + (reply-id visibility cw lang &optional scheduled scheduled-id media poll) "Set the toot properties for the current redrafted or edited toot. REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set. MEDIA is the media_attachments data for a status from the server." @@ -693,6 +695,8 @@ MEDIA is the media_attachments data for a status from the server." (mastodon-toot--set-cw cw) (when media (mastodon-toot--set-toot-media-attachments media)) + (when poll + (mastodon-toot--server-poll-to-local poll)) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields))) @@ -948,14 +952,15 @@ instance to edit a toot." (toot-visibility (alist-get 'visibility toot)) (toot-language (alist-get 'language toot)) (reply-id (alist-get 'in_reply_to_id toot)) - (media (alist-get 'media_attachments toot))) + (media (alist-get 'media_attachments toot)) + (poll (alist-get 'poll toot))) (when (y-or-n-p "Edit this toot? ") (mastodon-toot--compose-buffer nil reply-id nil content :edit) (goto-char (point-max)) ;; adopt reply-to-id, visibility, CW, language, and media: (mastodon-toot--set-toot-properties reply-id toot-visibility - source-cw toot-language nil nil - media) + source-cw toot-language nil + nil media poll) (setq mastodon-toot--edit-item-id id))))))) (defun mastodon-toot--get-toot-source (id) @@ -1384,10 +1389,12 @@ MAX is the maximum number set by their instance." (multiple-p (y-or-n-p "Multiple choice? ")) (options (mastodon-toot--read-poll-options count length)) (hide-totals (y-or-n-p "Hide votes until poll ends? ")) - (expiry (mastodon-toot--read-poll-expiry))) + (expiry (mastodon-toot--read-poll-expiry)) + (expiry-str (cdr expiry)) + (expiry-human (car expiry))) (setq mastodon-toot-poll - `(:options ,options :length ,length :multi ,multiple-p - :hide ,hide-totals :expiry ,expiry)) + `( :options ,options :length ,length :expiry-readable ,expiry-human + :expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals)) (message "poll created!") (mastodon-toot--update-status-fields))) @@ -1407,15 +1414,15 @@ LENGTH is the maximum character length allowed for a poll option." choices))) (defun mastodon-toot--read-poll-expiry () - "Prompt for a poll expiry time." + "Prompt for a poll expiry time. +Return a cons of a human readable string, and a seconds-from-now string." ;; API requires this in seconds (let* ((options (mastodon-toot--poll-expiry-options-alist)) (response (completing-read "poll ends in [or enter seconds]: " options nil 'confirm))) - (or (alist-get response options nil nil #'equal) + (or (assoc response options #'equal) (if (< (string-to-number response) 600) - "600" ;; min 5 mins - response)))) + (car options))))) ;; min 5 mins (defun mastodon-toot--poll-expiry-options-alist () "Return an alist of expiry options options in seconds." @@ -1438,6 +1445,29 @@ Sets `mastodon-toot-poll' to nil." (setq mastodon-toot-poll nil) (mastodon-toot--update-status-fields))) +(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 + (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))) + (options (mapcar (lambda (o) + (alist-get 'title o)) + .options)) + (multiple (if (eq :json-false .multiple) + nil + t))) + (setq mastodon-toot-poll + `( :options ,options :expiry-readable ,expiry-human + :expiry ,expiry-str :multi ,multiple))))) + ;;; SCHEDULE -- cgit v1.2.3 From a1667687e3fc472f5ad48e8f2e234a9ad70bfa05 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 3 Jun 2024 11:20:02 +0200 Subject: index --- mastodon-index.org | 1 + 1 file changed, 1 insertion(+) diff --git a/mastodon-index.org b/mastodon-index.org index 0108fce..90be3df 100644 --- a/mastodon-index.org +++ b/mastodon-index.org @@ -155,6 +155,7 @@ | C-c C-k | mastodon-toot--cancel | Kill new-toot buffer/window. Does not POST content. | | C-c C-v | mastodon-toot--change-visibility | Change the current visibility to the next valid value. | | C-c ! | mastodon-toot--clear-all-attachments | Remove all attachments from a toot draft. | +| C-c C-o | mastodon-toot--clear-poll | Remove poll from toot compose buffer. | | | mastodon-toot--copy-toot-text | Copy text of toot at point. | | C | mastodon-toot--copy-toot-url | Copy URL of toot at point. | | C-c C-p | mastodon-toot--create-poll | Prompt for new poll options and return as a list. | -- cgit v1.2.3 From b4fc0f52b8737d761353df995eae9ebd1e084c40 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 3 Jun 2024 13:00:53 +0200 Subject: refactor apply status fields props --- lisp/mastodon-toot.el | 101 ++++++++++++++++++++++++++++---------------------- 1 file changed, 56 insertions(+), 45 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index eec879e..edb8bb7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1734,61 +1734,72 @@ REPLY-REGION is a string to be injected into the buffer." (point-min))) (count-region (mastodon-tl--find-property-range 'toot-post-counter (point-min))) - (visibility-region (mastodon-tl--find-property-range - 'toot-post-visibility (point-min))) + (vis-region (mastodon-tl--find-property-range + 'toot-post-visibility (point-min))) (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag (point-min))) (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag (point-min))) (lang-region (mastodon-tl--find-property-range 'toot-post-language (point-min))) - (scheduled-region (mastodon-tl--find-property-range 'toot-post-scheduled - (point-min))) + (sched-region (mastodon-tl--find-property-range 'toot-post-scheduled + (point-min))) (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag (point-min))) (toot-string (buffer-substring-no-properties (cdr header-region) (point-max)))) - (add-text-properties (car count-region) (cdr count-region) - (list 'display - (format "%s/%s chars" - (mastodon-toot--count-toot-chars toot-string) - (number-to-string mastodon-toot--max-toot-chars)))) - (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "%s" - (if (equal - mastodon-toot--visibility - "private") - "followers-only" - mastodon-toot--visibility)))) - (add-text-properties (car lang-region) (cdr lang-region) - (list 'display - (if mastodon-toot--language - (format "Lang: %s ⋅" - mastodon-toot--language) - ""))) - (add-text-properties (car scheduled-region) (cdr scheduled-region) - (list 'display - (if mastodon-toot--scheduled-for - (format "Scheduled: %s ⋅" - (mastodon-toot--iso-to-human - mastodon-toot--scheduled-for)) - ""))) - (add-text-properties (car nsfw-region) (cdr nsfw-region) - (list 'display (if mastodon-toot--content-nsfw - (if mastodon-toot--media-attachments - "NSFW" "NSFW (attachments only)") - "") - 'face 'mastodon-cw-face)) - (add-text-properties (car poll-region) (cdr poll-region) - (list 'display (if mastodon-toot-poll "POLL" "") - 'face 'mastodon-cw-face - 'help-echo (prin1-to-string mastodon-toot-poll))) - (add-text-properties (car cw-region) (cdr cw-region) - (list 'display (if mastodon-toot--content-warning - "CW" - " ") ;; hold the blank space - 'face 'mastodon-cw-face))))) + (mastodon-toot--apply-fields-props + count-region + (format "%s/%s chars" + (mastodon-toot--count-toot-chars toot-string) + (number-to-string mastodon-toot--max-toot-chars))) + (mastodon-toot--apply-fields-props + vis-region + (format "%s" + (if (equal + mastodon-toot--visibility + "private") + "followers-only" + mastodon-toot--visibility))) + (mastodon-toot--apply-fields-props + lang-region + (if mastodon-toot--language + (format "Lang: %s ⋅" + mastodon-toot--language) + "")) + (mastodon-toot--apply-fields-props + sched-region + (if mastodon-toot--scheduled-for + (format "Scheduled: %s ⋅" + (mastodon-toot--iso-to-human + mastodon-toot--scheduled-for)) + "")) + (mastodon-toot--apply-fields-props + nsfw-region + (if mastodon-toot--content-nsfw + (if mastodon-toot--media-attachments + "NSFW" "NSFW (attachments only)") + "") + 'mastodon-cw-face) + (mastodon-toot--apply-fields-props + poll-region + (if mastodon-toot-poll "POLL" "") + 'mastodon-cw-face + (prin1-to-string mastodon-toot-poll)) + (mastodon-toot--apply-fields-props + cw-region + (if mastodon-toot--content-warning + "CW" + " ") ;; hold the blank space + 'mastodon-cw-face)))) + +(defun mastodon-toot--apply-fields-props (region display &optional face help-echo) + "" + (add-text-properties (car region) (cdr region) + `(display + ,display + ,@(when face `(face ,face)) + ,@(when help-echo `(help-echo ,help-echo))))) (defun mastodon-toot--count-toot-chars (toot-string &optional cw) "Count the characters in TOOT-STRING. -- cgit v1.2.3 From 5e7e38a81a99e110ec62c0ccc622eb3c4b476cbc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 3 Jun 2024 16:36:07 +0200 Subject: boxed face for "pinned" in profile view --- lisp/mastodon-profile.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index b96caa0..069334a 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -573,7 +573,11 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--insert-statuses-pinned (pinned-statuses) "Insert each of the PINNED-STATUSES for a given account." (mapc (lambda (pinned-status) - (insert (mastodon-tl--set-face " :pinned: " 'success)) + (insert + (concat " " + (propertize " pinned " + 'face '(:inherit success :box t)) + " ")) (mastodon-tl--toot pinned-status)) pinned-statuses)) -- cgit v1.2.3 From daf97c3d8fc3560fb3d79aaffcfebf65802af4e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 11:42:42 +0200 Subject: factor out format-heading from insert-heading --- lisp/mastodon-search.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index d73bf9f..e69366e 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -122,15 +122,21 @@ PRINT-FUN is the function used to print the data from the response." ;; functions for mastodon search -(defun mastodon-search--insert-heading (heading &optional type) - "Format HEADING as a heading. +(defun mastodon-search--insert-heading (str &optional type) + "Insert STR as a heading. Optionally add string TYPE after HEADING." (insert - (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " - (upcase heading) " " - (if type (upcase type) "") "\n" - " " mastodon-tl--horiz-bar "\n") - 'success))) + (mastodon-search--format-heading str type))) + +(defun mastodon-search--format-heading (str &optional type) + "Format STR as a heading. +Optionally add string TYPE after HEADING." + (mastodon-tl--set-face + (concat "\n " mastodon-tl--horiz-bar "\n " + (upcase str) " " + (if type (upcase type) "") "\n" + " " mastodon-tl--horiz-bar "\n") + 'success)) (defvar mastodon-search-types '("statuses" "accounts" "hashtags")) -- cgit v1.2.3 From 5964ad1703bf04010d46497b27b388e1b0057883 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 11:43:00 +0200 Subject: rough toggle display of sensitive images --- lisp/mastodon-media.el | 44 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 41 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 3f6d0df..8da9bb5 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -38,6 +38,7 @@ (require 'image-mode) (autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") (defvar url-show-status) @@ -173,12 +174,50 @@ 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. - (put-text-property marker (+ marker region-length) - 'display 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)))))) +(defun mastodon-media--display-image-or-sensitive (marker region-length image) + "Display image using display property, or add sensitive mask. +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 (not (get-text-property marker 'sensitive)) + ;; display image + (put-text-property marker (+ marker region-length) + 'display image) + ;; display sensitive placeholder and save image data as prop: + (add-text-properties marker (+ marker region-length) + `(display + ;; TODO: use an image placeholder + ;; ,(mastodon-search--format-heading " SENSITIVE") + ,(create-image mastodon-media--generic-broken-image-data nil t) + sensitive-state hidden + image-data ,image)))) + +(defun mastodon-media--toggle-sensitive-image () + "Toggle dislay of sensitive image at point." + (interactive) + (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 + ;; TODO: use an image placeholder + ,(create-image mastodon-media--generic-broken-image-data nil t) + ;; ,(mastodon-search--format-heading " SENSITIVE") + ))))) + (defun mastodon-media--process-full-sized-image-response (status-plist url) ;; FIXME: refactor this with but not into ;; `mastodon-media--process-image-response'. @@ -295,7 +334,6 @@ Replace them with the referenced image." (put-text-property start end 'media-state 'invalid-url) ;; proceed to load this image asynchronously (put-text-property start end 'media-state 'loading) - ;; TODO: only load-image if not sensitive: (mastodon-media--load-image-from-url image-url media-type start (- end start)) (when (or (equal type "gifv") -- cgit v1.2.3 From 7d27e4d5ff7f2e5c330f23ec119b6aeca30031e3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 12:08:46 +0200 Subject: move toggle sensitive image to tl and give it a binding --- lisp/mastodon-media.el | 21 --------------------- lisp/mastodon-tl.el | 23 +++++++++++++++++++++++ 2 files changed, 23 insertions(+), 21 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8da9bb5..9827ab8 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -38,7 +38,6 @@ (require 'image-mode) (autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") -(autoload 'mastodon-tl--property "mastodon-tl") (defvar url-show-status) @@ -198,26 +197,6 @@ image-data prop so it can be toggled." sensitive-state hidden image-data ,image)))) -(defun mastodon-media--toggle-sensitive-image () - "Toggle dislay of sensitive image at point." - (interactive) - (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 - ;; TODO: use an image placeholder - ,(create-image mastodon-media--generic-broken-image-data nil t) - ;; ,(mastodon-search--format-heading " SENSITIVE") - ))))) - (defun mastodon-media--process-full-sized-image-response (status-plist url) ;; FIXME: refactor this with but not into ;; `mastodon-media--process-image-response'. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 573c2fa..cf5d316 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -292,6 +292,7 @@ types of mastodon links and not just shr.el-generated ones.") ;; keep new my-profile binding; shr 'O' doesn't work here anyway (define-key map (kbd "O") #'mastodon-profile--my-profile) (define-key map (kbd "C") #'mastodon-tl--copy-image-caption) + (define-key map (kbd "C-c C-c") #'mastodon-tl--toggle-sensitive-image) (define-key map (kbd "") #'mastodon-tl--mpv-play-video-at-point) (define-key map (kbd "") #'mastodon-tl--click-image-or-video) map) @@ -1215,6 +1216,28 @@ SENSITIVE is a flag from the item's JSON data." (url-retrieve url #'mastodon-media--process-full-sized-image-response `(,url))))))) +(defvar mastodon-media--generic-broken-image-data) + +(defun mastodon-tl--toggle-sensitive-image () + "Toggle dislay of sensitive image at point." + (interactive) + (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 + ;; TODO: use an image placeholder + ,(create-image mastodon-media--generic-broken-image-data nil t) + ;; ,(mastodon-search--format-heading " SENSITIVE") + ))))) + ;; POLLS -- cgit v1.2.3 From 4d49c35380000488e2c553d39f92f330020f5dfb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 12:31:53 +0200 Subject: fix sensitive prop test: json-false or t! --- lisp/mastodon-media.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9827ab8..5c286fb 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -184,7 +184,8 @@ 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 (not (get-text-property marker 'sensitive)) + (if (equal :json-false + (get-text-property marker 'sensitive)) ;; display image (put-text-property marker (+ marker region-length) 'display image) -- cgit v1.2.3 From 1528a130e7c3119a32b47586e3b206b8993243d8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 14:07:18 +0200 Subject: use sensitive image placeholder --- lisp/mastodon-media.el | 135 +++++++++++++++++++++++++++++++++++++++++++++++-- lisp/mastodon-tl.el | 6 +-- 2 files changed, 134 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 5c286fb..2a4f9c4 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -138,6 +138,136 @@ BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") "The PNG data for a generic 200x200 \"broken image\" view.") +(defvar mastodon-media--sensitive-image-data + (base64-decode-string + "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl +IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs +MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y +Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc +ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD +Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI +UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2 +tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi +c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz +2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh +BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN +f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14 +aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN +cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv +IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0 +dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp +cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94 +YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv +c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs +ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg +ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht +cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt +cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w +TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi +NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3 +NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ +ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1 +MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv +bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9 +IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0 +VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8 +cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i +CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt +Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4 +KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y +ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS +REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg +ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA +CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh +dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe +YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za +3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI +BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA +IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw +CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O +BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz +anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS +UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9 +uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr +1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW +DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn +a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC ++53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO +q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr +q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd ++5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO +O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N +MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl +j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte +19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh +GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL +y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2 +u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K +Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ +l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs +9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO +q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S +DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd +y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe ++LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS +OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK +BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9 +sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8 +oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO +s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv +lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V +l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO +h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59 +W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09 +KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c +uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L +4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns +5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX +LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF +Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP +/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ +CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA +QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA +QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA +BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA +IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==") + "The PNG data for a sensitive image placeholder.") + (defun mastodon-media--process-image-response (status-plist marker image-options region-length url) "Callback function processing the url retrieve response for URL. @@ -192,9 +322,8 @@ image-data prop so it can be toggled." ;; display sensitive placeholder and save image data as prop: (add-text-properties marker (+ marker region-length) `(display - ;; TODO: use an image placeholder - ;; ,(mastodon-search--format-heading " SENSITIVE") - ,(create-image mastodon-media--generic-broken-image-data nil t) + ;; (image :type png :data ,mastodon-media--sensitive-image-data) + ,(create-image mastodon-media--sensitive-image-data nil t) sensitive-state hidden image-data ,image)))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index cf5d316..5ad5e69 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1233,10 +1233,8 @@ SENSITIVE is a flag from the item's JSON data." (add-text-properties (point) end `( sensitive-state hidden display - ;; TODO: use an image placeholder - ,(create-image mastodon-media--generic-broken-image-data nil t) - ;; ,(mastodon-search--format-heading " SENSITIVE") - ))))) + ,(create-image + mastodon-media--sensitive-image-data nil t)))))) ;; POLLS -- cgit v1.2.3 From 7c7f02b5b4211913324c5a1d18528f6533513830 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 14:07:31 +0200 Subject: fix sensitive prop check --- lisp/mastodon-media.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 2a4f9c4..ccc0893 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -314,8 +314,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 (equal :json-false - (get-text-property marker 'sensitive)) + (if (not (equal t (get-text-property marker 'sensitive))) ;; display image (put-text-property marker (+ marker region-length) 'display image) -- cgit v1.2.3 From b743ca81fcd1883d9ac80daf5ec151b2fd7e94b6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 15:46:26 +0200 Subject: move sensitive binding off C-c C-c. C C is bad in search buffers (it cycles them) and profile buffers (cycling), so if point isn't on image, it does the other action, and being on an image also masks that binding. we go with S instead, which otherwise is just jump to scheduled toots. --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5ad5e69..62e4c81 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -292,7 +292,7 @@ types of mastodon links and not just shr.el-generated ones.") ;; keep new my-profile binding; shr 'O' doesn't work here anyway (define-key map (kbd "O") #'mastodon-profile--my-profile) (define-key map (kbd "C") #'mastodon-tl--copy-image-caption) - (define-key map (kbd "C-c C-c") #'mastodon-tl--toggle-sensitive-image) + (define-key map (kbd "S") #'mastodon-tl--toggle-sensitive-image) (define-key map (kbd "") #'mastodon-tl--mpv-play-video-at-point) (define-key map (kbd "") #'mastodon-tl--click-image-or-video) map) -- cgit v1.2.3 From bd2f44911044f64c3303d080649ca2571b876ce1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 17:19:54 +0200 Subject: add remove-overlays to with-mastodon-buffer macro --- lisp/mastodon-profile.el | 1 - lisp/mastodon-tl.el | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 069334a..de16b7d 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -645,7 +645,6 @@ MAX-ID is a flag to include the max_id pagination parameter." (relationships (mastodon-profile--relationships-get .id))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-profile-mode) - (remove-overlays) (setq mastodon-profile--account account) (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header args nil max-id-str) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 573c2fa..00e3ce3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -322,6 +322,7 @@ than `pop-to-buffer'." (let ((inhibit-read-only t)) (erase-buffer) (funcall ,mode-fun) + (remove-overlays) ; video overlays (if ,other-window (switch-to-buffer-other-window ,buffer) (pop-to-buffer ,buffer '(display-buffer-same-window))) @@ -1979,7 +1980,6 @@ view all branches of a thread." ;; if we have a thread: (with-mastodon-buffer buffer #'mastodon-mode nil (let ((marker (make-marker))) - (remove-overlays) ; video overlays (mastodon-tl--set-buffer-spec buffer endpoint #'mastodon-tl--thread) (mastodon-tl--timeline (alist-get 'ancestors context) :thread) -- cgit v1.2.3 From 638045a2b2e76d506eab61f7aca23b5439299c39 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 4 Jun 2024 17:19:54 +0200 Subject: add remove-overlays to with-mastodon-buffer macro --- lisp/mastodon-profile.el | 1 - lisp/mastodon-tl.el | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 069334a..de16b7d 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -645,7 +645,6 @@ MAX-ID is a flag to include the max_id pagination parameter." (relationships (mastodon-profile--relationships-get .id))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-profile-mode) - (remove-overlays) (setq mastodon-profile--account account) (mastodon-tl--set-buffer-spec buffer endpoint update-function link-header args nil max-id-str) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 62e4c81..166a0a4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -323,6 +323,7 @@ than `pop-to-buffer'." (let ((inhibit-read-only t)) (erase-buffer) (funcall ,mode-fun) + (remove-overlays) ; video overlays (if ,other-window (switch-to-buffer-other-window ,buffer) (pop-to-buffer ,buffer '(display-buffer-same-window))) @@ -2000,7 +2001,6 @@ view all branches of a thread." ;; if we have a thread: (with-mastodon-buffer buffer #'mastodon-mode nil (let ((marker (make-marker))) - (remove-overlays) ; video overlays (mastodon-tl--set-buffer-spec buffer endpoint #'mastodon-tl--thread) (mastodon-tl--timeline (alist-get 'ancestors context) :thread) -- cgit v1.2.3 From 4b892cad51b4dacbc2a00426c90223b8fe97ac09 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 5 Jun 2024 20:12:45 +0200 Subject: defcustom for hiding sensitive media --- lisp/mastodon-media.el | 7 ++++++- mastodon-index.org | 2 ++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index ccc0893..d14d283 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -60,6 +60,10 @@ "Whether images should be cached." :type 'boolean) +(defcustom mastodon-media--hide-sensitive-media t + "Whether media marked as sensitive should be hidden." + :type 'boolean) + (defvar mastodon-media--generic-avatar-data (base64-decode-string "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA @@ -314,7 +318,8 @@ 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 (not (equal t (get-text-property marker 'sensitive))) + (if (or (not (equal t (get-text-property marker 'sensitive))) + (not mastodon-media--hide-sensitive-media)) ;; display image (put-text-property marker (+ marker region-length) 'display image) diff --git a/mastodon-index.org b/mastodon-index.org index 90be3df..4637403 100644 --- a/mastodon-index.org +++ b/mastodon-index.org @@ -137,6 +137,7 @@ | | mastodon-tl--single-toot | View toot at point in separate buffer. | | | mastodon-tl--some-followed-tags-timeline | Prompt for some tags, and open a timeline for them. | | RET, T | mastodon-tl--thread | Open thread buffer for toot at point or with ID. | +| | mastodon-tl--toggle-sensitive-image | Toggle dislay of sensitive image at point. | | | mastodon-tl--toggle-spoiler-in-thread | Toggler content warning for all posts in current thread. | | c | mastodon-tl--toggle-spoiler-text-in-toot | Toggle the visibility of the spoiler text in the current toot. | | C-S-b | mastodon-tl--unblock-user | Query for USER-HANDLE from list of blocked users and unblock that user. | @@ -247,6 +248,7 @@ | mastodon-instance-url | Base URL for the fediverse instance you want to be active. | | mastodon-media--avatar-height | Height of the user avatar images (if shown). | | mastodon-media--enable-image-caching | Whether images should be cached. | +| mastodon-media--hide-sensitive-media | Whether media marked as sensitive should be hidden. | | mastodon-media--preview-max-height | Max height of any media attachment preview to be shown in timelines. | | mastodon-mode-hook | Hook run when entering Mastodon mode. | | mastodon-notifications--profile-note-in-foll-reqs | If non-nil, show a user's profile note in follow request notifications. | -- cgit v1.2.3 From 73d91dd163b7c7a8401aba26c5f41b13277239da Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 5 Jun 2024 20:21:26 +0200 Subject: add check to sensitive media toggle --- lisp/mastodon-tl.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 166a0a4..122e7fb 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -100,6 +100,7 @@ (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) @@ -1217,25 +1218,25 @@ SENSITIVE is a flag from the item's JSON data." (url-retrieve url #'mastodon-media--process-full-sized-image-response `(,url))))))) -(defvar mastodon-media--generic-broken-image-data) - (defun mastodon-tl--toggle-sensitive-image () "Toggle dislay of sensitive image at point." (interactive) - (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: + (if (not (eq t (mastodon-tl--property 'sensitive))) + (user-error "No sensitive media at point?") + (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 - `(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)))))) + `( sensitive-state hidden + display + ,(create-image + mastodon-media--sensitive-image-data nil t))))))) ;; POLLS -- cgit v1.2.3 From c7d026da82e901b9f1264e1f1a6369dd9c921921 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 10 Jun 2024 13:12:59 +0200 Subject: http: handle --get returning nil from instance --- lisp/mastodon-http.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 60654ff..d6abac4 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -187,9 +187,13 @@ PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. NO-HEADERS means don't collect http response headers. VECTOR means return json arrays as vectors." - (let ((buf (mastodon-http--get url params silent))) +(let ((buf (mastodon-http--get url params silent))) + ;; --get can return nil if instance unresponsive: + (if (not buf) + (user-error "Looks like the server response borked. \ +Is your instance up?") (with-current-buffer buf - (mastodon-http--process-response no-headers vector)))) + (mastodon-http--process-response no-headers vector))))) (defun mastodon-http--get-json (url &optional params silent vector) "Return only JSON data from URL request. -- cgit v1.2.3 From 2dfcd876dde600fea62adf126b572a1fb3a3357a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 15 Jun 2024 12:14:56 +0200 Subject: rough bookmarks, make record and handler --- lisp/mastodon-tl.el | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 122e7fb..f74bc8b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -3026,5 +3026,28 @@ When DOMAIN, force inclusion of user's domain in their handle." (unless (mastodon-tl--profile-buffer-p) (mastodon-tl--goto-first-item))) +;;; BOOKMARKS + +(defun mastodon-tl--bookmark-handler (record) + "Jump to a bookmarked location in mastodon.el. +RECORD is the bookmark record." + (let ((id (bookmark-prop-get record 'id))) + ;; we need to handle thread and single toot for starters + (mastodon-tl--thread id))) + +(defun mastodon-tl--bookmark-make-record () + "Return a bookmark record for the current mastodon buffer." + (let ((id (mastodon-tl--property 'item-id :no-move)) + (name (buffer-name))) + `(,name + (buf . ,name) + (id . ,id) + (handler . mastodon-tl--bookmark-handler)))) + +(add-hook 'mastodon-mode-hook + (lambda () + (setq-local bookmark-make-record-function + #'mastodon-tl--bookmark-make-record))) + (provide 'mastodon-tl) ;;; mastodon-tl.el ends here -- cgit v1.2.3 From 09212d2a6db0b3604014e4371f3b0c92376bc6e0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 15 Jun 2024 12:39:10 +0200 Subject: fix message-help-echo checks --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f74bc8b..c330dbd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -570,10 +570,10 @@ 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 echo ; not for followers/following in profile + (when (not (equal "" echo)) ; not for followers/following in profile (unless (or (string= type "follow_request") (string= type "follow")) ; no counts for these - (message "%s" (mastodon-tl--property 'help-echo :no-move)))))) + (message "%s" echo))))) (defun mastodon-tl--byline-author (toot &optional avatar domain) "Propertize author of TOOT. -- cgit v1.2.3 From 901da7f72221be31109cd4c47a31fe4314c6a6f2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 15 Jun 2024 12:44:52 +0200 Subject: with-mastodon-buffer : switch buffer after body --- lisp/mastodon-tl.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c330dbd..3611d1c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -325,10 +325,11 @@ than `pop-to-buffer'." (erase-buffer) (funcall ,mode-fun) (remove-overlays) ; video overlays + ,@body + ;; return result of switching buffer: (if ,other-window (switch-to-buffer-other-window ,buffer) - (pop-to-buffer ,buffer '(display-buffer-same-window))) - ,@body))) + (pop-to-buffer ,buffer '(display-buffer-same-window)))))) (defmacro mastodon-tl--do-if-item (&rest body) "Execute BODY if we have an item at point." -- cgit v1.2.3 From ae0b9ad7c11c7593a22fd0e8175911fe8a5a1e55 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 15 Jun 2024 12:46:27 +0200 Subject: pop-to-buffer in handler --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3611d1c..08debda 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -3034,7 +3034,8 @@ 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 - (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 b6faff356fca5b3305fd9c9167b020e67bdb85a8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 18 Jun 2024 13:22:59 +0200 Subject: cl-loop in tl--map-alist --- lisp/mastodon-tl.el | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 08debda..f518345 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1853,20 +1853,18 @@ timeline." ;;; UTILITIES -(defun mastodon-tl--map-alist (key alist) +(defun mastodon-tl--map-alist (key alist &optional testfn) "Return a list of values extracted from ALIST with KEY. Key is a symbol, as with `alist-get'." - (mapcar (lambda (x) - (alist-get key x)) - alist)) + (cl-loop for x in alist + collect (alist-get key x nil nil testfn))) (defun mastodon-tl--map-alist-vals-to-alist (key1 key2 alist) "From ALIST, return an alist consisting of (val1 . val2) elements. Values are accessed by `alist-get', using KEY1 and KEY2." - (mapcar (lambda (x) - (cons (alist-get key1 x) - (alist-get key2 x))) - alist)) + (cl-loop for x in alist + collect (cons (alist-get key1 x) + (alist-get key2 x)))) (defun mastodon-tl--symbol (name) "Return the unicode symbol (as a string) corresponding to NAME. @@ -2354,12 +2352,10 @@ ARGS is an alist of any parameters to send with the request." (let* ((toot (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs (mastodon-tl--property 'item-json :no-move))) (tags (mastodon-tl--field 'tags toot))) - (mapcar (lambda (x) - (alist-get 'name x)) - tags))) + (mastodon-tl--map-alist 'name tags))) (defun mastodon-tl--follow-tag (&optional tag) - "Prompt for a tag and follow it. + "Prompt for a tag (from post at point) and follow it. If TAG provided, follow it." (interactive) (let* ((tags (unless tag (mastodon-tl--get-tags-list))) -- cgit v1.2.3 From b5e9fb03ce310e5574efa06103ae119f31a25e43 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 18 Jun 2024 13:23:26 +0200 Subject: block fave/boost/bookmark on folls/foll-reqs --- lisp/mastodon-toot.el | 176 ++++++++++++++++++++++++++------------------------ 1 file changed, 92 insertions(+), 84 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index edb8bb7..d6de471 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -365,61 +365,65 @@ boosting, or bookmarking toots." "Toggle boost or favourite of toot at `point'. TYPE is a symbol, either `favourite' or `boost.'" (mastodon-tl--do-if-item-strict - (let* ((boost-p (equal type 'boost)) - ;; (has-id (mastodon-tl--property 'base-item-id)) - (byline-region ;(when has-id - (mastodon-tl--find-property-range 'byline (point))) - (id (when byline-region - (mastodon-tl--as-string (mastodon-tl--property 'base-item-id)))) - (boosted (when byline-region - (get-text-property (car byline-region) 'boosted-p))) - (faved (when byline-region - (get-text-property (car byline-region) 'favourited-p))) - (action (if boost-p - (if boosted "unreblog" "reblog") - (if faved "unfavourite" "favourite"))) - (msg (if boosted "unboosted" "boosted")) - (action-string (if boost-p "boost" "favourite")) - (remove (if boost-p (when boosted t) (when faved t))) - (item-json (mastodon-tl--property 'item-json)) - (toot-type (alist-get 'type item-json)) - (visibility (mastodon-tl--field 'visibility item-json))) - (if byline-region - (if (and (or (equal visibility "direct") - (equal visibility "private")) - boost-p) - (message "You cant boost posts with visibility: %s" visibility) - (cond ;; actually there's nothing wrong with faving/boosting own toots! - ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'item-json)) - ;;(error "You can't %s your own toots" action-string)) - ;; & nothing wrong with faving/boosting own toots from notifs: - ;; this boosts/faves the base toot, not the notif status - ((and (equal "reblog" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (user-error "You can't %s boosts" action-string)) - ((and (equal "favourite" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (user-error "You can't %s favourites" action-string)) - ((and (equal "private" visibility) - (equal type 'boost)) - (user-error "You can't boost private toots")) - (t - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action type remove) - (mastodon-toot--action-success (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove)) - (message (format "%s #%s" (if boost-p msg action) id))))))) - (message (format "Nothing to %s here?!?" action-string)))))) + (let ((n-type (mastodon-tl--property 'notification-type :no-move))) + (if (or (equal n-type "follow") + (equal n-type "follow_request")) + (user-error (format "Can't do action on %s notifications." n-type)) + (let* ((boost-p (equal type 'boost)) + ;; (has-id (mastodon-tl--property 'base-item-id)) + (byline-region ;(when has-id + (mastodon-tl--find-property-range 'byline (point))) + (id (when byline-region + (mastodon-tl--as-string (mastodon-tl--property 'base-item-id)))) + (boosted (when byline-region + (get-text-property (car byline-region) 'boosted-p))) + (faved (when byline-region + (get-text-property (car byline-region) 'favourited-p))) + (action (if boost-p + (if boosted "unreblog" "reblog") + (if faved "unfavourite" "favourite"))) + (msg (if boosted "unboosted" "boosted")) + (action-string (if boost-p "boost" "favourite")) + (remove (if boost-p (when boosted t) (when faved t))) + (item-json (mastodon-tl--property 'item-json)) + (toot-type (alist-get 'type item-json)) + (visibility (mastodon-tl--field 'visibility item-json))) + (if byline-region + (if (and (or (equal visibility "direct") + (equal visibility "private")) + boost-p) + (message "You cant boost posts with visibility: %s" visibility) + (cond ;; actually there's nothing wrong with faving/boosting own toots! + ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'item-json)) + ;;(error "You can't %s your own toots" action-string)) + ;; & nothing wrong with faving/boosting own toots from notifs: + ;; this boosts/faves the base toot, not the notif status + ((and (equal "reblog" toot-type) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (user-error "You can't %s boosts" action-string)) + ((and (equal "favourite" toot-type) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (user-error "You can't %s favourites" action-string)) + ((and (equal "private" visibility) + (equal type 'boost)) + (user-error "You can't boost private toots")) + (t + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--update-stats-on-action type remove) + (mastodon-toot--action-success (if boost-p + (mastodon-tl--symbol 'boost) + (mastodon-tl--symbol 'favourite)) + byline-region remove)) + (message (format "%s #%s" (if boost-p msg action) id))))))) + (message (format "Nothing to %s here?!?" action-string)))))))) (defun mastodon-toot--inc-or-dec (count subtract) "If SUBTRACT, decrement COUNT, else increment." @@ -464,35 +468,39 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "Bookmark or unbookmark toot at point." (interactive) (mastodon-tl--do-if-item-strict - (let* ((id (mastodon-tl--property 'base-item-id)) - (bookmarked-p - (mastodon-tl--property - 'bookmarked-p - (if (mastodon-tl--property 'byline :no-move) - ;; no move if not in byline, the idea being if in body, we do - ;; move forward to byline to toggle correctly. - ;; alternatively we could bookmarked-p whole posts. - :no-move))) - (byline-region (when id - (mastodon-tl--find-property-range 'byline (point)))) - (action (if bookmarked-p "unbookmark" "bookmark")) - (bookmark-str (mastodon-tl--symbol 'bookmark)) - (message (if bookmarked-p - "Bookmark removed!" - "Toot bookmarked!")) - (remove (when bookmarked-p t))) - (if byline-region - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success bookmark-str - byline-region remove) - (message (format "%s #%s" message id)))) - (message (format "Nothing to %s here?!?" action)))))) + (let ((n-type (mastodon-tl--property 'notification-type :no-move))) + (if (or (equal n-type "follow") + (equal n-type "follow_request")) + (user-error (format "Can't do action on %s notifications." n-type)) + (let* ((id (mastodon-tl--property 'base-item-id)) + (bookmarked-p + (mastodon-tl--property + 'bookmarked-p + (if (mastodon-tl--property 'byline :no-move) + ;; no move if not in byline, the idea being if in body, we do + ;; move forward to byline to toggle correctly. + ;; alternatively we could bookmarked-p whole posts. + :no-move))) + (byline-region (when id + (mastodon-tl--find-property-range 'byline (point)))) + (action (if bookmarked-p "unbookmark" "bookmark")) + (bookmark-str (mastodon-tl--symbol 'bookmark)) + (message (if bookmarked-p + "Bookmark removed!" + "Toot bookmarked!")) + (remove (when bookmarked-p t))) + (if byline-region + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p)))) + (mastodon-toot--action-success bookmark-str + byline-region remove) + (message (format "%s #%s" message id)))) + (message (format "Nothing to %s here?!?" action)))))))) (defun mastodon-toot--list-toot-boosters () "List the boosters of toot at point." -- cgit v1.2.3 From e7a630c900eda41a0f08e6cb08d716cd300c2d9d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Jun 2024 15:04:43 +0200 Subject: use map alist in attach descs and server poll to local --- lisp/mastodon-toot.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d6de471..928e317 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1291,9 +1291,10 @@ File is actually attached to the toot upon posting." (defun mastodon-toot--attachment-descriptions () "Return a list of image descriptions for current attachments." - (mapcar (lambda (a) - (alist-get :description a)) - mastodon-toot--media-attachments)) + (mastodon-tl--map-alist :description + ;; (mapcar (lambda (a) + ;; (alist-get :description a)) + mastodon-toot--media-attachments)) (defun mastodon-toot--attachment-from-desc (desc) "Return an attachment based on its description DESC." @@ -1466,9 +1467,7 @@ Sets `mastodon-toot-poll' to nil." (format-time-string "%s" expiry-seconds-from-now)) (expiry-human (car (mastodon-tl--human-duration expiry-seconds-from-now))) - (options (mapcar (lambda (o) - (alist-get 'title o)) - .options)) + (options (mastodon-tl--map-alist 'title .options)) (multiple (if (eq :json-false .multiple) nil t))) -- cgit v1.2.3 From d1baf1eed450b5dc5ddb8555d29eec3bb969a4fb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Jun 2024 15:09:14 +0200 Subject: bump version --- lisp/mastodon.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 490b9fa..d0dddee 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -6,7 +6,7 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 1.0.23 +;; Version: 1.0.24 ;; Package-Requires: ((emacs "27.1") (request "0.3.0") (persist "0.4")) ;; Homepage: https://codeberg.org/martianh/mastodon.el -- cgit v1.2.3 From caa3931c3950fac0d960639ce17dbc27c8e27689 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Jun 2024 15:10:27 +0200 Subject: map-alist: adapt arg and docstring --- lisp/mastodon-tl.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f518345..a40ec09 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1853,10 +1853,12 @@ timeline." ;;; UTILITIES -(defun mastodon-tl--map-alist (key alist &optional testfn) - "Return a list of values extracted from ALIST with KEY. -Key is a symbol, as with `alist-get'." - (cl-loop for x in alist +(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. +ALISTS is a list of alists." + ;; this actually for a list of alists, right? so change the arg? + (cl-loop for x in alists collect (alist-get key x nil nil testfn))) (defun mastodon-tl--map-alist-vals-to-alist (key1 key2 alist) -- cgit v1.2.3 From 47f93353ebdba93125fb8a9abcda33e2c6d46efe Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Jun 2024 15:11:53 +0200 Subject: flycheck tl.el --- lisp/mastodon-tl.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a40ec09..41ecd85 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1219,6 +1219,8 @@ SENSITIVE is a flag from the item's JSON data." (url-retrieve url #'mastodon-media--process-full-sized-image-response `(,url))))))) +(defvar mastodon-media--sensitive-image-data) + (defun mastodon-tl--toggle-sensitive-image () "Toggle dislay of sensitive image at point." (interactive) @@ -3027,6 +3029,8 @@ When DOMAIN, force inclusion of user's domain in their handle." ;;; BOOKMARKS +(require 'bookmark) + (defun mastodon-tl--bookmark-handler (record) "Jump to a bookmarked location in mastodon.el. RECORD is the bookmark record." -- cgit v1.2.3 From 66b14285e428207a60bfa18cc1464c1087713258 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 24 Jun 2024 15:14:02 +0200 Subject: docstring --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 928e317..23de8b7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1801,7 +1801,7 @@ REPLY-REGION is a string to be injected into the buffer." 'mastodon-cw-face)))) (defun mastodon-toot--apply-fields-props (region display &optional face help-echo) - "" + "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end." (add-text-properties (car region) (cdr region) `(display ,display -- cgit v1.2.3