diff options
| -rw-r--r-- | Cask | 5 | ||||
| -rw-r--r-- | README.org | 161 | ||||
| -rw-r--r-- | lisp/mastodon-async.el | 6 | ||||
| -rw-r--r-- | lisp/mastodon-auth.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-discover.el | 14 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 17 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 8 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 3 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 36 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 581 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 137 | ||||
| -rw-r--r-- | lisp/mastodon.el | 40 | ||||
| -rw-r--r-- | test/ert-helper.el | 8 |
14 files changed, 667 insertions, 357 deletions
@@ -4,11 +4,6 @@ (package-file "lisp/mastodon.el") (files "lisp/*.el") -(depends-on "request" "0.3.0") -(depends-on "seq") -(depends-on "persist") -(depends-on "ts") - (development (depends-on "ert-runner") (depends-on "el-mock") @@ -1,5 +1,3 @@ -#+OPTIONS: toc:nil - @@html: <a href="https://melpa.org/#/mastodon"><img alt="MELPA" src="https://melpa.org/packages/mastodon-badge.svg"/></a>@@ @@html: <a href="https://ci.codeberg.org/martianh/mastodon.el"><img alt="Build Status" src="https://ci.codeberg.org/api/badges/martianh/mastodon.el/status.svg"></a>@@ @@ -109,69 +107,73 @@ not contain =:client_id= and =:client_secret=. **** Keybindings -|----------------+-----------------------------------------------------------------------| -| Key | Action | -|----------------+-----------------------------------------------------------------------| -| | *Help* | -| =?= | Open context menu if =discover= is available | -|----------------+-----------------------------------------------------------------------| -| | *Timeline actions* | -| =n= | Go to next item (toot, notification) | -| =p= | Go to previous item (toot, notification) | -| =M-n=/=<tab>= | Go to the next interesting thing that has an action | -| =M-p=/=<S-tab>= | Go to the previous interesting thing that has an action | -| =F= | Open federated timeline | -| =H= | Open home timeline | -| =L= | Open local timeline | -| =N= | Open notifications timeline | -| =@= | Open mentions-only notifications timeline | -| =u= | Update current timeline | -| =T= | Open thread for toot under =point= | -| =#= | Prompt for tag and open its timeline | -| =A= | Open author profile of toot under =point= | -| =P= | Open profile of user attached to toot under =point= | -| =O= | View own profile | -| =U= | update your profile bio note | -|----------------+-----------------------------------------------------------------------| -| | *Other views* | -| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | -| =I=, =c=, =d= | view, create, and delete filters | -| =R=, =a=, =j= | view/accept/reject follow requests | -| =G= | view follow suggestions | -| =V= | view your favourited toots | -| =K= | view bookmarked toots | -| =X= | view/edit/create/delete lists | -|----------------+-----------------------------------------------------------------------| -| | *Toot actions* | -| =t= | Compose a new toot | -| =c= | Toggle content warning content | -| =b= | Boost toot under =point= | -| =f= | Favourite toot under =point= | -| =k= | toggle bookmark of toot at point | -| =r= | Reply to toot under =point= | -| =v= | Vote on poll at point | -| =C= | copy url of toot at point | -| =C-RET= | play video/gif at point (requires =mpv=) | -| =e= | edit your toot at point | -| =E= | view edits of toot at point | -| =i= | (un)pin your toot at point | -| =d= | delete your toot at point, and reload current timeline | -| =D= | delete and redraft toot at point, preserving reply/CW/visibility | -| (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | -|----------------+-----------------------------------------------------------------------| -| | *Profile view* | +|----------------+---------------------------------------------------------------------------| +| Key | Action | +|----------------+---------------------------------------------------------------------------| +| | *Help* | +| =?= | Show discover menu of all bindings, if =discover= is available | +|----------------+---------------------------------------------------------------------------| +| | *Timeline actions* | +| =n= | Go to next item (toot, notification) | +| =p= | Go to previous item (toot, notification) | +| =M-n=/=<tab>= | Go to the next interesting thing that has an action | +| =M-p=/=<S-tab>= | Go to the previous interesting thing that has an action | +| =F= | Open federated timeline | +| =H= | Open home timeline | +| =L= | Open local timeline | +| =N= | Open notifications timeline | +| =@= | Open mentions-only notifications timeline | +| =u= | Update current timeline | +| =T= | Open thread for toot at point | +| =#= | Prompt for tag and open its timeline | +| =A= | Open author profile of toot at point | +| =P= | Open profile of user attached to toot at point | +| =O= | View own profile | +| =U= | update your profile bio note | +| =;= | view instance description for toot at point | +| =,= | view favouriters of toot at point | +| =.= | view boosters of toot at point | +|----------------+---------------------------------------------------------------------------| +| | *Other views* | +| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | +| =I=, =c=, =d= | view, create, and delete filters | +| =R=, =a=, =j= | view/accept/reject follow requests | +| =G= | view follow suggestions | +| =V= | view your favourited toots | +| =K= | view bookmarked toots | +| =X= | view/edit/create/delete lists | +| =s= | view your scheduled toots | +|----------------+---------------------------------------------------------------------------| +| | *Toot actions* | +| =t= | Compose a new toot | +| =c= | Toggle content warning content | +| =b= | Boost toot under =point= | +| =f= | Favourite toot under =point= | +| =k= | toggle bookmark of toot at point | +| =r= | Reply to toot under =point= | +| =v= | Vote on poll at point | +| =C= | copy url of toot at point | +| =C-RET= | play video/gif at point (requires =mpv=) | +| =e= | edit your toot at point | +| =E= | view edits of toot at point | +| =i= | (un)pin your toot at point | +| =d= | delete your toot at point, and reload current timeline | +| =D= | delete and redraft toot at point, preserving reply/CW/visibility | +| (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | +|----------------+---------------------------------------------------------------------------| +| | *Profile view* | | =C-c C-c= | cycle between statuses, followers, following, and statuses without boosts | -| | =mastodon-profile--account-account-to-list= (see lists view) | -|----------------+-----------------------------------------------------------------------| -| | *Notifications view* | -| =a=, =j= | accept/reject follow request | -| =c= | clear notification at point | -| | see =mastodon-notifications--get-*= functions for filtered views | -|----------------+-----------------------------------------------------------------------| -| | *Quitting* | -| =q= | Quit mastodon buffer, leave window open | -| =Q= | Quit mastodon buffer and kill window | -|----------------+-----------------------------------------------------------------------| +| | =mastodon-profile--account-account-to-list= (see lists view) | +|----------------+---------------------------------------------------------------------------| +| | *Notifications view* | +| =a=, =j= | accept/reject follow request | +| =c= | clear notification at point | +| | see =mastodon-notifications--get-*= functions for filtered views | +|----------------+---------------------------------------------------------------------------| +| | *Quitting* | +| =q= | Quit mastodon buffer, leave window open | +| =Q= | Quit mastodon buffer and kill window | +|----------------+---------------------------------------------------------------------------| **** Toot byline legend @@ -217,7 +219,7 @@ You can download and use your instance's custom emoji | =C-c C-l= | Set toot language | |---------+----------------------------------| -**** draft toots +**** Draft toots - Compose buffer text is saved as you type, kept in =mastodon-toot-current-toot-text=. - =mastodon-toot--save-draft=: save the current toot as a draft. @@ -227,7 +229,7 @@ You can download and use your instance's custom emoji *** Other commands and account settings: -In addition to =mastodon=, the following functions are autoloaded and should +In addition to =mastodon=, the following three functions are autoloaded and should work without first loading =mastodon.el=: - =mastodon-toot=: Compose new toot - =mastodon-notifications-get=: View all notifications @@ -242,11 +244,17 @@ work without first loading =mastodon.el=: instance. +- =mastodon-tl--add-toot-account-at-point-to-list=: Add the account of the toot at point to a list. + + - =mastodon-tl--follow-tag=: Follow a tag (works like following a user) - =mastodon-tl--unfollow-tag=: Unfollow a tag - =mastodon-tl--list-followed-tags=: View a list of tags you're following. +- =mastodon-switch-to-buffer=: switch between mastodon buffers. + + - =mastodon-profile--update-display-name=: Update the display name for your account. - =mastodon-profile--update-user-profile-note=: Update your bio note. @@ -269,16 +277,25 @@ See =M-x customize-group RET mastodon= to view all customize options. - Timeline options: - Use proportional fonts + - Default number of posts displayed - Timestamp format - Relative timestamps - Display user avatars - Avatar image height - Enable image caching + - Hide replies in timelines - Compose options: - Completion style for mentions and tags - Enable custom emoji - Display toot being replied to + - Set default reply visibility + +*** Alternative timeline layout + +The incomparable Nicholas Rougier has written an alternative timeline layout for =mastodon.el=. + +The repo is at https://github.com/rougier/mastodon-alt. *** Live-updating timelines: =mastodon-async-mode= @@ -295,7 +312,7 @@ view a timeline with one of the commands that begin with *** Translating toots -You can translate toots with =mastodon-toot--translate-toot-text=. At the moment +You can translate toots with =mastodon-toot--translate-toot-text= (=a= in a timeline). At the moment this requires [[https://codeberg.org/martianh/lingva.el][lingva.el]], a little interface I wrote to https://lingva.ml, to be installed to work. @@ -328,7 +345,7 @@ Optional dependencies: - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots -** Network compatibility. +** Network compatibility =mastodon.el= should work with ActivityPub servers that implement the Mastodon API. @@ -359,23 +376,23 @@ PRs, issues, feature requests, and general feedback are very welcome! 3. Run the tests and ensure that your code doesn't break any of them. 4. Create a pull request referencing the issue created in step 1. -*** coding style +*** Coding style - This library uses an unconvential double dash (=--=) between file namespaces and function names, which contradicts normal Elisp style. This needs to be respected until the whole library is changed. - Use =aggressive-indent-mode= or similar to keep your code indented. - Single spaces end sentences in docstrings. - There's no need for a blank line after the first docstring line (one is added automatically when documentation is displayed). -** Supporting mastodon.el +** Supporting =mastodon.el= If you'd like to support continued development of =mastodon.el=, I accept -donations via paypal: https://paypal.me/martianh. If you would +donations via paypal: [[https://paypal.me/martianh][https://paypal.me/martianh]]. If you would prefer a different payment method, write to me at that address and I can provide IBAN or other details. I don't have a tech worker's income, so even a small tip would help out. -** Contributors: +** Contributors =mastodon.el= is the work of a number of people. diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 58e7b93..a352ffc 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -131,7 +131,6 @@ (defun mastodon-async--mastodon (endpoint timeline name filter) "Make sure that the previous async process has been closed. - Then start an async stream at ENDPOINT filtering toots using FILTER. TIMELINE is a specific target, such as federated or home. @@ -157,7 +156,6 @@ NAME is the center portion of the buffer name for (defun mastodon-async--set-http-buffer (buffer http-buffer) "Initialize for BUFFER a local variable `mastodon-async--http-buffer'. - HTTP-BUFFER is the initializing value. Use this funcion if HTTP-BUFFER is not known when `mastodon-async--setup-buffer' is called." (with-current-buffer (get-buffer-create buffer) @@ -178,7 +176,6 @@ is not known when `mastodon-async--setup-buffer' is called." (defun mastodon-async--setup-http (http-buffer name) "Add local variables to HTTP-BUFFER. - NAME is used to generate the display buffer and the queue." (let ((queue-name (concat " *mastodon-async-queue-" name "-" mastodon-instance-url "*")) @@ -200,7 +197,6 @@ NAME is used to generate the display buffer and the queue." (defun mastodon-async--setup-buffer (http-buffer name endpoint) "Set up the buffer timeline like `mastodon-tl--init'. - HTTP-BUFFER the name of the http-buffer, if unknown, set to... NAME is the name of the stream for the buffer name. ENDPOINT is the endpoint for the stream and timeline." @@ -334,7 +330,6 @@ NAME is used for the queue and display buffer." (defun mastodon-async--cycle-queue (string) "Append the most recent STRING from http buffer to queue buffer. - Then determine if a full message has been recived. If so return it. Full messages are seperated by two newlines" (with-current-buffer mastodon-async--queue @@ -350,7 +345,6 @@ Full messages are seperated by two newlines" (defun mastodon-async--http-layer (proc data) "Passes PROC and DATA to ‘url-http-generic-filter’. - It then processes its output." (with-current-buffer (process-buffer proc) (let ((start (max 1 (- (point-max) 2)))) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 3de2901..788fa77 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -221,7 +221,9 @@ Handle any errors from the server." 'acct (mastodon-http--get-json (mastodon-http--api - "accounts/verify_credentials")))) + "accounts/verify_credentials") + nil + :silent))) (defun mastodon-auth--get-account-id () "Request user credentials and return an account name." diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 1b960e5..57c1aa0 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -66,11 +66,15 @@ ("C" "Copy toot URL" mastodon-toot--copy-toot-url) ("d" "Delete (your) toot" mastodon-toot--delete-toot) ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) + ("e" "Edit (your) toot" mastodon-toot--edit-toot-at-point) + ("E" "View edits of (your) toot" mastodon-toot--view-toot-edits) ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) - ("s" "Translate toot at point" mastodon-toot--translate-toot-text) + ("a" "Translate toot at point" mastodon-toot--translate-toot-text) ("T" "View thread" mastodon-tl--thread) - ("v" "Vote on poll" mastodon-tl--poll-vote)) + ("v" "Vote on poll" mastodon-tl--poll-vote) + ("," "View toot's favouriters" mastodon-toot--list-toot-favouriters) + ("." "View toot's boosters" mastodon-toot--list-toot-boosters)) ("Views" ("h/?" "View mode help/keybindings" describe-mode) ("#" "Tag search" mastodon-tl--get-tag-timeline) @@ -78,6 +82,7 @@ ("H" "Home" mastodon-tl--get-home-timeline) ("L" "Local" mastodon-tl--get-local-timeline) ("N" "Notifications" mastodon-notifications-get) + ("@" "Notifications with mentions" mastodon-notifications--get-mentions) ("u" "Update timeline" mastodon-tl--update) ("S" "Search" mastodon-search--search-query) ("O" "Jump to your profile" mastodon-profile--my-profile) @@ -86,7 +91,10 @@ ("V" "View favourites" mastodon-profile--view-favourites) ("R" "View follow requests" mastodon-profile--view-follow-requests) ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) - ("I" "View filters" mastodon-tl--view-filters)) + ("I" "View filters" mastodon-tl--view-filters) + ("X" "View lists" mastodon-tl--view-lists) + ("s" "View scheduled toots" mastodon-tl--view-scheduled-toots) + (";" "View instance description" mastodon-tl--view-instance-description)) ("Users" ("W" "Follow" mastodon-tl--follow-user) ("C-S-W" "Unfollow" mastodon-tl--unfollow-user) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9ef7aec..88bc9c6 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -73,7 +73,6 @@ (defun mastodon-http--url-retrieve-synchronously (url &optional silent) "Retrieve URL asynchronously. - This is a thin abstraction over the system `url-retrieve-synchronously'. Depending on which version of this is available we will call it with or without a timeout. @@ -84,7 +83,6 @@ SILENT means don't message." (defun mastodon-http--triage (response success) "Determine if RESPONSE was successful. Call SUCCESS if successful. - Message status and JSON error from RESPONSE if unsuccessful." (let ((status (with-current-buffer response (mastodon-http--status)))) @@ -136,7 +134,6 @@ Used for API form data parameters that take an array." (defun mastodon-http--post (url &optional params headers unauthenticated-p) "POST synchronously to URL, optionally with PARAMS and HEADERS. - Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request "POST" @@ -207,8 +204,18 @@ Callback to `mastodon-http--get-response-async', usually (buffer-substring-no-properties (point) (point-max)) 'utf-8))) (kill-buffer) - (unless (or (string-empty-p json-string) (null json-string)) - `(,(json-read-from-string json-string) . ,headers))))) + ;; (unless (or (string-empty-p json-string) (null json-string)) + (cond ((or (string-empty-p json-string) (null json-string)) + nil) + ;; if we don't have json, maybe we have a plain string error + ;; message (misskey works like this for instance, but there are + ;; probably less dunce ways to do this): + ;; FIXME: friendica at least sends plain html if endpoint not found. + ((not (or (string-prefix-p "\n{" json-string) + (string-prefix-p "\n[" json-string))) + (error "%s" json-string)) + (t + `(,(json-read-from-string json-string) . ,headers)))))) (defun mastodon-http--process-headers () "Return an alist of http response headers." diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 4e50dbc..3fb10b0 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -144,7 +144,6 @@ fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") (defun mastodon-media--process-image-response (status-plist marker image-options region-length url) "Callback function processing the url retrieve response for URL. - STATUS-PLIST is the usual plist of status events as per `url-retrieve'. IMAGE-OPTIONS are the precomputed options to apply to the image. MARKER is the marker to where the response should be visible. @@ -186,7 +185,6 @@ with the image." (defun mastodon-media--load-image-from-url (url media-type start region-length) "Take a URL and MEDIA-TYPE and load the image asynchronously. - MEDIA-TYPE is a symbol and either 'avatar or 'media-link. START is the position where we start loading the image. REGION-LENGTH is the range from start to propertize." @@ -199,8 +197,8 @@ REGION-LENGTH is the range from start to propertize." `(:max-height ,mastodon-media--preview-max-height)))))) (let ((buffer (current-buffer)) (marker (copy-marker start)) - ;; Keep url.el from spamming us with messages about connecting to hosts: - (url-show-status nil)) + ;; Keep url.el from spamming us with messages about connecting to hosts: + (url-show-status nil)) (condition-case nil ;; catch any errors in url-retrieve so as to not abort ;; whatever called us @@ -226,7 +224,6 @@ REGION-LENGTH is the range from start to propertize." (defun mastodon-media--select-next-media-line (end-pos) "Find coordinates of the next media to load before END-POS. - Returns the list of (`start' . `end', `media-symbol') points of that line and string found or nil no more media links were found." @@ -249,7 +246,6 @@ found." (defun mastodon-media--valid-link-p (link) "Check if LINK is valid. - Checks to make sure the missing string has not been returned." (and link (> (length link) 8) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index b7fe038..279361b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -85,7 +85,7 @@ (copy-keymap mastodon-mode-map))) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) - (define-key map (kbd "c") #'mastodon-notifications--clear-current) + (define-key map (kbd "C-k") #'mastodon-notifications--clear-current) (keymap-canonicalize map)) "Keymap for viewing notifications.") @@ -244,7 +244,6 @@ Status notifications are given when author-byline action-byline id &optional base-toot) "Display the content and byline of timeline element TOOT. - BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 7e3262a..8d8d0c7 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -39,6 +39,7 @@ (require 'cl-lib) (require 'persist) (require 'ts) +(require 'parse-time) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -78,6 +79,9 @@ (autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") (autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") +(autoload 'mastodon-toot--count-toot-chars "mastodon-toot") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) @@ -86,6 +90,7 @@ (defvar mastodon-toot--max-toot-chars) (defvar mastodon-toot--visibility) (defvar mastodon-toot--content-nsfw) +(defvar mastodon-tl--timeline-posts-count) (defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") @@ -169,15 +174,14 @@ NO-REBLOGS means do not display boosts in statuses." (defun mastodon-profile--account-view-cycle () "Cycle through profile view: toots, followers, and following." (interactive) - (let ((endpoint (plist-get mastodon-tl--buffer-spec 'endpoint))) - (cond ((string-suffix-p "statuses" endpoint) - (mastodon-profile--open-followers)) - ((string-suffix-p "followers" endpoint) - (mastodon-profile--open-following)) - ((string-suffix-p "following" endpoint) - (mastodon-profile--open-statuses-no-reblogs)) - (t - (mastodon-profile--make-author-buffer mastodon-profile--account))))) + (cond ((mastodon-tl--buffer-type-eq 'profile-statuses) + (mastodon-profile--open-followers)) + ((mastodon-tl--buffer-type-eq 'profile-followers) + (mastodon-profile--open-following)) + ((mastodon-tl--buffer-type-eq 'profile-following) + (mastodon-profile--open-statuses-no-reblogs)) + (t + (mastodon-profile--make-author-buffer mastodon-profile--account)))) (defun mastodon-profile--open-statuses-no-reblogs () "Open a profile buffer showing statuses without reblogs." @@ -363,7 +367,7 @@ Ask for confirmation if length > 500 characters." (mastodon-profile--user-profile-send-updated-do url note)))) (defun mastodon-profile--user-profile-send-updated-do (url note) - "Send PATCH request with the updated profile note." + "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!"))))) @@ -621,7 +625,8 @@ FIELDS means provide a fields vector fetched by other means." NO-REBLOGS means do not display boosts in statuses. HEADERS means also fetch link headers for pagination." (let* ((id (mastodon-profile--account-field account 'id)) - (args (when no-reblogs '(("exclude_reblogs" . "t")))) + (args `(("limit" . ,mastodon-tl--timeline-posts-count))) + (args (if no-reblogs (push '("exclude_reblogs" . "t") args) args)) (endpoint (format "accounts/%s/%s" id endpoint-type)) (url (mastodon-http--api endpoint)) (acct (mastodon-profile--account-field account 'acct)) @@ -739,11 +744,8 @@ HEADERS means also fetch link headers for pagination." (defun mastodon-profile--format-joined-date-string (joined) "Format a human-readable Joined string from timestamp JOINED." - (let ((joined-ts (ts-parse joined))) - (format "Joined %s" (concat (ts-month-name joined-ts) - " " - (number-to-string - (ts-year joined-ts)))))) + (format-time-string "Joined: %d %B %Y" + (parse-iso8601-time-string joined))) (defun mastodon-profile--get-toot-author () "Open profile of author of toot under point. @@ -763,7 +765,7 @@ IMG_TYPE is the JSON key from the account data." "Query for USER-HANDLE from current status and show that user's profile." (interactive (list - (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (if (and (not (mastodon-tl--profile-buffer-p)) (not (get-text-property (point) 'toot-json))) (message "Looks like there's no toot or user at point?") (let ((user-handles (mastodon-profile--extract-users-handles diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 1aed676..0f2a6d4 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -94,7 +94,7 @@ QUERY is the string to search." (mastodon-mode) (let ((inhibit-read-only t)) (erase-buffer) - (mastodon-tl--set-buffer-spec buffer + (mastodon-tl--set-buffer-spec (buffer-name buffer) "api/v1/trends" nil) ;; hashtag results: @@ -230,13 +230,11 @@ user's profile note. This is also called by (defun mastodon-search--get-id-from-status (status) "Fetch the id from a STATUS returned by a search call to the server. - We use this to fetch the complete status from the server." (alist-get 'id status)) (defun mastodon-search--fetch-full-status-from-id (id) "Fetch the full status with id ID from the server. - This allows us to access the full account etc. details and to render them properly." (let* ((url (concat mastodon-instance-url "/api/v1/statuses/" (mastodon-tl--as-string id))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1d1ca97..ba6b1df 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -87,6 +87,7 @@ (autoload 'mastodon-toot--iso-to-human "mastodon-toot") (defvar mastodon-toot--visibility) +(defvar mastodon-toot-mode) (defvar mastodon-active-user) (when (require 'mpv nil :no-error) @@ -103,7 +104,6 @@ (defcustom mastodon-tl--enable-relative-timestamps t "Whether to show relative (to the current time) timestamps. - This will require periodic updates of a timeline buffer to keep the timestamps current as time progresses." :group 'mastodon-tl @@ -111,7 +111,6 @@ keep the timestamps current as time progresses." (defcustom mastodon-tl--enable-proportional-fonts nil "Nonnil to enable using proportional fonts when rendering HTML. - By default fixed width fonts are used." :group 'mastodon-tl :type '(boolean :tag "Enable using proportional rather than fixed \ @@ -159,9 +158,20 @@ Valid values are: (const :tag "Keep original position of point" keep-point) (const :tag "The last toot before the new ones" last-old-toot))) +(defcustom mastodon-tl--timeline-posts-count "20" + "Number of posts to display when loading a timeline. +Must be an integer between 20 and 40 inclusive." + :type '(string)) + +(defcustom mastodon-tl--hide-replies nil + "Whether to hide replies from the timelines. +Note that you can hide replies on a one-off basis by loading a +timeline with a simple prefix argument, `C-u'." + :group 'mastodon-tl + :type '(boolean :tag "Whether to hide replies from the timelines.")) + (defvar-local mastodon-tl--update-point nil "When updating a mastodon buffer this is where new toots will be inserted. - If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--after-update-marker nil @@ -185,7 +195,6 @@ If nil `(point-min)' is used instead.") (define-key map [follow-link] 'mouse-face) (keymap-canonicalize map)) "The keymap for link-like things in buffer (except for shr.el generate links). - This will make the region of text act like like a link with mouse highlighting, mouse click action tabbing to next/previous link etc.") @@ -201,7 +210,6 @@ etc.") (define-key map [remap shr-browse-url] 'mastodon-url-lookup) (keymap-canonicalize map)) "The keymap to be set for shr.el generated links that are not images. - We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") @@ -224,7 +232,6 @@ types of mastodon links and not just shr.el-generated ones.") (define-key map (kbd "<C-return>") 'mastodon-tl--mpv-play-video-at-point) (keymap-canonicalize map)) "The keymap to be set for shr.el generated image links. - We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") @@ -305,7 +312,6 @@ NAME is not part of the symbol table, '?' is returned." (defun mastodon-tl--next-tab-item () "Move to the next interesting item. - This could be the next toot, link, or image; whichever comes first. Don't move if nothing else to move to is found, i.e. near the end of the buffer. This also skips tab items in invisible text, i.e. hidden spoiler text." @@ -326,7 +332,6 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (defun mastodon-tl--previous-tab-item () "Move to the previous interesting item. - This could be the previous toot, link, or image; whichever comes first. Don't move if nothing else to move to is found, i.e. near the start of the buffer. This also skips tab items in invisible @@ -403,14 +408,18 @@ Used on initializing a timeline or thread." (interactive) (message "Loading federated timeline...") (mastodon-tl--init - "federated" "timelines/public" 'mastodon-tl--timeline)) + "federated" "timelines/public" 'mastodon-tl--timeline nil + `(("limit" . ,mastodon-tl--timeline-posts-count)) + (when current-prefix-arg t))) (defun mastodon-tl--get-home-timeline () "Opens home timeline." (interactive) (message "Loading home timeline...") (mastodon-tl--init - "home" "timelines/home" 'mastodon-tl--timeline)) + "home" "timelines/home" 'mastodon-tl--timeline nil + `(("limit" . ,mastodon-tl--timeline-posts-count)) + (when current-prefix-arg t))) (defun mastodon-tl--get-local-timeline () "Opens local timeline." @@ -418,21 +427,26 @@ Used on initializing a timeline or thread." (message "Loading local timeline...") (mastodon-tl--init "local" "timelines/public" 'mastodon-tl--timeline - nil '(("local" . "true")))) + nil `(("local" . "true") + ("limit" . ,mastodon-tl--timeline-posts-count)) + (when current-prefix-arg t))) -(defun mastodon-tl--get-tag-timeline () - "Prompt for tag and opens its timeline." +(defun mastodon-tl--get-tag-timeline (&optional tag) + "Prompt for tag and opens its timeline. +Optionally load TAG timeline directly." (interactive) (let* ((word (or (word-at-point) "")) - (input (read-string (format "Load timeline for tag (%s): " word))) - (tag (if (string-empty-p input) word input))) + (input (or tag (read-string (format "Load timeline for tag (%s): " word)))) + (tag (or tag (if (string-empty-p input) word input)))) (message "Loading timeline for #%s..." tag) (mastodon-tl--show-tag-timeline tag))) (defun mastodon-tl--show-tag-timeline (tag) "Opens a new buffer showing the timeline of posts with hastag TAG." (mastodon-tl--init - (concat "tag-" tag) (concat "timelines/tag/" tag) 'mastodon-tl--timeline)) + (concat "tag-" tag) (concat "timelines/tag/" tag) + 'mastodon-tl--timeline nil + `(("limit" . ,mastodon-tl--timeline-posts-count)))) (defun mastodon-tl--message-help-echo () "Call message on 'help-echo property at point. @@ -569,14 +583,12 @@ The result is added as an attachments property to author-byline." (defun mastodon-tl--field (field toot) "Return FIELD from TOOT. - Return value from boosted content if available." (or (alist-get field (alist-get 'reblog toot)) (alist-get field toot))) (defun mastodon-tl--relative-time-details (timestamp &optional current-time) "Return cons of (descriptive string . next change) for the TIMESTAMP. - Use the optional CURRENT-TIME as the current time (only used for reliable testing). @@ -631,7 +643,6 @@ TIMESTAMP is assumed to be in the past." (defun mastodon-tl--relative-time-description (timestamp &optional current-time) "Return a string with a human readable TIMESTAMP relative to the current time. - Use the optional CURRENT-TIME as the current time (only used for reliable testing). @@ -641,7 +652,6 @@ TIME-STAMP is assumed to be in the past." (defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p) "Generate byline for TOOT. - AUTHOR-BYLINE is a function for adding the author portion of the byline that takes one variable. ACTION-BYLINE is a function for adding an action, such as boosting, @@ -784,7 +794,6 @@ LETTER is a string, F for favourited, B for boosted, or K for bookmarked." (defun mastodon-tl--render-text (string &optional toot) "Return a propertized text rendering the given HTML string STRING. - The contents comes from the given TOOT which is used in parsing links in the text. If TOOT is nil no parsing occurs." (when string ; handle rare empty notif server bug @@ -896,7 +905,6 @@ Return nil if no matching element" (defun mastodon-tl--extract-userhandle-from-url (url buffer-text) "Return the user hande the URL points to or nil if it is not a profile link. - BUFFER-TEXT is the text covered by the link with URL, for a user profile this should be of the form <at-sign><user id>, e.g. \"@Gargon\"." (let* ((parsed-url (url-generic-parse-url url)) @@ -912,7 +920,6 @@ this should be of the form <at-sign><user id>, e.g. \"@Gargon\"." (defun mastodon-tl--extract-hashtag-from-url (url instance-url) "Return the hashtag that URL points to or nil if URL is not a tag link. - INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing the toot)." @@ -963,7 +970,6 @@ the toot)." (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. - LINK-TYPE is the type of link to produce." (let ((help-text (cond ((eq link-type 'content-warning) @@ -1020,7 +1026,6 @@ Used for a mouse-click EVENT on a link." (defun mastodon-tl--has-spoiler (toot) "Check if the given TOOT has a spoiler text. - Spoiler text should initially be shown only while the main content should be hidden." (let ((spoiler (mastodon-tl--field 'spoiler_text toot))) @@ -1033,7 +1038,6 @@ content should be hidden." (defun mastodon-tl--spoiler (toot) "Render TOOT with spoiler message. - This assumes TOOT is a toot with a spoiler message. The main body gets hidden and only the spoiler text and the content warning message are displayed. The content warning @@ -1111,7 +1115,6 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type help-echo &optional display face) "Propertize an media placeholder string \"[img]\" or media URL. - STR is the string to propertize, MEDIA-URL is the preview link, FULL-REMOTE-URL is the link to the full resolution image on the server, TYPE is the media type. @@ -1150,11 +1153,11 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id base-toot detailed-p) "Display the content and byline of timeline element TOOT. - BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author portion of the byline that takes one variable. By default it is -`mastodon-tl--byline-author' +`mastodon-tl--byline-author'. + ACTION-BYLINE is also an optional function for adding an action, such as boosting favouriting and following to the byline. It also takes a single function. By default it is @@ -1348,9 +1351,13 @@ in which case play first video or gif from current toot." (message "no moving image here?")) (message "no moving image here?")))) -(defun mastodon-tl--toot (toot &optional detailed-p) - "Formats TOOT and insertes it into the buffer. +(defun mastodon-tl--is-reply (toot) + "Check if the TOOT is a reply to another one (and not boosted)." + (and (null (mastodon-tl--field 'in_reply_to_id toot)) + (not (mastodon-tl--field 'rebloged toot)))) +(defun mastodon-tl--toot (toot &optional detailed-p) + "Formats TOOT and inserts it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client." (mastodon-tl--insert-status @@ -1366,8 +1373,18 @@ this just means displaying toot client." detailed-p)) (defun mastodon-tl--timeline (toots) - "Display each toot in TOOTS." - (mapc 'mastodon-tl--toot toots) + "Display each toot in TOOTS. +This function removes replies if user required." + (mapc 'mastodon-tl--toot + ;; hack to *not* filter replies on profiles: + (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) + toots + (if (or ; we were called via --more*: + (mastodon-tl--get-buffer-property 'hide-replies nil :no-error) + ;; loading a tl with a prefix arg: + (mastodon-tl--hide-replies-p current-prefix-arg)) + (cl-remove-if-not #'mastodon-tl--is-reply toots) + toots))) (goto-char (point-min))) (defun mastodon-tl--get-update-function (&optional buffer) @@ -1375,42 +1392,180 @@ this just means displaying toot client." Optionally get it for BUFFER." (mastodon-tl--get-buffer-property 'update-function buffer)) -(defun mastodon-tl--get-endpoint (&optional buffer) +(defun mastodon-tl--get-endpoint (&optional buffer no-error) "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'. -Optionally set it for BUFFER." - (mastodon-tl--get-buffer-property 'endpoint buffer)) +Optionally set it for BUFFER. +NO-ERROR means to fail silently." + (mastodon-tl--get-buffer-property 'endpoint buffer no-error)) -(defun mastodon-tl--buffer-name (&optional buffer) +(defun mastodon-tl--buffer-name (&optional buffer no-error) "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. -Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'buffer-name buffer)) +Optionally get it for BUFFER. +NO-ERROR means to fail silently." + (mastodon-tl--get-buffer-property 'buffer-name buffer no-error)) (defun mastodon-tl--link-header (&optional buffer) "Get the LINK HEADER stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'link-header buffer)) + (mastodon-tl--get-buffer-property 'link-header buffer :no-error)) + +(defun mastodon-tl--update-params (&optional buffer) + "Get the UPDATE PARAMS stored in `mastodon-tl--buffer-spec'. +Optionally get it for BUFFER." + (mastodon-tl--get-buffer-property 'update-params buffer :no-error)) -(defun mastodon-tl--get-buffer-property (property &optional buffer) - "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'." +(defun mastodon-tl--get-buffer-property (property &optional buffer no-error) + "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'. +If NO-ERROR is non-nil, do not error when property is empty." (with-current-buffer (or buffer (current-buffer)) - (or (plist-get mastodon-tl--buffer-spec property) - (error "Mastodon-tl--buffer-spec is not defined for buffer %s" - (or buffer (current-buffer)))))) + (if no-error + (plist-get mastodon-tl--buffer-spec property) + (or (plist-get mastodon-tl--buffer-spec property) + (error "Mastodon-tl--buffer-spec is not defined for buffer %s" + (or buffer (current-buffer))))))) (defun mastodon-tl--set-buffer-spec (buffer endpoint update-function - &optional link-header) + &optional link-header update-params + hide-replies) "Set `mastodon-tl--buffer-spec' for the current buffer. - BUFFER is buffer name, ENDPOINT is buffer's enpoint, UPDATE-FUNCTION is its update function. -LINK-HEADER is the http Link header if present." +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." (setq mastodon-tl--buffer-spec `(account ,(cons mastodon-active-user mastodon-instance-url) buffer-name ,buffer endpoint ,endpoint update-function ,update-function - link-header ,link-header))) + link-header ,link-header + update-params ,update-params + hide-replies ,hide-replies))) + +(defun mastodon-tl--get-buffer-type () + "Return a symbol descriptive of current mastodon buffer type. +Should work in all mastodon buffers. +Note that for many buffers, this requires `mastodon-tl--buffer-spec' +to be set. It is set for almost all buffers, but you still have to +call this function after it is set or use something else." + (let ((endpoint-fun (mastodon-tl--get-endpoint nil :no-error)) + (buffer-name-fun (mastodon-tl--buffer-name nil :no-error))) + (cond (mastodon-toot-mode + ;; composing/editing: + (if (string= "*edit toot*" (buffer-name)) + 'edit-toot + 'new-toot)) + ;; main timelines: + ((string= "timelines/home" endpoint-fun) + 'home) + ((string= "*mastodon-local*" buffer-name-fun) + 'local) + ((string= "timelines/public" endpoint-fun) + 'federated) + ((string-prefix-p "timelines/tag/" endpoint-fun) + 'tag-timeline) + ((string-prefix-p "timelines/list/" endpoint-fun) + 'list-timeline) + ;; notifs: + ((string-suffix-p "mentions*" buffer-name-fun) + 'mentions) + ((string= "notifications" endpoint-fun) + 'notifications) + ;; threads: + ((string-suffix-p "context" endpoint-fun) + 'thread) + ((string-prefix-p "statuses" endpoint-fun) + 'single-status) + ;; profiles: + ((mastodon-tl--profile-buffer-p) + (cond + ;; own profile: + ((equal (mastodon-tl--buffer-name) + (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) + 'own-profile) + ;; profile note: + ((string-suffix-p "update-profile*" buffer-name-fun) + 'update-profile-note) + ;; posts + ((string-suffix-p "statuses" endpoint-fun) + 'profile-statuses) + ;; profile followers + ((string-suffix-p "followers" endpoint-fun) + 'profile-followers) + ;; profile following + ((string-suffix-p "following" endpoint-fun) + 'profile-following))) + ((string= "preferences" endpoint-fun) + 'preferences) + ;; search + ((string-suffix-p "search" endpoint-fun) + 'search) + ((string-suffix-p "trends" endpoint-fun) + 'trending-tags) + ;; User's views: + ((string= "filters" endpoint-fun) + 'filters) + ((string= "lists" endpoint-fun) + 'lists) + ((string= "suggestions" endpoint-fun) + 'follow-suggestions) + ((string= "favourites" endpoint-fun) + 'favourites) + ((string= "bookmarks" endpoint-fun) + 'bookmarks) + ((string= "follow_requests" endpoint-fun) + 'follow-requests) + ((string= "scheduled_statuses" endpoint-fun) + 'scheduled-statuses) + ;; instance description + ((string= "instance" endpoint-fun) + 'instance-description) + ((string= "*mastodon-toot-edits*" buffer-name-fun) + 'toot-edits)))) + +(defun mastodon-tl--buffer-type-eq (type) + "Return t if current buffer type is equal to symbol TYPE." + (eq (mastodon-tl--get-buffer-type) type)) + +(defun mastodon-tl--profile-buffer-p () + "Return t if current buffer is a profile buffer of any kind. +This includes the update profile note buffer, but not the preferences one." + (string-prefix-p "accounts" (mastodon-tl--get-endpoint nil :no-error))) + +(defun mastodon-tl--has-toots-p () + "Return non-nil if the current buffer contains toots. +Return value is that of `member'. +This is used to avoid running into trouble using functions that +presume we are in a timeline of toots or similar elements, such as +`mastodon-tl--property'." + (let ((toot-buffers + '(home federated local tag-timeline notifications + thread profile-statuses search trending-tags bookmarks + favourites))) + ;; profile-followers profile following + (member (mastodon-tl--get-buffer-type) toot-buffers))) + +(defun mastodon-tl--timeline-proper-p () + "Return non-nil if the current buffer is a 'proper' timeline. +A proper timeline excludes notifications, threads, and other toot +buffers that aren't strictly mastodon timelines." + (let ((timeline-buffers '(home federated local tag-timeline list-timeline profile-statuses))) + (member (mastodon-tl--get-buffer-type) timeline-buffers))) + +(defun mastodon-tl--hide-replies-p (&optional prefix) + "Return non-nil if replies should be hidden in the timeline. +We hide replies if user explictly set the +`mastodon-tl--hide-replies' or used PREFIX combination to open a +timeline." + (and + ;; Only hide replies if we are in a proper timeline + (mastodon-tl--timeline-proper-p) + (or + ;; User configured to hide replies + mastodon-tl--hide-replies + ;; Timeline called with C-u prefix + (equal '(4) prefix)))) (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." @@ -1420,25 +1575,27 @@ LINK-HEADER is the http Link header if present." (defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs) "Return JSON for timeline ENDPOINT before ID. -Then run CALLBACK with arguments CBARGS -PARAMS is used to send 'local=true' for local timeline." +Then run CALLBACK with arguments CBARGS. +PARAMS is used to send any parameters needed to correctly update +the current view." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push params args) args)) + (args (if params (push (car args) params) args)) (url (mastodon-http--api endpoint))) (apply 'mastodon-http--get-json-async url args callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local (defun mastodon-tl--updated-json (endpoint id &optional params) - "Return JSON for timeline ENDPOINT since ID." + "Return JSON for timeline ENDPOINT since ID. +PARAMS is used to send any parameters needed to correctly update +the current view." (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push params args) args)) + (args (if params (push (car args) params) args)) (url (mastodon-http--api endpoint))) (mastodon-http--get-json url args))) (defun mastodon-tl--property (prop &optional backward) "Get property PROP for toot at point. - Move forward (down) the timeline unless BACKWARD is non-nil." (or (get-text-property (point) prop) (save-excursion @@ -1470,7 +1627,6 @@ Move forward (down) the timeline unless BACKWARD is non-nil." (defun mastodon-tl--toot-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 the toot. This is the same behaviour as the mastodon.social @@ -1499,6 +1655,18 @@ ID is that of the toot to view." (let ((inhibit-read-only t)) (mastodon-tl--toot toot :detailed-p)))))) +(defun mastodon-tl--view-whole-thread () + "From a thread view, view entire thread. +If you load a thread from a toot, only the branches containing +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") + (goto-char (point-min)) + (let ((id (mastodon-tl--property 'base-toot-id))) + (mastodon-tl--thread id)))) + (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." ;; NB: this is called by `mastodon-url-lookup', which means it must work @@ -1566,7 +1734,7 @@ Note that you can only (un)mute threads you have posted in." "Mute a thread. If UNMUTE, unmute it." (let ((endpoint (mastodon-tl--get-endpoint))) - (if (string-suffix-p "context" endpoint) ; thread view + (if (mastodon-tl--buffer-type-eq 'thread) (let* ((id (save-match-data (string-match "statuses/\\(?2:[[:digit:]]+\\)/context" @@ -1670,8 +1838,7 @@ If ID is provided, use that list." (let* ((json (mastodon-http--process-json)) (name-new (alist-get 'title json))) (message "list %s edited to %s!" name-old name-new))) - (when (equal (buffer-name (current-buffer)) - "*mastodon-lists*") + (when (mastodon-tl--buffer-type-eq 'lists) (mastodon-tl--view-lists)))))) (defun mastodon-tl--view-timeline-list-at-point () @@ -1794,7 +1961,7 @@ a: add account to this list, r: remove account from this list" "Return the list of followers of the logged in account." (let* ((id (mastodon-auth--get-account-id)) (url (mastodon-http--api (format "accounts/%s/following" id)))) - (mastodon-http--get-json url))) + (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts (defun mastodon-tl--add-account-to-list-at-point () "Prompt for account and add to list at point." @@ -1807,9 +1974,12 @@ a: add account to this list, r: remove account from this list" If ID is provided, use that list. If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (interactive) - (let* ((list-name (if id + (let* ((list-prompt (if handle + (format "Add %s to list: " handle) + "Add account to list: ")) + (list-name (if id (get-text-property (point) 'list-name) - (completing-read "Add account to list: " + (completing-read list-prompt (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) (followings (mastodon-tl--get-users-followings)) @@ -1827,6 +1997,15 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." response (message "%s added to list %s!" account list-name)))) +(defun mastodon-tl--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)) + (account (mastodon-tl--field 'account toot)) + (account-id (mastodon-tl--field 'id account)) + (handle (mastodon-tl--field 'acct account))) + (mastodon-tl--add-account-to-list nil account-id handle))) + (defun mastodon-tl--remove-account-from-list-at-point () "Prompt for account and remove from list at point." (interactive) @@ -1861,8 +2040,7 @@ If ID is provided, use that list." "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." (mastodon-http--triage response (lambda () - (when (equal (buffer-name (current-buffer)) - "*mastodon-lists*") + (when (mastodon-tl--buffer-type-eq 'lists) (mastodon-tl--view-lists)) message))) @@ -2008,8 +2186,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (lambda () (message "Filter created for %s!" word) ;; reload if we are in filters view: - (when (string= (mastodon-tl--get-endpoint) - "filters") + (when (mastodon-tl--buffer-type-eq 'filters) (mastodon-tl--view-filters)))))) (defun mastodon-tl--view-filters () @@ -2096,7 +2273,7 @@ RESPONSE is the JSON returned by the server." (defmacro mastodon-tl--do-if-toot (&rest body) "Execute BODY if we have a toot or user at point." (declare (debug t)) - `(if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + `(if (and (not (mastodon-tl--profile-buffer-p)) (not (mastodon-tl--property 'toot-json))) (message "Looks like there's no toot or user at point?") ,@body)) @@ -2125,61 +2302,73 @@ USER means to show the instance details for the logged in user. BRIEF means to show fewer details. INSTANCE is an instance domain name." (interactive) - (mastodon-tl--do-if-toot - (let* ((profile-p (get-text-property (point) 'profile-json)) - (toot (if profile-p - (mastodon-tl--property 'profile-json) ; profile may have 0 toots - (mastodon-tl--property 'toot-json))) - (reblog (alist-get 'reblog toot)) - (account (or (alist-get 'account reblog) - (alist-get 'account toot))) - (url (if profile-p - (alist-get 'url toot) ; profile - (alist-get 'url account))) - (username (if profile-p - (alist-get 'username toot) ;; profile - (alist-get 'username account))) - (instance (if instance - (concat "https://" instance) - ;; pleroma URL is https://instance.com/users/username - (if (string-suffix-p "users/" (url-basepath url)) - (string-remove-suffix "/users/" - (url-basepath url)) - ;; mastodon: - (string-remove-suffix (concat "/@" username) - url)))) - (response (mastodon-http--get-json - (if user - (mastodon-http--api "instance") - (concat instance "/api/v1/instance")) - nil ; params - nil ; silent - :vector))) - (when response - (let ((buf (get-buffer-create "*mastodon-instance*"))) - (with-current-buffer buf - (switch-to-buffer-other-window buf) - (mastodon-tl--set-buffer-spec (buffer-name buf) - "instance" - nil) - (let ((inhibit-read-only t)) - (erase-buffer) - (special-mode) - (when brief - (setq response - (list (assoc 'uri response) - (assoc 'title response) - (assoc 'short_description response) - (assoc 'email response) - (cons 'contact_account - (list - (assoc 'username - (assoc 'contact_account response)))) - (assoc 'rules response) - (assoc 'stats response)))) - (mastodon-tl--print-json-keys response) - (mastodon-mode) - (goto-char (point-min))))))))) + (if user + (let ((response (mastodon-http--get-json + (mastodon-http--api "instance") + nil ; params + nil ; silent + :vector))) + (mastodon-tl--instance-response-fun response brief)) + (mastodon-tl--do-if-toot + (let* ((profile-p (get-text-property (point) 'profile-json)) + (toot (if profile-p + (mastodon-tl--property 'profile-json) ; profile may have 0 toots + (mastodon-tl--property 'toot-json))) + (reblog (alist-get 'reblog toot)) + (account (or (alist-get 'account reblog) + (alist-get 'account toot))) + (url (if profile-p + (alist-get 'url toot) ; profile + (alist-get 'url account))) + (username (if profile-p + (alist-get 'username toot) ;; profile + (alist-get 'username account))) + (instance (if instance + (concat "https://" instance) + ;; pleroma URL is https://instance.com/users/username + (if (string-suffix-p "users/" (url-basepath url)) + (string-remove-suffix "/users/" + (url-basepath url)) + ;; mastodon: + (string-remove-suffix (concat "/@" username) + url)))) + (response (mastodon-http--get-json + (if user + (mastodon-http--api "instance") + (concat instance "/api/v1/instance")) + nil ; params + nil ; silent + :vector))) + (mastodon-tl--instance-response-fun response brief))))) + +(defun mastodon-tl--instance-response-fun (response brief) + "Display instance description RESPONSE in a new buffer. +BRIEF means to show fewer details." + (when response + (let ((buf (get-buffer-create "*mastodon-instance*"))) + (with-current-buffer buf + (switch-to-buffer-other-window buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (special-mode) + (when brief + (setq response + (list (assoc 'uri response) + (assoc 'title response) + (assoc 'short_description response) + (assoc 'email response) + (cons 'contact_account + (list + (assoc 'username + (assoc 'contact_account response)))) + (assoc 'rules response) + (assoc 'stats response)))) + (mastodon-tl--print-json-keys response) + (mastodon-mode) + (mastodon-tl--set-buffer-spec (buffer-name buf) + "instance" + nil) + (goto-char (point-min))))))) (defun mastodon-tl--format-key (el pad) "Format a key of element EL, a cons, with PAD padding." @@ -2395,19 +2584,19 @@ LANGS is the accumulated array param alist if we re-run recursively." "Get the list of user-handles for ACTION from the current toot." (mastodon-tl--do-if-toot (let ((user-handles - (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*") + (cond ((or (mastodon-tl--buffer-type-eq 'follow-suggestions) ;; follow suggests / search / foll requests compat: - (string-prefix-p "*mastodon-search" (buffer-name)) - (equal (buffer-name) "*mastodon-follow-requests*") + (mastodon-tl--buffer-type-eq 'search) + (mastodon-tl--buffer-type-eq 'follow-requests) ;; profile view follows/followers compat: ;; but not for profile statuses: ;; fetch 'toot-json: - (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) - (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint))))) + (mastodon-tl--buffer-type-eq 'profile-followers) + (mastodon-tl--buffer-type-eq 'profile-following)) (list (alist-get 'acct (get-text-property (point) 'toot-json)))) ;; profile view, no toots, point on profile note, ie. 'profile-json: ;; needed for e.g. gup.pe groups which show no toots publically: - ((and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + ((and (mastodon-tl--profile-buffer-p) (get-text-property (point) 'profile-json)) (list (alist-get 'acct (get-text-property (point) 'profile-json)))) ;; avoid tl--property here because it calls next-toot @@ -2453,7 +2642,7 @@ LANGS is an array parameters alist of languages to filer user's posts by." (mastodon-profile--search-account-by-handle user-handle) ;; if profile view, use 'profile-json as status: - (if (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (if (mastodon-tl--profile-buffer-p) (mastodon-profile--lookup-account-in-status user-handle (get-text-property (point) 'profile-json)) ;; if muting/blocking, we select from handles in current status @@ -2524,7 +2713,7 @@ If TAG provided, follow it." (defun mastodon-tl--unfollow-tag (&optional tag) "Prompt for a followed tag, and unfollow it. -If TAG if provided, unfollow it." +If TAG is provided, unfollow it." (interactive) (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) (tags (unless tag (mapcar (lambda (x) @@ -2539,30 +2728,28 @@ If TAG if provided, unfollow it." (message "tag #%s unfollowed!" tag))))) (defun mastodon-tl--list-followed-tags () - "List tags followed. If user choses one, display its JSON." + "List followed tags. View timeline of tag user choses." (interactive) (let* ((followed-tags-json (mastodon-tl--followed-tags)) (tags (mapcar (lambda (x) (alist-get 'name x)) followed-tags-json)) (tag (completing-read "Tag: " tags))) - (message (prin1-to-string - (mastodon-tl--get-tag-json tag))))) + (mastodon-tl--get-tag-timeline tag))) ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () "Reload the current timeline or profile page. For use after e.g. deleting a toot." - (cond ((equal (mastodon-tl--get-endpoint) "timelines/home") + (cond ((mastodon-tl--buffer-type-eq 'home) (mastodon-tl--get-home-timeline)) - ((equal (mastodon-tl--get-endpoint) "timelines/public") + ((mastodon-tl--buffer-type-eq 'federated) (mastodon-tl--get-federated-timeline)) - ((equal (mastodon-tl--buffer-name) "*mastodon-local*") + ((mastodon-tl--buffer-type-eq 'local) (mastodon-tl--get-local-timeline)) - ((equal (mastodon-tl--get-endpoint) "notifications") + ((mastodon-tl--buffer-type-eq 'notifications) (mastodon-notifications-get)) - ((equal (mastodon-tl--buffer-name) - (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) + ((mastodon-tl--buffer-type-eq 'own-profile) (mastodon-profile--my-profile)) ((save-match-data (string-match @@ -2579,15 +2766,13 @@ For use after e.g. deleting a toot." (concat url-base "&" param))) (defun mastodon-tl--use-link-header-p () - "Return t if we are in a view that uses Link header pagination. + "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." - (let ((buf (buffer-name (current-buffer))) - (endpoint (mastodon-tl--get-endpoint))) - (or (member buf '("*mastodon-favourites*" "*mastodon-bookmarks*")) - (and (string-prefix-p "accounts" endpoint) - (or (string-suffix-p "followers" endpoint) - (string-suffix-p "following" endpoint)))))) + (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))) (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." @@ -2595,18 +2780,21 @@ when showing followers or accounts followed." (message "Loading older toots...") (if (mastodon-tl--use-link-header-p) ;; link-header: can't build a URL with --more-json-async, endpoint/id: - (let* ((next (car (mastodon-tl--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)) - (mastodon-tl--more-json-async - (mastodon-tl--get-endpoint) - (mastodon-tl--oldest-id) - ;; local has same endpoint as federated: - (when (string= (mastodon-tl--buffer-name) "*mastodon-local*") - '("local" . "true")) - 'mastodon-tl--more* (current-buffer) (point)))) + ;; 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") + (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)) + (mastodon-tl--more-json-async + (mastodon-tl--get-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. @@ -2620,7 +2808,12 @@ HEADERS is the http headers returned in the response, if any." (headers (if headers (cdr response) nil)) (link-header (mastodon-tl--get-link-header-from-response headers))) (goto-char (point-max)) - (funcall (mastodon-tl--get-update-function) json) + (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) + (funcall (mastodon-tl--get-update-function))) + (funcall (mastodon-tl--get-update-function) json)) (goto-char point-before) ;; update buffer spec to new link-header: ;; (other values should just remain as they were) @@ -2633,7 +2826,6 @@ HEADERS is the http headers returned in the response, if any." (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) "Return `nil` if no such range is found. - If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. @@ -2669,7 +2861,6 @@ before (non-nil) or after (nil)" (defun mastodon-tl--find-next-or-previous-property-range (property start-point search-backwards) "Find (start . end) property range after/before START-POINT. - Does so while PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). @@ -2694,7 +2885,6 @@ START-POINT otherwise after START-POINT." (defun mastodon-tl--consider-timestamp-for-updates (timestamp) "Take note that TIMESTAMP is used in buffer and ajust timers as needed. - This calculates the next time the text for TIMESTAMP will change and may adjust existing or future timer runs should that time before current plans to run the update function. @@ -2724,7 +2914,6 @@ is a no-op." (defun mastodon-tl--update-timestamps-callback (buffer previous-marker) "Update the next few timestamp displays in BUFFER. - Start searching for more timestamps from PREVIOUS-MARKER or from the start if it is nil." ;; only do things if the buffer hasn't been killed in the meantime @@ -2778,6 +2967,9 @@ from the start if it is nil." buffer nil)))))))) (defun mastodon-tl--set-after-update-marker () + "Set `mastodon-tl--after-update-marker' to the after-update location. +This location is defined by a non-nil value of +`mastodon-tl-position-after-update'." (if mastodon-tl-position-after-update (let ((marker (make-marker))) (set-marker marker @@ -2788,8 +2980,9 @@ from the start if it is nil." (next-single-property-change (or mastodon-tl--update-point (point-min)) 'byline)) - (error "Unknown mastodon-tl-position-after-update value %S" - mastodon-tl-position-after-update))) + (t + (error "Unknown mastodon-tl-position-after-update value %S" + mastodon-tl-position-after-update)))) ;; Make the marker advance if text gets inserted there. (set-marker-insertion-type marker t) (setq mastodon-tl--after-update-marker marker)) @@ -2802,12 +2995,11 @@ from the start if it is nil." (update-function (mastodon-tl--get-update-function)) (thread-id (mastodon-tl--property 'toot-id))) ;; update a thread, without calling `mastodon-tl--updated-json': - (if (string-suffix-p "context" (mastodon-tl--get-endpoint)) + (if (mastodon-tl--buffer-type-eq 'thread) (funcall update-function thread-id) ;; update other timelines: (let* ((id (mastodon-tl--newest-id)) - (params (when (string= (mastodon-tl--buffer-name) "*mastodon-local*") - '("local" . "true"))) + (params (mastodon-tl--update-params)) (json (mastodon-tl--updated-json endpoint id params))) (if json (let ((inhibit-read-only t)) @@ -2820,26 +3012,30 @@ from the start if it is nil." (defun mastodon-tl--get-link-header-from-response (headers) "Get http Link header from list of http HEADERS." - (when headers - ;; pleroma uses "link", so case-insensitive match required: - (split-string (alist-get "Link" headers nil nil 'cl-equalp) ", "))) + ;; pleroma uses "link", so case-insensitive match required: + (when-let ((link-headers (alist-get "Link" headers nil nil 'cl-equalp))) + (split-string link-headers ", "))) -(defun mastodon-tl--init (buffer-name endpoint update-function &optional headers params) +(defun mastodon-tl--init (buffer-name endpoint update-function + &optional headers params hide-replies) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots. HEADERS means to also collect the response headers. Used for paginating favourites and bookmarks. -PARAMS is any parameters to send with the request, currently only -used to send 'local=true' for local timeline." +PARAMS is any parameters to send with the request. +HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (if headers - (mastodon-http--get-response-async - url params 'mastodon-tl--init* buffer endpoint update-function headers) - (mastodon-http--get-json-async - url params 'mastodon-tl--init* buffer endpoint update-function)))) - -(defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) + (mastodon-http--get-response-async url params + 'mastodon-tl--init* buffer endpoint update-function + headers params hide-replies) + (mastodon-http--get-json-async url params + 'mastodon-tl--init* buffer endpoint update-function nil + params hide-replies)))) + +(defun mastodon-tl--init* (response buffer endpoint update-function + &optional headers update-params hide-replies) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by @@ -2859,7 +3055,9 @@ JSON and http headers, without it just the JSON." (mastodon-tl--set-buffer-spec buffer endpoint update-function - link-header) + link-header + update-params + hide-replies) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -2871,7 +3069,9 @@ JSON and http headers, without it just the JSON." (mastodon-tl--set-buffer-spec buffer endpoint update-function - link-header) + link-header + update-params + hide-replies) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds @@ -2881,13 +3081,11 @@ JSON and http headers, without it just the JSON." #'mastodon-tl--update-timestamps-callback (current-buffer) nil))) - (unless (string-prefix-p "accounts" endpoint) - ;; for everything save profiles + (unless (mastodon-tl--profile-buffer-p) (mastodon-tl--goto-first-item))))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. - UPDATE-FUNCTION is used to receive more toots. Runs synchronously. Optional arg NOTE-TYPE means only get that type of note." @@ -2895,11 +3093,8 @@ Optional arg NOTE-TYPE means only get that type of note." (mastodon-notifications--filter-types-list note-type))) (args (when note-type (mastodon-http--build-array-params-alist "exclude_types[]" exclude-types))) - ;; (query-string (when note-type - ;; (mastodon-http--build-params-string args))) - ;; add note-type exclusions to endpoint so it works in `mastodon-tl--buffer-spec' - ;; that way `mastodon-tl--more' works seamlessly too: - ;; (endpoint (if note-type (concat endpoint "?" query-string) endpoint)) + ;; NB: we now store 'update-params separately in `mastodon-tl--buffer-spec' + ;; and -http.el handles all conversion of params alists into query strings. (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*")) (json (mastodon-http--get-json url args))) @@ -2918,7 +3113,7 @@ Optional arg NOTE-TYPE means only get that type of note." (funcall update-function json)) (mastodon-mode) (with-current-buffer buffer - (mastodon-tl--set-buffer-spec buffer endpoint update-function) + (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds @@ -2928,9 +3123,7 @@ Optional arg NOTE-TYPE means only get that type of note." #'mastodon-tl--update-timestamps-callback (current-buffer) nil))) - (when ;(and (not (equal json '[])) - ;; for everything save profiles: - (not (string-prefix-p "accounts" endpoint)) + (unless (mastodon-tl--profile-buffer-p) (mastodon-tl--goto-first-item))) buffer)) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index cbcc4f3..2625695 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -41,7 +41,6 @@ (require 'cl-lib) (require 'persist) - (require 'mastodon-iso) (defvar mastodon-instance-url) @@ -77,13 +76,15 @@ (autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") (autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-tl--symbol "mastodon-tl") (autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl") (autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot") (autoload 'org-read-date "org") (autoload 'iso8601-parse "iso8601") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -113,7 +114,6 @@ Used for completion in toot compose buffer." (defcustom mastodon-toot--use-company-for-completion nil "Whether to enable company for completion. - When non-nil, `company-mode' is enabled in the toot compose buffer, and mastodon completion backends are added to `company-capf'. @@ -140,6 +140,16 @@ You need to install company yourself to use this." :group 'mastodon-toot :type 'integer) +(defcustom mastodon-toot--default-reply-visibility "public" + "Default visibility settings when replying. +If the original toot visibility is different we use the more restricted one." + :group 'mastodon-toot + :type '(choice + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) + (defcustom mastodon-toot--enable-custom-instance-emoji nil "Whether to enable your instance's custom emoji by default." :group 'mastodon-toot @@ -160,7 +170,6 @@ You need to install company yourself to use this." (defvar-local mastodon-toot--visibility nil "A string indicating the visibility of the toot being composed. - Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\". @@ -279,13 +288,13 @@ NO-TOOT means we are not calling from a toot buffer." (defun mastodon-toot--action-success (marker byline-region remove) "Insert/remove the text MARKER with 'success face in byline. - BYLINE-REGION is a cons of start and end pos of the byline to be modified. Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((inhibit-read-only t) (bol (car byline-region)) - (eol (cdr byline-region))) + (eol (cdr byline-region)) + (at-byline-p (eq (get-text-property (point) 'byline) t))) (save-excursion (when remove (goto-char bol) @@ -297,9 +306,14 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (goto-char bol) (insert (format "(%s) " (propertize marker 'face 'success))))) - ;; leave point after the marker: - (unless remove - (mastodon-tl--goto-next-toot)))) + (when at-byline-p + ;; leave point after the marker: + (unless remove + ;; if point is inside the byline, back up first so + ;; we don't move to the following toot: + (beginning-of-line) + (forward-line -1) + (mastodon-tl--goto-next-toot))))) (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. @@ -333,7 +347,9 @@ TYPE is a symbol, either 'favourite or 'boost." (msg (if boosted "unboosted" "boosted")) (action-string (if boost-p "boost" "favourite")) (remove (if boost-p (when boosted t) (when faved t))) - (toot-type (alist-get 'type (mastodon-tl--property 'toot-json)))) + (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) + (visibility (mastodon-tl--field 'visibility + (mastodon-tl--property 'toot-json)))) (if byline-region (cond ;; actually there's nothing wrong with faving/boosting own toots! ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) @@ -341,11 +357,14 @@ TYPE is a symbol, either 'favourite or 'boost." ;; & 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 (string= (mastodon-tl--get-endpoint) "notifications"))) + (not (mastodon-tl--buffer-type-eq 'notifications))) (error "You can't %s boosts" action-string)) ((and (equal "favourite" toot-type) - (not (string= (mastodon-tl--get-endpoint) "notifications"))) - (error "Your can't %s favourites" action-string)) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (error "You can't %s favourites" action-string)) + ((and (equal "private" visibility) + (equal type 'boost)) + (error "You can't boost private toots")) (t (mastodon-toot--action action @@ -409,6 +428,40 @@ TYPE is a symbol, either 'favourite or 'boost." (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." + (interactive) + (mastodon-toot--list-toot-boosters-or-favers)) + +(defun mastodon-toot--list-toot-favouriters () + "List the favouriters of toot at point." + (interactive) + (mastodon-toot--list-toot-boosters-or-favers :favourite)) + +(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." + (let* ((base-toot (mastodon-tl--property 'base-toot-id)) + (endpoint (if favourite "favourited_by" "reblogged_by")) + (url (mastodon-http--api + (format "statuses/%s/%s" base-toot endpoint))) + (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)) + (let ((handles (mapcar (lambda (x) (alist-get 'acct x)) json)) + (type-string (if favourite "Favouriters" "Boosters"))) + (if (not handles) + (error "Looks like this toot has no %s" type-string) + (let ((choice + (completing-read + (format "%s (enter to view profile): " type-string) + handles + nil + t))) + (mastodon-profile--show-user choice))))))) + (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point. If the toot is a fave/boost notification, copy the URLof the @@ -701,12 +754,11 @@ If media items have been attached and uploaded with If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to instance to edit a toot." (interactive) - (let* ((edit-p (if mastodon-toot--edit-toot-id t nil)) - (toot (mastodon-toot--remove-docs)) + (let* ((toot (mastodon-toot--remove-docs)) (scheduled mastodon-toot--scheduled-for) (scheduled-id mastodon-toot--scheduled-id) (endpoint - (if edit-p + (if mastodon-toot--edit-toot-id ;; we are sending an edit: (mastodon-http--api (format "statuses/%s" mastodon-toot--edit-toot-id)) @@ -722,8 +774,8 @@ instance to edit a toot." (symbol-name t))) ("spoiler_text" . ,spoiler) ("language" . ,mastodon-toot--language)) - ; Pleroma instances can't handle null-valued - ; scheduled_at args, so only add if non-nil + ;; Pleroma instances can't handle null-valued + ;; scheduled_at args, so only add if non-nil (when scheduled `(("scheduled_at" . ,scheduled))))) (args-media (when mastodon-toot--media-attachments (mastodon-http--build-array-params-alist @@ -751,7 +803,7 @@ instance to edit a toot." ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (if edit-p + (let ((response (if mastodon-toot--edit-toot-id ;; we are sending an edit: (mastodon-http--put endpoint args) (mastodon-http--post endpoint args)))) @@ -785,9 +837,9 @@ instance to edit a 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) + (mastodon-toot--compose-buffer nil reply-id nil content :edit) (goto-char (point-max)) - (insert content) + ;; (insert content) ;; adopt reply-to-id, visibility, CW, and language: (mastodon-toot--set-toot-properties reply-id toot-visibility source-cw toot-language) @@ -807,7 +859,8 @@ 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 ((history (mastodon-tl--property 'edit-history))) + (let ((id (mastodon-tl--property 'base-toot-id)) + (history (mastodon-tl--property 'edit-history))) (with-current-buffer (get-buffer-create "*mastodon-toot-edits*") (let ((inhibit-read-only t)) (special-mode) @@ -828,7 +881,10 @@ instance to edit a toot." (format "Edits to toot by %s:" (alist-get 'username (alist-get 'account (car history)))) - 'face font-lock-comment-face)))))) + 'face font-lock-comment-face)) + (mastodon-tl--set-buffer-spec (buffer-name (current-buffer)) + (format "statuses/%s/history" id) + nil))))) (defun mastodon-toot--insert-toot-iter (it) "Insert iteration IT of toot." @@ -844,16 +900,15 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." (goto-char (cadr config))) (defun mastodon-toot--mentions-to-string (mentions) - "Applies mastodon-toot--process-local function to each mention, -removes empty string (self) from result and joins the sequence with whitespace \" \"." - (mapconcat (lambda(mention) mention) - (remove "" (mapcar (lambda(x) (mastodon-toot--process-local x)) + "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. +Remove empty string (self) from result and joins the sequence with whitespace." + (mapconcat (lambda (mention) mention) + (remove "" (mapcar (lambda (x) (mastodon-toot--process-local x)) mentions)) " ")) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". - Mastodon requires the full @user@domain, even in the case of local accts. eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the mastodon-instance-url). @@ -1348,11 +1403,22 @@ REPLY-TEXT is the text of the toot being replied to." 'read-only "Edit your message below." 'toot-post-header t)))) +(defun mastodon-toot--most-restrictive-visibility (reply-visibility) + "Return REPLY-VISIBILITY or default visibility, whichever is more restrictive. +The default is given by `mastodon-toot--default-reply-visibility'." + (unless (null reply-visibility) + (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) + mastodon-toot-visibility-list))) + (if (member (intern reply-visibility) less-restrictive) + mastodon-toot--default-reply-visibility reply-visibility)))) + (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. REPLY-JSON is the full JSON of the toot being replied to." - (let ((reply-visibility (alist-get 'visibility reply-json)) + (let ((reply-visibility + (mastodon-toot--most-restrictive-visibility + (alist-get 'visibility reply-json))) (reply-cw (alist-get 'spoiler_text reply-json))) (when reply-to-user (insert (format "%s " reply-to-user)) @@ -1516,20 +1582,23 @@ Added to `after-change-functions'." (defun mastodon-toot--compose-buffer-p () "Return t if compose buffer is current." - (equal (buffer-name (current-buffer)) "*new toot*")) + (mastodon-tl--buffer-type-eq 'new-toot)) ;; NB: now that we have toot drafts, to ensure offline composing remains ;; possible, avoid any direct requests here: (defun mastodon-toot--compose-buffer (&optional reply-to-user - reply-to-id reply-json initial-text) + reply-to-id reply-json initial-text + edit) "Create a new buffer to capture text for a new toot. If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var. REPLY-JSON is the full JSON of the toot being replied to. INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add -a draft into the buffer." - (let* ((buffer-exists (get-buffer "*new toot*")) - (buffer (or buffer-exists (get-buffer-create "*new toot*"))) +a draft into the buffer. +EDIT means we are editing an existing toot, not composing a new one." + (let* ((buffer-name (if edit "*edit toot*" "*new toot*")) + (buffer-exists (get-buffer buffer-name)) + (buffer (or buffer-exists (get-buffer-create buffer-name))) (inhibit-read-only t) (reply-text (alist-get 'content reply-json)) (previous-window-config (list (current-window-configuration) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 20b420e..cd4cf13 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -61,7 +61,6 @@ (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--show-user "mastodon-profile") (autoload 'mastodon-discover "mastodon-discover") - (autoload 'mastodon-tl--block-user "mastodon-tl") (autoload 'mastodon-tl--unblock-user "mastodon-tl") (autoload 'mastodon-tl--mute-user "mastodon-tl") @@ -98,6 +97,9 @@ (autoload 'mastodon-toot--view-toot-history "mastodon-tl") (autoload 'mastodon-tl--init-sync "mastodon-tl") (autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-tl--view-instance-description "mastodon-tl") +(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") (defvar mastodon-notifications--map) @@ -108,7 +110,6 @@ (defcustom mastodon-instance-url "https://mastodon.social" "Base URL for the Mastodon instance you want to be active. - For example, if your mastodon username is \"example_user@social.instance.org\", and you want this account to be active, the value of this variable should be @@ -124,7 +125,6 @@ changes to take effect." (defcustom mastodon-active-user nil "Username of the active user. - For example, if your mastodon username is \"example_user@social.instance.org\", and you want this account to be active, the value of this variable should be @@ -140,7 +140,6 @@ changes to take effect." (defcustom mastodon-toot-timestamp-format "%F %T" "Format to use for timestamps. - For valid formatting options see `format-time-string`. The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS. Use. e.g. \"%c\" for your locale's date and time format." @@ -207,8 +206,14 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "@") #'mastodon-notifications--get-mentions) (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point) (define-key map (kbd "E") #'mastodon-toot--view-toot-edits) + (define-key map (kbd "l") #'recenter-top-bottom) (when (require 'lingva nil :no-error) - (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) + (define-key map (kbd "a") #'mastodon-toot--translate-toot-text)) + (define-key map (kbd "s") #'mastodon-tl--view-scheduled-toots) + (define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers) + (define-key map (kbd ";") #'mastodon-tl--view-instance-description) + (define-key map (kbd ",") #'mastodon-toot--list-toot-favouriters) + (define-key map (kbd ".") #'mastodon-toot--list-toot-boosters) map) "Keymap for `mastodon-mode'.") @@ -350,6 +355,31 @@ not, just browse the URL in the normal fashion." (string-match "^/[[:alpha:]]+$" query) (string-match "^/u/[[:alpha:]]+$" query))))) +(defun mastodon-live-buffers () + "Return a list of open mastodon buffers. +Calls `mastodon-tl--get-buffer-type', which see." + (cl-loop for x in (buffer-list) + when (with-current-buffer x (mastodon-tl--get-buffer-type)) + collect (get-buffer x))) + +(defun mastodon-kill-all-buffers () + "Kill any and all open mastodon buffers, hopefully." + (interactive) + (let ((mastodon-buffers (mastodon-live-buffers))) + (cl-loop for x in mastodon-buffers + do (kill-buffer x)))) + +(defun mastodon-switch-to-buffer () + "Switch to a live mastodon buffer." + (interactive) + (let* ((bufs (mastodon-live-buffers)) + (buf-names (mapcar (lambda (buf) + (buffer-name buf)) + bufs)) + (choice (completing-read "Switch to mastodon buffer: " + buf-names))) + (switch-to-buffer choice))) + ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () (when (require 'emojify nil :noerror) diff --git a/test/ert-helper.el b/test/ert-helper.el index 140425b..230baf2 100644 --- a/test/ert-helper.el +++ b/test/ert-helper.el @@ -1,18 +1,18 @@ +(load-file "lisp/mastodon-http.el") +(load-file "lisp/mastodon-iso.el") +(load-file "lisp/mastodon-toot.el") (load-file "lisp/mastodon.el") (load-file "lisp/mastodon-search.el") (load-file "lisp/mastodon-async.el") -(load-file "lisp/mastodon-http.el") -(load-file "lisp/mastodon-auth.el") (load-file "lisp/mastodon-client.el") +(load-file "lisp/mastodon-auth.el") (load-file "lisp/mastodon-discover.el") (load-file "lisp/mastodon-inspect.el") (load-file "lisp/mastodon-media.el") (load-file "lisp/mastodon-notifications.el") -(load-file "lisp/mastodon.el") (load-file "lisp/mastodon-profile.el") (load-file "lisp/mastodon-search.el") (load-file "lisp/mastodon-tl.el") -(load-file "lisp/mastodon-toot.el") ;; load tests in bulk to avoid using deprecated `cask exec' (let ((tests (cl-remove-if-not (lambda (x) |