From 199b3935a6364e76258974545108feb77e47f571 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 16 Nov 2022 11:24:22 +0100 Subject: docstrings and comments --- lisp/mastodon.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 11741e1..c57cc56 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -213,7 +213,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (defface mastodon-handle-face '((t :inherit default)) - "Face used for user display names.") + "Face used for user handles in bylines.") (defface mastodon-display-name-face '((t :inherit warning)) -- cgit v1.2.3 From 44e3f3796c529ea3b52be54be4636ca8d6f54c3f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 16 Nov 2022 12:47:17 +0100 Subject: notifications - use local map with foll-req acc/rej this way we can remove these bindings from mastodon mode map --- lisp/mastodon-notifications.el | 12 +++++++++++- lisp/mastodon.el | 6 ------ 2 files changed, 11 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 7c5d40b..f05e670 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -73,6 +73,15 @@ ("Posted a poll" . "that has now ended")) "Alist of subjects for notification types.") +(defvar mastodon-notifications--map + (let ((map + (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 "g") #'mastodon-notifications--get) + (keymap-canonicalize map)) + "Keymap for viewing notifications.") + (defun mastodon-notifications--byline-concat (message) "Add byline for TOOT with MESSAGE." (concat @@ -265,7 +274,8 @@ of the toot responded to." (mastodon-tl--init-sync "notifications" "notifications" - 'mastodon-notifications--timeline)) + 'mastodon-notifications--timeline) + (use-local-map mastodon-notifications--map)) (defun mastodon-notifications--clear-all () "Clear all notifications." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 11741e1..1aec556 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -187,13 +187,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) (define-key map (kbd "V") #'mastodon-profile--view-favourites) (define-key map (kbd "R") #'mastodon-profile--view-follow-requests) - ;; (define-key map (kbd "C-c h") #'mastodon-async--stream-home) - ;; (define-key map (kbd "C-c f") #'mastodon-async--stream-federated) - ;; (define-key map (kbd "C-c l") #'mastodon-async--stream-local) - ;; (define-key map (kbd "C-c n") #'mastodon-async--stream-notifications) (define-key map (kbd "U") #'mastodon-profile--update-user-profile-note) - (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) - (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) (define-key map (kbd "v") #'mastodon-tl--poll-vote) (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle) (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) -- cgit v1.2.3 From 97285a25f0d8613deb420e51acd83bc27b04ec46 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 16 Nov 2022 11:24:43 +0100 Subject: list view, keymaps, actions --- lisp/mastodon-tl.el | 183 +++++++++++++++++++++++++++++++++++++++++----------- lisp/mastodon.el | 1 + 2 files changed, 147 insertions(+), 37 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index bc751f9..daa6626 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -174,7 +174,7 @@ We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") (defvar mastodon-tl--view-filters-keymap - (let ((map ;(make-sparse-keymap))) + (let ((map (copy-keymap mastodon-mode-map))) (define-key map (kbd "d") 'mastodon-tl--delete-filter) (define-key map (kbd "c") 'mastodon-tl--create-filter) @@ -186,7 +186,7 @@ types of mastodon links and not just shr.el-generated ones.") "Keymap for viewing filters.") (defvar mastodon-tl--follow-suggestions-map - (let ((map ;(make-sparse-keymap))) + (let ((map (copy-keymap mastodon-mode-map))) (define-key map (kbd "n") 'mastodon-tl--goto-next-item) (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) @@ -194,6 +194,30 @@ types of mastodon links and not just shr.el-generated ones.") (keymap-canonicalize map)) "Keymap for viewing follow suggestions.") +(defvar mastodon-tl--view-lists-keymap + (let ((map ;(make-sparse-keymap))) + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "D") 'mastodon-tl--delete-list) + (define-key map (kbd "C") 'mastodon-tl--create-list) + (define-key map (kbd "A") 'mastodon-tl--add-account-to-list) + (define-key map (kbd "R") 'mastodon-tl--remove-account-from-list) + (define-key map (kbd "E") 'mastodon-tl--edit-list) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "g") 'mastodon-tl--view-lists) + (keymap-canonicalize map)) + "Keymap for viewing lists.") + +(defvar mastodon-tl--list-name-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "") 'mastodon-tl--view-timeline-list-at-point) + (define-key map (kbd "d") 'mastodon-tl--delete-list-at-point) + (define-key map (kbd "a") 'mastodon-tl--add-account-to-list-at-point) + (define-key map (kbd "r") 'mastodon-tl--remove-account-from-list-at-point) + (define-key map (kbd "e") 'mastodon-tl--edit-list-at-point) + (keymap-canonicalize map)) + "Keymap for when point is on list name.") + (defvar mastodon-tl--byline-link-keymap (when (require 'mpv nil :no-error) (let ((map (make-sparse-keymap))) @@ -1352,6 +1376,8 @@ ID is that of the toot to view." ;; else just print the lone toot: (mastodon-tl--single-toot id))))))) +;;; LISTS + (defun mastodon-tl--get-users-lists () "Get the list of the user's lists from the server." (let ((url (mastodon-http--api "lists"))) @@ -1382,13 +1408,20 @@ ID is that of the toot to view." (response (mastodon-http--get-json url))) (alist-get 'title response))) -(defun mastodon-tl--edit-list () - "Prompt for a list and edit the name and replies policy." +(defun mastodon-tl--edit-list-at-point () + "Edit list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--edit-list id))) + +(defun mastodon-tl--edit-list (&optional id) + "Prompt for a list and edit the name and replies policy. +If ID is provided, use that list." (interactive) - (let* ((list-names (mastodon-tl--get-lists-names)) - (name-old (completing-read "Edit list: " - list-names)) - (id (mastodon-tl--get-list-id name-old)) + (let* ((list-names (unless id (mastodon-tl--get-lists-names))) + (name-old (unless id (completing-read "Edit list: " + list-names))) + (id (or id (mastodon-tl--get-list-id name-old))) (name-choice (read-string "List name: " name-old)) (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") @@ -1404,13 +1437,19 @@ ID is that of the toot to view." (name-new (alist-get 'title json))) (message "list %s edited to %s!" name-old name-new))))))) -(defun mastodon-tl--view-list-timeline () - "Prompt for a list and view its timeline." +(defun mastodon-tl--view-timeline-list-at-point () + "View timeline of list at point." + (interactive) + (let ((list-id (get-text-property (point) 'list-id))) + (mastodon-tl--view-list-timeline list-id))) + +(defun mastodon-tl--view-list-timeline (&optional id) + "Prompt for a list and view its timeline. +If ID is provided, use that list." (interactive) - (let* ((list-names (mastodon-tl--get-lists-names)) - (list-name (completing-read "View list: " - list-names)) - (id (mastodon-tl--get-list-id list-name)) + (let* ((list-names (unless id (mastodon-tl--get-lists-names))) + (list-name (unless id (completing-read "View list: " list-names))) + (id (or id (mastodon-tl--get-list-id list-name))) (endpoint (format "timelines/list/%s" id)) (name (mastodon-tl--get-list-name id)) (buffer-name (format "list-%s" name))) @@ -1420,7 +1459,7 @@ ID is that of the toot to view." "Create a new list. Prompt for name and replies policy." (interactive) - (let* ((title (read-string "List name: ")) + (let* ((title (read-string "New list name: ")) (replies-policy (completing-read "Replies policy: " ; give this a proper name '("followed" "list" "none") nil t nil nil "list")) ; default @@ -1432,18 +1471,72 @@ Prompt for name and replies policy." (lambda () (message "list %s created!" title))))) -(defun mastodon-tl--delete-list () - "Prompt for a list and delete it." +(defun mastodon-tl--delete-list-at-point () + "Delete list at point." (interactive) - (let* ((list-names (mastodon-tl--get-lists-names)) - (name (completing-read "Delete list: " - list-names)) - (id (mastodon-tl--get-list-id name)) - (url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (message "list %s deleted!" name))))) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--delete-list id))) + +(defun mastodon-tl--delete-list (&optional id) + "Prompt for a list and delete it. +If ID is provided, delete that list." + (interactive) + (let* ((list-names (unless id (mastodon-tl--get-lists-names))) + (name (if id + (mastodon-tl--get-list-name id) + (completing-read "Delete list: " + list-names))) + (id (or id (mastodon-tl--get-list-id name))) + (url (mastodon-http--api (format "lists/%s" id)))) + (when (y-or-n-p (format "Delete list %s?" name)) + (let ((response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda () + (message "list %s deleted!" name))))))) + +(defun mastodon-tl--view-lists () + "Show the user's lists in a new buffer." + (interactive) + (mastodon-tl--init-sync "lists" + "lists" + 'mastodon-tl--insert-lists) + (use-local-map mastodon-tl--view-lists-keymap)) + +(defun mastodon-tl--insert-lists (_json) + "Insert the user's lists from JSON." + ;; TODO: for now we don't use the JSON, we get it ourself again + (let* ((lists-names (mastodon-tl--get-lists-names))) + (insert (mastodon-tl--set-face + (concat "\n ------------\n" + " YOUR LISTS\n" + " ------------\n\n") + 'success) + (mastodon-tl--set-face + "[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]\n\n" + 'font-lock-comment-face)) + (mapc (lambda (x) + (mastodon-tl--print-list-accounts x)) + lists-names))) + +(defun mastodon-tl--print-list-accounts (list-name) + "Insert the accounts in list named LIST-NAME." + (let* ((id (mastodon-tl--get-list-id list-name)) + (accounts (mastodon-tl--accounts-in-list id))) + (insert + (propertize list-name + 'list t + 'list-name list-name + 'list-id id + 'keymap mastodon-tl--list-name-keymap + 'byline t ; so we nav here + 'toot-id "0" ; so we nav here + 'help-echo "RET: view list timeline, d: delete this list, \ +a: add account to this list, r: remove account from this list" + 'face '((:underline t :inherit success))) + "\n\n") + (mastodon-search--insert-users-propertized accounts))) (defun mastodon-tl--get-users-followings () "Return the list of followers of the logged in account." @@ -1451,12 +1544,20 @@ Prompt for name and replies policy." (url (mastodon-http--api (format "accounts/%s/following" id)))) (mastodon-http--get-json url))) -(defun mastodon-tl--add-account-to-list () - "Prompt for a list and for an account, add account to list." +(defun mastodon-tl--add-account-to-list-at-point () + "Prompt for account and add to list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--add-account-to-list id))) + +(defun mastodon-tl--add-account-to-list (&optional id) + "Prompt for a list and for an account, add account to list. +If ID is provided, use that list." (interactive) - (let* ((list-name (completing-read "Add account to list: " - (mastodon-tl--get-lists-names) nil t)) - (list-id (mastodon-tl--get-list-id list-name)) + (let* ((list-name (unless id + (completing-read "Add account to list: " + (mastodon-tl--get-lists-names) nil t))) + (list-id (or id (mastodon-tl--get-list-id list-name))) (followings (mastodon-tl--get-users-followings)) (handles (mapcar (lambda (x) (cons (alist-get 'acct x) @@ -1473,18 +1574,26 @@ Prompt for name and replies policy." (lambda () (message "%s added to list %s!" account list-name))))) -(defun mastodon-tl--remove-account-from-list () - "Promppt for a list, select an account and remove from list." +(defun mastodon-tl--remove-account-from-list-at-point () + "Prompt for account and remove from list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-tl--remove-account-from-list id))) + +(defun mastodon-tl--remove-account-from-list (&optional id) + "Prompt for a list, select an account and remove from list. +If ID is provided, use that list." (interactive) - (let* ((list-name (completing-read "Remove account from list: " - (mastodon-tl--get-lists-names) nil t)) - (list-id (mastodon-tl--get-list-id list-name)) + (let* ((list-name (unless id + (completing-read "Remove account from list: " + (mastodon-tl--get-lists-names) nil t))) + (list-id (or id (mastodon-tl--get-list-id list-name))) (accounts (mastodon-tl--accounts-in-list list-id)) (handles (mapcar (lambda (x) (cons (alist-get 'acct x) (alist-get 'id x))) accounts)) - (account (completing-read "Account: " + (account (completing-read "Account to remove: " handles nil t)) (account-id (alist-get account handles nil nil 'equal)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index c57cc56..ff245a4 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -199,6 +199,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) (define-key map (kbd "I") #'mastodon-tl--view-filters) (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) + (define-key map (kbd "X") #'mastodon-tl--view-lists) (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3 From 0bd8213302e4cbeb8483a2bef47f09cf2d8e9da2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 11:08:24 +0100 Subject: add notifications--get-mentions fix endpoint arg in init-sync --- lisp/mastodon-notifications.el | 19 ++++++++++++++++--- lisp/mastodon-tl.el | 15 +++++++++++++-- lisp/mastodon.el | 1 + 3 files changed, 30 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 45bd222..27b01c1 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -268,16 +268,29 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -(defun mastodon-notifications--get () - "Display NOTIFICATIONS in buffer." +(defun mastodon-notifications--get (&optional type) + "Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string." (interactive) (message "Loading your notifications...") (mastodon-tl--init-sync "notifications" "notifications" - 'mastodon-notifications--timeline) + 'mastodon-notifications--timeline + type) (use-local-map mastodon-notifications--map)) +(defun mastodon-notifications--get-mentions () + "Display mention notifications in buffer." + (interactive) + (mastodon-notifications--get "mention")) + +(defun mastodon-notifications--filter-types-list (type) + "Return a list of notification types with TYPE (and \"status\") removed." + (let ((types (remove "status" + (mapcar #'car mastodon-notifications--types-alist)))) + (remove type types))) + (defun mastodon-notifications--clear-all () "Clear all notifications." (interactive) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f0ef000..8c02adf 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2103,12 +2103,23 @@ headers." ;; for everything save profiles (mastodon-tl--goto-first-item))))) -(defun mastodon-tl--init-sync (buffer-name endpoint update-function) +(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." - (let* ((url (mastodon-http--api endpoint)) + (let* ((exclude-types (when note-type + (mastodon-notifications--filter-types-list note-type))) + (args (when note-type + (mapcar (lambda (x) + `("exclude_types[]" . ,x)) + exclude-types))) + (query-string (when note-type + (mastodon-http--build-query-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)) + (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*")) (json (mastodon-http--get-json url))) (with-output-to-temp-buffer buffer diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 1aec556..707ce82 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -193,6 +193,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) (define-key map (kbd "I") #'mastodon-tl--view-filters) (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) + (define-key map (kbd "@") #'mastodon-notifications--get-mentions) (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3 From 78be808887e984c8ea4aa791860053d11336852e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 13:50:13 +0100 Subject: -- separator for profile/tl funs in other files --- README.org | 18 +++--- lisp/mastodon-discover.el | 2 +- lisp/mastodon-toot.el | 10 +-- lisp/mastodon.el | 4 +- test/mastodon-notifications-tests.el | 8 +-- test/mastodon-profile-tests.el | 116 +++++++++++++++++------------------ 6 files changed, 79 insertions(+), 79 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/README.org b/README.org index b6425de..6e8dc07 100644 --- a/README.org +++ b/README.org @@ -211,7 +211,7 @@ You can download and use your instance's custom emoji **** 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. +- =mastodon-toot--save-draft=: save the current toot as a draft. - =mastodon-toot-open-draft-toot=: Open a compose buffer and insert one of your draft toots. - =mastodon-toot-delete-draft-toot=: Delete a draft toot. - =mastodon-toot-delete-all-drafts=: Delete all your drafts. @@ -220,18 +220,18 @@ You can download and use your instance's custom emoji - =mastodon-url-lookup=: Attempt to load URL in =mastodon.el=. URL may be the one at point or provided in the minibuffer. Should also work if =mastodon.el= is not yet loaded. -- =mastodon-tl-view-instance-description=: View information about the instance that the author of the toot at point is on. -- =mastodon-tl-view-own-instance=: View information about your own instance. +- =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. +- =mastodon-tl--view-own-instance=: View information about your own instance. - =mastodon-search-trending-tags=: View a list of trending hashtags on your instance. -- =mastodon-profile-update-display-name=: Update the display name for your account. +- =mastodon-profile--update-display-name=: Update the display name for your account. - =mastodon-profile-update-user-profile-note=: Update your bio note. -- =mastodon-profile-update-meta-fields=: Update your metadata fields. +- =mastodon-profile--update-meta-fields=: Update your metadata fields. - =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. -- =mastodon-profile-account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. -- =mastodon-profile-account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. -- =mastodon-profile-account-bot-toggle=: Toggle whether your account is flagged as a bot. -- =mastodon-profile-account-sensitive-toggle=: Toggle whether your posts are marked as sensitive (nsfw) by default. +- =mastodon-profile--account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. +- =mastodon-profile--account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. +- =mastodon-profile--account-bot-toggle=: Toggle whether your account is flagged as a bot. +- =mastodon-profile--account-sensitive-toggle=: Toggle whether your posts are marked as sensitive (nsfw) by default. *** Customization diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 0ef64e2..5d1a86e 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -100,7 +100,7 @@ ("-" "zoom out" 'image-decrease-size) ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) ("Profile view" - ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle)) + ("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle)) ("Quit" ("q" "Quit mastodon and bury buffer." kill-this-buffer) ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window))))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6c2ccf6..69c188d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -76,9 +76,9 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-profile--get-source-pref "mastodon-profile") (autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") @@ -502,10 +502,10 @@ If toot is not empty, prompt to save text as a draft." (if (mastodon-toot-empty-p) (mastodon-toot--kill) (when (y-or-n-p "Save draft toot?") - (mastodon-toot-save-draft)) + (mastodon-toot--save-draft)) (mastodon-toot--kill))) -(defun mastodon-toot-save-draft () +(defun mastodon-toot--save-draft () "Save the current compose toot text as a draft. Pushes `mastodon-toot-current-toot-text' to `mastodon-toot-draft-toots-list'." @@ -1338,7 +1338,7 @@ a draft into the buffer." (insert initial-text)))) ;;;###autoload -(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings-maybe) +(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 707ce82..055de21 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -91,7 +91,7 @@ (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (defgroup mastodon nil "Interface with Mastodon." @@ -324,7 +324,7 @@ not, just browse the URL in the normal fashion." (mastodon-toot--enable-custom-emoji))))) ;;;###autoload -(add-hook 'mastodon-mode-hook #'mastodon-profile-fetch-server-account-settings) +(add-hook 'mastodon-mode-hook #'mastodon-profile--fetch-server-account-settings) (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index 7c87933..bc70e49 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -187,11 +187,11 @@ "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) - (mock (mastodon-profile-fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (mastodon-notifications--get)))) + (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 267e48b..9d1ec72 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,64 @@ help identify when things change unexpectedly. TODO: Consider separating the data retrieval and the actual content generation in the function under test." (with-mock - ;; Don't start any image loading: - (mock (mastodon-media--inline-images * *) => nil) - (if (version< emacs-version "27.1") - (mock (image-type-available-p 'imagemagick) => t) - (mock (image-transforms-p) => t)) - (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") - => - gargon-statuses-json) - (mock (mastodon-profile--get-statuses-pinned *) - => - []) - (mock (mastodon-profile--relationships-get "1") - => - '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) - ;; Let's not do formatting as that makes it hard to not rely on - ;; window width and reflowing the text. - (mock (shr-render-region * *) => nil) - ;; Don't perform the actual update call at the end. - ;;(mock (mastodon-tl--timeline *)) - (mock (mastodon-profile-fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + ;; Don't start any image loading: + (mock (mastodon-media--inline-images * *) => nil) + (if (version< emacs-version "27.1") + (mock (image-type-available-p 'imagemagick) => t) + (mock (image-transforms-p) => t)) + (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") + => + gargon-statuses-json) + (mock (mastodon-profile--get-statuses-pinned *) + => + []) + (mock (mastodon-profile--relationships-get "1") + => + '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) + ;; Let's not do formatting as that makes it hard to not rely on + ;; window width and reflowing the text. + (mock (shr-render-region * *) => nil) + ;; Don't perform the actual update call at the end. + ;;(mock (mastodon-tl--timeline *)) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (let ((mastodon-tl--show-avatars t) - (mastodon-tl--display-media-p t) - (mastodon-instance-url "https://instance.url")) - (mastodon-profile--make-author-buffer gargron-profile-json) + (let ((mastodon-tl--show-avatars t) + (mastodon-tl--display-media-p t) + (mastodon-instance-url "https://instance.url")) + (mastodon-profile--make-author-buffer gargron-profile-json) - (should - (equal - (buffer-substring-no-properties (point-min) (point-max)) - (concat - "\n" - "[img] [img] \n" - "Eugen\n" - "@Gargron\n" - " ------------\n" - "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" - "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" - " ------------\n" - " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" - " ------------\n" - "\n" - " ------------\n" - " TOOTS \n" - " ------------\n" - "\n" - "

Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.

\n" - " Eugen (@Gargron) 2021-11-11 11:11:11\n" - " ------------\n" - "\n" - "\n" - "

@CCC At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.

\n" - " Eugen (@Gargron) 2021-11-11 00:00:00\n" - " ------------\n" - "\n" - ))) + (should + (equal + (buffer-substring-no-properties (point-min) (point-max)) + (concat + "\n" + "[img] [img] \n" + "Eugen\n" + "@Gargron\n" + " ------------\n" + "

Developer of Mastodon and administrator of mastodon.social. I post service announcements, development updates, and personal stuff.

\n" + "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com\n" + " ------------\n" + " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" + " ------------\n" + "\n" + " ------------\n" + " TOOTS \n" + " ------------\n" + "\n" + "

Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.

\n" + " Eugen (@Gargron) 2021-11-11 11:11:11\n" + " ------------\n" + "\n" + "\n" + "

@CCC At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.

\n" + " Eugen (@Gargron) 2021-11-11 00:00:00\n" + " ------------\n" + "\n" + ))) - ;; Until the function gets refactored this creates a non-temp - ;; buffer with Gargron's statuses which we want to delete (if - ;; the tests succeed). - (kill-buffer)))) + ;; Until the function gets refactored this creates a non-temp + ;; buffer with Gargron's statuses which we want to delete (if + ;; the tests succeed). + (kill-buffer)))) -- cgit v1.2.3 From f49ef7a5647fadc64e3f8af3abce7c95454fe04b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:29:24 +0100 Subject: fix merge remnants --- lisp/mastodon.el | 3 --- 1 file changed, 3 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 6b56341..57d5bd4 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -193,11 +193,8 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) (define-key map (kbd "I") #'mastodon-tl--view-filters) (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) -<<<<<<< HEAD (define-key map (kbd "X") #'mastodon-tl--view-lists) -======= (define-key map (kbd "@") #'mastodon-notifications--get-mentions) ->>>>>>> develop (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3 From 9fe26b121470bb1182a239a102f82c5117395791 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 21:01:04 +0100 Subject: edit toot at point edit from notifs we fetch 'base-toot or 'toot-json --- lisp/mastodon-toot.el | 56 ++++++++++++++++++++++++++++++++++++++++++++++----- lisp/mastodon.el | 2 ++ 2 files changed, 53 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4344e68..aa0ea39 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -81,6 +81,7 @@ (autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") +(autoload 'mastodon-http--put "mastodon-http") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -171,6 +172,8 @@ change the setting on the server, see (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 + "The id of the toot being edited.") (defvar-local mastodon-toot-previous-window-config nil "A list of window configuration prior to composing a toot. @@ -635,13 +638,21 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "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." +`mastodon-toot--attach-media', they are attached to the toot. +If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to instance to edit a toot." (interactive) - (let* ((toot (mastodon-toot--remove-docs)) - (endpoint (mastodon-http--api "statuses")) + (let* ((edit-p (if mastodon-toot--edit-toot-id t nil)) + (toot (mastodon-toot--remove-docs)) + (endpoint + (if edit-p + ;; we are sending an edit: + (mastodon-http--api (format "statuses/%s" + mastodon-toot--edit-toot-id)) + (mastodon-http--api "statuses"))) (spoiler (when (and (not (mastodon-toot--empty-p)) mastodon-toot--content-warning) - (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) + (read-string "Warning: " + mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -674,13 +685,48 @@ If media items have been attached and uploaded with ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (mastodon-http--post endpoint args))) + (let ((response (if edit-p + ;; we are sending an edit: + (mastodon-http--put endpoint args) + (mastodon-http--post endpoint args)))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) (message "Toot toot!") (mastodon-toot--restore-previous-window-config prev-window-config)))))))) +;; EDITING TOOTS: + +(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)) + (reply-id (alist-get 'in_reply_to_id toot))) + (when (y-or-n-p "Edit this toot? ") + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert content) + ;; adopt reply-to-id, visibility and CW: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) + (setq mastodon-toot--visibility toot-visibility) + (mastodon-toot--set-cw source-cw) + (mastodon-toot--update-status-fields) + (setq mastodon-toot--edit-toot-id id)))))) + +(defun mastodon-toot--get-toot-source (id) + "Fetch the source JSON of toot with ID." + (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) + (mastodon-http--get-json url :silent))) + (defun mastodon-toot--restore-previous-window-config (config) "Restore the window CONFIG after killing the toot compose buffer. Buffer-local variable `mastodon-toot-previous-window-config' holds the config." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 57d5bd4..d10932b 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -92,6 +92,7 @@ (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") (autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (defgroup mastodon nil "Interface with Mastodon." @@ -195,6 +196,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) (define-key map (kbd "X") #'mastodon-tl--view-lists) (define-key map (kbd "@") #'mastodon-notifications--get-mentions) + (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point) (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3 From ec3821d4a0126d978a052a522ab161a40c689cf3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 21:01:29 +0100 Subject: docstrings + autoloads --- lisp/mastodon-toot.el | 11 ++++++----- lisp/mastodon.el | 6 +++++- 2 files changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index aa0ea39..628a546 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -191,7 +191,7 @@ For the moment we just put all composed toots in here, as we want to also capture toots that are 'sent' but that don't successfully send.") -(defvar mastodon-handle-regex +(defvar mastodon-toot-handle-regex (concat ;; preceding space or bol [boundary doesn't work with @] "\\([\n\t ]\\|^\\)" @@ -639,7 +639,8 @@ 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 instance to edit a toot." +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)) @@ -832,7 +833,7 @@ meta fields respectively." (if (string= str-prefix "@") (save-match-data (save-excursion - (re-search-backward mastodon-handle-regex nil :no-error) + (re-search-backward mastodon-toot-handle-regex nil :no-error) (if (match-string-no-properties 2) ;; match full handle inc. domain (see the regex for subexp 2) (buffer-substring-no-properties (match-beginning 2) (match-end 2)) @@ -1269,7 +1270,7 @@ REPLY-JSON is the full JSON of the toot being replied to." 'face 'mastodon-cw-face))))) (defun mastodon-toot--count-toot-chars (toot-string) - "Count the characters in the current toot. + "Count the characters in TOOT-STRING. URLs always = 23, and domain names of handles are not counted. This is how mastodon does it." (with-temp-buffer @@ -1354,7 +1355,7 @@ Added to `after-change-functions'." 'success (cdr header-region)) (mastodon-toot--propertize-item - mastodon-handle-regex + mastodon-toot-handle-regex 'mastodon-display-name-face (cdr header-region))))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d10932b..393d7b6 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -92,6 +92,8 @@ (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") (autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") +(autoload 'mastodon-tl--view-lists "mastodon-tl") (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (defgroup mastodon nil @@ -250,7 +252,9 @@ Use. e.g. \"%c\" for your locale's date and time format." (if buffer (switch-to-buffer buffer) (mastodon-tl--get-home-timeline) - (message "Loading Mastodon account %s on %s..." (mastodon-auth--user-acct) mastodon-instance-url)))) + (message "Loading Mastodon account %s on %s..." + (mastodon-auth--user-acct) + mastodon-instance-url)))) ;;;###autoload (defun mastodon-toot (&optional user reply-to-id reply-json) -- cgit v1.2.3 From f751e7792e223a078bf63fde8c8028ee34185171 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 23:11:56 +0100 Subject: display edit timestamp in byline, function to view toot history --- README.org | 4 +++- lisp/mastodon-tl.el | 38 +++++++++++++++++++++++++++++++++++++- lisp/mastodon-toot.el | 47 +++++++++++++++++++++++++++++++++++------------ lisp/mastodon.el | 2 ++ 4 files changed, 77 insertions(+), 14 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/README.org b/README.org index bfb1641..c6df5ed 100644 --- a/README.org +++ b/README.org @@ -150,10 +150,12 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | =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 | +| (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | |---------------+-----------------------------------------------------------------------| | | Notifications view | | =a=, =j= | accept/reject follow request | diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 20ac788..b8f2238 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -593,7 +593,9 @@ this just means displaying toot client." "K")) (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) - (avatar-url (alist-get 'avatar account))) + (avatar-url (alist-get 'avatar account)) + (edited-time (alist-get 'edited_at toot)) + (edited-parsed (when edited-time (date-to-time edited-time)))) (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 @@ -621,6 +623,7 @@ this just means displaying toot client." ;; we propertize help-echo format faves for author name ;; in `mastodon-tl--byline-author' (funcall author-byline toot) + ;; visibility: (cond ((equal visibility "direct") (if (fontp (char-displayable-p #10r9993)) " ✉" @@ -629,6 +632,7 @@ this just means displaying toot client." (if (fontp (char-displayable-p #10r128274)) " 🔒" " [followers]"))) + ;; action: (funcall action-byline toot) " " ;; TODO: Once we have a view for toot (responses etc.) make @@ -654,12 +658,44 @@ this just means displaying toot client." 'shr-url app-url 'help-echo app-url 'keymap mastodon-tl--shr-map-replacement))))) + (when edited-time + (concat + (if (fontp (char-displayable-p #10r128274)) + " ✍ " + " [edited] ") + (propertize + (format-time-string mastodon-toot-timestamp-format + edited-parsed) + 'face 'font-lock-comment-face + 'timestamp edited-parsed + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description edited-parsed) + edited-parsed)))) (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked + 'edited edited-time + 'edit-history (when edited-time + (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--format-edit-timestamp (timestamp) + "Convert edit TIMESTAMP into a descriptive string." + (let ((parsed (ts-human-duration + (ts-diff (ts-now) (ts-parse timestamp))))) + (cond ((> (plist-get parsed :days) 0) + (format "%s days ago" (plist-get parsed :days) (plist-get parsed :hours))) + ((> (plist-get parsed :hours) 0) + (format "%s hours ago" (plist-get parsed :hours) (plist-get parsed :minutes))) + ((> (plist-get parsed :minutes) 0) + (format "%s minutes ago" (plist-get parsed :minutes))) + (t ;; we failed to guess: + (format "%s days, %s hours, %s minutes ago" + (plist-get parsed :days) + (plist-get parsed :hours) + (plist-get parsed :minutes)))))) + (defun mastodon-tl--format-faved-or-boosted-byline (letter) "Format the byline marker for a boosted or favourited status. LETTER is a string, F for favourited, B for boosted, or K for bookmarked." diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9714854..ffb603d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -728,20 +728,43 @@ instance to edit a toot." (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) (mastodon-http--get-json url :silent))) -(defun mastodon-toot--get-toot-edits () - "Return the edit history of toot at point." - (let* ((toot (or (mastodon-tl--property 'base-toot) - (mastodon-tl--property 'toot-json))) - (id (mastodon-tl--field 'id toot)) - (url (mastodon-http--api (format "statuses/%s/history" id)))) +(defun mastodon-toot--get-toot-edits (id) + "Return the edit history of toot with ID." + (let* ((url (mastodon-http--api (format "statuses/%s/history" id)))) (mastodon-http--get-json url))) -(defun mastodon-toot--edited-at () - "Return edited_at timestamp of TOOT. -Is also a predicated test for whether a toot has been edited." - (let* ((toot (or (mastodon-tl--property 'base-toot) - (mastodon-tl--property 'toot-json)))) - (alist-get 'edited_at 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))) + (with-current-buffer (get-buffer-create "*mastodon-toot-edits*") + (let ((inhibit-read-only t)) + (special-mode) + (erase-buffer) + (let ((count 1)) + (mapc (lambda (x) + (insert (propertize (if (= count 1) + (format "%s [original]:\n" count) + (format "%s:\n" count)) + 'face 'font-lock-comment-face) + (mastodon-toot--insert-toot-iter x) + "\n") + (cl-incf count)) + history)) + (switch-to-buffer-other-window (current-buffer)) + (setq-local header-line-format + (propertize + (format "Edits to toot by %s:" + (alist-get 'username + (alist-get 'account (car history)))) + 'face font-lock-comment-face)))))) + +(defun mastodon-toot--insert-toot-iter (it) + "Insert iteration IT of toot." + (let ((content (alist-get 'content it)) + (account (alist-get 'account it))) + ;; TODO: handle polls, media + (mastodon-tl--render-text content))) (defun mastodon-toot--restore-previous-window-config (config) "Restore the window CONFIG after killing the toot compose buffer. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 393d7b6..5be168c 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -95,6 +95,7 @@ (autoload 'mastodon-notifications--get-mentions "mastodon-notifications") (autoload 'mastodon-tl--view-lists "mastodon-tl") (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") +(autoload 'mastodon-toot--view-toot-history "mastodon-tl") (defgroup mastodon nil "Interface with Mastodon." @@ -199,6 +200,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "X") #'mastodon-tl--view-lists) (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) (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3