From 370f0a8367e381345950e145554481d988a1709c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 14 Nov 2022 19:09:27 +0100 Subject: make a start on lists --- lisp/mastodon-tl.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 120 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3e8c08d..e28da63 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -70,6 +70,7 @@ (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") +(autoload 'mastodon-auth--get-account-id "mastodon-auth") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -1349,6 +1350,124 @@ ID is that of the toot to view." ;; else just print the lone toot: (mastodon-tl--single-toot id))))))) +(defun mastodon-tl--get-users-lists () + "Get the list of the user's lists from the server." + (let ((url (mastodon-http--api "lists"))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--get-lists-names () + "Return a list of the user's lists' names." + (let ((lists (mastodon-tl--get-users-lists))) + (mapcar (lambda (x) + (alist-get 'title x)) + lists))) + +(defun mastodon-tl--get-list-by-name (name) + "Return the list data for list with NAME." + (let* ((lists (mastodon-tl--get-users-lists))) + (cl-loop for list in lists + if (string= (alist-get 'title list) name) + return list))) + +(defun mastodon-tl--get-list-id (name) + "Return id for list with NAME." + (let ((list (mastodon-tl--get-list-by-name name))) + (alist-get 'id list))) + +(defun mastodon-tl--get-list-name (id) + "Return name of list with ID." + (let* ((url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--get-json url))) + (alist-get 'title response))) + +(defun mastodon-tl--view-list-timeline () + "Prompt for a list and view its timeline." + (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)) + (endpoint (format "timelines/list/%s" id)) + (name (mastodon-tl--get-list-name id)) + (buffer-name (format "list-%s" name))) + (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline))) + +(defun mastodon-tl--create-list () + "Create a new list. +Prompt for name and replies policy." + (interactive) + (let* ((title (read-string "List name: ")) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) ; default + (response (mastodon-http--post (mastodon-http--api "lists") + `(("title" . ,title) + ("replies_policy" . ,replies-policy)) + nil))) + (mastodon-http--triage response + (lambda () + (message "list %s created!" title))))) + +(defun mastodon-tl--get-users-followings () + "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))) + +(defun mastodon-tl--add-account-to-list () + "Prompt for a list and for an account, add account to 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)) + (followings (mastodon-tl--get-users-followings)) + (handles (mapcar (lambda (x) + (cons (alist-get 'acct x) + (alist-get 'id x))) + followings)) + (account (completing-read "Account to add: " + handles nil t)) + (account-id (alist-get account handles nil nil 'equal)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--post url + `(("account_ids[]" . ,account-id)) + nil))) + (mastodon-http--triage response + (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." + (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)) + (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: " + handles nil t)) + (account-id (alist-get account handles nil nil 'equal)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--delete url + `(("account_ids[]" . ,account-id))))) + (mastodon-http--triage response + (lambda () + (message "%s removed from list %s!" account list-name))))) + +(defun mastodon-tl--accounts-in-list (&optional list-id) + "Prompt for a list and return the JSON of the accounts in it. +Use LIST-ID rather than prompting if given." + (interactive) + (let* ((list-name (unless list-id + (completing-read "View accounts in list: " + (mastodon-tl--get-lists-names) nil t))) + (list-id (or list-id (mastodon-tl--get-list-id list-name))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id)))) + (mastodon-http--get-json url))) + (defun mastodon-tl--create-filter () "Create a filter for a word. Prompt for a context, must be a list containting at least one of \"home\", @@ -1748,7 +1867,7 @@ Can be called to toggle NOTIFY on users already being followed." (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) "Fetch the list of accounts for ACTION from the server. -Action must be either \"unblock\" or \"mute\"." +Action must be either \"unblock\" or \"unmute\"." (let* ((endpoint (cond ((equal action "unblock") "blocks") ((equal action "unmute") -- cgit v1.2.3 From 8b7471b154fb636181be86268013039f78215a56 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 16 Nov 2022 09:38:05 +0100 Subject: move avatar insert from --byline-author to --byline so that it can be outside of 'byline t, so we don't auto navigate to it but to the user name part of the byline. --- lisp/mastodon-tl.el | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 86a7b56..f0ef000 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -352,17 +352,10 @@ Used on initializing a timeline or thread." (name (if (not (string-empty-p (alist-get 'display_name account))) (alist-get 'display_name account) (alist-get 'username account))) - (profile-url (alist-get 'url account)) - (avatar-url (alist-get 'avatar account))) - ;; TODO: Once we have a view for a user (e.g. their posts - ;; timeline) make this a tab-stop and attach an action + (profile-url (alist-get 'url account))) (concat - (when (and mastodon-tl--show-avatars - mastodon-tl--display-media-p - (if (version< emacs-version "27.1") - (image-type-available-p 'imagemagick) - (image-transforms-p))) - (mastodon-media--get-avatar-rendering avatar-url)) + ;; avatar insertion moved up to `mastodon-tl--byline' in order to be + ;; outside of text prop 'byline t. (propertize name 'face 'mastodon-display-name-face ;; enable playing of videos when point is on byline: @@ -554,7 +547,9 @@ this just means displaying toot client." (bookmark-str (if (fontp (char-displayable-p #10r128278)) "🔖" "K")) - (visibility (mastodon-tl--field 'visibility toot))) + (visibility (mastodon-tl--field 'visibility toot)) + (account (alist-get 'account toot)) + (avatar-url (alist-get 'avatar account))) (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 @@ -569,6 +564,14 @@ this just means displaying toot client." (mastodon-tl--format-faved-or-boosted-byline "F")) (when bookmarked (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) + ;; we remove avatars from the byline also, so that they also do not mess + ;; with `mastodon-tl--goto-next-toot': + (when (and mastodon-tl--show-avatars + mastodon-tl--display-media-p + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + (mastodon-media--get-avatar-rendering avatar-url)) (propertize (concat ;; we propertize help-echo format faves for author name -- cgit v1.2.3 From c3e1c3403f8a308894f5c335b4a060def85b4d4d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 15 Nov 2022 11:28:30 +0100 Subject: add delete and edit lists --- lisp/mastodon-http.el | 16 ++++++++++++++++ lisp/mastodon-tl.el | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 106c76b..843afc1 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -216,6 +216,22 @@ Callback to `mastodon-http--get-response-async', usually (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) +(defun mastodon-http--put (url &optional args headers) + "Make PUT request to URL." + (mastodon-http--authorized-request + "PUT" + (let ((url-request-data + (when args + (mastodon-http--build-query-string args))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + ;; pleroma compat: + (unless (assoc "Content-Type" headers) + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) + (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e28da63..f1941a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -71,6 +71,8 @@ (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") (autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -1380,6 +1382,28 @@ 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." + (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)) + (name-choice (read-string "List name: " name-old)) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--put url + `(("title" . ,name-choice) + ("replies_policy" . ,replies-policy))))) + (mastodon-http--triage response + (lambda () + (with-current-buffer response + (let* ((json (mastodon-http--process-json)) + (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." (interactive) @@ -1408,6 +1432,19 @@ Prompt for name and replies policy." (lambda () (message "list %s created!" title))))) +(defun mastodon-tl--delete-list () + "Prompt for a list and delete it." + (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))))) + (defun mastodon-tl--get-users-followings () "Return the list of followers of the logged in account." (let* ((id (mastodon-auth--get-account-id)) -- cgit v1.2.3 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-search.el | 2 +- lisp/mastodon-tl.el | 8 ++++++++ lisp/mastodon.el | 2 +- 3 files changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index d161544..6422716 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -162,7 +162,7 @@ QUERY is the string to search." (defun mastodon-search--insert-users-propertized (json &optional note) "Insert users list into the buffer. -JSON is the data from the server.. If NOTE is non-nil, include +JSON is the data from the server. If NOTE is non-nil, include user's profile note. This is also called by `mastodon-tl--get-follow-suggestions' and `mastodon-profile--insert-follow-requests'." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f1941a5..bc751f9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1505,6 +1505,8 @@ Use LIST-ID rather than prompting if given." (url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) +;;; FILTERS + (defun mastodon-tl--create-filter () "Create a filter for a word. Prompt for a context, must be a list containting at least one of \"home\", @@ -1600,6 +1602,8 @@ JSON is what is returned by by the server." (mastodon-tl--view-filters) (message "Filter for \"%s\" deleted!" phrase))))))) +;;; FOLLOW SUGGESTIONS + (defun mastodon-tl--get-follow-suggestions () "Display a buffer of suggested accounts to follow." (interactive) @@ -1627,6 +1631,8 @@ RESPONSE is the JSON returned by the server." (message "Looks like there's no toot or user at point?") ,@body)) +;;;; INSTANCES + (defun mastodon-tl-view-own-instance (&optional brief) "View details of your own instance. BRIEF means show fewer details." @@ -1802,6 +1808,8 @@ IND is the optional indentation level to print at." "\n" ""))) +;;; FOLLOW/BLOCK/MUTE, ETC + (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. 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 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-tl.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-tl.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 0996c7eabfd89e6bb5fa3c9f2558c9d6ac23a44b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 11:49:49 +0100 Subject: refactor array params into -http--build-array-args-alist --- lisp/mastodon-http.el | 5 +++++ lisp/mastodon-tl.el | 8 ++++---- lisp/mastodon-toot.el | 16 ++++++---------- 3 files changed, 15 insertions(+), 14 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 66707b7..a127427 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -121,6 +121,11 @@ Unless UNAUTHENTICATED-P is non-nil." args "&")) +(defun mastodon-http--build-array-args-alist (param-str array) + "Return parameters alist using PARAM-STR and ARRAY param values." + (cl-loop for x in array + collect (cons param-str x))) + (defun mastodon-http--post (url args headers &optional unauthenticated-p) "POST synchronously to URL with ARGS and HEADERS. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8c02adf..0db517c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -70,6 +70,8 @@ (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") +(autoload 'mastodon-http--build-array-args-alist "mastodon-http") + (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -2110,10 +2112,8 @@ UPDATE-FUNCTION is used to receive more toots. Runs synchronously." (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))) + (args (when note-type (mastodon-http--build-array-args-alist + "exclude_types[]" 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' diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 438e887..17a3938 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -79,6 +79,7 @@ (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-http--build-array-args-alist "mastodon-http") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -615,7 +616,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append - (mastodon-toot--make-poll-options-params + (mastodon-http--build-array-args-alist + "poll[options][]" (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) @@ -638,9 +640,9 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mastodon-http--build-array-args-alist + "media_ids[]" + mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll (mastodon-toot--build-poll-params))) ;; media || polls: @@ -960,12 +962,6 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) -(defun mastodon-toot--make-poll-options-params (options) - "Return an parameter query alist from poll OPTIONS." - (let ((key "poll[options][]")) - (cl-loop for o in options - collect `(,key . ,o)))) - (defun mastodon-toot--fetch-max-poll-options () "Return the maximum number of poll options." (mastodon-toot--fetch-poll-field 'max_options)) -- cgit v1.2.3 From e6566d53d56d26a954bb0cef2a73d77fc5ff17d0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 12:31:39 +0100 Subject: autoloads docstring --- lisp/mastodon-tl.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0db517c..177237e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -71,6 +71,8 @@ (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") (autoload 'mastodon-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-http--build-query-string "mastodon-http") +(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -2109,7 +2111,8 @@ headers." "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to receive more toots. -Runs synchronously." +Runs synchronously. +Optional arg NOTE-TYPE means only get that type of note." (let* ((exclude-types (when note-type (mastodon-notifications--filter-types-list note-type))) (args (when note-type (mastodon-http--build-array-args-alist -- cgit v1.2.3 From c036cf9a9788ac5676cd32f8a4becd3c1e7ff77c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 12:32:45 +0100 Subject: profile--add-author-bylines -- still print avatar byline-author --- lisp/mastodon-profile.el | 3 ++- lisp/mastodon-tl.el | 22 +++++++++++++++++----- 2 files changed, 19 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 63c062b..54b464a 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -707,7 +707,8 @@ Used to view a user's followers and those they're following." (let ((start-pos (point))) (insert "\n" (propertize - (mastodon-tl--byline-author `((account . ,toot))) + (mastodon-tl--byline-author `((account . ,toot)) + :avatar) 'byline 't 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 177237e..fc85b85 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -349,17 +349,29 @@ Used on initializing a timeline or thread." (t2 (replace-regexp-in-string "<\/?span>" "" t1))) (replace-regexp-in-string "" "" t2))) -(defun mastodon-tl--byline-author (toot) - "Propertize author of TOOT." +(defun mastodon-tl--byline-author (toot &optional avatar) + "Propertize author of TOOT. +With arg AVATAR, include the account's avatar image." (let* ((account (alist-get 'account toot)) (handle (alist-get 'acct account)) (name (if (not (string-empty-p (alist-get 'display_name account))) (alist-get 'display_name account) (alist-get 'username account))) - (profile-url (alist-get 'url account))) + (profile-url (alist-get 'url account)) + (avatar-url (alist-get 'avatar account))) + ;; TODO: Once we have a view for a user (e.g. their posts + ;; timeline) make this a tab-stop and attach an action (concat - ;; avatar insertion moved up to `mastodon-tl--byline' in order to be - ;; outside of text prop 'byline t. + ;; avatar insertion moved up to `mastodon-tl--byline' by default in order + ;; to be outside of text prop 'byline t. arg avatar is used by + ;; `mastodon-profile--add-author-bylines' + (when (and avatar + mastodon-tl--show-avatars + mastodon-tl--display-media-p + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + (mastodon-media--get-avatar-rendering avatar-url)) (propertize name 'face 'mastodon-display-name-face ;; enable playing of videos when point is on byline: -- cgit v1.2.3 From 92d040b9e32ba31fd1184fd72e06ee833159905a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 12:58:24 +0100 Subject: handle nil voters-count in poll display --- lisp/mastodon-tl.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fc85b85..db61ce1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1012,7 +1012,8 @@ this just means displaying toot client." (expiry (mastodon-tl--field 'expires_at poll)) (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) (multi (mastodon-tl--field 'multiple poll)) - (vote-count (mastodon-tl--field 'voters_count poll)) + (voters-count (mastodon-tl--field 'voters_count poll)) + (vote-count (mastodon-tl--field 'votes_count poll)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -1041,10 +1042,16 @@ this just means displaying toot client." options "\n") "\n" - (propertize (if (= vote-count 1) - (format "%s person | " vote-count) - (format "%s people | " vote-count)) - 'face 'font-lock-comment-face) + (propertize + (cond (voters-count ; sometimes it is nil + (if (= voters-count 1) + (format "%s person | " voters-count) + (format "%s people | " voters-count))) + (vote-count + (format "%s votes | " vote-count)) + (t + "")) + 'face 'font-lock-comment-face) (let ((str (if expired-p "Poll expired." (mastodon-tl--format-poll-expiry expiry)))) -- cgit v1.2.3 From a1e6888d1948a472e100b272dbc4dcb998c574e1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 13:13:34 +0100 Subject: tl--update: message when no updates to avoid hang appearance --- lisp/mastodon-tl.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index db61ce1..5398b57 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2059,10 +2059,11 @@ from the start if it is nil." (update-function (mastodon-tl--get-update-function)) (id (mastodon-tl--newest-id)) (json (mastodon-tl--updated-json endpoint id))) - (when json - (let ((inhibit-read-only t)) - (goto-char (or mastodon-tl--update-point (point-min))) - (funcall update-function json))))) + (if json + (let ((inhibit-read-only t)) + (goto-char (or mastodon-tl--update-point (point-min))) + (funcall update-function json)) + (message "nothing to update")))) (defun mastodon-tl--get-link-header-from-response (headers) "Get http Link header from list of http HEADERS." -- cgit v1.2.3 From a555573985ca36a34240bb7bf8db95b6f89f5d9e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 13:43:15 +0100 Subject: tl.el: -- separator for all function names --- lisp/mastodon-tl.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 5398b57..f30fc29 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1496,23 +1496,23 @@ RESPONSE is the JSON returned by the server." (message "Looks like there's no toot or user at point?") ,@body)) -(defun mastodon-tl-view-own-instance (&optional brief) +(defun mastodon-tl--view-own-instance (&optional brief) "View details of your own instance. BRIEF means show fewer details." (interactive) - (mastodon-tl-view-instance-description :user brief)) + (mastodon-tl--view-instance-description :user brief)) -(defun mastodon-tl-view-own-instance-brief () +(defun mastodon-tl--view-own-instance-brief () "View brief details of your own instance." (interactive) - (mastodon-tl-view-instance-description :user :brief)) + (mastodon-tl--view-instance-description :user :brief)) -(defun mastodon-tl-view-instance-description-brief () +(defun mastodon-tl--view-instance-description-brief () "View brief details of the instance the current post's author is on." (interactive) - (mastodon-tl-view-instance-description nil :brief)) + (mastodon-tl--view-instance-description nil :brief)) -(defun mastodon-tl-view-instance-description (&optional user brief instance) +(defun mastodon-tl--view-instance-description (&optional user brief instance) "View the details of the instance the current post's author is on. USER means to show the instance details for the logged in user. BRIEF means to show fewer details. -- cgit v1.2.3 From a1e0ff1a3d8302a725d13aa6d8f35f6cf6e74249 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:10:18 +0100 Subject: filters - read prompt add space --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 27241f5..64d22a9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1631,7 +1631,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (if (string-empty-p word) (error "You must select at least one word for a filter") (completing-read-multiple - "Contexts to filter [TAB for options]:" + "Contexts to filter [TAB for options]: " '("home" "notifications" "public" "thread") nil ; no predicate t))) ; require-match, as context is mandatory -- cgit v1.2.3 From ecaf47eac07c94781dc7e4e48a89d223917f832e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:10:45 +0100 Subject: lists -- clean up, reload view etc --- lisp/mastodon-tl.el | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 64d22a9..542072f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1421,8 +1421,10 @@ ID is that of the toot to view." If ID is provided, use that list." (interactive) (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (name-old (unless id (completing-read "Edit list: " - list-names))) + (name-old (if id + (word-at-point :no-properties) + (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 @@ -1437,7 +1439,10 @@ If ID is provided, use that list." (with-current-buffer response (let* ((json (mastodon-http--process-json)) (name-new (alist-get 'title json))) - (message "list %s edited to %s!" name-old name-new))))))) + (message "list %s edited to %s!" name-old name-new))) + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)))))) (defun mastodon-tl--view-timeline-list-at-point () "View timeline of list at point." @@ -1471,6 +1476,9 @@ Prompt for name and replies policy." nil))) (mastodon-http--triage response (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) (message "list %s created!" title))))) (defun mastodon-tl--delete-list-at-point () @@ -1494,6 +1502,9 @@ If ID is provided, delete that list." (let ((response (mastodon-http--delete url))) (mastodon-http--triage response (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) (message "list %s deleted!" name))))))) (defun mastodon-tl--view-lists () @@ -1508,6 +1519,7 @@ If ID is provided, delete that list." "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))) + (erase-buffer) (insert (mastodon-tl--set-face (concat "\n ------------\n" " YOUR LISTS\n" @@ -1520,7 +1532,9 @@ If ID is provided, delete that list." 'font-lock-comment-face)) (mapc (lambda (x) (mastodon-tl--print-list-accounts x)) - lists-names))) + lists-names) + (goto-char (point-min)))) +;; (mastodon-tl--goto-next-item))) ; causes another request! (defun mastodon-tl--print-list-accounts (list-name) "Insert the accounts in list named LIST-NAME." @@ -1574,6 +1588,9 @@ If ID is provided, use that list." nil))) (mastodon-http--triage response (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) (message "%s added to list %s!" account list-name))))) (defun mastodon-tl--remove-account-from-list-at-point () @@ -1586,7 +1603,8 @@ If ID is provided, use that list." "Prompt for a list, select an account and remove from list. If ID is provided, use that list." (interactive) - (let* ((list-name (unless id + (let* ((list-name (if id + (word-at-point :no-properties) (completing-read "Remove account from list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) -- cgit v1.2.3 From aa41b5bd3a0176dc5650d9443298c963a4013887 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:27:51 +0100 Subject: fix remove account from list, simplify --accounts-in-list --- lisp/mastodon-tl.el | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9481fdc..4ef6b47 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1639,22 +1639,20 @@ If ID is provided, use that list." (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))) - (response (mastodon-http--delete url - `(("account_ids[]" . ,account-id))))) + ;; letting --delete handle the params doesn't work + ;; so we do it here for now: + (base-url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) + (query-str (mastodon-http--build-query-string args)) + (url (concat base-url "?" query-str)) + (response (mastodon-http--delete url))) (mastodon-http--triage response (lambda () (message "%s removed from list %s!" account list-name))))) -(defun mastodon-tl--accounts-in-list (&optional list-id) - "Prompt for a list and return the JSON of the accounts in it. -Use LIST-ID rather than prompting if given." - (interactive) - (let* ((list-name (unless list-id - (completing-read "View accounts in list: " - (mastodon-tl--get-lists-names) nil t))) - (list-id (or list-id (mastodon-tl--get-list-id list-name))) - (url (mastodon-http--api (format "lists/%s/accounts" list-id)))) +(defun mastodon-tl--accounts-in-list (list-id) + "Return the JSON of the accounts in list with LIST-ID." + (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) ;;; FILTERS -- cgit v1.2.3 From 82e0ee3f7526f455485acd833c816362722a501a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:53:23 +0100 Subject: lists refactor response triage --- lisp/mastodon-tl.el | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4ef6b47..f7c8b7f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1497,12 +1497,9 @@ Prompt for name and replies policy." `(("title" . ,title) ("replies_policy" . ,replies-policy)) nil))) - (mastodon-http--triage response - (lambda () - (when (equal (buffer-name (current-buffer)) - "*mastodon-lists*") - (mastodon-tl--view-lists)) - (message "list %s created!" title))))) + (mastodon-tl--list-action-triage + response + (message "list %s created!" title)))) (defun mastodon-tl--delete-list-at-point () "Delete list at point." @@ -1523,12 +1520,9 @@ If ID is provided, delete that list." (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 () - (when (equal (buffer-name (current-buffer)) - "*mastodon-lists*") - (mastodon-tl--view-lists)) - (message "list %s deleted!" name))))))) + (mastodon-tl--list-action-triage + response + (message "list %s deleted!" name)))))) (defun mastodon-tl--view-lists () "Show the user's lists in a new buffer." @@ -1593,7 +1587,8 @@ a: add account to this list, r: remove account from this list" "Prompt for a list and for an account, add account to list. If ID is provided, use that list." (interactive) - (let* ((list-name (unless id + (let* ((list-name (if id + (word-at-point :no-properties) (completing-read "Add account to list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) @@ -1609,12 +1604,9 @@ If ID is provided, use that list." (response (mastodon-http--post url `(("account_ids[]" . ,account-id)) nil))) - (mastodon-http--triage response - (lambda () - (when (equal (buffer-name (current-buffer)) - "*mastodon-lists*") - (mastodon-tl--view-lists)) - (message "%s added to list %s!" account list-name))))) + (mastodon-tl--list-action-triage + response + (message "%s added to list %s!" account list-name)))) (defun mastodon-tl--remove-account-from-list-at-point () "Prompt for account and remove from list at point." @@ -1646,9 +1638,18 @@ If ID is provided, use that list." (query-str (mastodon-http--build-query-string args)) (url (concat base-url "?" query-str)) (response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (message "%s removed from list %s!" account list-name))))) + (mastodon-tl--list-action-triage + response + (message "%s removed from list %s!" account list-name)))) + +(defun mastodon-tl--list-action-triage (response message) + "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." + (mastodon-http--triage response + (lambda () + (when (equal (buffer-name (current-buffer)) + "*mastodon-lists*") + (mastodon-tl--view-lists)) + message))) (defun mastodon-tl--accounts-in-list (list-id) "Return the JSON of the accounts in list with LIST-ID." -- cgit v1.2.3 From 8c215cfaa42db195dfd29bb6ed2f0ed13b386548 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 12:23:01 +0100 Subject: list title - use link face --- lisp/mastodon-tl.el | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f7c8b7f..b191b3d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1497,9 +1497,8 @@ Prompt for name and replies policy." `(("title" . ,title) ("replies_policy" . ,replies-policy)) nil))) - (mastodon-tl--list-action-triage - response - (message "list %s created!" title)))) + (mastodon-tl--list-action-triage response + (message "list %s created!" title)))) (defun mastodon-tl--delete-list-at-point () "Delete list at point." @@ -1520,9 +1519,8 @@ If ID is provided, delete that list." (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-tl--list-action-triage - response - (message "list %s deleted!" name)))))) + (mastodon-tl--list-action-triage response + (message "list %s deleted!" name)))))) (defun mastodon-tl--view-lists () "Show the user's lists in a new buffer." @@ -1567,7 +1565,7 @@ If ID is provided, delete that list." '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))) + 'face 'link) ; '((:underline t :inherit success))) "\n\n") (mastodon-search--insert-users-propertized accounts))) -- cgit v1.2.3 From 82d3869fb24fc2e4976604e53b456f0a57bab0c6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 15:53:52 +0100 Subject: propertize list accounts so -at-point list funs work there (rough) --- lisp/mastodon-tl.el | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b191b3d..c024358 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1445,7 +1445,7 @@ If ID is provided, use that list." (interactive) (let* ((list-names (unless id (mastodon-tl--get-lists-names))) (name-old (if id - (word-at-point :no-properties) + (get-text-property (point) 'list-id) (completing-read "Edit list: " list-names))) (id (or id (mastodon-tl--get-list-id name-old))) @@ -1557,17 +1557,20 @@ If ID is provided, delete that list." (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 'link) ; '((:underline t :inherit success))) - "\n\n") - (mastodon-search--insert-users-propertized accounts))) + "\n\n" + (propertize + (mapconcat #'mastodon-search--propertize-user accounts + " ") + ;; (mastodon-search--insert-users-propertized accounts) + 'list t + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id)))) (defun mastodon-tl--get-users-followings () "Return the list of followers of the logged in account." @@ -1586,7 +1589,7 @@ a: add account to this list, r: remove account from this list" If ID is provided, use that list." (interactive) (let* ((list-name (if id - (word-at-point :no-properties) + (get-text-property (point) 'list-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))) @@ -1617,7 +1620,7 @@ If ID is provided, use that list." If ID is provided, use that list." (interactive) (let* ((list-name (if id - (word-at-point :no-properties) + (get-text-property (point) 'list-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))) -- cgit v1.2.3 From 38b6075e5ce35f512321f05cd5f9f9d622703845 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 17:33:55 +0100 Subject: start on follow/unfollow tags --- lisp/mastodon-tl.el | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c024358..b8486cc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -63,6 +63,7 @@ ;; make notifications--get available via M-x and outside our keymap: (autoload 'mastodon-notifications--get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive +(autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-search--get-user-info "mastodon-search") (autoload 'mastodon-http--delete "mastodon-http") @@ -2131,6 +2132,45 @@ by `mastodon-tl--follow-user' to enable or disable notifications." ((eq notify nil) (message "User %s (@%s) %sed!" name user-handle action))))))) +;; FOLLOW TAGS + +(defun mastodon-tl--get-tag-json (tag) + "Return JSON data about TAG." + (let ((url (mastodon-http--api (format "tags/%s" tag)))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--follow-tag (&optional tag) + "Prompt for a tag and follow it. +If TAG provided, follow it." + (interactive) + (let* ((tag (or tag (read-string "Tag to follow: "))) + (url (mastodon-http--api (format "tags/%s/follow" tag))) + (response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (message "tag #%s followed!" tag))))) + +(defun mastodon-tl--followed-tags () + "Return JSON of tags followed." + (let ((url (mastodon-http--api (format "followed_tags")))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--unfollow-tag (&optional tag) + "Prompt for a followed tag, and unfollow it. +If TAG if provided, unfollow it." + (interactive) + (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) + (tags (unless tag (mapcar (lambda (x) + (alist-get 'name x)) + followed-tags-json))) + (tag (or tag (completing-read "Unfollow tag: " + tags))) + (url (mastodon-http--api (format "tags/%s/unfollow" tag))) + (response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (message "tag #%s unfollowed!" 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. -- cgit v1.2.3 From 25f7e47beddb8fcf789a7e06a03fce5339f8500d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 17:58:01 +0100 Subject: http--post - make args + headers optional args also update all calls to it, no need for nil nil everywhere. --- lisp/mastodon-http.el | 4 +- lisp/mastodon-notifications.el | 9 ++--- lisp/mastodon-tl.el | 14 +++---- lisp/mastodon-toot.el | 4 +- test/mastodon-tl-tests.el | 90 +++++++++++++++++++++--------------------- test/mastodon-toot-tests.el | 16 ++++---- 6 files changed, 66 insertions(+), 71 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e67cf2d..6e7bfb3 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -130,8 +130,8 @@ Used for API form data parameters that take an array." (cl-loop for x in array collect (cons param-str x))) -(defun mastodon-http--post (url args headers &optional unauthenticated-p) - "POST synchronously to URL with ARGS and HEADERS. +(defun mastodon-http--post (url &optional args headers unauthenticated-p) + "POST synchronously to URL, optionally with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index b23e3c5..127a9e2 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -117,8 +117,7 @@ follow-requests view." (mastodon-http--api "follow_requests") (format "/%s/%s" id (if reject "reject" - "authorize"))) - nil nil))) + "authorize")))))) (mastodon-http--triage response (lambda () (if f-reqs-view-p @@ -326,8 +325,7 @@ Status notifications are created when you call (interactive) (when (y-or-n-p "Clear all notifications?") (let ((response - (mastodon-http--post (mastodon-http--api "notifications/clear") - nil nil))) + (mastodon-http--post (mastodon-http--api "notifications/clear")))) (mastodon-http--triage response (lambda () (when mastodon-tl--buffer-spec @@ -342,8 +340,7 @@ Status notifications are created when you call (mastodon-tl--property 'toot-json)))) (response (mastodon-http--post (mastodon-http--api - (format "notifications/%s/dismiss" id)) - nil nil))) + (format "notifications/%s/dismiss" id))))) (mastodon-http--triage response (lambda () (when mastodon-tl--buffer-spec diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b8486cc..6618c48 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1145,7 +1145,7 @@ this just means displaying toot client." ;; need to zero-index our option: (option-as-arg (number-to-string (1- (string-to-number (car option))))) (arg `(("choices[]" . ,option-as-arg))) - (response (mastodon-http--post url arg nil))) + (response (mastodon-http--post url arg))) (mastodon-http--triage response (lambda () (message "You voted for option %s: %s!" @@ -1604,8 +1604,7 @@ If ID is provided, use that list." (account-id (alist-get account handles nil nil 'equal)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (response (mastodon-http--post url - `(("account_ids[]" . ,account-id)) - nil))) + `(("account_ids[]" . ,account-id))))) (mastodon-tl--list-action-triage response (message "%s added to list %s!" account list-name)))) @@ -1685,8 +1684,7 @@ Prompt for a context, must be a list containting at least one of \"home\", contexts))) (response (mastodon-http--post url (push `("phrase" . ,word) - contexts-processed) - nil))) + contexts-processed)))) (mastodon-http--triage response (lambda () (message "Filter created for %s!" word) @@ -2117,7 +2115,7 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." "Post ACTION on user NAME/USER-HANDLE to URL. NOTIFY is either \"true\" or \"false\", and used when we have been called by `mastodon-tl--follow-user' to enable or disable notifications." - (let ((response (mastodon-http--post url nil nil))) + (let ((response (mastodon-http--post url))) (mastodon-http--triage response (lambda () (cond ((string-equal notify "true") @@ -2145,7 +2143,7 @@ If TAG provided, follow it." (interactive) (let* ((tag (or tag (read-string "Tag to follow: "))) (url (mastodon-http--api (format "tags/%s/follow" tag))) - (response (mastodon-http--post url nil nil))) + (response (mastodon-http--post url))) (mastodon-http--triage response (lambda () (message "tag #%s followed!" tag))))) @@ -2166,7 +2164,7 @@ If TAG if provided, unfollow it." (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) - (response (mastodon-http--post url nil nil))) + (response (mastodon-http--post url))) (mastodon-http--triage response (lambda () (message "tag #%s unfollowed!" tag))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 53e60bd..d0eb143 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -268,7 +268,7 @@ boosting, or bookmarking toots." (mastodon-tl--as-string id) "/" action)))) - (let ((response (mastodon-http--post url nil nil))) + (let ((response (mastodon-http--post url))) (mastodon-http--triage response callback)))) (defun mastodon-toot--toggle-boost-or-favourite (type) @@ -666,7 +666,7 @@ 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 nil))) + (let ((response (mastodon-http--post endpoint args))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index bb5d00f..19934dd 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1047,53 +1047,53 @@ correct value for following, as well as notifications enabled or disabled." (let ((response-buffer-true (current-buffer))) (insert mastodon-tl--follow-notify-true-response) (with-mock - (mock (mastodon-http--post url-follow-only nil nil) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-follow-only - user-name - user-handle - "follow") - "User some-user (@some-user@instance.url) followed!")) - (mock (mastodon-http--post url-mute nil nil) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-mute - user-name - user-handle - "mute") - "User some-user (@some-user@instance.url) muted!")) - (mock (mastodon-http--post url-block nil nil) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-block - user-name - user-handle - "block") - "User some-user (@some-user@instance.url) blocked!"))) + (mock (mastodon-http--post url-follow-only) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-follow-only + user-name + user-handle + "follow") + "User some-user (@some-user@instance.url) followed!")) + (mock (mastodon-http--post url-mute) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-mute + user-name + user-handle + "mute") + "User some-user (@some-user@instance.url) muted!")) + (mock (mastodon-http--post url-block) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-block + user-name + user-handle + "block") + "User some-user (@some-user@instance.url) blocked!"))) (with-mock - (mock (mastodon-http--post url-true nil nil) => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-true - user-name - user-handle - "follow" - "true") - "Receiving notifications for user some-user (@some-user@instance.url)!"))))) + (mock (mastodon-http--post url-true) => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-true + user-name + user-handle + "follow" + "true") + "Receiving notifications for user some-user (@some-user@instance.url)!"))))) (with-temp-buffer (let ((response-buffer-false (current-buffer))) (insert mastodon-tl--follow-notify-false-response) (with-mock - (mock (mastodon-http--post url-false nil nil) => response-buffer-false) - (should - (equal - (mastodon-tl--do-user-action-function url-false - user-name - user-handle - "follow" - "false") - "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) + (mock (mastodon-http--post url-false) => response-buffer-false) + (should + (equal + (mastodon-tl--do-user-action-function url-false + user-name + user-handle + "follow" + "false") + "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 39e0984..9741964 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -152,14 +152,14 @@ mention string." (toot mastodon-toot-test-base-toot) (id 61208)) (with-mock - (mock (mastodon-tl--property 'base-toot-id) => id) - (mock (mastodon-http--api "statuses/61208/pin") - => "https://example.space/statuses/61208/pin") - (mock (mastodon-http--post "https://example.space/statuses/61208/pin" nil nil) - => pin-response) - (should (equal (mastodon-toot--action "pin" (lambda () - (message "Toot pinned!"))) - "Toot pinned!")))))) + (mock (mastodon-tl--property 'base-toot-id) => id) + (mock (mastodon-http--api "statuses/61208/pin") + => "https://example.space/statuses/61208/pin") + (mock (mastodon-http--post "https://example.space/statuses/61208/pin") + => pin-response) + (should (equal (mastodon-toot--action "pin" (lambda () + (message "Toot pinned!"))) + "Toot pinned!")))))) (ert-deftest mastodon-toot--pin-toot-fail () (with-temp-buffer -- cgit v1.2.3 From e4c809efce66eeaf272441cb9ea842340d18f68a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 19:14:29 +0100 Subject: list followed tags --- lisp/mastodon-tl.el | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6618c48..20ac788 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2169,6 +2169,17 @@ If TAG if provided, unfollow it." (lambda () (message "tag #%s unfollowed!" tag))))) +(defun mastodon-tl--list-followed-tags () + "List tags followed. If user choses one, display its JSON." + (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))))) + ;; 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. -- cgit v1.2.3 From f50f726f55d42d5a43a79627574a88c46e0770fe Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 09:48:10 +0100 Subject: paginate bookmarks timeline (3/4 working?) seems tl--more seems to repeat bookmarks after 3-4 loads. a similar issue was solved with favourites, but it was always after 2nd load. and we are using the fixed code here already. i have many more favourites than bookmarks. but still it would be nice to not seem to load more when we hit the end. --- lisp/mastodon-profile.el | 3 ++- lisp/mastodon-tl.el | 10 +++++++--- 2 files changed, 9 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 226da95..f81441e 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -203,7 +203,8 @@ contains") (message "Loading your bookmarked toots...") (mastodon-tl--init "bookmarks" "bookmarks" - 'mastodon-tl--timeline)) + 'mastodon-tl--timeline + :headers)) (defun mastodon-profile--view-follow-requests () "Open a new buffer displaying the user's follow requests." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 20ac788..d7b977f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -128,6 +128,10 @@ If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--timestamp-update-timer nil "The timer that, when set will scan the buffer to update the timestamps.") +(defvar mastodon-tl--link-header-buffers + '("*mastodon-favourites*" "*mastodon-bookmarks*") + "A list of buffers that use link headers for pagination.") + (defvar mastodon-tl--link-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'mastodon-tl--do-link-action-at-point) @@ -1232,7 +1236,7 @@ Optionally get it for BUFFER." (mastodon-tl--get-buffer-property 'buffer-name buffer)) (defun mastodon-tl--link-header (&optional buffer) - "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. + "Get the LINK HEADER stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." (mastodon-tl--get-buffer-property 'link-header buffer)) @@ -2213,10 +2217,10 @@ For use after e.g. deleting a toot." "Append older toots to timeline, asynchronously." (interactive) (message "Loading older toots...") - (if (string= (buffer-name (current-buffer)) "*mastodon-favourites*") + (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers) ;; 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))) + ;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) (mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer) (point) :headers)) -- cgit v1.2.3 From be196fb53b564acfbb8afd7f3b5b70e1b17039e0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 09:50:55 +0100 Subject: group nav functions together --- lisp/mastodon-tl.el | 99 ++++++++++++++++++++++++++++------------------------- 1 file changed, 53 insertions(+), 46 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d7b977f..56001db 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -132,6 +132,8 @@ If nil `(point-min)' is used instead.") '("*mastodon-favourites*" "*mastodon-bookmarks*") "A list of buffers that use link headers for pagination.") +;; KEYMAPS + (defvar mastodon-tl--link-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'mastodon-tl--do-link-action-at-point) @@ -236,6 +238,8 @@ types of mastodon links and not just shr.el-generated ones.") "The keymap to be set for the author byline. It is active where point is placed by `mastodon-tl--goto-next-toot.'") +;; NAV + (defun mastodon-tl--next-tab-item () "Move to the next interesting item. @@ -278,52 +282,6 @@ text, i.e. hidden spoiler text." (goto-char (car next-range)) (message "%s" (get-text-property (point) 'help-echo))))) -(defun mastodon-tl--get-federated-timeline () - "Opens federated timeline." - (interactive) - (message "Loading federated timeline...") - (mastodon-tl--init - "federated" "timelines/public" 'mastodon-tl--timeline)) - -(defun mastodon-tl--get-home-timeline () - "Opens home timeline." - (interactive) - (message "Loading home timeline...") - (mastodon-tl--init - "home" "timelines/home" 'mastodon-tl--timeline)) - -(defun mastodon-tl--get-local-timeline () - "Opens local timeline." - (interactive) - (message "Loading local timeline...") - (mastodon-tl--init - "local" "timelines/public?local=true" 'mastodon-tl--timeline)) - -(defun mastodon-tl--get-tag-timeline () - "Prompt for tag and opens its timeline." - (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))) - (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)) - -(defun mastodon-tl--message-help-echo () - "Call message on 'help-echo property at point. -Do so if type of status at poins is not follow_request/follow." - (let ((type (alist-get - 'type - (get-text-property (point) 'toot-json))) - (echo (get-text-property (point) 'help-echo))) - (when echo ; not for followers/following in profile - (unless (or (string= type "follow_request") - (string= type "follow")) ; no counts for these - (message "%s" (get-text-property (point) 'help-echo)))))) (defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) "Search for toot with FIND-POS. @@ -375,6 +333,55 @@ Used on initializing a timeline or thread." (mastodon-tl--goto-toot-pos 'previous-single-property-change 'previous-line)) +;; TIMELINES + +(defun mastodon-tl--get-federated-timeline () + "Opens federated timeline." + (interactive) + (message "Loading federated timeline...") + (mastodon-tl--init + "federated" "timelines/public" 'mastodon-tl--timeline)) + +(defun mastodon-tl--get-home-timeline () + "Opens home timeline." + (interactive) + (message "Loading home timeline...") + (mastodon-tl--init + "home" "timelines/home" 'mastodon-tl--timeline)) + +(defun mastodon-tl--get-local-timeline () + "Opens local timeline." + (interactive) + (message "Loading local timeline...") + (mastodon-tl--init + "local" "timelines/public?local=true" 'mastodon-tl--timeline)) + +(defun mastodon-tl--get-tag-timeline () + "Prompt for tag and opens its timeline." + (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))) + (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)) + +(defun mastodon-tl--message-help-echo () + "Call message on 'help-echo property at point. +Do so if type of status at poins is not follow_request/follow." + (let ((type (alist-get + 'type + (get-text-property (point) 'toot-json))) + (echo (get-text-property (point) 'help-echo))) + (when echo ; not for followers/following in profile + (unless (or (string= type "follow_request") + (string= type "follow")) ; no counts for these + (message "%s" (get-text-property (point) 'help-echo)))))) + (defun mastodon-tl--remove-html (toot) "Remove unrendered tags from TOOT." (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) -- cgit v1.2.3 From 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-tl.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 From c19cd695b3f40a9de508e066989cb23438c9c7f7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:46:20 +0100 Subject: make mastodon-notifications-get a global function so we can view notifs without first openin other masto buffers - move it to mastodon.el - autoload cookie - rename all instances - pray the keymap works --- README.org | 5 ++++- lisp/mastodon-discover.el | 2 +- lisp/mastodon-notifications.el | 34 ++++++++-------------------------- lisp/mastodon-tl.el | 4 ++-- lisp/mastodon.el | 26 ++++++++++++++++++++++++-- test/mastodon-notifications-tests.el | 2 +- 6 files changed, 40 insertions(+), 33 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/README.org b/README.org index 97e2f4f..8eb9242 100644 --- a/README.org +++ b/README.org @@ -222,7 +222,10 @@ You can download and use your instance's custom emoji *** Other commands and account settings: -- =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. +In addition to =mastodon=, the following functions are autoloaded and should work without first loading =mastodon.el=: +- =mastodon-toot=: Compose new toot +- =mastodon-notifications-get=: View all notifications +- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at point or provided in the minibuffer. - =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 5d1a86e..dc8a924 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -76,7 +76,7 @@ ("F" "Federated" mastodon-tl--get-federated-timeline) ("H" "Home" mastodon-tl--get-home-timeline) ("L" "Local" mastodon-tl--get-local-timeline) - ("N" "Notifications" mastodon-notifications--get) + ("N" "Notifications" mastodon-notifications-get) ("u" "Update timeline" mastodon-tl--update) ("S" "Search" mastodon-search--search-query) ("O" "Jump to your profile" mastodon-profile--my-profile) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ae82b60..a11513e 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -51,6 +51,7 @@ (autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-notifications-get "mastodon") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -83,7 +84,7 @@ (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 "g") #'mastodon-notifications--get) + (define-key map (kbd "g") #'mastodon-notifications-get) (keymap-canonicalize map)) "Keymap for viewing notifications.") @@ -125,7 +126,7 @@ follow-requests view." (lambda () (if f-reqs-view-p (mastodon-profile--view-follow-requests) - (mastodon-notifications--get)) + (mastodon-notifications-get)) (message "Follow request of %s (@%s) %s!" name handle (if reject "rejected" @@ -277,51 +278,32 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -;;;###autoload -(defun mastodon-notifications--get (&optional type buffer-name) - "Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string. -BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." - (interactive) - (let ((buffer (or (concat "*mastodon-" buffer-name "*") - "*mastodon-notifications*"))) - (if (get-buffer buffer) - (progn (switch-to-buffer buffer) - (mastodon-tl--update)) - (message "Loading your notifications...") - (mastodon-tl--init-sync - (or buffer-name "notifications") - "notifications" - '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" "mentions")) + (mastodon-notifications-get "mention" "mentions")) (defun mastodon-notifications--get-favourites () "Display favourite notifications in buffer." (interactive) - (mastodon-notifications--get "favourite" "favourites")) + (mastodon-notifications-get "favourite" "favourites")) (defun mastodon-notifications--get-boosts () "Display boost notifications in buffer." (interactive) - (mastodon-notifications--get "reblog" "boosts")) + (mastodon-notifications-get "reblog" "boosts")) (defun mastodon-notifications--get-polls () "Display poll notifications in buffer." (interactive) - (mastodon-notifications--get "poll" "polls")) + (mastodon-notifications-get "poll" "polls")) (defun mastodon-notifications--get-statuses () "Display status notifications in buffer. Status notifications are created when you call `mastodon-tl--enable-notify-user-posts'." (interactive) - (mastodon-notifications--get "status" "statuses")) + (mastodon-notifications-get "status" "statuses")) (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE removed." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 34048e7..aa58771 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -61,7 +61,7 @@ (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") ;; make notifications--get available via M-x and outside our keymap: -(autoload 'mastodon-notifications--get "mastodon-notifications" +(autoload 'mastodon-notifications-get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive (autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-search--insert-users-propertized "mastodon-search") @@ -2238,7 +2238,7 @@ For use after e.g. deleting a toot." ((equal (mastodon-tl--get-endpoint) "timelines/public?local=true") (mastodon-tl--get-local-timeline)) ((equal (mastodon-tl--get-endpoint) "notifications") - (mastodon-notifications--get)) + (mastodon-notifications-get)) ((equal (mastodon-tl--buffer-name) (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) (mastodon-profile--my-profile)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 5be168c..527de18 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -57,7 +57,6 @@ (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-notifications--get "mastodon-notifications") (autoload 'mastodon-profile--get-toot-author "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--show-user "mastodon-profile") @@ -96,6 +95,10 @@ (autoload 'mastodon-tl--view-lists "mastodon-tl") (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (autoload 'mastodon-toot--view-toot-history "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") + +(defvar mastodon-notifications--map) (defgroup mastodon nil "Interface with Mastodon." @@ -160,7 +163,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "F") #'mastodon-tl--get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl--get-home-timeline) (define-key map (kbd "L") #'mastodon-tl--get-local-timeline) - (define-key map (kbd "N") #'mastodon-notifications--get) + (define-key map (kbd "N") #'mastodon-notifications-get) (define-key map (kbd "P") #'mastodon-profile--show-user) (define-key map (kbd "T") #'mastodon-tl--thread) ;; navigation out of mastodon @@ -267,6 +270,25 @@ If REPLY-JSON is the json of the toot being replied to." (interactive) (mastodon-toot--compose-buffer user reply-to-id reply-json)) +;;;###autoload +(defun mastodon-notifications-get (&optional type buffer-name) + "Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." + (interactive) + (let ((buffer (or (concat "*mastodon-" buffer-name "*") + "*mastodon-notifications*"))) + (if (get-buffer buffer) + (progn (switch-to-buffer buffer) + (mastodon-tl--update)) + (message "Loading your notifications...") + (mastodon-tl--init-sync + (or buffer-name "notifications") + "notifications" + 'mastodon-notifications--timeline + type) + (use-local-map mastodon-notifications--map)))) + ;; URL lookup: should be available even if `mastodon.el' not loaded: ;;;###autoload diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index bc70e49..1275c72 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -191,7 +191,7 @@ (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. -- cgit v1.2.3 From bf7cc6fd0cde8b3caba850bad7c9b217bef481a7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 17:49:12 +0100 Subject: hack separator and propertizing for lists properties mean that the list-at-point functions also work on accounts/whitespace within the particular list. --- lisp/mastodon-tl.el | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 34048e7..b1cbce1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1594,7 +1594,9 @@ If ID is provided, delete that 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)) + (mastodon-tl--print-list-accounts x) + (insert (propertize " ------------\n\n" + 'face 'success))) lists-names) (goto-char (point-min)))) ;; (mastodon-tl--goto-next-item))) ; causes another request! @@ -1609,8 +1611,17 @@ If ID is provided, delete that list." '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 'link) ; '((:underline t :inherit success))) - "\n\n" + 'list t + 'face 'link + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + "\n\n" + 'list t + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id) (propertize (mapconcat #'mastodon-search--propertize-user accounts " ") -- cgit v1.2.3 From 9b9431b130c1d8d1a03e445ae1f7803d2a511d70 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 22:01:07 +0100 Subject: params always in http.el, only ever send alists from elsewhere. probably incomplete but mostly done. --- lisp/mastodon-http.el | 85 +++++++++++++++++++++--------------- lisp/mastodon-profile.el | 28 ++++++------ lisp/mastodon-search.el | 4 +- lisp/mastodon-tl.el | 51 ++++++++-------------- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- test/mastodon-notifications-tests.el | 8 ++-- 7 files changed, 91 insertions(+), 89 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 37770ef..259432e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,27 +151,34 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) -(defun mastodon-http--get (url &optional silent) +(defun mastodon-http--get (url &optional params silent) "Make synchronous GET request to URL. -Pass response buffer to CALLBACK function. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." (mastodon-http--authorized-request "GET" - (mastodon-http--url-retrieve-synchronously url silent))) + ;; url-request-data doesn't seem to work with GET requests: + (let ((url (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) + (mastodon-http--url-retrieve-synchronously url silent)))) -(defun mastodon-http--get-response (url &optional no-headers silent vector) +(defun mastodon-http--get-response (url &optional params no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. NO-HEADERS means don't collect http response headers. VECTOR means return json arrays as vectors." - (with-current-buffer (mastodon-http--get url silent) + (with-current-buffer (mastodon-http--get url params silent) (mastodon-http--process-response no-headers vector))) -(defun mastodon-http--get-json (url &optional silent vector) +(defun mastodon-http--get-json (url &optional params silent vector) "Return only JSON data from URL request. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. VECTOR means return json arrays as vectors." - (car (mastodon-http--get-response url :no-headers silent vector))) + (car (mastodon-http--get-response url params :no-headers silent vector))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. @@ -214,35 +221,37 @@ Callback to `mastodon-http--get-response-async', usually (cons (car list) (cadr list)))) head-list))) -(defun mastodon-http--delete (url &optional args) - "Make DELETE request to URL." - (let ((url-request-data - (when args - (mastodon-http--build-query-string args)))) +(defun mastodon-http--delete (url &optional params) + "Make DELETE request to URL. +PARAMS is an alist of any extra parameters to send with the request." + ;; url-request-data only works with POST requests? + (let ((url + (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) (mastodon-http--authorized-request "DELETE" (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) -(defun mastodon-http--put (url &optional args headers) - "Make PUT request to URL." +(defun mastodon-http--put (url &optional params headers) + "Make PUT request to URL. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args - (mastodon-http--build-query-string args))) + (when args (mastodon-http--build-query-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: (unless (assoc "Content-Type" headers) '(("Content-Type" . "application/x-www-form-urlencoded"))) headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))))) + (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. - PARAMS should be an alist as required by `url-build-query-string'." (let ((query-string (url-build-query-string params))) (concat url "?" query-string))) @@ -259,24 +268,25 @@ PARAMS should be an alist as required by `url-build-query-string'." (kill-buffer) (json-read-from-string json-string))) -(defun mastodon-http--get-search-json (url query &optional param silent) +(defun mastodon-http--get-search-json (url query &optional params silent) "Make GET request to URL, searching for QUERY and return JSON response. -PARAM is any extra parameters to send with the request. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." - (let ((buffer (mastodon-http--get-search url query param silent))) + (let ((buffer (mastodon-http--get-search url query params silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) -(defun mastodon-http--get-search (base-url query &optional param silent) +(defun mastodon-http--get-search (base-url query &optional params silent) "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function. -PARAM is a formatted request parameter, eg 'following=true'. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." (mastodon-http--authorized-request "GET" - (let ((url (if param - (concat base-url "?" param "&q=" (url-hexify-string query)) - (concat base-url "?q=" (url-hexify-string query))))) + (let* ((query-str (mastodon-http--build-query-string + `(("q" . ,(url-hexify-string query))))) + (params-str (mastodon-http--build-query-string params)) + (url (concat base-url "?" query-str params-str))) (mastodon-http--url-retrieve-synchronously url silent)))) ;; profile update functions @@ -299,12 +309,17 @@ Optionally specify the PARAMS to send." ;; Asynchronous functions -(defun mastodon-http--get-async (url &optional callback &rest cbargs) +(defun mastodon-http--get-async (url &optional params callback &rest cbargs) "Make GET request to URL. -Pass response buffer to CALLBACK function with args CBARGS." - (mastodon-http--authorized-request - "GET" - (url-retrieve url callback cbargs))) +Pass response buffer to CALLBACK function with args CBARGS. +PARAMS is an alist of any extra parameters to send with the request." + (let ((url (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) + (mastodon-http--authorized-request + "GET" + (url-retrieve url callback cbargs)))) (defun mastodon-http--get-response-async (url callback &rest args) "Make GET request to URL. Call CALLBACK with http response and ARGS." @@ -314,9 +329,11 @@ Pass response buffer to CALLBACK function with args CBARGS." (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-response) args))))) -(defun mastodon-http--get-json-async (url callback &rest args) - "Make GET request to URL. Call CALLBACK with json-list and ARGS." +(defun mastodon-http--get-json-async (url &optional params callback &rest args) + "Make GET request to URL. Call CALLBACK with json-list and ARGS. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async + params url (lambda (status) (when status ;; only when we actually get sth? diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 512aae4..975f7b7 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -36,6 +36,7 @@ (require 'seq) (require 'cl-lib) (require 'persist) +(require 'ts) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -492,11 +493,10 @@ This endpoint only holds a few preferences. For others, see (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." (let* ((their-id id) - (url (mastodon-http--api (format - "accounts/relationships?id[]=%s" - their-id)))) + (args `(("id[]" . ,their-id))) + (url (mastodon-http--api "accounts/relationships"))) ;; FIXME: not sure why we need to do this for relationships only! - (car (mastodon-http--get-json url)))) + (car (mastodon-http--get-json url args)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -527,8 +527,9 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--get-statuses-pinned (account) "Fetch the pinned toots for ACCOUNT." (let* ((id (mastodon-profile--account-field account 'id)) - (url (mastodon-http--api (format "accounts/%s/statuses?pinned=true" id)))) - (mastodon-http--get-json url))) + (args `(("pinned" . "true"))) + (url (mastodon-http--api (format "accounts/%s/statuses" id)))) + (mastodon-http--get-json url args))) (defun mastodon-profile--insert-statuses-pinned (pinned-statuses) "Insert each of the PINNED-STATUSES for a given account." @@ -538,18 +539,17 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-tl--toot pinned-status)) pinned-statuses)) -(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type + update-function + &optional no-reblogs) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." (let* ((id (mastodon-profile--account-field account 'id)) (args (when no-reblogs '(("exclude_reblogs" . "t")))) - (base-url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) - (url (if no-reblogs - (concat base-url "?" (mastodon-http--build-query-string args)) - base-url)) + (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) (note (mastodon-profile--account-field account 'note)) - (json (mastodon-http--get-json url)) + (json (mastodon-http--get-json url args)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string (mastodon-profile--account-field @@ -751,12 +751,14 @@ If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) (substring handle 1 (length handle)) handle)) + (args `(("q" . ,handle))) (matching-account (seq-remove (lambda (x) (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json - (mastodon-http--api (format "accounts/search?q=%s" handle)))))) + (mastodon-http--api "accounts/search") + args)))) (when (equal 1 (length matching-account)) (elt matching-account 0)))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 31fcae3..fee79c4 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -61,7 +61,7 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query "following=true") + (mastodon-http--get-search-json url query '(("following" . "true"))) (mastodon-http--get-search-json url query)))) (mapcar #'mastodon-search--get-user-info-@ response))) @@ -72,7 +72,7 @@ Returns a nested list containing user handle, display name, and URL." QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (type-param (concat "type=hashtags")) + (type-param '(("type" . "hashtags"))) (response (mastodon-http--get-search-json url query type-param)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1cbce1..fd74ed5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -77,6 +77,7 @@ (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-http--build-query-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -1305,38 +1306,23 @@ LINK-HEADER is the http Link header if present." (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." - (let* ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "max_id=" - (mastodon-tl--as-string id))))) - (mastodon-http--get-json url))) + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) (defun mastodon-tl--more-json-async (endpoint id callback &rest cbargs) "Return JSON for timeline ENDPOINT before ID. Then run CALLBACK with arguments CBARGS." - (let* ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "max_id=" - (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url callback cbargs))) + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (apply 'mastodon-http--get-json-async url params callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local (defun mastodon-tl--updated-json (endpoint id) "Return JSON for timeline ENDPOINT since ID." - (let ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "since_id=" - (mastodon-tl--as-string id))))) + (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) (mastodon-http--get-json url))) (defun mastodon-tl--property (prop &optional backward) @@ -1417,8 +1403,9 @@ ID is that of the toot to view." ;; refetch current toot in case we just faved/boosted: (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id)) + nil :silent)) - (context (mastodon-http--get-json url :silent)) + (context (mastodon-http--get-json url nil :silent)) (marker (make-marker))) (if (equal (caar toot) 'error) (message "Error: %s" (cdar toot)) @@ -1690,13 +1677,9 @@ If ID is provided, use that list." (account (completing-read "Account to remove: " handles nil t)) (account-id (alist-get account handles nil nil 'equal)) - ;; letting --delete handle the params doesn't work - ;; so we do it here for now: - (base-url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) - (query-str (mastodon-http--build-query-string args)) - (url (concat base-url "?" query-str)) - (response (mastodon-http--delete url))) + (response (mastodon-http--delete url args))) (mastodon-tl--list-action-triage response (message "%s removed from list %s!" account list-name)))) @@ -2535,14 +2518,14 @@ 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-args-alist "exclude_types[]" exclude-types))) - (query-string (when note-type - (mastodon-http--build-query-string args))) + ;; (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)) + ;; (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))) + (json (mastodon-http--get-json url args))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5a735dc..24c6c75 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -728,7 +728,7 @@ instance to edit a toot." (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))) + (mastodon-http--get-json url nil :silent))) (defun mastodon-toot--get-toot-edits (id) "Return the edit history of toot with ID." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d8591e1..cfe6681 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -291,7 +291,7 @@ not, just browse the URL in the normal fashion." (browse-url query) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (param (concat "resolve=t")) ; webfinger + (param '(("resolve" . "t"))) ; webfinger (response (mastodon-http--get-search-json url query param :silent))) (cond ((not (seq-empty-p (alist-get 'statuses response))) diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index bc70e49..18fc757 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" nil)) + (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. -- cgit v1.2.3 From 8b45a7a83de0747029b6cd1d1cf7628afef0ad6c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 23:33:28 +0100 Subject: fix some tests due to params --- lisp/mastodon-http.el | 2 +- lisp/mastodon-tl.el | 9 ++++----- lisp/mastodon-toot.el | 1 + test/mastodon-profile-tests.el | 11 ++++++++--- test/mastodon-tl-tests.el | 45 ++++++++++++++++++++++-------------------- 5 files changed, 38 insertions(+), 30 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 259432e..d56f3ad 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -333,8 +333,8 @@ PARAMS is an alist of any extra parameters to send with the request." "Make GET request to URL. Call CALLBACK with json-list and ARGS. PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async - params url + params (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-json) args))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fd74ed5..d0c2b0b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1315,7 +1315,7 @@ LINK-HEADER is the http Link header if present." Then run CALLBACK with arguments CBARGS." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) (url (mastodon-http--api endpoint))) - (apply 'mastodon-http--get-json-async url params callback cbargs))) + (apply 'mastodon-http--get-json-async url args callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local @@ -1323,7 +1323,7 @@ Then run CALLBACK with arguments CBARGS." "Return JSON for timeline ENDPOINT since ID." (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) + (mastodon-http--get-json url args))) (defun mastodon-tl--property (prop &optional backward) "Get property PROP for toot at point. @@ -1873,8 +1873,7 @@ INSTANCE is an instance domain name." (response (mastodon-http--get-json (if user (mastodon-http--api "instance") - (concat instance - "/api/v1/instance")) + (concat instance "/api/v1/instance")) nil :vector))) (when response @@ -2462,7 +2461,7 @@ favourites." (mastodon-http--get-response-async url 'mastodon-tl--init* buffer endpoint update-function headers) (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function)))) + url nil 'mastodon-tl--init* buffer endpoint update-function)))) (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "Initialize BUFFER with timeline targeted by ENDPOINT. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 24c6c75..8ac75f9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -227,6 +227,7 @@ send.") NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") + nil 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 3e238f1..f65661e 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -172,7 +172,8 @@ The search will happen as if called without the \"@\"." (with-mock (mock (mastodon-http--get-json - "https://instance.url/api/v1/accounts/search?q=gargron")) + "https://instance.url/api/v1/accounts/search" + '(("q" . "gargron")))) (let ((mastodon-instance-url "https://instance.url")) ;; We don't check anything from the return value. We only care @@ -182,7 +183,9 @@ The search will happen as if called without the \"@\"." (ert-deftest mastodon-profile--search-account-by-handle--filters-out-false-results () "Should ignore results that don't match the searched handle." (with-mock - (mock (mastodon-http--get-json *) + (mock (mastodon-http--get-json + "https://instance.url/api/v1/accounts/search" + '(("q" . "Gargron"))) => (vector ccc-profile-json gargron-profile-json)) @@ -197,7 +200,9 @@ The search will happen as if called without the \"@\"." TODO: We need to decide if this is actually desired or not." (with-mock - (mock (mastodon-http--get-json *) => (vector gargron-profile-json)) + (mock (mastodon-http--get-json * + '(("q" . "gargron"))) + => (vector gargron-profile-json)) (let ((mastodon-instance-url "https://instance.url")) (should diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 19934dd..0ac5caf 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -175,27 +175,30 @@ Strict-Transport-Security: max-age=31536000 "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" 12345)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("max_id" . "12345")))) + (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--more-json-id-string () "Should request toots older than max_id. -`mastodon-tl--more-json' should accept and id that is either -a string or a numeric." + `mastodon-tl--more-json' should accept and id that is either + a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("max_id" . "12345")))) (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--update-json-id-string () "Should request toots more recent than since_id. -`mastodon-tl--updated-json' should accept and id that is either -a string or a numeric." + `mastodon-tl--updated-json' should accept and id that is either + a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("since_id" . "12345")))) (mastodon-tl--updated-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--relative-time-description () @@ -314,7 +317,7 @@ a string or a numeric." byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -")) + ")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -337,7 +340,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-boosted () "Should format the boosted toot correctly." @@ -354,7 +357,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-favorited () "Should format the favourited toot correctly." @@ -371,7 +374,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -389,7 +392,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-reblogged () "Should format the reblogged toot correctly." @@ -413,9 +416,9 @@ a string or a numeric." (handle2-location 65)) (should (string= (substring-no-properties byline) "Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -")) + ")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) @@ -446,9 +449,9 @@ a string or a numeric." 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited () "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -470,9 +473,9 @@ a string or a numeric." 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-timestamp-has-relative-display () "Should display the timestamp with a relative time." @@ -808,8 +811,8 @@ a string or a numeric." (defun tl-tests--property-values-at (property ranges) "Returns a list with property values at the given ranges. -The property value for PROPERTY within a region is assumed to be -constant." + The property value for PROPERTY within a region is assumed to be + constant." (let (result) (dolist (range ranges (nreverse result)) (push (get-text-property (car range) property) result)))) -- cgit v1.2.3 From 2b07cf720d4766b39584bff0d82125335f73f824 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 10:01:26 +0100 Subject: fix --get-response-async re params --- lisp/mastodon-http.el | 3 ++- lisp/mastodon-tl.el | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d56f3ad..d1bf573 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -321,10 +321,11 @@ PARAMS is an alist of any extra parameters to send with the request." "GET" (url-retrieve url callback cbargs)))) -(defun mastodon-http--get-response-async (url callback &rest args) +(defun mastodon-http--get-response-async (url &optional params callback &rest args) "Make GET request to URL. Call CALLBACK with http response and ARGS." (mastodon-http--get-async url + params (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-response) args))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d0c2b0b..8d4bba4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2459,7 +2459,7 @@ favourites." (buffer (concat "*mastodon-" buffer-name "*"))) (if headers (mastodon-http--get-response-async - url 'mastodon-tl--init* buffer endpoint update-function headers) + url nil 'mastodon-tl--init* buffer endpoint update-function headers) (mastodon-http--get-json-async url nil 'mastodon-tl--init* buffer endpoint update-function)))) -- cgit v1.2.3 From 4e483bd8862282991793409ca49fb6fa66bb8109 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 10:08:46 +0100 Subject: fix list-name grabbing in list add/delete/edit --- lisp/mastodon-tl.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1cbce1..f75398f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1493,7 +1493,7 @@ If ID is provided, use that list." (interactive) (let* ((list-names (unless id (mastodon-tl--get-lists-names))) (name-old (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Edit list: " list-names))) (id (or id (mastodon-tl--get-list-id name-old))) @@ -1648,7 +1648,7 @@ a: add account to this list, r: remove account from this list" If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Add account to list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) @@ -1678,7 +1678,7 @@ If ID is provided, use that list." If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Remove account from list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) -- cgit v1.2.3 From 348a917b8bafb2b6dafbdfa0a6945c6803b0d806 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:04:46 +0100 Subject: try setting mastodon-mode in view-instance buffers --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f75398f..027b7e8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1914,6 +1914,7 @@ INSTANCE is an instance domain name." (assoc 'rules response) (assoc 'stats response)))) (mastodon-tl--print-json-keys response) + (mastodon-mode) (goto-char (point-min))))))))) (defun mastodon-tl--format-key (el pad) -- cgit v1.2.3 From 6d11b36f890be413c0126aa09566646d6a74d571 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 12:29:29 +0100 Subject: tl fix a -get-json call that :vector arg --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8d4bba4..0de925f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1874,7 +1874,8 @@ INSTANCE is an instance domain name." (if user (mastodon-http--api "instance") (concat instance "/api/v1/instance")) - nil + nil ; params + nil ; silent :vector))) (when response (let ((buf (get-buffer-create "*mastodon-instance*"))) -- cgit v1.2.3 From 09e38ba8b61c9a50e50453535d1e1f409a61a7ab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:04:46 +0100 Subject: try setting mastodon-mode in view-instance buffers --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0de925f..15943ba 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1897,6 +1897,7 @@ INSTANCE is an instance domain name." (assoc 'rules response) (assoc 'stats response)))) (mastodon-tl--print-json-keys response) + (mastodon-mode) (goto-char (point-min))))))))) (defun mastodon-tl--format-key (el pad) -- cgit v1.2.3 From d0c7a2f330bb5ef22eb9956255e2fb4c171e7e59 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:36:24 +0100 Subject: rename build-query-string to -params-str, + build-array-params-alist --- lisp/mastodon-http.el | 28 ++++++++++++++-------------- lisp/mastodon-tl.el | 10 +++++----- lisp/mastodon-toot.el | 6 +++--- 3 files changed, 22 insertions(+), 22 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index c1ab3fb..69a571d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -114,19 +114,19 @@ Unless UNAUTHENTICATED-P is non-nil." (concat "Bearer " (mastodon-auth--access-token))))))) ,body)) -(defun mastodon-http--build-query-string (args) - "Build a request query string from ARGS." +(defun mastodon-http--build-params-string (params) + "Build a request parameters string from parameters alist PARAMS." ;; (url-build-query-string args nil)) ;; url-build-query-string adds 'nil' to empty params so lets stay with our ;; own: - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) + (mapconcat (lambda (p) + (concat (url-hexify-string (car p)) "=" - (url-hexify-string (cdr arg)))) - args + (url-hexify-string (cdr p)))) + params "&")) -(defun mastodon-http--build-array-args-alist (param-str array) +(defun mastodon-http--build-array-params-alist (param-str array) "Return parameters alist using PARAM-STR and ARRAY param values. Used for API form data parameters that take an array." (cl-loop for x in array @@ -140,7 +140,7 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. "POST" (let ((url-request-data (when args - (mastodon-http--build-query-string args))) + (mastodon-http--build-params-string args))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -160,7 +160,7 @@ SILENT means don't message." ;; url-request-data doesn't seem to work with GET requests: (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--url-retrieve-synchronously url silent)))) @@ -228,7 +228,7 @@ PARAMS is an alist of any extra parameters to send with the request." (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--authorized-request "DELETE" @@ -241,7 +241,7 @@ PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args (mastodon-http--build-query-string params))) + (when args (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -271,7 +271,7 @@ Optionally specify the PARAMS to send." "PATCH" (let ((url (concat base-url "?" - (mastodon-http--build-query-string params)))) + (mastodon-http--build-params-string params)))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions @@ -282,7 +282,7 @@ Pass response buffer to CALLBACK function with args CBARGS. PARAMS is an alist of any extra parameters to send with the request." (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--authorized-request "GET" @@ -316,7 +316,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((request-timeout 5) (url-request-data (when args - (mastodon-http--build-query-string args)))) + (mastodon-http--build-params-string args)))) (with-temp-buffer (url-retrieve url callback cbargs))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 15943ba..efb6612 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -74,8 +74,8 @@ (autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--build-array-args-alist "mastodon-http") -(autoload 'mastodon-http--build-query-string "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") (autoload 'mastodon-toot--get-toot-edits "mastodon-toot") @@ -1678,7 +1678,7 @@ If ID is provided, use that list." handles nil t)) (account-id (alist-get account handles nil nil 'equal)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) + (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) (response (mastodon-http--delete url args))) (mastodon-tl--list-action-triage response @@ -2517,10 +2517,10 @@ Runs synchronously. Optional arg NOTE-TYPE means only get that type of note." (let* ((exclude-types (when note-type (mastodon-notifications--filter-types-list note-type))) - (args (when note-type (mastodon-http--build-array-args-alist + (args (when note-type (mastodon-http--build-array-params-alist "exclude_types[]" exclude-types))) ;; (query-string (when note-type - ;; (mastodon-http--build-query-string args))) + ;; (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)) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8ac75f9..c870092 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -79,7 +79,7 @@ (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-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") @@ -631,7 +631,7 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append - (mastodon-http--build-array-args-alist + (mastodon-http--build-array-params-alist "poll[options][]" (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) @@ -664,7 +664,7 @@ instance to edit a toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-http--build-array-args-alist + (mastodon-http--build-array-params-alist "media_ids[]" mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll -- cgit v1.2.3 From feaa4d34a30da292e9a7f61187449252b4932171 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:49:11 +0100 Subject: speculatively fix byline tests --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index efb6612..0abf996 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -499,7 +499,7 @@ The result is added as an attachments property to author-byline." (let ((reblog (alist-get 'reblog toot))) (when reblog (concat - "\n " + "\n " (propertize "Boosted" 'face 'mastodon-boosted-face) " " (mastodon-tl--byline-author reblog))))) -- cgit v1.2.3 From 70aaeaebed48d07b6966c3633bea955f6b047828 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:49:59 +0100 Subject: if not when for edited-time in byline (for tests) --- lisp/mastodon-tl.el | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0abf996..35a9dfa 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -666,24 +666,25 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + '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)) + 'keymap mastodon-tl--shr-map-replacement))))) + (if 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 -- cgit v1.2.3 From 54bf253a26c899a21dec819033b51831684a6eb5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:12:00 +0100 Subject: add missing nil params arg to tl--more --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 35a9dfa..e4f2dc9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2259,9 +2259,9 @@ For use after e.g. deleting a toot." (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers) ;; 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))) + ;;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) - (mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer) + (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--more* (current-buffer) (point)))) -- cgit v1.2.3 From 6aa934389c6644c84196f75ee51f294b5264ef6d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 12:21:40 +0100 Subject: add account to list from profile buffer --- lisp/mastodon-tl.el | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d8a5417..0928b1b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1643,9 +1643,10 @@ a: add account to this list, r: remove account from this list" (let ((id (get-text-property (point) 'list-id))) (mastodon-tl--add-account-to-list id))) -(defun mastodon-tl--add-account-to-list (&optional id) +(defun mastodon-tl--add-account-to-list (&optional id account-id handle) "Prompt for a list and for an account, add account to list. -If ID is provided, use that 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 (get-text-property (point) 'list-name) @@ -1657,9 +1658,9 @@ If ID is provided, use that list." (cons (alist-get 'acct x) (alist-get 'id x))) followings)) - (account (completing-read "Account to add: " - handles nil t)) - (account-id (alist-get account handles nil nil 'equal)) + (account (or handle (completing-read "Account to add: " + handles nil t))) + (account-id (or account-id (alist-get account handles nil nil 'equal))) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) @@ -1715,6 +1716,15 @@ If ID is provided, use that list." (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) +(defun mastodon-tl--add-profile-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; FILTERS (defun mastodon-tl--create-filter () -- cgit v1.2.3 From ebefa1141e0ebd2a2d217e4b5b00720d8c60530a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 12:51:36 +0100 Subject: move add account to list profile to profile.el, + readme --- README.org | 120 ++++++++++++++++++++++++----------------------- lisp/mastodon-profile.el | 11 +++++ lisp/mastodon-tl.el | 16 ++----- 3 files changed, 77 insertions(+), 70 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/README.org b/README.org index 8eb9242..a757706 100644 --- a/README.org +++ b/README.org @@ -107,65 +107,69 @@ take place if your =mastodon-token-file= does not contain =:client_id= and **** 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=/== | Go to the next interesting thing that has an action | -| =M-p=/== | 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 | +|----------------+-----------------------------------------------------------------------| +| 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=/== | Go to the next interesting thing that has an action | +| =M-p=/== | 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 | -|---------------+-----------------------------------------------------------------------| -| | 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 | -|---------------+-----------------------------------------------------------------------| +|----------------+-----------------------------------------------------------------------| +| | *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 | +|----------------+-----------------------------------------------------------------------| **** Toot byline legend diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3a869ed..c604bcd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -69,6 +69,8 @@ (autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") +(autoload 'mastodon-tl--add-account-to-list "mastodon-tl") + (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) @@ -243,6 +245,15 @@ JSON is the data returned by the server." (mastodon-search--insert-users-propertized json :note))) ;; (mastodon-profile--add-author-bylines json))) +(defun mastodon-profile--add-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; ACCOUNT PREFERENCES (defun mastodon-profile--get-json-value (val) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0928b1b..e3a2665 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -77,6 +77,7 @@ (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-http--build-query-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -665,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (when edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -1716,15 +1717,6 @@ If ID is provided, use that list." (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) -(defun mastodon-tl--add-profile-account-to-list () - "Add account of current profile buffer to a list." - (interactive) - (when mastodon-profile--account - (let* ((profile mastodon-profile--account) - (id (alist-get 'id profile)) - (handle (alist-get 'acct profile))) - (mastodon-tl--add-account-to-list nil id handle)))) - ;;; FILTERS (defun mastodon-tl--create-filter () -- cgit v1.2.3 From 81ecff802190fc1040e331630f6648765ea7320a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 15:27:23 +0100 Subject: use unicode star if poss for faves. --return-fave-char --- lisp/mastodon-tl.el | 13 ++++++++++++- lisp/mastodon-toot.el | 4 +++- 2 files changed, 15 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e3a2665..d829015 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -619,7 +619,8 @@ this just means displaying toot client." (concat (when boosted (mastodon-tl--format-faved-or-boosted-byline "B")) (when faved - (mastodon-tl--format-faved-or-boosted-byline "F")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-fave-char))) (when bookmarked (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) ;; we remove avatars from the byline also, so that they also do not mess @@ -692,6 +693,16 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--return-fave-char () + "" + (cond + ((fontp (char-displayable-p #10r11088)) + "⭐") + ((fontp (char-displayable-p #10r9733)) + "★") + (t + "F"))) + (defun mastodon-tl--format-edit-timestamp (timestamp) "Convert edit TIMESTAMP into a descriptive string." (let ((parsed (ts-human-duration diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6162f52..36d08fd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -332,7 +332,9 @@ TYPE is a symbol, either 'favourite or 'boost." (list 'boosted-p (not boosted)) (list 'favourited-p (not faved)))) (mastodon-toot--action-success - (if boost-p "B" "F") + (if boost-p + "B" + (mastodon-tl--return-fave-char)) byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) (message (format "Nothing to %s here?!?" action-string))))) -- cgit v1.2.3 From b2b8fe39b6863a1398bf7d50e9ee9bc3143d2fe2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 15:03:20 +0100 Subject: display icon for boosts will later follow rougier's lead on this, but just wanted to see how it looked --- lisp/mastodon-tl.el | 29 +++++++++++++++++++++-------- lisp/mastodon-toot.el | 2 +- 2 files changed, 22 insertions(+), 9 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..e65d3a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -600,9 +600,6 @@ this just means displaying toot client." (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) (avatar-url (alist-get 'avatar account)) @@ -617,12 +614,14 @@ this just means displaying toot client." ;; displayed for an already boosted/favourited toot or as the result of ;; the toot having just been favourited/boosted. (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline "B")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-boost-char))) (when faved (mastodon-tl--format-faved-or-boosted-byline (mastodon-tl--return-fave-char))) (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-bookmark-char)))) ;; we remove avatars from the byline also, so that they also do not mess ;; with `mastodon-tl--goto-next-toot': (when (and mastodon-tl--show-avatars @@ -667,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -694,6 +693,14 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--return-boost-char () + "" + (cond + ((fontp (char-displayable-p #10r128257)) + "🔁") + (t + "B"))) + (defun mastodon-tl--return-fave-char () "" (cond @@ -704,6 +711,12 @@ this just means displaying toot client." (t "F"))) +(defun mastodon-tl--return-bookmark-char () + "" + (if (fontp (char-displayable-p #10r128278)) + "🔖" + "K")) + (defun mastodon-tl--format-edit-timestamp (timestamp) "Convert edit TIMESTAMP into a descriptive string." (let ((parsed (ts-human-duration diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4f9fb1b..7211183 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -334,7 +334,7 @@ TYPE is a symbol, either 'favourite or 'boost." (list 'favourited-p (not faved)))) (mastodon-toot--action-success (if boost-p - "B" + (mastodon-tl--return-boost-char) (mastodon-tl--return-fave-char)) byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) -- cgit v1.2.3 From 143232e53d05bd42560d5ee9265bcb74245a29e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:02:01 +0100 Subject: remove trailing double space from sparator tl-tests: remove trailing double spaces from separator again --- lisp/mastodon-tl.el | 2 +- test/mastodon-tl-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..159c2cc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -685,7 +685,7 @@ this just means displaying toot client." (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n " 'face 'default)) + (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index f9b315c..a80c3ee 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -317,7 +317,7 @@ Strict-Transport-Security: max-age=31536000 byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - ")) +")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -418,7 +418,7 @@ Strict-Transport-Security: max-age=31536000 "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - ")) +")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) -- cgit v1.2.3 From 383f31d06cbf8327507aabfa71d6d6fd85618873 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:37:33 +0100 Subject: caption + props for media urls as well as actual media adds fun mastodon-tl--propertize-img-str-or-url, to prop both. --- lisp/mastodon-media.el | 35 +++++++++++------------------ lisp/mastodon-tl.el | 60 +++++++++++++++++++++++++++++++++++++------------- 2 files changed, 58 insertions(+), 37 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9715a6c..c783130 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -35,6 +35,8 @@ ;;; Code: (require 'url-cache) +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") + (defvar url-show-status) (defvar mastodon-tl--shr-image-map-replacement) @@ -306,34 +308,23 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url + type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") - (help-echo (if caption - (concat help-echo-base - "\n\"" - caption "\"") - help-echo-base))) + (help-echo (if caption + (concat help-echo-base + "\n\"" + caption "\"") + help-echo-base))) (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'mastodon-media-type type - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (if (or (string= type "image") - (string= type nil) - (string= type "unknown")) ;handle borked images - help-echo - (concat help-echo "\nC-RET: play " type " with mpv"))) - " "))) + (mastodon-tl--propertize-img-str-or-url + "[img]" media-url full-remote-url type help-echo + (create-image mastodon-media--generic-broken-image-data nil t)) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 159c2cc..b74ac84 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1019,26 +1019,56 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string (mapconcat - (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat "Media::" preview-url "\n")))) - media-attachements ""))) + (media-string + (mapconcat + (lambda (media-attachement) + (let ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) + preview-url remote-url type caption nil 'shr-link) + "\n")))) + media-attachements ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(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. +HELP-ECHO, DISPLAY, and FACE are the text properties to add." + (propertize str + 'media-url media-url + 'media-state (when (string= str "[img]") 'needs-loading) + 'media-type 'media-link + 'mastodon-media-type type + 'display display + 'face face + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (or (string= type "image") + (string= type nil) + (string= type "unknown")) ;handle borked images + help-echo + (concat help-echo "\nC-RET: play " type " with mpv")))) + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." -- cgit v1.2.3 From 021ae971f25a96428927cf5b3d82980b5464d820 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:50:51 +0100 Subject: set 'display to the image caption if we have one --- lisp/mastodon-tl.el | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b74ac84..aac5761 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1022,21 +1022,29 @@ message is a link which unhides/hides the main body." (media-string (mapconcat (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) + (let* ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement)) + (display-str (if caption + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering preview-url remote-url type caption) ; 2nd arg for shr-browse-url (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) - preview-url remote-url type caption nil 'shr-link) + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p -- cgit v1.2.3 From 3717b6cb86c8d0037ca49d4f500a44560c9ac5ae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 16:19:19 +0100 Subject: refactor tl--media-attachment + customize to display caption not URL --- lisp/mastodon-tl.el | 70 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 29 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aac5761..d907915 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -107,6 +107,13 @@ By default fixed width fonts are used." :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) +(defcustom mastodon-tl--display-caption-not-url-when-no-media t + "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." + :group 'mastodon-tl + :type 'boolean) + (defvar-local mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -1018,40 +1025,45 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." - (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string - (mapconcat - (lambda (media-attachement) - (let* ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement)) - (display-str (if caption - (concat "Media:: " caption) - (concat "Media:: " preview-url)))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat - (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) ;; string - preview-url remote-url type caption - display-str ;; display - ;; FIXME: shr-link underlining is awful for captions with - ;; newlines, as the underlining runs to the edge of the - ;; frame even if the text doesn' - 'shr-link) - "\n")))) - media-attachements ""))) + (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) + (media-string (mapconcat #'mastodon-tl--media-attachment + media-attachments ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--media-attachment (media-attachment) + "Return a propertized string for MEDIA-ATTACHMENT." + (let* ((preview-url + (alist-get 'preview_url media-attachment)) + (remote-url + (or (alist-get 'remote_url media-attachment) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachment))) + (type (alist-get 'type media-attachment)) + (caption (alist-get 'description media-attachment)) + (display-str + (if (and mastodon-tl--display-caption-not-url-when-no-media + caption) + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) + (if mastodon-tl--display-media-p + ;; return placeholder [img]: + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + ;; return URL/caption: + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) + "\n")))) + (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. -- cgit v1.2.3 From 0c889fd275b8338aed5f173f0a7df78e23801b92 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 09:34:20 +0100 Subject: paginate profile view followers/following with link header --- lisp/mastodon-profile.el | 36 ++++++++++++++++++++++++++---------- lisp/mastodon-tl.el | 23 +++++++++++++++-------- 2 files changed, 41 insertions(+), 18 deletions(-) (limited to 'lisp/mastodon-tl.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3ba00b9..658b1d4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -71,6 +71,9 @@ (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") (autoload 'mastodon-tl--add-account-to-list "mastodon-tl") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) @@ -186,7 +189,9 @@ NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for mastodon-profile--account "following" - #'mastodon-profile--add-author-bylines) + #'mastodon-profile--add-author-bylines + nil + :headers) (error "Not in a mastodon profile"))) (defun mastodon-profile--open-followers () @@ -196,7 +201,9 @@ NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for mastodon-profile--account "followers" - #'mastodon-profile--add-author-bylines) + #'mastodon-profile--add-author-bylines + nil + :headers) (error "Not in a mastodon profile"))) (defun mastodon-profile--view-favourites () @@ -552,16 +559,25 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function - &optional no-reblogs) + &optional no-reblogs headers) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. -NO-REBLOGS means do not display boosts in statuses." +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")))) (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) + (response (if headers + (mastodon-http--get-response url args) + (mastodon-http--get-json url args))) + (json (if headers (car response) response)) + (endpoint (format "accounts/%s/%s" id endpoint-type)) + (link-header (when headers + (mastodon-tl--get-link-header-from-response + (cdr response)))) + (note (mastodon-profile--account-field account 'note)) - (json (mastodon-http--get-json url args)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string (mastodon-profile--account-field @@ -585,11 +601,11 @@ NO-REBLOGS means do not display boosts in statuses." (switch-to-buffer buffer) (mastodon-mode) (mastodon-profile-mode) - (setq mastodon-profile--account account - mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "accounts/%s/%s" id endpoint-type) - update-function ,update-function)) + (setq mastodon-profile--account account) + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) (let* ((inhibit-read-only t) (is-statuses (string= endpoint-type "statuses")) (is-followers (string= endpoint-type "followers")) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a726c4..a87cd73 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -136,10 +136,6 @@ If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--timestamp-update-timer nil "The timer that, when set will scan the buffer to update the timestamps.") -(defvar mastodon-tl--link-header-buffers - '("*mastodon-favourites*" "*mastodon-bookmarks*") - "A list of buffers that use link headers for pagination.") - ;; KEYMAPS (defvar mastodon-tl--link-keymap @@ -2327,11 +2323,22 @@ For use after e.g. deleting a toot." (param (cadr split))) (concat url-base "&" param))) +(defun mastodon-tl--use-link-header-p () + "Return t if we are in a view that uses 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)))))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) (message "Loading older toots...") - (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers) + (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))) @@ -2532,7 +2539,7 @@ from the start if it is nil." "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." +favourites and bookmarks." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (if headers @@ -2545,8 +2552,8 @@ favourites." "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by -`mastodon-http--process-json', a cons cell of JSON and http -headers." +`mastodon-http--process-json', with arg HEADERS a cons cell of +JSON and http headers, without it just the JSON." (let* ((json (if headers (car response) response)) (headers (if headers (cdr response) nil)) (link-header (mastodon-tl--get-link-header-from-response headers))) -- cgit v1.2.3