diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-auth.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-discover.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-inspect.el | 26 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 22 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 50 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 33 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 406 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 151 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 205 | ||||
| -rw-r--r-- | lisp/mastodon.el | 8 |
11 files changed, 501 insertions, 407 deletions
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 5069271..5867b97 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -134,6 +134,7 @@ When ASK is absent return nil." (defun mastodon-auth--request-authorization-code () "Ask authorization code and return it." (let ((url (mastodon-auth--get-browser-login-url)) + (select-enable-clipboard t) authorization-code) (kill-new url) (message "%s" url) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index b3d8537..da25196 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -55,8 +55,8 @@ ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot) ("k" "Bookmark toot" mastodon-toot--toggle-bookmark) ("v" "Vote on poll" mastodon-tl--poll-vote) - ("n" "Next" mastodon-tl--goto-next-toot) - ("p" "Prev" mastodon-tl--goto-prev-toot) + ("n" "Next" mastodon-tl--goto-next-item) + ("p" "Prev" mastodon-tl--goto-prev-item) ("TAB" "Next link item" mastodon-tl--next-tab-item) ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) ;; NB: (when (require 'mpv etc. calls don't work here diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 3d26dc5..1edc8b5 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -91,7 +91,7 @@ RESPONSE if unsuccessful." (let ((status (with-current-buffer response (mastodon-http--status)))) (if (string-prefix-p "2" status) - (funcall success) + (funcall success response) (if (string-prefix-p "404" status) (message "Error %s: page not found" status) (let ((json-response (with-current-buffer response diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index c332dde..0a278ab 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -62,21 +62,21 @@ (interactive) (mastodon-inspect--dump-json-in-buffer (concat "*mastodon-inspect-toot-" - (mastodon-tl--as-string (mastodon-tl--property 'toot-id)) + (mastodon-tl--as-string (mastodon-tl--property 'item-id)) "*") - (mastodon-tl--property 'toot-json))) + (mastodon-tl--property 'item-json))) -(defun mastodon-inspect--download-single-toot (toot-id) - "Download the toot/status represented by TOOT-ID." +(defun mastodon-inspect--download-single-toot (item-id) + "Download the toot/status represented by ITEM-ID." (mastodon-http--get-json - (mastodon-http--api (concat "statuses/" toot-id)))) + (mastodon-http--api (concat "statuses/" item-id)))) -(defun mastodon-inspect--view-single-toot (toot-id) - "View the toot/status represented by TOOT-ID." +(defun mastodon-inspect--view-single-toot (item-id) + "View the toot/status represented by ITEM-ID." (interactive "s Toot ID: ") - (let ((buffer (get-buffer-create (concat "*mastodon-status-" toot-id "*")))) + (let ((buffer (get-buffer-create (concat "*mastodon-status-" item-id "*")))) (with-current-buffer buffer - (let ((toot (mastodon-inspect--download-single-toot toot-id ))) + (let ((toot (mastodon-inspect--download-single-toot item-id ))) (mastodon-tl--toot toot) (goto-char (point-min)) (while (search-forward "\n\n\n | " nil t) @@ -85,12 +85,12 @@ (switch-to-buffer-other-window buffer) (mastodon-mode))) -(defun mastodon-inspect--view-single-toot-source (toot-id) - "View the ess source of a toot/status represented by TOOT-ID." +(defun mastodon-inspect--view-single-toot-source (item-id) + "View the ess source of a toot/status represented by ITEM-ID." (interactive "s Toot ID: ") (mastodon-inspect--dump-json-in-buffer - (concat "*mastodon-status-raw-" toot-id "*") - (mastodon-inspect--download-single-toot toot-id))) + (concat "*mastodon-status-raw-" item-id "*") + (mastodon-inspect--download-single-toot item-id))) (defvar mastodon-inspect--search-query-accounts-result) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 5f6d1ba..a1aea31 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -50,7 +50,7 @@ (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--spoiler "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-tl--item-id "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") (autoload 'mastodon-views--view-follow-requests "mastodon-views") @@ -98,17 +98,17 @@ With no argument, the request is accepted. Argument REJECT means reject the request. Can be called in notifications view or in follow-requests view." - (if (not (mastodon-tl--find-property-range 'toot-json (point))) + (if (not (mastodon-tl--find-property-range 'item-json (point))) (message "No follow request at point?") - (let* ((toot-json (mastodon-tl--property 'toot-json)) + (let* ((item-json (mastodon-tl--property 'item-json)) (f-reqs-view-p (string= "follow_requests" (plist-get mastodon-tl--buffer-spec 'endpoint))) - (f-req-p (or (string= "follow_request" (alist-get 'type toot-json)) ;notifs + (f-req-p (or (string= "follow_request" (alist-get 'type item-json)) ;notifs f-reqs-view-p))) (if (not f-req-p) (message "No follow request at point?") - (let-alist (or (alist-get 'account toot-json) ;notifs - toot-json) ;f-reqs + (let-alist (or (alist-get 'account item-json) ;notifs + item-json) ;f-reqs (if .id (let ((response (mastodon-http--post @@ -116,7 +116,7 @@ follow-requests view." (mastodon-http--api "follow_requests") (format "/%s/%s" .id (if reject "reject" "authorize")))))) (mastodon-http--triage response - (lambda () + (lambda (_) (if f-reqs-view-p (mastodon-views--view-follow-requests) (mastodon-tl--reload-timeline-or-profile)) @@ -311,7 +311,7 @@ Status notifications are created when you call (let ((response (mastodon-http--post (mastodon-http--api "notifications/clear")))) (mastodon-http--triage - response (lambda () + response (lambda (_) (when mastodon-tl--buffer-spec (mastodon-tl--reload-timeline-or-profile)) (message "All notifications cleared!")))))) @@ -319,14 +319,14 @@ Status notifications are created when you call (defun mastodon-notifications--clear-current () "Dismiss the notification at point." (interactive) - (let* ((id (or (mastodon-tl--property 'toot-id) + (let* ((id (or (mastodon-tl--property 'item-id) (mastodon-tl--field 'id - (mastodon-tl--property 'toot-json)))) + (mastodon-tl--property 'item-json)))) (response (mastodon-http--post (mastodon-http--api (format "notifications/%s/dismiss" id))))) (mastodon-http--triage - response (lambda () + response (lambda (_) (when mastodon-tl--buffer-spec (mastodon-tl--reload-timeline-or-profile)) (message "Notification dismissed!"))))) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3d27bb4..1003853 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -74,7 +74,7 @@ (autoload 'mastodon-tl--symbol "mastodon-tl") (autoload 'mastodon-tl--timeline "mastodon-tl.el") (autoload 'mastodon-tl--toot "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-tl--item-id "mastodon-tl") (autoload 'mastodon-toot--count-toot-chars "mastodon-toot") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") (autoload 'mastodon-views--add-account-to-list "mastodon-views") @@ -136,10 +136,10 @@ contains") :keymap mastodon-profile-update-mode-map :global nil) -(defun mastodon-profile--toot-json () - "Get the next toot-json." +(defun mastodon-profile--item-json () + "Get the next item-json." (interactive) - (mastodon-tl--property 'toot-json)) + (mastodon-tl--property 'item-json)) (defun mastodon-profile--make-author-buffer (account &optional no-reblogs) "Take an ACCOUNT json and insert a user account into a new buffer. @@ -165,7 +165,7 @@ NO-REBLOGS means do not display boosts in statuses." (interactive) (if mastodon-profile--account (mastodon-profile--make-author-buffer mastodon-profile--account :no-reblogs) - (error "Not in a mastodon profile"))) + (user-error "Not in a mastodon profile"))) (defun mastodon-profile--open-following () "Open a profile buffer showing the accounts that current profile follows." @@ -177,7 +177,7 @@ NO-REBLOGS means do not display boosts in statuses." #'mastodon-profile--format-user nil :headers) - (error "Not in a mastodon profile"))) + (user-error "Not in a mastodon profile"))) (defun mastodon-profile--open-followers () "Open a profile buffer showing the accounts following the current profile." @@ -189,7 +189,7 @@ NO-REBLOGS means do not display boosts in statuses." #'mastodon-profile--format-user nil :headers) - (error "Not in a mastodon profile"))) + (user-error "Not in a mastodon profile"))) (defun mastodon-profile--view-favourites () "Open a new buffer displaying the user's favourites." @@ -319,7 +319,7 @@ Ask for confirmation if length > 500 characters." "Send PATCH request with the updated profile NOTE to URL." (let ((response (mastodon-http--patch url `(("note" . ,note))))) (mastodon-http--triage response - (lambda () (message "Profile note updated!"))))) + (lambda (_) (message "Profile note updated!"))))) (defun mastodon-profile--update-preference (pref val &optional source) "Update account PREF erence to setting VAL. @@ -329,7 +329,7 @@ SOURCE means that the preference is in the `source' part of the account JSON." (pref-formatted (if source (concat "source[" pref "]") pref)) (response (mastodon-http--patch url `((,pref-formatted . ,val))))) (mastodon-http--triage response - (lambda () + (lambda (_) (mastodon-profile--fetch-server-account-settings) (message "Account setting %s updated to %s!" pref val))))) @@ -441,7 +441,7 @@ Returns an alist." (params (mastodon-profile--make-meta-fields-params fields-updated)) (response (mastodon-http--patch url params))) (mastodon-http--triage response - (lambda () + (lambda (_) (mastodon-profile--fetch-server-account-settings) (message "Metadata fields updated to %s!" fields-updated))))) @@ -679,7 +679,7 @@ the format \"2000-01-31T00:00:00.000Z\"." If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer - (alist-get 'account (mastodon-profile--toot-json)))) + (alist-get 'account (mastodon-profile--item-json)))) (defun mastodon-profile--image-from-account (account img-type) "Return a avatar image from ACCOUNT. @@ -693,21 +693,21 @@ IMG-TYPE is the JSON key from the account data." (interactive (list (if (and (not (mastodon-tl--profile-buffer-p)) - (not (mastodon-tl--property 'toot-json :no-move))) + (not (mastodon-tl--property 'item-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) + (mastodon-profile--item-json)))) (completing-read "View profile of user [choose or enter any handle]: " user-handles nil ; predicate 'confirm))))) - (if (not (or ; own profile has no need for toot-json test: + (if (not (or ; own profile has no need for item-json test: (equal user-handle (mastodon-auth--get-account-name)) (mastodon-tl--profile-buffer-p) - (mastodon-tl--property 'toot-json :no-move))) + (mastodon-tl--property 'item-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json)))) + user-handle (mastodon-profile--item-json)))) (if account (progn (message "Loading profile of user %s..." user-handle) @@ -733,14 +733,14 @@ Used to view a user's followers and those they're following." (propertize (mastodon-tl--byline-author `((account . ,toot)) :avatar) 'byline 't - 'toot-id (alist-get 'id toot) - 'base-toot-id (mastodon-tl--toot-id toot) - 'toot-json toot)) + 'item-id (alist-get 'id toot) + 'base-item-id (mastodon-tl--item-id toot) + 'item-json toot)) (mastodon-media--inline-images start-pos (point)) (insert "\n" (propertize (mastodon-tl--render-text (alist-get 'note toot) nil) - 'toot-json toot) + 'item-json toot) "\n"))) tootv)))) @@ -805,7 +805,7 @@ These include the author, author of reblogged entries and any user mentioned." "Remove a user from your followers. Optionally provide the ID of the account to remove." (interactive) - (let* ((account (unless id (mastodon-tl--property 'toot-json :no-move))) + (let* ((account (unless id (mastodon-tl--property 'item-json :no-move))) (id (or id (alist-get 'id account))) (handle (if account (alist-get 'acct account) @@ -816,17 +816,17 @@ Optionally provide the ID of the account to remove." (when (y-or-n-p (format "Remove follower %s? " handle)) (let ((response (mastodon-http--post url))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "Follower %s removed!" handle))))))) (defun mastodon-profile--remove-from-followers-at-point () "Prompt for a user in the item at point and remove from followers." (interactive) (let* ((handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json))) + (mastodon-profile--item-json))) (handle (completing-read "Remove from followers: " handles nil)) (account (mastodon-profile--lookup-account-in-status - handle (mastodon-profile--toot-json))) + handle (mastodon-profile--item-json))) (id (alist-get 'id account))) (mastodon-profile--remove-user-from-followers id))) @@ -862,7 +862,7 @@ NOTE-OLD is the text of any existing note." (url (mastodon-http--api (format "accounts/%s/note" id))) (response (mastodon-http--post url params))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "Private note on %s added!" handle))))) (defun mastodon-profile--view-account-private-note () diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 41e4f23..1f39088 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -89,7 +89,7 @@ QUERY is the string to search." "Display a list of tags trending on your instance." (interactive) (mastodon-search--view-trending "tags" - #'mastodon-search--print-tags-list)) + #'mastodon-search--print-tags)) (defun mastodon-search--trending-statuses () "Display a list of statuses trending on your instance." @@ -109,35 +109,27 @@ PRINT-FUN is the function used to print the data from the response." '("limit" . "20"))) (offset '(("offset" . "0"))) (params (push limit offset)) - (response (mastodon-http--get-json url params)) - (data (cond ((equal type "tags") - (mapcar #'mastodon-search--get-hashtag-info response)) - ((equal type "statuses") - response) ; no longer needs further processing - ((equal type "links") - (message "todo")))) + (data (mastodon-http--get-json url params)) (buffer (get-buffer-create (format "*mastodon-trending-%s*" type)))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec (buffer-name buffer) (format "trends/%s" type) print-fun nil params) - (insert (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n" - (upcase (format " TRENDING %s\n" type)) - " " mastodon-tl--horiz-bar "\n\n") - 'success)) + (mastodon-search--insert-heading "trending" type) (funcall print-fun data) (unless (equal type "statuses") (goto-char (point-min)))))) ;; functions for mastodon search -(defun mastodon-search--format-heading (heading) - "Format HEADING as a heading." +(defun mastodon-search--insert-heading (heading &optional type) + "Format HEADING as a heading. +Optionally add string TYPE after HEADING." (insert (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " - heading "\n" + (upcase heading) " " + (if type (upcase type) "") "\n" " " mastodon-tl--horiz-bar "\n") 'success))) @@ -186,7 +178,7 @@ is used for pagination." (alist-get 'statuses response)))) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-search-mode) - (mastodon-search--format-heading (upcase type)) + (mastodon-search--insert-heading type) ;; user results: (cond ((equal type "accounts") (mastodon-search--render-response accts type buffer params @@ -269,7 +261,8 @@ If NOTE is non-nil, include user's profile note. This is also (propertize (car user) 'face 'mastodon-display-name-face 'byline t - 'toot-id id) ; for prev/next nav + 'item-type 'user + 'item-id id) ; for prev/next nav " : \n : " (propertize (concat "@" (cadr user)) 'face 'mastodon-handle-face @@ -283,7 +276,7 @@ If NOTE is non-nil, include user's profile note. This is also (mastodon-tl--render-text (cadddr user) acct) "") "\n") - 'toot-json acct))) ; for compat w other processing functions + 'item-json acct))) ; for compat w other processing functions (defun mastodon-search--print-tags (tags) "Print TAGS data as returned from a \"hashtags\" search query." @@ -300,6 +293,8 @@ If NOTE is non-nil, include user's profile note. This is also 'mouse-face 'highlight 'mastodon-tag (car el) 'mastodon-tab-stop 'hashtag + 'item-type 'tag ; for next/prev nav + 'byline t ; for next/prev nav 'help-echo (concat "Browse tag #" (car el)) 'keymap mastodon-tl--link-keymap) " : \n\n")) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index cb48bc6..135c7f5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -69,7 +69,7 @@ (autoload 'mastodon-profile--open-statuses-no-reblogs "mastodon-profile") (autoload 'mastodon-profile--profile-json "mastodon-profile") (autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") -(autoload 'mastodon-profile--toot-json "mastodon-profile") +(autoload 'mastodon-profile--item-json "mastodon-profile") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") (autoload 'mastodon-search--get-user-info "mastodon-search") @@ -85,6 +85,8 @@ (autoload 'mastodon-search--buf-type "mastodon-search") (autoload 'mastodon-http--api-search "mastodon-http") (autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-search--insert-heading "mastodon-search") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) @@ -235,6 +237,9 @@ etc.") (define-key map [remap shr-previous-link] #'mastodon-tl--previous-tab-item) ;; keep new my-profile binding; shr 'O' doesn't work here anyway (define-key map (kbd "O") #'mastodon-profile--my-profile) + ;; remove shr's u binding, as it the maybe-probe-and-copy-url + ;; is already bound to w also + (define-key map (kbd "u") #'mastodon-tl--update) (define-key map [remap shr-browse-url] #'mastodon-url-lookup) map) "The keymap to be set for shr.el generated links that are not images. @@ -272,7 +277,7 @@ types of mastodon links and not just shr.el-generated ones.") (define-key map (kbd "RET") #'mastodon-profile--get-toot-author) map)) "The keymap to be set for the author byline. -It is active where point is placed by `mastodon-tl--goto-next-toot.'") +It is active where point is placed by `mastodon-tl--goto-next-item.'") ;;; MACROS @@ -293,24 +298,34 @@ than `switch-to-buffer'." (switch-to-buffer ,buffer)) ,@body))) -(defmacro mastodon-tl--do-if-toot (&rest body) - "Execute BODY if we have a toot or user at point." +(defmacro mastodon-tl--do-if-item (&rest body) + "Execute BODY if we have an item at point." (declare (debug t)) `(if (and (not (mastodon-tl--profile-buffer-p)) - (not (mastodon-tl--property 'toot-json))) ; includes user listings - (message "Looks like there's no toot or user at point?") + (not (mastodon-tl--property 'item-json))) ; includes users but not tags + (message "Looks like there's no item at point?") ,@body)) -(defmacro mastodon-tl--do-if-toot-strict (&rest body) - "Execute BODY if we have a toot, and only a toot, at point." +(defmacro mastodon-tl--do-if-item-strict (&rest body) + "Execute BODY if we have a toot object at point. +Includes boosts, and notifications that display toots." (declare (debug t)) - `(if (not (mastodon-tl--property 'toot-id :no-move)) + `(if (not (equal 'toot (mastodon-tl--property 'item-type :no-move))) (message "Looks like there's no toot at point?") ,@body)) ;;; NAV +(defun mastodon-tl--scroll-up-command () + "Call `scroll-up-command', loading more toots if necessary. +If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." + (interactive) + (if (not (equal (point) (point-max))) + (scroll-up-command) + (mastodon-tl--more) + (scroll-up-command))) + (defun mastodon-tl--next-tab-item (&optional previous) "Move to the next interesting item. This could be the next toot, link, or image; whichever comes first. @@ -343,63 +358,54 @@ text, i.e. hidden spoiler text." (interactive) (mastodon-tl--next-tab-item :previous)) -(defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) - "Search for toot with FIND-POS. +(defun mastodon-tl--goto-item-pos (find-pos refresh &optional pos) + "Search for item with function FIND-POS. If search returns nil, execute REFRESH function. Optionally start from POS." - (let* ((npos (funcall find-pos - (or pos (point)) - 'byline - (current-buffer)))) + (let* ((npos (or ; toot/user items have byline: + (funcall find-pos + (or pos (point)) + ;; 'item-type ; breaks nav to last item in a view? + 'byline + (current-buffer))))) (if npos - (if (not (get-text-property npos 'toot-id)) - (mastodon-tl--goto-toot-pos find-pos refresh npos) + (if (not (or + ;; (get-text-property npos 'item-id) ; toots, users, not tags + (get-text-property npos 'item-type))) ; generic + (mastodon-tl--goto-item-pos find-pos refresh npos) (goto-char npos) ;; force display of help-echo on moving to a toot byline: (mastodon-tl--message-help-echo)) - (funcall refresh)))) - -(defun mastodon-tl--scroll-up-command () - "Call `scroll-up-command', loading more toots if necessary. -If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." - (interactive) - (if (not (equal (point) (point-max))) - (scroll-up-command) - (mastodon-tl--more) - (scroll-up-command))) + ;; FIXME: this doesn't really work, as the funcall doesn't return if we + ;; run into an endless refresh loop + (condition-case nil + (funcall refresh) + (error "No more items"))))) -(defun mastodon-tl--goto-next-toot () - "Jump to next toot header." +(defun mastodon-tl--goto-next-item () + "Jump to next item. +Load more items it no next item." (interactive) - (mastodon-tl--goto-toot-pos 'next-single-property-change + (mastodon-tl--goto-item-pos 'next-single-property-change 'mastodon-tl--more)) -(defun mastodon-tl--goto-prev-toot () - "Jump to last toot header." +(defun mastodon-tl--goto-prev-item () + "Jump to previous item. +Update if no previous items" (interactive) - (mastodon-tl--goto-toot-pos 'previous-single-property-change + (mastodon-tl--goto-item-pos 'previous-single-property-change 'mastodon-tl--update)) (defun mastodon-tl--goto-first-item () "Jump to first toot or item in buffer. Used on initializing a timeline or thread." - ;; goto-next-toot assumes we already have toots, and is therefore + ;; goto-next-item assumes we already have items, and is therefore ;; incompatible with any view where it is possible to have no items. ;; when that is the case the call to goto-toot-pos loops infinitely (goto-char (point-min)) - (mastodon-tl--goto-next-item)) - -(defun mastodon-tl--goto-next-item () - "Jump to next item, e.g. filter or follow request." - (interactive) - (mastodon-tl--goto-toot-pos 'next-single-property-change + (mastodon-tl--goto-item-pos 'next-single-property-change 'next-line)) - -(defun mastodon-tl--goto-prev-item () - "Jump to previous item, e.g. filter or follow request." - (interactive) - (mastodon-tl--goto-toot-pos 'previous-single-property-change - 'previous-line)) +;; (mastodon-tl--goto-next-item)) ;;; TIMELINES @@ -481,7 +487,7 @@ With a double PREFIX arg, limit results to your own instance." "Call message on `help-echo' property at point. Do so if type of status at poins is not follow_request/follow." (let ((type (alist-get 'type - (mastodon-tl--property 'toot-json :no-move))) + (mastodon-tl--property 'item-json :no-move))) (echo (mastodon-tl--property 'help-echo :no-move))) (when echo ; not for followers/following in profile (unless (or (string= type "follow_request") @@ -534,7 +540,7 @@ With arg AVATAR, include the account's avatar image." Displays a toot's media types and optionally the binding to play moving image media from the byline. Used when point is at the start of a byline, i.e. where -`mastodon-tl--goto-next-toot' leaves point." +`mastodon-tl--goto-next-item' leaves point." (let* ((toot-to-count (or ; simply praying this order works (alist-get 'status toot) ; notifications timeline @@ -627,7 +633,7 @@ this just means displaying toot client." (concat ;; Boosted/favourited markers are not technically part of the byline, so ;; we don't propertize them with 'byline t', as per the rest. This - ;; ensures that `mastodon-tl--goto-next-toot' puts point on + ;; ensures that `mastodon-tl--goto-next-item' puts point on ;; author-byline, not before the (F) or (B) marker. Not propertizing like ;; this makes the behaviour of these markers consistent whether they are ;; displayed for an already boosted/favourited toot or as the result of @@ -642,7 +648,7 @@ this just means displaying toot client." (mastodon-tl--format-faved-or-boosted-byline (mastodon-tl--symbol 'bookmark)))) ;; we remove avatars from the byline also, so that they also do not mess - ;; with `mastodon-tl--goto-next-toot': + ;; with `mastodon-tl--goto-next-item': (when (and mastodon-tl--show-avatars mastodon-tl--display-media-p (if (version< emacs-version "27.1") @@ -961,9 +967,9 @@ content should be hidden." "Toggle the visibility of the spoiler text in the current toot." (interactive) (let* ((toot-range (or (mastodon-tl--find-property-range - 'toot-json (point)) + 'item-json (point)) (mastodon-tl--find-property-range - 'toot-json (point) t))) + 'item-json (point) t))) (spoiler-range (when toot-range (mastodon-tl--find-property-range 'mastodon-content-warning-body @@ -1187,7 +1193,7 @@ displayed when the duration is smaller than a minute)." (defun mastodon-tl--read-poll-option () "Read a poll option to vote on a poll." - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (mastodon-tl--property 'item-json)) (poll (mastodon-tl--field 'poll toot)) (options (mastodon-tl--field 'options poll)) (options-titles (mastodon-tl--map-alist 'title options)) @@ -1212,9 +1218,9 @@ displayed when the duration is smaller than a minute)." (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." (interactive (mastodon-tl--read-poll-option)) - (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) + (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'item-json))) (message "No poll here.") - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (mastodon-tl--property 'item-json)) (poll (mastodon-tl--field 'poll toot)) (poll-id (alist-get 'id poll)) (url (mastodon-http--api (format "polls/%s/votes" poll-id))) @@ -1223,7 +1229,7 @@ displayed when the duration is smaller than a minute)." (arg `(("choices[]" . ,option-as-arg))) (response (mastodon-http--post url arg))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "You voted for option %s: %s!" (car option) (cdr option))))))) @@ -1295,7 +1301,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (mastodon-tl--get-poll toot)) (mastodon-tl--media toot)))) -(defun mastodon-tl--prev-toot-id () +(defun mastodon-tl--prev-item-id () "Return the id of the last toot inserted into the buffer." (let* ((prev-change (save-excursion @@ -1307,7 +1313,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (defun mastodon-tl--after-reply-status (reply-to-id) "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer." - (let ((prev-id (mastodon-tl--prev-toot-id))) + (let ((prev-id (mastodon-tl--prev-item-id))) (string= reply-to-id prev-id))) (defun mastodon-tl--insert-status (toot body author-byline action-byline @@ -1322,7 +1328,7 @@ such as boosting favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'. ID is that of the status if it is a notification, which is -attached as a `toot-id' property if provided. If the +attached as a `item-id' property if provided. If the status is a favourite or boost notification, BASE-TOOT is the JSON of the toot responded to. DETAILED-P means display more detailed info. For now @@ -1349,14 +1355,15 @@ THREAD means the status will be displayed in a thread view." body) " \n" (mastodon-tl--byline toot author-byline action-byline detailed-p)) - 'toot-id (or id ; notification's own id + 'item-type 'toot + 'item-id (or id ; notification's own id (alist-get 'id toot)) ; toot id - 'base-toot-id (mastodon-tl--toot-id + 'base-item-id (mastodon-tl--item-id ;; if status is a notif, get id from base-toot - ;; (-tl--toot-id toot) will not work here: + ;; (-tl--item-id toot) will not work here: (or base-toot toot)) ; else normal toot with reblog check - 'toot-json toot + 'item-json toot 'base-toot base-toot 'cursor-face 'mastodon-cursor-highlight-face) "\n") @@ -1367,7 +1374,7 @@ THREAD means the status will be displayed in a thread view." (defun mastodon-tl--toot-for-stats (&optional toot) "Return the TOOT on which we want to extract stats. If no TOOT is given, the one at point is considered." - (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) + (let* ((original-toot (or toot (get-text-property (point) 'item-json))) (toot (or (alist-get 'status original-toot) (when (alist-get 'type original-toot) original-toot) @@ -1490,8 +1497,9 @@ If NO-ERROR is non-nil, do not error when property is empty." (if no-error (plist-get mastodon-tl--buffer-spec property) (or (plist-get mastodon-tl--buffer-spec property) - (error "Mastodon-tl--buffer-spec is not defined for buffer %s" - (or buffer (current-buffer))))))) + (error "Mastodon-tl--buffer-spec not defined for buffer %s, prop %s" + (or buffer (current-buffer)) + property))))) (defun mastodon-tl--set-buffer-spec (buffer endpoint update-fun &optional link-header update-params hide-replies) @@ -1698,21 +1706,21 @@ BACKWARD means move backward (up) the timeline." (or (get-text-property (point) prop) (save-excursion (if backward - (mastodon-tl--goto-prev-toot) - (mastodon-tl--goto-next-toot)) + (mastodon-tl--goto-prev-item) + (mastodon-tl--goto-next-item)) (get-text-property (point) prop))))) (defun mastodon-tl--newest-id () - "Return toot-id from the top of the buffer." + "Return item-id from the top of the buffer." (save-excursion (goto-char (point-min)) - (mastodon-tl--property 'toot-id))) + (mastodon-tl--property 'item-id))) (defun mastodon-tl--oldest-id () - "Return toot-id from the bottom of the buffer." + "Return item-id from the bottom of the buffer." (save-excursion (goto-char (point-max)) - (mastodon-tl--property 'toot-id nil :backward))) + (mastodon-tl--property 'item-id nil :backward))) (defun mastodon-tl--as-string (numeric) "Convert NUMERIC to string." @@ -1722,7 +1730,7 @@ BACKWARD means move backward (up) the timeline." (t (error "Numeric:%s must be either a string or a number" numeric)))) -(defun mastodon-tl--toot-id (json) +(defun mastodon-tl--item-id (json) "Find approproiate toot id in JSON. If the toot has been boosted use the id found in the reblog portion of the toot. Otherwise, use the body of @@ -1746,7 +1754,7 @@ ID is that of the toot to view." (toot (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id))))) (if (equal (caar toot) 'error) - (message "Error: %s" (cdar toot)) + (user-error "Error: %s" (cdar toot)) (with-mastodon-buffer buffer #'mastodon-mode nil (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) #'mastodon-tl--update-toot) @@ -1766,19 +1774,19 @@ are displayed by default. Call this if you subsequently want to view all branches of a thread." (interactive) (if (not (eq (mastodon-tl--get-buffer-type) 'thread)) - (error "You need to be viewing a thread to call this") + (user-error "You need to be viewing a thread to call this") (goto-char (point-min)) - (let ((id (mastodon-tl--property 'base-toot-id))) + (let ((id (mastodon-tl--property 'base-item-id))) (mastodon-tl--thread id)))) (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." (interactive) - (let* ((id (or id (mastodon-tl--property 'base-toot-id :no-move))) - (type (mastodon-tl--field 'type (mastodon-tl--property 'toot-json :no-move)))) + (let* ((id (or id (mastodon-tl--property 'base-item-id :no-move))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'item-json :no-move)))) (if (or (string= type "follow_request") (string= type "follow")) ; no can thread these - (error "No thread") + (user-error "No thread") (let* ((endpoint (format "statuses/%s/context" id)) (url (mastodon-http--api endpoint)) (buffer (format "*mastodon-thread-%s*" id)) @@ -1787,7 +1795,7 @@ view all branches of a thread." nil :silent)) (context (mastodon-http--get-json url nil :silent))) (if (equal (caar toot) 'error) - (message "Error: %s" (cdar toot)) + (user-error "Error: %s" (cdar toot)) (when (member (alist-get 'type toot) '("reblog" "favourite")) (setq toot (alist-get 'status toot))) (if (> (+ (length (alist-get 'ancestors context)) @@ -1807,7 +1815,7 @@ view all branches of a thread." :thread) ;; put point at the toot: (goto-char (marker-position marker)) - (mastodon-tl--goto-next-toot))) + (mastodon-tl--goto-next-item))) ;; else just print the lone toot: (mastodon-tl--single-toot id))))))) @@ -1832,7 +1840,7 @@ If UNMUTE, unmute it." (mastodon-tl--buffer-type-eq 'notifications)) (let* ((id (if (mastodon-tl--buffer-type-eq 'notifications) - (get-text-property (point) 'base-toot-id) + (get-text-property (point) 'base-item-id) (save-match-data (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" endpoint) @@ -1844,7 +1852,7 @@ If UNMUTE, unmute it." (when (y-or-n-p (format "%s this thread? " (capitalize mute-str))) (let ((response (mastodon-http--post url))) (mastodon-http--triage response - (lambda () + (lambda (_) (if unmute (message "Thread unmuted!") (message "Thread muted!"))))))))))) @@ -1872,7 +1880,7 @@ ID is that of the post the context is currently displayed for." ;;; FOLLOW/BLOCK/MUTE, ETC -(defun mastodon-tl--follow-user (user-handle &optional notify langs) +(defun mastodon-tl--follow-user (user-handle &optional notify langs reblogs) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. @@ -1880,15 +1888,16 @@ Can be called to toggle NOTIFY on users already being followed. LANGS is an array parameters alist of languages to filer user's posts by." (interactive (list (mastodon-tl--user-handles-get "follow"))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-tl--do-user-action-and-response - user-handle "follow" nil notify langs))) + user-handle "follow" nil notify langs reblogs))) +;; TODO: make this action "enable/disable notifications" (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." (interactive (list (mastodon-tl--user-handles-get "enable"))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-tl--follow-user user-handle "true"))) (defun mastodon-tl--disable-notify-user-posts (user-handle) @@ -1897,6 +1906,18 @@ LANGS is an array parameters alist of languages to filer user's posts by." (list (mastodon-tl--user-handles-get "disable"))) (mastodon-tl--follow-user user-handle "false")) +(defun mastodon-tl--follow-user-disable-boosts (user-handle) + "" + (interactive + (list (mastodon-tl--user-handles-get "disable boosts"))) + (mastodon-tl--follow-user user-handle nil nil "false")) + +(defun mastodon-tl--follow-user-enable-boosts (user-handle) + "" + (interactive + (list (mastodon-tl--user-handles-get "enable boosts"))) + (mastodon-tl--follow-user user-handle nil nil "true")) + (defun mastodon-tl--filter-user-user-posts-by-language (user-handle) "Query for USER-HANDLE and enable notifications when they post. This feature is experimental and for now not easily varified by @@ -1904,7 +1925,7 @@ the instance API." (interactive (list (mastodon-tl--user-handles-get "filter by language"))) (let ((langs (mastodon-tl--read-filter-langs))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-tl--follow-user user-handle nil langs)))) (defun mastodon-tl--read-filter-langs (&optional langs) @@ -1926,14 +1947,14 @@ LANGS is the accumulated array param alist if we re-run recursively." "Query for USER-HANDLE from current status and unfollow that user." (interactive (list (mastodon-tl--user-handles-get "unfollow"))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) (defun mastodon-tl--block-user (user-handle) "Query for USER-HANDLE from current status and block that user." (interactive (list (mastodon-tl--user-handles-get "block"))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-tl--do-user-action-and-response user-handle "block"))) (defun mastodon-tl--unblock-user (user-handle) @@ -1948,7 +1969,7 @@ LANGS is the accumulated array param alist if we re-run recursively." "Query for USER-HANDLE from current status and mute that user." (interactive (list (mastodon-tl--user-handles-get "mute"))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-tl--do-user-action-and-response user-handle "mute"))) (defun mastodon-tl--unmute-user (user-handle) @@ -1963,14 +1984,14 @@ LANGS is the accumulated array param alist if we re-run recursively." "Query for USER-HANDLE from current status and compose a message to that user." (interactive (list (mastodon-tl--user-handles-get "message"))) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (mastodon-toot--compose-buffer (concat "@" user-handle)) (setq mastodon-toot--visibility "direct") (mastodon-toot--update-status-fields))) (defun mastodon-tl--user-handles-get (action) "Get the list of user-handles for ACTION from the current toot." - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (let ((user-handles (cond ((or ; follow suggests / search / foll requests compat: (mastodon-tl--buffer-type-eq 'follow-suggestions) @@ -1979,9 +2000,9 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; profile follows/followers but not statuses: (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following)) - ;; fetch 'toot-json: + ;; fetch 'item-json: (list (alist-get 'acct - (mastodon-tl--property 'toot-json :no-move)))) + (mastodon-tl--property 'item-json :no-move)))) ;; profile view, point in profile details, poss no toots ;; needed for e.g. gup.pe groups which show no toots publically: ((and (mastodon-tl--profile-buffer-p) @@ -1990,14 +2011,18 @@ LANGS is the accumulated array param alist if we re-run recursively." (mastodon-profile--profile-json)))) (t (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))))) + (mastodon-profile--item-json)))))) ;; return immediately if only 1 handle: (if (eq 1 (length user-handles)) (car user-handles) - (completing-read (if (or (equal action "disable") - (equal action "enable")) - (format "%s notifications when user posts: " action) - (format "Handle of user to %s: " action)) + (completing-read (cond ((or ; TODO: make this "enable/disable notifications" + (equal action "disable") + (equal action "enable")) + (format "%s notifications when user posts: " action)) + ((string-suffix-p "boosts" action) + (format "%s by user: " action)) + (t + (format "Handle of user to %s: " action))) user-handles nil ; predicate 'confirm))))) @@ -2017,13 +2042,15 @@ Action must be either \"unblock\" or \"unmute\"." accts nil t)))) ; require match (defun mastodon-tl--do-user-action-and-response - (user-handle action &optional negp notify langs) + (user-handle action &optional negp notify langs reblogs) "Do ACTION on user USER-HANDLE. NEGP is whether the action involves un-doing something. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. NOTIFY is only non-nil when called by `mastodon-tl--follow-user'. -LANGS is an array parameters alist of languages to filer user's posts by." +LANGS is an array parameters alist of languages to filer user's posts by. +REBLOGS is a boolean string like NOTIFY, enabling or disabling +display of the user's boosts in your timeline." (let* ((account (if negp ;; unmuting/unblocking, handle from mute/block list (mastodon-profile--search-account-by-handle user-handle) @@ -2033,24 +2060,25 @@ LANGS is an array parameters alist of languages to filer user's posts by." user-handle (mastodon-profile--profile-json)) ;; muting/blocking, select from handles in current status (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))))) + user-handle (mastodon-profile--item-json))))) (user-id (alist-get 'id account)) (name (if (string-empty-p (alist-get 'display_name account)) (alist-get 'username account) (alist-get 'display_name account))) (args (cond (notify `(("notify" . ,notify))) (langs langs) + (reblogs `(("reblogs" . ,reblogs))) (t nil))) (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) (if account (if (equal action "follow") ; y-or-n for all but follow - (mastodon-tl--do-user-action-function url name user-handle action notify args) + (mastodon-tl--do-user-action-function url name user-handle action notify args reblogs) (when (y-or-n-p (format "%s user %s? " action name)) (mastodon-tl--do-user-action-function url name user-handle action args))) (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--do-user-action-function - (url name user-handle action &optional notify args) + (url name user-handle action &optional notify args reblogs) "Post ACTION on user NAME/USER-HANDLE to URL. NOTIFY is either \"true\" or \"false\", and used when we have been called by `mastodon-tl--follow-user' to enable or disable notifications. @@ -2058,21 +2086,35 @@ ARGS is an alist of any parameters to send with the request." (let ((response (mastodon-http--post url args))) (mastodon-http--triage response - (lambda () - (cond ((string-equal notify "true") - (message "Receiving notifications for user %s (@%s)!" - name user-handle)) - ((string-equal notify "false") - (message "Not receiving notifications for user %s (@%s)!" - name user-handle)) - ((or (string-equal action "mute") - (string-equal action "unmute")) - (message "User %s (@%s) %sd!" name user-handle action)) - ((assoc "languages[]" args #'equal) - (message "User %s filtered by language(s): %s" name - (mapconcat #'cdr args " "))) - ((eq notify nil) - (message "User %s (@%s) %sed!" name user-handle action))))))) + (lambda (response) + (let ((json (with-current-buffer response + (mastodon-http--process-json)))) + ;; TODO: when > if, with failure msg + (cond ((string-equal notify "true") + (when (equal 't (alist-get 'notifying json)) + (message "Receiving notifications for user %s (@%s)!" + name user-handle))) + ((string-equal notify "false") + (when (equal :json-false (alist-get 'notifying json)) + (message "Not receiving notifications for user %s (@%s)!" + name user-handle))) + ((string-equal reblogs "true") + (when (equal 't (alist-get 'showing_reblogs json)) + (message "Receiving boosts by user %s (@%s)!" + name user-handle))) + ((string-equal reblogs "false") + (when (equal :json-false (alist-get 'showing_reblogs json)) + (message "Not receiving boosts by user %s (@%s)!" + name user-handle))) + ((or (string-equal action "mute") + (string-equal action "unmute")) + (message "User %s (@%s) %sd!" name user-handle action)) + ((assoc "languages[]" args #'equal) + (message "User %s filtered by language(s): %s" name + (mapconcat #'cdr args " "))) + ((and (eq notify nil) + (eq reblogs nil)) + (message "User %s (@%s) %sed!" name user-handle action)))))))) ;; FOLLOW TAGS @@ -2080,7 +2122,7 @@ ARGS is an alist of any parameters to send with the request." (defun mastodon-tl--get-tags-list () "Return the list of tags of the toot at point." (let* ((toot (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs - (mastodon-tl--property 'toot-json :no-move))) + (mastodon-tl--property 'item-json :no-move))) (tags (mastodon-tl--field 'tags toot))) (mapcar (lambda (x) (alist-get 'name x)) @@ -2101,7 +2143,7 @@ If TAG provided, follow it." (url (mastodon-http--api (format "tags/%s/follow" tag))) (response (mastodon-http--post url))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "tag #%s followed!" tag))))) (defun mastodon-tl--followed-tags () @@ -2119,7 +2161,7 @@ If TAG is provided, unfollow it." (url (mastodon-http--api (format "tags/%s/unfollow" tag))) (response (mastodon-http--post url))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "tag #%s unfollowed!" tag))))) (defun mastodon-tl--list-followed-tags (&optional prefix) @@ -2135,7 +2177,9 @@ PREFIX is sent to `mastodon-tl--get-tag-timeline', which see." (defun mastodon-tl--followed-tags-timeline (&optional prefix) "Open a timeline of all your followed tags. -PREFIX is sent to `mastodon-tl--show-tag-timeline', which see." +PREFIX is sent to `mastodon-tl--show-tag-timeline', which see. +Note that the number of tags supported is undocumented, and from +manual testing appears to be limited to a total of four tags." (interactive "p") (let* ((followed-tags-json (mastodon-tl--followed-tags)) (tags (mastodon-tl--map-alist 'name followed-tags-json))) @@ -2166,25 +2210,25 @@ PREFIX is for `mastodon-tl--show-tag-timeline', which see." ACCOUNT and TOOT are the data to use." (let* ((account-id (alist-get 'id account)) (comment (read-string "Add comment [optional]: ")) - (toot-id (when (y-or-n-p "Also report status at point? ") - (mastodon-tl--toot-id toot))) ; base toot if poss + (item-id (when (y-or-n-p "Also report status at point? ") + (mastodon-tl--item-id toot))) ; base toot if poss (forward-p (when (y-or-n-p "Forward to remote admin? ") "true")) (rules (when (y-or-n-p "Cite a rule broken? ") (mastodon-tl--read-rules-ids))) (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other")))) - (mastodon-tl--report-build-params account-id comment toot-id + (mastodon-tl--report-build-params account-id comment item-id forward-p cat rules))) (defun mastodon-tl--report-build-params - (account-id comment toot-id forward-p cat &optional rules) + (account-id comment item-id forward-p cat &optional rules) "Build the parameters alist based on user responses. -ACCOUNT-ID, COMMENT, TOOT-ID, FORWARD-P, CAT, and RULES are all from +ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from `mastodon-tl--report-params', which see." (let ((params `(("account_id" . ,account-id) ,(when comment `("comment" . ,comment)) - ,(when toot-id - `("status_ids[]" . ,toot-id)) + ,(when item-id + `("status_ids[]" . ,item-id)) ,(when forward-p `("forward" . ,forward-p)) ,(when cat @@ -2205,17 +2249,17 @@ Optionally report the toot at point, add a comment, cite rules that have been broken, forward the report to the remove admin, report the account for spam." (interactive) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (when (y-or-n-p "Report author of toot at point?") (let* ((url (mastodon-http--api "reports")) (toot (mastodon-tl--toot-or-base - (mastodon-tl--property 'toot-json :no-move))) + (mastodon-tl--property 'item-json :no-move))) (account (alist-get 'account toot)) (handle (alist-get 'acct account)) (params (mastodon-tl--report-params account toot)) (response (mastodon-http--post url params))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "User %s reported!" handle))))))) (defvar crm-separator) @@ -2336,12 +2380,13 @@ POS is a number, where point will be placed." (defun mastodon-tl--use-link-header-p () "Return t if we are in a view needing Link header pagination. -Currently this includes favourites, bookmarks, and profile pages -when showing followers or accounts followed." +Currently this includes favourites, bookmarks, follow requests, +and profile pages when showing followers or accounts followed." (or (mastodon-tl--buffer-type-eq 'favourites) (mastodon-tl--buffer-type-eq 'bookmarks) (mastodon-tl--buffer-type-eq 'profile-followers) - (mastodon-tl--buffer-type-eq 'profile-following))) + (mastodon-tl--buffer-type-eq 'profile-following) + (mastodon-tl--buffer-type-eq 'follow-requests))) (defun mastodon-tl--get-link-header-from-response (headers) "Get http Link header from list of http HEADERS." @@ -2351,34 +2396,38 @@ when showing followers or accounts followed." (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." - (message "Loading older toots...") + (message "Loading...") (if (mastodon-tl--use-link-header-p) - ;; link-header: can't build a URL with --more-json-async, endpoint/id: + ;; link-header paginate: + ;; can't build a URL with --more-json-async, endpoint/id: ;; ensure we have a "next" type here, otherwise the CAR will be the ;; "prev" type! (let ((link-header (mastodon-tl--link-header))) (if (> 2 (length link-header)) - (error "No next page") + (message "No next page") (let* ((next (car link-header)) ;;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) (mastodon-http--get-response-async url nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) - ;; offset (search, trending, user lists, ...?): - (if (or (string-prefix-p "*mastodon-trending-" (buffer-name)) - (mastodon-tl--search-buffer-p)) - ;; Endpoints that do not implement: follow-suggestions, - ;; follow-requests - (mastodon-tl--more-json-async-offset - (mastodon-tl--endpoint) - (mastodon-tl--update-params) - 'mastodon-tl--more* (current-buffer) (point)) - ;; max_id (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))))) + (cond ( ; no paginate + (or (mastodon-tl--buffer-type-eq 'follow-suggestions) + (mastodon-tl--buffer-type-eq 'filters) + (mastodon-tl--buffer-type-eq 'lists)) + (message "No more results")) + ;; offset paginate (search, trending, user lists, ...?): + ((or (string-prefix-p "*mastodon-trending-" (buffer-name)) + (mastodon-tl--search-buffer-p)) + (mastodon-tl--more-json-async-offset + (mastodon-tl--endpoint) + (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) "Append older toots to timeline, asynchronously. @@ -2386,7 +2435,8 @@ 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." (with-current-buffer buffer - (when response + (if (not response) + (message "No more results") (let* ((inhibit-read-only t) (json (if headers (car response) response)) ;; FIXME: max-id pagination works for statuses only, not other @@ -2406,7 +2456,7 @@ HEADERS is the http headers returned in the response, if any." (if (eq (mastodon-tl--get-buffer-type) 'thread) ;; if thread view, call --thread with parent ID (progn (goto-char (point-min)) - (mastodon-tl--goto-next-toot) + (mastodon-tl--goto-next-item) (funcall (mastodon-tl--update-function)) (goto-char point-before) (message "Loaded full thread.")) @@ -2421,7 +2471,7 @@ HEADERS is the http headers returned in the response, if any." (mastodon-tl--endpoint) (mastodon-tl--update-function) link-header)) - (message "Loading older toots... done."))))))) + (message "Loading... done."))))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) @@ -2586,8 +2636,13 @@ This location is defined by a non-nil value of (defun mastodon-tl--update () "Update timeline with new toots." (interactive) + ;; FIXME: actually these buffers should just reload by calling their own + ;; load function: (if (or (mastodon-tl--buffer-type-eq 'trending-statuses) (mastodon-tl--buffer-type-eq 'trending-tags) + (mastodon-tl--buffer-type-eq 'follow-suggestions) + (mastodon-tl--buffer-type-eq 'lists) + (mastodon-tl--buffer-type-eq 'filters) (mastodon-tl--search-buffer-p)) (message "update not available in this view.") ;; FIXME: handle update for search and trending buffers @@ -2595,7 +2650,7 @@ This location is defined by a non-nil value of (update-function (mastodon-tl--update-function))) ;; update a thread, without calling `mastodon-tl--updated-json': (if (mastodon-tl--buffer-type-eq 'thread) - (let ((thread-id (mastodon-tl--property 'toot-id))) + (let ((thread-id (mastodon-tl--property 'item-id))) (funcall update-function thread-id)) ;; update other timelines: (let* ((id (mastodon-tl--newest-id)) @@ -2648,21 +2703,40 @@ JSON and http headers, without it just the JSON." link-header update-params hide-replies) (mastodon-tl--do-init json update-function)))))) -(defun mastodon-tl--init-sync (buffer-name endpoint update-function - &optional note-type) +(defun mastodon-tl--init-sync + (buffer-name endpoint update-function + &optional note-type 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 note." +Optional arg NOTE-TYPE means only get that type of note. +PARAMS is an alist of any params to include in the request. +HEADERS are any headers to send in the request. +VIEW-NAME is a string, to be used as a heading for the view. +BINDING-STR is a string explaining any bindins in the view." + ;; Used by `mastodon-notifications-get' and in views.el (let* ((exclude-types (when note-type (mastodon-notifications--filter-types-list note-type))) - (args (when note-type (mastodon-http--build-array-params-alist - "exclude_types[]" exclude-types))) + (notes-params (when note-type + (mastodon-http--build-array-params-alist + "exclude_types[]" exclude-types))) + (params (append notes-params params)) (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*")) - (json (mastodon-http--get-json url args))) + (response (mastodon-http--get-response url params)) + (json (car response)) + (headers (when headers (cdr response))) + (link-header (when headers + (mastodon-tl--get-link-header-from-response headers)))) (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args) + ;; insert view-name/ heading-str + (when view-name + (mastodon-search--insert-heading view-name)) + (when binding-str + (insert (mastodon-tl--set-face (concat "[" binding-str "]\n\n") + 'font-lock-comment-face))) + (mastodon-tl--set-buffer-spec buffer endpoint update-function + link-header params) (mastodon-tl--do-init json update-function) buffer))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index acedcfe..e10e7e8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -75,18 +75,18 @@ (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") -(autoload 'mastodon-tl--do-if-toot-strict "mastodon-tl") +(autoload 'mastodon-tl--do-if-item-strict "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") -(autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--goto-next-item "mastodon-tl") (autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-tl--item-id "mastodon-tl") (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-views--cancel-scheduled-toot "mastodon-views") (autoload 'mastodon-views--view-scheduled-toots "mastodon-views") @@ -203,7 +203,7 @@ Should be at least 5 minutes into the future.") (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") -(defvar-local mastodon-toot--edit-toot-id nil +(defvar-local mastodon-toot--edit-item-id nil "The id of the toot being edited.") (defvar-local mastodon-toot-previous-window-config nil @@ -329,13 +329,13 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." ;; we don't move to the following toot: (beginning-of-line) (forward-line -1) - (mastodon-tl--goto-next-toot))))) + (mastodon-tl--goto-next-item))))) (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. Makes a POST request to the server. Used for favouriting, boosting, or bookmarking toots." - (let* ((id (mastodon-tl--property 'base-toot-id)) + (let* ((id (mastodon-tl--property 'base-item-id)) (url (mastodon-http--api (concat "statuses/" (mastodon-tl--as-string id) "/" action))) (response (mastodon-http--post url))) @@ -344,13 +344,13 @@ boosting, or bookmarking toots." (defun mastodon-toot--toggle-boost-or-favourite (type) "Toggle boost or favourite of toot at `point'. TYPE is a symbol, either `favourite' or `boost.'" - (mastodon-tl--do-if-toot-strict + (mastodon-tl--do-if-item-strict (let* ((boost-p (equal type 'boost)) - ;; (has-id (mastodon-tl--property 'base-toot-id)) + ;; (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-toot-id)))) + (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 @@ -361,32 +361,32 @@ TYPE is a symbol, either `favourite' or `boost.'" (msg (if boosted "unboosted" "boosted")) (action-string (if boost-p "boost" "favourite")) (remove (if boost-p (when boosted t) (when faved t))) - (toot-json (mastodon-tl--property 'toot-json)) - (toot-type (alist-get 'type toot-json)) - (visibility (mastodon-tl--field 'visibility toot-json))) + (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 'toot-json)) + ;;((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))) - (error "You can't %s boosts" action-string)) + (user-error "You can't %s boosts" action-string)) ((and (equal "favourite" toot-type) (not (mastodon-tl--buffer-type-eq 'notifications))) - (error "You can't %s favourites" action-string)) + (user-error "You can't %s favourites" action-string)) ((and (equal "private" visibility) (equal type 'boost)) - (error "You can't boost private toots")) + (user-error "You can't boost private toots")) (t (mastodon-toot--action action - (lambda () + (lambda (_) (let ((inhibit-read-only t)) (add-text-properties (car byline-region) (cdr byline-region) @@ -443,12 +443,9 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (defun mastodon-toot--toggle-bookmark () "Bookmark or unbookmark toot at point." (interactive) - (mastodon-tl--do-if-toot-strict - (let* ((id (mastodon-tl--property 'base-toot-id)) + (mastodon-tl--do-if-item-strict + (let* ((id (mastodon-tl--property 'base-item-id)) (bookmarked-p (mastodon-tl--property 'bookmarked-p)) - (prompt (if bookmarked-p - (format "Toot already bookmarked. Remove? ") - (format "Bookmark this toot? "))) (byline-region (when id (mastodon-tl--find-property-range 'byline (point)))) (action (if bookmarked-p "unbookmark" "bookmark")) @@ -458,17 +455,16 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." "Toot bookmarked!")) (remove (when bookmarked-p t))) (if byline-region - (when (y-or-n-p prompt) - (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))))) + (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 () @@ -484,18 +480,18 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." - (mastodon-tl--do-if-toot-strict - (let* ((base-toot (mastodon-tl--property 'base-toot-id)) + (mastodon-tl--do-if-item-strict + (let* ((base-toot (mastodon-tl--property 'base-item-id)) (endpoint (if favourite "favourited_by" "reblogged_by")) (url (mastodon-http--api (format "statuses/%s/%s" base-toot endpoint))) (params '(("limit" . "80"))) (json (mastodon-http--get-json url params))) (if (eq (caar json) 'error) - (error "%s (Status does not exist or is private)" (alist-get 'error json)) + (user-error "%s (Status does not exist or is private)" (alist-get 'error json)) (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) - (error "Looks like this toot has no %s" type-string) + (user-error "Looks like this toot has no %s" type-string) (let ((choice (completing-read (format "%s (enter to view profile): " type-string) handles @@ -515,7 +511,7 @@ base toot." (defun mastodon-toot--toot-url () "Return the URL of the base toot at point." (let* ((toot (or (mastodon-tl--property 'base-toot) - (mastodon-tl--property 'toot-json)))) + (mastodon-tl--property 'item-json)))) (if (mastodon-tl--field 'reblog toot) (alist-get 'url (alist-get 'reblog toot)) (alist-get 'url toot)))) @@ -526,7 +522,7 @@ If the toot is a fave/boost notification, copy the text of the base toot." (interactive) (let* ((toot (or (mastodon-tl--property 'base-toot) - (mastodon-tl--property 'toot-json)))) + (mastodon-tl--property 'item-json)))) (kill-new (mastodon-tl--content toot)) (message "Toot content copied to the clipboard."))) @@ -537,7 +533,7 @@ Uses `lingva.el'." (if (not (require 'lingva nil :no-error)) (message "Looks like you need to install lingva.el first.") (if mastodon-tl--buffer-spec - (if-let ((toot (mastodon-tl--property 'toot-json))) + (if-let ((toot (mastodon-tl--property 'item-json))) (lingva-translate nil (mastodon-tl--content toot) (when mastodon-tl--enable-proportional-fonts @@ -546,16 +542,18 @@ Uses `lingva.el'." (message "No mastodon buffer?")))) (defun mastodon-toot--own-toot-p (toot) - "Check if TOOT is user's own, e.g. for deleting it." - (and (not (alist-get 'reblog toot)) - (equal (alist-get 'acct (alist-get 'account toot)) - (mastodon-auth--user-acct)))) + "Check if TOOT is user's own, for deleting, editing, or pinning it." + ;; this check needs to allow acting on own toots displayed as boosts, so we + ;; call `mastodon-tl--toot-or-base'. + (let ((json (mastodon-tl--toot-or-base toot))) + (equal (alist-get 'acct (alist-get 'account json)) + (mastodon-auth--user-acct)))) (defun mastodon-toot--pin-toot-toggle () "Pin or unpin user's toot at point." (interactive) (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs - (mastodon-tl--property 'toot-json))) + (mastodon-tl--property 'item-json))) (pinnable-p (mastodon-toot--own-toot-p toot)) (pinned-p (equal (alist-get 'pinned toot) t)) (action (if pinned-p "unpin" "pin")) @@ -565,7 +563,7 @@ Uses `lingva.el'." (message "You can only pin your own toots.") (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) (mastodon-toot--action action - (lambda () + (lambda (_) (when mastodon-tl--buffer-spec (mastodon-tl--reload-timeline-or-profile)) (message "Toot %s!" msg))))))) @@ -584,8 +582,8 @@ Uses `lingva.el'." NO-REDRAFT means delete toot only." (interactive) (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs - (mastodon-tl--property 'toot-json))) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (mastodon-tl--property 'item-json))) + (id (mastodon-tl--as-string (mastodon-tl--item-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) (toot-cw (alist-get 'spoiler_text toot)) (toot-visibility (alist-get 'visibility toot)) @@ -599,7 +597,7 @@ NO-REDRAFT means delete toot only." (let* ((response (mastodon-http--delete url))) (mastodon-http--triage response - (lambda () + (lambda (_) (if no-redraft (progn (when mastodon-tl--buffer-spec @@ -806,13 +804,13 @@ to `emojify-user-emojis', and the emoji data is updated." "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with `mastodon-toot--attach-media', they are attached to the toot. -If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to +If `mastodon-toot--edit-item-id' is non-nil, PUT contents to instance to edit a toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) (scheduled mastodon-toot--scheduled-for) (scheduled-id mastodon-toot--scheduled-id) - (edit-id mastodon-toot--edit-toot-id) + (edit-id mastodon-toot--edit-item-id) (endpoint (if edit-id ; we are sending an edit: (mastodon-http--api (format "statuses/%s" edit-id)) (mastodon-http--api "statuses"))) @@ -858,7 +856,7 @@ instance to edit a toot." (mastodon-http--post endpoint args)))) (mastodon-http--triage response - (lambda () + (lambda (_) (mastodon-toot--kill) (if scheduled (message "Toot scheduled!") @@ -878,25 +876,26 @@ instance to edit a toot." (defun mastodon-toot--edit-toot-at-point () "Edit the user's toot at point." (interactive) - (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs - (mastodon-tl--property 'toot-json)))) - (if (not (mastodon-toot--own-toot-p toot)) - (message "You can only edit your own toots.") - (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (source (mastodon-toot--get-toot-source id)) - (content (alist-get 'text source)) - (source-cw (alist-get 'spoiler_text source)) - (toot-visibility (alist-get 'visibility toot)) - (toot-language (alist-get 'language toot)) - (reply-id (alist-get 'in_reply_to_id 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, and language: - (mastodon-toot--set-toot-properties reply-id toot-visibility - source-cw toot-language) - (mastodon-toot--update-status-fields) - (setq mastodon-toot--edit-toot-id id)))))) + (mastodon-tl--do-if-item-strict + (let ((toot (or (mastodon-tl--property 'base-toot) ; fave/boost notifs + (mastodon-tl--property 'item-json)))) + (if (not (mastodon-toot--own-toot-p toot)) + (message "You can only edit your own toots.") + (let* ((id (mastodon-tl--as-string (mastodon-tl--item-id toot))) + (source (mastodon-toot--get-toot-source id)) + (content (alist-get 'text source)) + (source-cw (alist-get 'spoiler_text source)) + (toot-visibility (alist-get 'visibility toot)) + (toot-language (alist-get 'language toot)) + (reply-id (alist-get 'in_reply_to_id 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, and language: + (mastodon-toot--set-toot-properties reply-id toot-visibility + source-cw toot-language) + (mastodon-toot--update-status-fields) + (setq mastodon-toot--edit-item-id id))))))) (defun mastodon-toot--get-toot-source (id) "Fetch the source JSON of toot with ID." @@ -911,7 +910,7 @@ instance to edit a toot." (defun mastodon-toot--view-toot-edits () "View editing history of the toot at point in a popup buffer." (interactive) - (let ((id (mastodon-tl--property 'base-toot-id)) + (let ((id (mastodon-tl--property 'base-item-id)) (history (mastodon-tl--property 'edit-history)) (buf "*mastodon-toot-edits*")) (with-mastodon-buffer buf #'special-mode :other-window @@ -1070,8 +1069,8 @@ If TAGS, we search for tags, else we search for handles." Customize `mastodon-toot-display-orig-in-reply-buffer' to display text of the toot being replied to in the compose buffer." (interactive) - (mastodon-tl--do-if-toot-strict - (let* ((toot (mastodon-tl--property 'toot-json)) + (mastodon-tl--do-if-item-strict + (let* ((toot (mastodon-tl--property 'item-json)) ;; no-move arg for base toot: don't try next toot (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) @@ -1251,7 +1250,7 @@ INSTANCE is JSON." MAX is the maximum number set by their instance." (let ((number (read-number (format "Number of options [2-%s]: " max) 2))) (if (> number max) - (error "You need to choose a number between 2 and %s" max) + (user-error "You need to choose a number between 2 and %s" max) number))) (defun mastodon-toot--create-poll () @@ -1344,7 +1343,7 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (url (mastodon-http--api (format "scheduled_statuses/%s" id))) (response (mastodon-http--put url args))) (mastodon-http--triage response - (lambda () + (lambda (_) ;; reschedule means we are in scheduled toots view: (mastodon-views--view-scheduled-toots) (message diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 24fe6d7..b1ff70d 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -51,10 +51,8 @@ (autoload 'mastodon-tl--set-face "mastodon-tl") (autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--profile-buffer-p "mastodon-tl") -(autoload 'mastodon-tl--goto-next-item "mastodon-tl") -(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") (autoload 'mastodon-tl--goto-first-item "mastodon-tl") -(autoload 'mastodon-tl--do-if-toot "mastodon-tl") +(autoload 'mastodon-tl--do-if-item "mastodon-tl") (autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") @@ -86,8 +84,6 @@ (defvar mastodon-views-map (let ((map (make-sparse-keymap))) (set-keymap-parent map mastodon-mode-map) - (define-key map (kbd "n") #'mastodon-tl--goto-next-item) - (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) map) "Base keymap for minor mastodon views.") @@ -96,7 +92,6 @@ (set-keymap-parent map mastodon-views-map) (define-key map (kbd "d") #'mastodon-views--delete-filter) (define-key map (kbd "c") #'mastodon-views--create-filter) - (define-key map (kbd "TAB") #'mastodon-tl--goto-next-item) (define-key map (kbd "g") #'mastodon-views--view-filters) map) "Keymap for viewing filters.") @@ -155,7 +150,7 @@ ;;; GENERAL FUNCTION -(defun mastodon-views--minor-view (view-name bindings-string insert-fun data) +(defun mastodon-views--minor-view (view-name insert-fun data) "Load a minor view named VIEW-NAME. BINDINGS-STRING is a string explaining the view's local bindings. INSERT-FUN is the function to call to insert the view's elements. @@ -164,27 +159,27 @@ request. This function is used as the update-function to `mastodon-tl--init-sync', which initializes a buffer for us and provides the JSON data." - (erase-buffer) - (insert (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n " - (upcase view-name) - "\n " mastodon-tl--horiz-bar "\n\n") - 'success) - (if bindings-string - (mastodon-tl--set-face (concat "[" bindings-string "]\n\n") - 'font-lock-comment-face) - "")) + ;; FIXME: this is not an update function as it inserts a heading and + ;; possible bindings string + ;; either it should go in init-sync, or possibly in each view function + ;; but either way, this function does almost nothing for us. + ;; could we call init-sync in here pehaps? + ;; (mastodon-search--insert-heading view-name) + ;; (when bindings-string + ;; (insert (mastodon-tl--set-face (concat "[" bindings-string "]\n\n") + ;; 'font-lock-comment-face))) (if (seq-empty-p data) (insert (propertize (format "Looks like you have no %s for now." view-name) 'face 'font-lock-comment-face 'byline t - 'toot-id "0")) ; so point can move here when no item + 'item-type 'no-item ; for nav + 'item-id "0")) ; so point can move here when no item (funcall insert-fun data) (goto-char (point-min))) ;; (when data ;; FIXME: this seems to trigger a new request, but ideally would run. - ;; (mastodon-tl--goto-next-toot)) + ;; (mastodon-tl--goto-next-item)) ) @@ -194,56 +189,62 @@ provides the JSON data." "Show the user's lists in a new buffer." (interactive) (mastodon-tl--init-sync "lists" "lists" - 'mastodon-views--insert-lists) + 'mastodon-views--insert-lists + nil nil nil + "your lists" + "C - create a list\n D - delete a list\ + \n A/R - add/remove account from a list\ + \n E - edit a list\n n/p - go to next/prev item") (with-current-buffer "*mastodon-lists*" (use-local-map mastodon-views--view-lists-keymap))) (defun mastodon-views--insert-lists (json) "Insert the user's lists from JSON." (mastodon-views--minor-view - "your lists" - "C - create a list\n D - delete a list\ - \n A/R - add/remove account from a list\ - \n E - edit a list\n n/p - go to next/prev item" + "lists" #'mastodon-views--print-list-set json)) (defun mastodon-views--print-list-set (lists) "Print each account plus a separator for each list in LISTS." - (let ((lists-names (mastodon-tl--map-alist 'title lists))) - (mapc (lambda (x) - (mastodon-views--print-list-accounts x) - (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n") - 'face 'success))) - lists-names))) - -(defun mastodon-views--print-list-accounts (list-name) - "Insert the accounts in list named LIST-NAME." - (let* ((id (mastodon-views--get-list-id list-name)) - (accounts (mastodon-views--accounts-in-list id))) - (insert - (propertize list-name - 'byline t ; so we nav here - 'toot-id "0" ; so we nav here - 'help-echo "RET: view list timeline, d: delete this list, \ + (mapc (lambda (x) + (mastodon-views--print-list-accounts x) + (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n") + 'face 'success))) + lists)) + +(defun mastodon-views--print-list-accounts (list) + "Insert the accounts in list named LIST, an alist." + (let-alist list + (let* ((accounts (mastodon-views--accounts-in-list .id))) + (insert + (propertize .title + 'byline t ; so we nav here + 'item-id "0" ; so we nav here + 'item-type 'list + 'help-echo "RET: view list timeline, d: delete this list, \ a: add account to this list, r: remove account from this list" - 'list t - 'face 'link - 'keymap mastodon-views--list-name-keymap - 'list-name list-name - 'list-id id) - (propertize "\n\n" - 'list t - 'keymap mastodon-views--list-name-keymap - 'list-name list-name - 'list-id id) - (propertize - (mapconcat #'mastodon-search--propertize-user accounts - " ") - 'list t - 'keymap mastodon-views--list-name-keymap - 'list-name list-name - 'list-id id)))) + 'list t + 'face 'link + 'keymap mastodon-views--list-name-keymap + 'list-name .title + 'list-id .id) + (propertize (format " [replies: %s, exclusive %s]" + .replies_policy + (when (eq t .exclusive) "true")) + 'face 'font-lock-comment-face) + (propertize "\n\n" + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name .title + 'list-id .id) + (propertize + (mapconcat #'mastodon-search--propertize-user accounts + " ") + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name .title + 'list-id .id))))) (defun mastodon-views--get-users-lists () "Get the list of the user's lists from the server." @@ -292,12 +293,16 @@ If ID is provided, use that list." (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") nil t nil nil "list")) + (exclusive (if (y-or-n-p "Exclude items from home timeline? ") + "true" + "false")) (url (mastodon-http--api (format "lists/%s" id))) (response (mastodon-http--put url `(("title" . ,name-choice) - ("replies_policy" . ,replies-policy))))) + ("replies_policy" . ,replies-policy) + ("exclusive" . ,exclusive))))) (mastodon-http--triage response - (lambda () + (lambda (_) (with-current-buffer response (let* ((json (mastodon-http--process-json)) (name-new (alist-get 'title json))) @@ -334,10 +339,12 @@ Prompt for name and replies policy." (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") nil t nil nil "list")) ; default + (exclusive (when (y-or-n-p "Exclude items from home timeline? ") + "true")) (response (mastodon-http--post (mastodon-http--api "lists") `(("title" . ,title) - ("replies_policy" . ,replies-policy)) - nil))) + ("replies_policy" . ,replies-policy) + ("exclusive" . ,exclusive))))) (mastodon-views--list-action-triage response "list %s created!" title))) @@ -400,7 +407,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (defun mastodon-views--add-toot-account-at-point-to-list () "Prompt for a list, and add the account of the toot at point to it." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (mastodon-tl--property 'item-json)) (account (mastodon-tl--field 'account toot)) (account-id (mastodon-tl--field 'id account)) (handle (mastodon-tl--field 'acct account))) @@ -435,7 +442,7 @@ If ID is provided, use that list." (defun mastodon-views--list-action-triage (response &rest args) "Call `mastodon-http--triage' on RESPONSE and call message on ARGS." (mastodon-http--triage response - (lambda () + (lambda (_) (when (mastodon-tl--buffer-type-eq 'lists) (mastodon-views--view-lists)) (apply #'message args)))) @@ -453,7 +460,6 @@ If ID is provided, use that list." JSON is the data returned by the server." (mastodon-views--minor-view "follow requests" - "a/j - accept/reject request at point\n n/p - go to next/prev request" #'mastodon-views--insert-users-propertized-note json)) @@ -462,7 +468,13 @@ JSON is the data returned by the server." (interactive) (mastodon-tl--init-sync "follow-requests" "follow_requests" - 'mastodon-views--insert-follow-requests) + 'mastodon-views--insert-follow-requests + nil + '(("limit" . "40")) ; server max is 80 + :headers + "follow requests" + "a/j - accept/reject request at point\n\ + n/p - go to next/prev request") (mastodon-tl--goto-first-item) (with-current-buffer "*mastodon-follow-requests*" (use-local-map mastodon-views--view-follow-requests-keymap))) @@ -475,15 +487,18 @@ JSON is the data returned by the server." (interactive) (mastodon-tl--init-sync "scheduled-toots" "scheduled_statuses" - 'mastodon-views--insert-scheduled-toots) + 'mastodon-views--insert-scheduled-toots + nil nil nil + "your scheduled toots" + "n/p - prev/next\n r - reschedule\n\ + e/RET - edit toot\n c - cancel") (with-current-buffer "*mastodon-scheduled-toots*" (use-local-map mastodon-views--scheduled-map))) (defun mastodon-views--insert-scheduled-toots (json) "Insert the user's scheduled toots, from JSON." (mastodon-views--minor-view - "your scheduled toots" - "n/p - prev/next\n r - reschedule\n e/RET - edit toot\n c - cancel" + "scheduled toots" #'mastodon-views--insert-scheduled-toots-list json)) @@ -499,7 +514,7 @@ JSON is the data returned by the server." " | " (mastodon-toot--iso-to-human .scheduled_at)) 'byline t ; so we nav here - 'toot-id "0" ; so we nav here + 'item-id "0" ; so we nav here 'face 'font-lock-comment-face 'keymap mastodon-views--scheduled-map 'scheduled-json toot @@ -544,7 +559,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) (response (mastodon-http--delete url))) (mastodon-http--triage response - (lambda () + (lambda (_) (mastodon-views--view-scheduled-toots) (unless no-confirm (message "Toot cancelled!"))))))))) @@ -574,7 +589,11 @@ NO-CONFIRM means there is no ask or message, there is only do." "View the user's filters in a new buffer." (interactive) (mastodon-tl--init-sync "filters" "filters" - 'mastodon-views--insert-filters) + 'mastodon-views--insert-filters + nil nil nil + "current filters" + "c - create filter\n d - delete filter at point\n\ + n/p - go to next/prev filter") (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) @@ -582,8 +601,7 @@ NO-CONFIRM means there is no ask or message, there is only do." "Insert the user's current filters. JSON is what is returned by by the server." (mastodon-views--minor-view - "current filters" - "c - create filter\n d - delete filter at point\n n/p - go to next/prev filter" + "filters" #'mastodon-views--insert-filter-string-set json)) @@ -601,7 +619,7 @@ JSON is the filters data." (mapconcat #'identity contexts ", ")))) (insert (propertize filter-string - 'toot-id id ;for goto-next-filter compat + 'item-id id ;for goto-next-filter compat 'phrase phrase 'byline t) ;for goto-next-filter compat "\n\n"))) @@ -617,14 +635,14 @@ Prompt for a context, must be a list containting at least one of \"home\", nil nil (or (current-word) ""))) (contexts (if (string-empty-p word) - (error "You must select at least one word for a filter") + (user-error "You must select at least one word for a filter") (completing-read-multiple "Contexts to filter [TAB for options]: " '("home" "notifications" "public" "thread") nil t))) (contexts-processed (if (equal nil contexts) - (error "You must select at least one context for a filter") + (user-error "You must select at least one context for a filter") (mapcar (lambda (x) (cons "context[]" x)) contexts))) @@ -632,7 +650,7 @@ Prompt for a context, must be a list containting at least one of \"home\", `("phrase" . ,word) contexts-processed)))) (mastodon-http--triage response - (lambda () + (lambda (_) (message "Filter created for %s!" word) (when (mastodon-tl--buffer-type-eq 'filters) (mastodon-views--view-filters)))))) @@ -640,27 +658,32 @@ Prompt for a context, must be a list containting at least one of \"home\", (defun mastodon-views--delete-filter () "Delete filter at point." (interactive) - (let* ((filter-id (mastodon-tl--property 'toot-id :no-move)) + (let* ((filter-id (mastodon-tl--property 'item-id :no-move)) (phrase (mastodon-tl--property 'phrase :no-move)) (url (mastodon-http--api (format "filters/%s" filter-id)))) (if (null phrase) - (error "No filter at point?") + (user-error "No filter at point?") (when (y-or-n-p (format "Delete filter %s? " phrase)) (let ((response (mastodon-http--delete url))) (mastodon-http--triage - response (lambda () + response (lambda (_) (mastodon-views--view-filters) (message "Filter for \"%s\" deleted!" phrase)))))))) ;;; FOLLOW SUGGESTIONS +;; No pagination: max 80 results (defun mastodon-views--view-follow-suggestions () "Display a buffer of suggested accounts to follow." (interactive) (mastodon-tl--init-sync "follow-suggestions" "suggestions" - 'mastodon-views--insert-follow-suggestions) + 'mastodon-views--insert-follow-suggestions + nil + '(("limit" . "80")) ; server max + nil + "suggested accounts") (with-current-buffer "*mastodon-follow-suggestions*" (use-local-map mastodon-views--follow-suggestions-map))) @@ -669,7 +692,6 @@ Prompt for a context, must be a list containting at least one of \"home\", JSON is the data returned by the server." (mastodon-views--minor-view "suggested accounts" - nil #'mastodon-views--insert-users-propertized-note json)) @@ -716,24 +738,26 @@ If INSTANCE is given, use that." (string-remove-suffix (concat "/@" username) url)))) -(defun mastodon-views--view-instance-description (&optional user brief instance misskey) +(defun mastodon-views--view-instance-description + (&optional user brief instance misskey) "View the details of the instance the current post's author is on. USER means to show the instance details for the logged in user. BRIEF means to show fewer details. -INSTANCE is an instance domain name." +INSTANCE is an instance domain name. +MISSKEY means the instance is a Misskey or derived server." (interactive) (if user (let ((response (mastodon-http--get-json (mastodon-http--api "instance") nil nil :vector))) (mastodon-views--instance-response-fun response brief instance)) - (mastodon-tl--do-if-toot + (mastodon-tl--do-if-item (let* ((toot (if (mastodon-tl--profile-buffer-p) ;; we may be on profile description itself: (or (mastodon-tl--property 'profile-json) ;; or on profile account listings, or just toots: - (mastodon-tl--property 'toot-json)) + (mastodon-tl--property 'item-json)) ;; normal timeline/account listing: - (mastodon-tl--property 'toot-json))) + (mastodon-tl--property 'item-json))) (reblog (alist-get 'reblog toot)) (account (or (alist-get 'account reblog) (alist-get 'account toot) @@ -778,15 +802,16 @@ USER, BRIEF, and INSTANCE are all for &optional misskey) "Display instance description RESPONSE in a new buffer. BRIEF means to show fewer details. -INSTANCE is the instance were are working with." +INSTANCE is the instance were are working with. +MISSKEY means the instance is a Misskey or derived server." (when response (let* ((domain (url-file-nondirectory instance)) (buf (get-buffer-create (format "*mastodon-instance-%s*" domain)))) (with-mastodon-buffer buf #'special-mode :other-window (if misskey - (mastodon-view--insert-json response) - (condition-case err + (mastodon-views--insert-json response) + (condition-case nil (progn (when brief (setq response diff --git a/lisp/mastodon.el b/lisp/mastodon.el index cd11697..bb06d1b 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -72,8 +72,8 @@ (autoload 'mastodon-tl--get-home-timeline "mastodon-tl") (autoload 'mastodon-tl--get-local-timeline "mastodon-tl") (autoload 'mastodon-tl--get-tag-timeline "mastodon-tl") -(autoload 'mastodon-tl--goto-next-toot "mastodon-tl") -(autoload 'mastodon-tl--goto-prev-toot "mastodon-tl") +(autoload 'mastodon-tl--goto-next-item "mastodon-tl") +(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") (autoload 'mastodon-tl--init-sync "mastodon-tl") (autoload 'mastodon-tl--list-followed-tags "mastodon-tl") (autoload 'mastodon-tl--mute-user "mastodon-tl") @@ -145,8 +145,8 @@ Use. e.g. \"%c\" for your locale's date and time format." (defvar mastodon-mode-map (let ((map (make-sparse-keymap))) ;; navigation inside a timeline - (define-key map (kbd "n") #'mastodon-tl--goto-next-toot) - (define-key map (kbd "p") #'mastodon-tl--goto-prev-toot) + (define-key map (kbd "n") #'mastodon-tl--goto-next-item) + (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) (define-key map (kbd "M-n") #'mastodon-tl--next-tab-item) (define-key map (kbd "M-p") #'mastodon-tl--previous-tab-item) (define-key map [?\t] #'mastodon-tl--next-tab-item) |