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-auth.el | 8 ++++ lisp/mastodon-http.el | 13 +++--- lisp/mastodon-tl.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 136 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 02799bf..263ece2 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -222,6 +222,14 @@ Handle any errors from the server." (mastodon-http--api "accounts/verify_credentials")))) +(defun mastodon-auth--get-account-id () + "Request user credentials and return an account name." + (alist-get + 'id + (mastodon-http--get-json + (mastodon-http--api + "accounts/verify_credentials")))) + (defun mastodon-auth--user-acct () "Return a mastodon user acct name." (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 66707b7..e69a5c9 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -203,12 +203,15 @@ Callback to `mastodon-http--get-response-async', usually (cons (car list) (cadr list)))) head-list))) -(defun mastodon-http--delete (url) +(defun mastodon-http--delete (url &optional args) "Make DELETE request to URL." - (mastodon-http--authorized-request - "DELETE" - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url)))) + (let ((url-request-data + (when args + (mastodon-http--build-query-string args)))) + (mastodon-http--authorized-request + "DELETE" + (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 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 2197fa013ec02cd82750a319c1c314fdb4a7c2a4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 15 Nov 2022 11:27:48 +0100 Subject: http--triage: add 404, don't process json in that case --- lisp/mastodon-http.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e69a5c9..106c76b 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -89,8 +89,11 @@ Message status and JSON error from RESPONSE if unsuccessful." (if (string-prefix-p "2" status) (funcall success) (switch-to-buffer response) - (let ((json-response (mastodon-http--process-json))) - (message "Error %s: %s" status (alist-get 'error json-response)))))) + ;; 404 returns http response not JSON: + (if (string-prefix-p "404" status) + (message "Error %s: page not found" status) + (let ((json-response (mastodon-http--process-json))) + (message "Error %s: %s" status (alist-get 'error json-response))))))) (defun mastodon-http--read-file-as-string (filename) "Read a file FILENAME as a string. Used to generate image preview." -- 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') 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') 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') 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 44e3f3796c529ea3b52be54be4636ca8d6f54c3f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 16 Nov 2022 12:47:17 +0100 Subject: notifications - use local map with foll-req acc/rej this way we can remove these bindings from mastodon mode map --- lisp/mastodon-notifications.el | 12 +++++++++++- lisp/mastodon.el | 6 ------ 2 files changed, 11 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 7c5d40b..f05e670 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -73,6 +73,15 @@ ("Posted a poll" . "that has now ended")) "Alist of subjects for notification types.") +(defvar mastodon-notifications--map + (let ((map + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) + (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) + (define-key map (kbd "g") #'mastodon-notifications--get) + (keymap-canonicalize map)) + "Keymap for viewing notifications.") + (defun mastodon-notifications--byline-concat (message) "Add byline for TOOT with MESSAGE." (concat @@ -265,7 +274,8 @@ of the toot responded to." (mastodon-tl--init-sync "notifications" "notifications" - 'mastodon-notifications--timeline)) + 'mastodon-notifications--timeline) + (use-local-map mastodon-notifications--map)) (defun mastodon-notifications--clear-all () "Clear all notifications." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 11741e1..1aec556 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -187,13 +187,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) (define-key map (kbd "V") #'mastodon-profile--view-favourites) (define-key map (kbd "R") #'mastodon-profile--view-follow-requests) - ;; (define-key map (kbd "C-c h") #'mastodon-async--stream-home) - ;; (define-key map (kbd "C-c f") #'mastodon-async--stream-federated) - ;; (define-key map (kbd "C-c l") #'mastodon-async--stream-local) - ;; (define-key map (kbd "C-c n") #'mastodon-async--stream-notifications) (define-key map (kbd "U") #'mastodon-profile--update-user-profile-note) - (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) - (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) (define-key map (kbd "v") #'mastodon-tl--poll-vote) (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle) (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) -- cgit v1.2.3 From 97285a25f0d8613deb420e51acd83bc27b04ec46 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 16 Nov 2022 11:24:43 +0100 Subject: list view, keymaps, actions --- lisp/mastodon-tl.el | 183 +++++++++++++++++++++++++++++++++++++++++----------- lisp/mastodon.el | 1 + 2 files changed, 147 insertions(+), 37 deletions(-) (limited to 'lisp') 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 5e71d81fe698badab960df2f6b46b89c4b6744d7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 09:49:46 +0100 Subject: prop tags/handles - tweak regex for spacing --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 438e887..3c4c7aa 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1262,10 +1262,10 @@ Added to `after-change-functions'." ;; stops all text after a handle or mention being propertized: (set-text-properties (cdr header-region) (point-max) nil) ;; TODO: confirm allowed hashtag/handle characters: - (mastodon-toot--propertize-item "[\n\t ]\\(?2:#[1-9a-zA-Z_]+\\)[\n\t ]" + (mastodon-toot--propertize-item "\\([\n\t ]\\|^\\)\\(?2:#[1-9a-zA-Z_]+\\)\\b" 'success (cdr header-region)) - (mastodon-toot--propertize-item "[\n\t ]\\(?2:@[1-9a-zA-Z._-]+\\)[\n\t ]" + (mastodon-toot--propertize-item "\\([\n\t ]\\|^\\)\\(?2:@[1-9a-zA-Z._-]+\\)\\b" 'mastodon-display-name-face (cdr header-region))))) -- cgit v1.2.3 From d0041dd190edb9eecd627ead1208a562f5ab2006 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 11:03:22 +0100 Subject: reorder notif types to match masto api docs --- lisp/mastodon-notifications.el | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index f05e670..b145fdd 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -52,25 +52,26 @@ (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) +(defvar mastodon-mode-map) (defvar mastodon-notifications--types-alist - '(("mention" . mastodon-notifications--mention) - ("follow" . mastodon-notifications--follow) + '(("follow" . mastodon-notifications--follow) ("favourite" . mastodon-notifications--favourite) ("reblog" . mastodon-notifications--reblog) + ("mention" . mastodon-notifications--mention) + ("poll" . mastodon-notifications--poll) ("follow_request" . mastodon-notifications--follow-request) - ("status" . mastodon-notifications--status) - ("poll" . mastodon-notifications--poll)) + ("status" . mastodon-notifications--status)) "Alist of notification types and their corresponding function.") (defvar mastodon-notifications--response-alist - '(("Mentioned" . "you") - ("Followed" . "you") + '(("Followed" . "you") ("Favourited" . "your status from") ("Boosted" . "your status from") + ("Mentioned" . "you") + ("Posted a poll" . "that has now ended") ("Requested to follow" . "you") - ("Posted" . "a post") - ("Posted a poll" . "that has now ended")) + ("Posted" . "a post")) "Alist of subjects for notification types.") (defvar mastodon-notifications--map -- cgit v1.2.3 From f03f26e953bfd521432efdd62c565755d90991cc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 11:03:43 +0100 Subject: kw arg for foll-req reject --- lisp/mastodon-notifications.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index b145fdd..45bd222 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -140,7 +140,7 @@ Can be called in notifications view or in follow-requests view." "Reject a follow request. Can be called in notifications view or in follow-requests view." (interactive) - (mastodon-notifications--follow-request-process t)) + (mastodon-notifications--follow-request-process :reject)) (defun mastodon-notifications--mention (note) "Format for a `mention' NOTE." -- 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') 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') 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') 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') 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 560292b335e89101f00a941bca30143c4fda9275 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 13:38:51 +0100 Subject: binding for clear notif at point --- README.org | 1 + lisp/mastodon-notifications.el | 1 + 2 files changed, 2 insertions(+) (limited to 'lisp') diff --git a/README.org b/README.org index ffe65df..a310f97 100644 --- a/README.org +++ b/README.org @@ -155,6 +155,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and |---------------+-----------------------------------------------------------------------| | | Notifications view | | =a=, =j= | accept/reject follow request | +| =c= | clear notification at point | |---------------+-----------------------------------------------------------------------| | | *Quitting* | | =q= | Quit mastodon buffer, leave window open | diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 27b01c1..bb01b77 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -79,6 +79,7 @@ (copy-keymap mastodon-mode-map))) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) + (define-key map (kbd "c") #'mastodon-notifications--clear-current) (define-key map (kbd "g") #'mastodon-notifications--get) (keymap-canonicalize map)) "Keymap for viewing notifications.") -- cgit v1.2.3 From e88f27ee6d0db28bedb43a03d86acc0ae00b34e0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 13:43:34 +0100 Subject: flycheck -toot.el --- lisp/mastodon-toot.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 705eebc..a213856 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -80,6 +80,7 @@ (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-tl--get-endpoint "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -515,8 +516,8 @@ Pushes `mastodon-toot-current-toot-text' to (message "Draft saved!"))) (defun mastodon-toot-empty-p (&optional text-only) - "Return t if no text, attachments, or polls have been added to the compose buffer. -TEXT-ONLY means don't check for attachments." + "Return t if toot has no text, attachments, or polls. +TEXT-ONLY means don't check for attachments or polls." (and (if text-only t (not mastodon-toot--media-attachments) @@ -972,7 +973,7 @@ which is used to attach it to a toot when posting." 50)) ; masto default (defun mastodon-toot--fetch-poll-field (field) - "Return FIELD from the poll settings from the user's instance. " + "Return FIELD from the poll settings from the user's instance." (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))) (alist-get field (alist-get 'polls @@ -1004,7 +1005,8 @@ MAX is the maximum number set by their instance." (message "poll created!"))) (defun mastodon-toot--read-poll-options (count length) - "Read a list of options for poll of LENGTH options." + "Read a list of options for poll with COUNT options. +LENGTH is the maximum character length allowed for a poll option." (cl-loop for x from 1 to count collect (read-string (format "Poll option [%s/%s] [max %s chars]: " x count length)))) -- cgit v1.2.3 From 99027d0d06b90d94a582ad3f67cf0e47af1b7afd Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 14:57:23 +0100 Subject: tweak toot prop mentions regex --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a213856..6c2ccf6 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1263,9 +1263,13 @@ Added to `after-change-functions'." (mastodon-toot--propertize-item "\\([\n\t ]\\|^\\)\\(?2:#[1-9a-zA-Z_]+\\)\\b" 'success (cdr header-region)) - (mastodon-toot--propertize-item "\\([\n\t ]\\|^\\)\\(?2:@[1-9a-zA-Z._-]+\\)\\b" - 'mastodon-display-name-face - (cdr header-region))))) + (mastodon-toot--propertize-item + (concat "\\([\n\t ]\\|^\\)" ; preceding space or bol + "\\(?2:@[1-9a-zA-Z._-]+" ; a handle + "\\(@[1-9a-zA-Z._-]+\\)?\\)" ; with poss domain + "\\b") ; boundary + 'mastodon-display-name-face + (cdr header-region))))) (defun mastodon-toot--propertize-item (regex face start) "Propertize item matching REGEX with FACE starting from START." -- cgit v1.2.3 From 1f3f41e9832d0a485e95c0c5c57f70809684a12d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 12:31:53 +0100 Subject: notifs mentions -- also set buffer name --- lisp/mastodon-notifications.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index bb01b77..a33a96b 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -269,13 +269,13 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -(defun mastodon-notifications--get (&optional type) +(defun mastodon-notifications--get (&optional type buffer-name) "Display NOTIFICATIONS in buffer. Optionally only print notifications of type TYPE, a string." (interactive) (message "Loading your notifications...") (mastodon-tl--init-sync - "notifications" + (or buffer-name "notifications") "notifications" 'mastodon-notifications--timeline type) @@ -284,7 +284,7 @@ Optionally only print notifications of type TYPE, a string." (defun mastodon-notifications--get-mentions () "Display mention notifications in buffer." (interactive) - (mastodon-notifications--get "mention")) + (mastodon-notifications--get "mention" "mentions")) (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE (and \"status\") removed." -- 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') 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') 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 660f91e83e8432d08659a6ef2b79b7c26d2a36ce Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 13:42:05 +0100 Subject: profile.el: -- separator for all function names --- lisp/mastodon-profile.el | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 54b464a..226da95 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -87,7 +87,7 @@ ;; maybe we can retire both of these awful bindings ;; (define-key map (kbd "s") #'mastodon-profile--open-followers) ;; (define-key map (kbd "g") #'mastodon-profile--open-following) - (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle) + (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle) map) "Keymap for `mastodon-profile-mode'.") @@ -156,7 +156,7 @@ contains") account "statuses" #'mastodon-tl--timeline)) ;; TODO: we shd just load all views' data then switch coz this is slow af: -(defun mastodon-profile-account-view-cycle () +(defun mastodon-profile--account-view-cycle () "Cycle through profile view: toots, followers, and following." (interactive) (let ((endpoint (plist-get mastodon-tl--buffer-spec 'endpoint))) @@ -295,25 +295,25 @@ SOURCE means that the preference is in the 'source' part of the account JSON." (response (mastodon-http--patch url `((,pref-formatted . ,val))))) (mastodon-http--triage response (lambda () - (mastodon-profile-fetch-server-account-settings) + (mastodon-profile--fetch-server-account-settings) (message "Account setting %s updated to %s!" pref val))))) (defun mastodon-profile--get-pref (pref) "Return PREF from `mastodon-profile-account-settings'." (plist-get mastodon-profile-account-settings pref)) -(defun mastodon-profile-update-preference-plist (pref val) +(defun mastodon-profile--update-preference-plist (pref val) "Set local account preference plist preference PREF to VAL. This is done after changing the setting on the server." (setq mastodon-profile-account-settings (plist-put mastodon-profile-account-settings pref val))) -(defun mastodon-profile-fetch-server-account-settings-maybe () +(defun mastodon-profile--fetch-server-account-settings-maybe () "Fetch account settings from the server. Only do so if `mastodon-profile-account-settings' is nil." - (mastodon-profile-fetch-server-account-settings :no-force)) + (mastodon-profile--fetch-server-account-settings :no-force)) -(defun mastodon-profile-fetch-server-account-settings (&optional no-force) +(defun mastodon-profile--fetch-server-account-settings (&optional no-force) "Fetch basic account settings from the server. Store the values in `mastodon-profile-account-settings'. Run in `mastodon-mode-hook'. @@ -324,42 +324,42 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." (let ((keys '(locked discoverable display_name bot)) (source-keys '(privacy sensitive language))) (mapc (lambda (k) - (mastodon-profile-update-preference-plist + (mastodon-profile--update-preference-plist k (mastodon-profile--get-json-value k))) keys) (mapc (lambda (sk) - (mastodon-profile-update-preference-plist + (mastodon-profile--update-preference-plist sk (mastodon-profile--get-source-value sk))) source-keys) ;; hack for max toot chars: (mastodon-toot--get-max-toot-chars :no-toot) - (mastodon-profile-update-preference-plist 'max_toot_chars - mastodon-toot--max-toot-chars) + (mastodon-profile--update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) ;; TODO: remove now redundant vars, replace with fetchers from the plist (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) mastodon-profile-account-settings))) -(defun mastodon-profile-account-locked-toggle () +(defun mastodon-profile--account-locked-toggle () "Toggle the locked status of your account. Locked means follow requests have to be approved." (interactive) (mastodon-profile--toggle-account-key 'locked)) -(defun mastodon-profile-account-discoverable-toggle () +(defun mastodon-profile--account-discoverable-toggle () "Toggle the discoverable status of your account. Discoverable means the account is listed in the server directory." (interactive) (mastodon-profile--toggle-account-key 'discoverable)) -(defun mastodon-profile-account-bot-toggle () +(defun mastodon-profile--account-bot-toggle () "Toggle the bot status of your account." (interactive) (mastodon-profile--toggle-account-key 'bot)) -(defun mastodon-profile-account-sensitive-toggle () +(defun mastodon-profile--account-sensitive-toggle () "Toggle the sensitive status of your account. When enabled, statuses are marked as sensitive by default." (interactive) @@ -387,7 +387,7 @@ Current settings are fetched from the server." val))) (mastodon-profile--update-preference (symbol-name key) new-val))) -(defun mastodon-profile-update-display-name () +(defun mastodon-profile--update-display-name () "Update display name for your account." (interactive) (mastodon-profile--edit-string-value 'display_name)) @@ -396,8 +396,8 @@ Current settings are fetched from the server." "Construct a parameter query string from metadata alist FIELDS. Returns an alist." (let ((keys (cl-loop for count from 1 to 5 - collect (cons (format "fields_attributes[%s][name]" count) - (format "fields_attributes[%s][value]" count))))) + collect (cons (format "fields_attributes[%s][name]" count) + (format "fields_attributes[%s][value]" count))))) (cl-loop for a-pair in keys for b-pair in fields append (list (cons (car a-pair) @@ -405,7 +405,7 @@ Returns an alist." (cons (cdr a-pair) (cdr b-pair)))))) -(defun mastodon-profile-update-meta-fields () +(defun mastodon-profile--update-meta-fields () "Prompt for new metadata fields information and PATCH the server." (interactive) (let* ((url (mastodon-http--api "accounts/update_credentials")) @@ -414,7 +414,7 @@ Returns an alist." (response (mastodon-http--patch url params))) (mastodon-http--triage response (lambda () - (mastodon-profile-fetch-server-account-settings) + (mastodon-profile--fetch-server-account-settings) (message "Account setting %s updated to %s!" "metadata fields" fields-updated))))) @@ -458,7 +458,7 @@ This endpoint only holds a few preferences. For others, see (mastodon-http--get-json (mastodon-http--api "preferences")))) -(defun mastodon-profile-view-preferences () +(defun mastodon-profile--view-preferences () "View user preferences in another window." (interactive) (let* ((url (mastodon-http--api "preferences")) -- 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') 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 78be808887e984c8ea4aa791860053d11336852e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 13:50:13 +0100 Subject: -- separator for profile/tl funs in other files --- README.org | 18 +++--- lisp/mastodon-discover.el | 2 +- lisp/mastodon-toot.el | 10 +-- lisp/mastodon.el | 4 +- test/mastodon-notifications-tests.el | 8 +-- test/mastodon-profile-tests.el | 116 +++++++++++++++++------------------ 6 files changed, 79 insertions(+), 79 deletions(-) (limited to 'lisp') diff --git a/README.org b/README.org index b6425de..6e8dc07 100644 --- a/README.org +++ b/README.org @@ -211,7 +211,7 @@ You can download and use your instance's custom emoji **** draft toots - Compose buffer text is saved as you type, kept in =mastodon-toot-current-toot-text=. -- =mastodon-toot-save-draft=: save the current toot as a draft. +- =mastodon-toot--save-draft=: save the current toot as a draft. - =mastodon-toot-open-draft-toot=: Open a compose buffer and insert one of your draft toots. - =mastodon-toot-delete-draft-toot=: Delete a draft toot. - =mastodon-toot-delete-all-drafts=: Delete all your drafts. @@ -220,18 +220,18 @@ You can download and use your instance's custom emoji - =mastodon-url-lookup=: Attempt to load URL in =mastodon.el=. URL may be the one at point or provided in the minibuffer. Should also work if =mastodon.el= is not yet loaded. -- =mastodon-tl-view-instance-description=: View information about the instance that the author of the toot at point is on. -- =mastodon-tl-view-own-instance=: View information about your own instance. +- =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. +- =mastodon-tl--view-own-instance=: View information about your own instance. - =mastodon-search-trending-tags=: View a list of trending hashtags on your instance. -- =mastodon-profile-update-display-name=: Update the display name for your account. +- =mastodon-profile--update-display-name=: Update the display name for your account. - =mastodon-profile-update-user-profile-note=: Update your bio note. -- =mastodon-profile-update-meta-fields=: Update your metadata fields. +- =mastodon-profile--update-meta-fields=: Update your metadata fields. - =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. -- =mastodon-profile-account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. -- =mastodon-profile-account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. -- =mastodon-profile-account-bot-toggle=: Toggle whether your account is flagged as a bot. -- =mastodon-profile-account-sensitive-toggle=: Toggle whether your posts are marked as sensitive (nsfw) by default. +- =mastodon-profile--account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. +- =mastodon-profile--account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. +- =mastodon-profile--account-bot-toggle=: Toggle whether your account is flagged as a bot. +- =mastodon-profile--account-sensitive-toggle=: Toggle whether your posts are marked as sensitive (nsfw) by default. *** Customization diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 0ef64e2..5d1a86e 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -100,7 +100,7 @@ ("-" "zoom out" 'image-decrease-size) ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) ("Profile view" - ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle)) + ("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle)) ("Quit" ("q" "Quit mastodon and bury buffer." kill-this-buffer) ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window))))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6c2ccf6..69c188d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -76,9 +76,9 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-profile--get-source-pref "mastodon-profile") (autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") @@ -502,10 +502,10 @@ If toot is not empty, prompt to save text as a draft." (if (mastodon-toot-empty-p) (mastodon-toot--kill) (when (y-or-n-p "Save draft toot?") - (mastodon-toot-save-draft)) + (mastodon-toot--save-draft)) (mastodon-toot--kill))) -(defun mastodon-toot-save-draft () +(defun mastodon-toot--save-draft () "Save the current compose toot text as a draft. Pushes `mastodon-toot-current-toot-text' to `mastodon-toot-draft-toots-list'." @@ -1338,7 +1338,7 @@ a draft into the buffer." (insert initial-text)))) ;;;###autoload -(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings-maybe) +(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 707ce82..055de21 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -91,7 +91,7 @@ (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (defgroup mastodon nil "Interface with Mastodon." @@ -324,7 +324,7 @@ not, just browse the URL in the normal fashion." (mastodon-toot--enable-custom-emoji))))) ;;;###autoload -(add-hook 'mastodon-mode-hook #'mastodon-profile-fetch-server-account-settings) +(add-hook 'mastodon-mode-hook #'mastodon-profile--fetch-server-account-settings) (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index 7c87933..bc70e49 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -187,11 +187,11 @@ "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) - (mock (mastodon-profile-fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (mastodon-notifications--get)))) + (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 267e48b..9d1ec72 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,64 @@ help identify when things change unexpectedly. TODO: Consider separating the data retrieval and the actual content generation in the function under test." (with-mock - ;; Don't start any image loading: - (mock (mastodon-media--inline-images * *) => nil) - (if (version< emacs-version "27.1") - (mock (image-type-available-p 'imagemagick) => t) - (mock (image-transforms-p) => t)) - (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") - => - gargon-statuses-json) - (mock (mastodon-profile--get-statuses-pinned *) - => - []) - (mock (mastodon-profile--relationships-get "1") - => - '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) - ;; Let's not do formatting as that makes it hard to not rely on - ;; window width and reflowing the text. - (mock (shr-render-region * *) => nil) - ;; Don't perform the actual update call at the end. - ;;(mock (mastodon-tl--timeline *)) - (mock (mastodon-profile-fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + ;; Don't start any image loading: + (mock (mastodon-media--inline-images * *) => nil) + (if (version< emacs-version "27.1") + (mock (image-type-available-p 'imagemagick) => t) + (mock (image-transforms-p) => t)) + (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses") + => + gargon-statuses-json) + (mock (mastodon-profile--get-statuses-pinned *) + => + []) + (mock (mastodon-profile--relationships-get "1") + => + '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) + ;; Let's not do formatting as that makes it hard to not rely on + ;; window width and reflowing the text. + (mock (shr-render-region * *) => nil) + ;; Don't perform the actual update call at the end. + ;;(mock (mastodon-tl--timeline *)) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (let ((mastodon-tl--show-avatars t) - (mastodon-tl--display-media-p t) - (mastodon-instance-url "https://instance.url")) - (mastodon-profile--make-author-buffer gargron-profile-json) + (let ((mastodon-tl--show-avatars t) + (mastodon-tl--display-media-p t) + (mastodon-instance-url "https://instance.url")) + (mastodon-profile--make-author-buffer gargron-profile-json) - (should - (equal - (buffer-substring-no-properties (point-min) (point-max)) - (concat - "\n" - "[img] [img] \n" - "Eugen\n" - "@Gargron\n" - " ------------\n" - "

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

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

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

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

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

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

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

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

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

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

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

\n" + " Eugen (@Gargron) 2021-11-11 00:00:00\n" + " ------------\n" + "\n" + ))) - ;; Until the function gets refactored this creates a non-temp - ;; buffer with Gargron's statuses which we want to delete (if - ;; the tests succeed). - (kill-buffer)))) + ;; Until the function gets refactored this creates a non-temp + ;; buffer with Gargron's statuses which we want to delete (if + ;; the tests succeed). + (kill-buffer)))) -- cgit v1.2.3 From acb12c6ef3f8dcdf293e57793795fffd9307ce27 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 10:07:17 +0100 Subject: toot.el -- separator for all funs but company backends --- README.org | 6 +++--- lisp/mastodon-toot.el | 34 +++++++++++++++++----------------- 2 files changed, 20 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/README.org b/README.org index 6ad02b1..9fb4643 100644 --- a/README.org +++ b/README.org @@ -212,9 +212,9 @@ You can download and use your instance's custom emoji - Compose buffer text is saved as you type, kept in =mastodon-toot-current-toot-text=. - =mastodon-toot--save-draft=: save the current toot as a draft. -- =mastodon-toot-open-draft-toot=: Open a compose buffer and insert one of your draft toots. -- =mastodon-toot-delete-draft-toot=: Delete a draft toot. -- =mastodon-toot-delete-all-drafts=: Delete all your drafts. +- =mastodon-toot--open-draft-toot=: Open a compose buffer and insert one of your draft toots. +- =mastodon-toot--delete-draft-toot=: Delete a draft toot. +- =mastodon-toot--delete-all-drafts=: Delete all your drafts. *** Other commands and account settings: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 69c188d..b45a84f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -157,7 +157,7 @@ Valid values are \"direct\", \"private\" (followers-only), This is determined by the account setting on the server. To change the setting on the server, see -`mastodon-toot-set-default-visibility'.") +`mastodon-toot--set-default-visibility'.") (defvar-local mastodon-toot--media-attachments nil "A list of the media attachments of the toot being composed.") @@ -203,7 +203,7 @@ send.") map) "Keymap for `mastodon-toot'.") -(defun mastodon-toot-set-default-visibility () +(defun mastodon-toot--set-default-visibility () "Set the default visibility for toots on the server." (interactive) (let ((vis (completing-read "Set default visibility to:" @@ -460,7 +460,7 @@ NO-REDRAFT means delete toot only." toot-visibility toot-cw))))))))) -(defun mastodon-toot-set-cw (&optional cw) +(defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." (unless (string-empty-p cw) (setq mastodon-toot--content-warning t) @@ -479,7 +479,7 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (when reply-id (setq mastodon-toot--reply-to-id reply-id)) (setq mastodon-toot--visibility toot-visibility) - (mastodon-toot-set-cw toot-cw) + (mastodon-toot--set-cw toot-cw) (mastodon-toot--update-status-fields)))) (defun mastodon-toot--kill (&optional cancel) @@ -499,7 +499,7 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." "Kill new-toot buffer/window. Does not POST content to Mastodon. If toot is not empty, prompt to save text as a draft." (interactive) - (if (mastodon-toot-empty-p) + (if (mastodon-toot--empty-p) (mastodon-toot--kill) (when (y-or-n-p "Save draft toot?") (mastodon-toot--save-draft)) @@ -515,7 +515,7 @@ Pushes `mastodon-toot-current-toot-text' to mastodon-toot-draft-toots-list :test 'equal) (message "Draft saved!"))) -(defun mastodon-toot-empty-p (&optional text-only) +(defun mastodon-toot--empty-p (&optional text-only) "Return t if toot has no text, attachments, or polls. TEXT-ONLY means don't check for attachments or polls." (and (if text-only @@ -631,7 +631,7 @@ If media items have been attached and uploaded with (interactive) (let* ((toot (mastodon-toot--remove-docs)) (endpoint (mastodon-http--api "statuses")) - (spoiler (when (and (not (mastodon-toot-empty-p)) + (spoiler (when (and (not (mastodon-toot--empty-p)) mastodon-toot--content-warning) (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) @@ -663,7 +663,7 @@ If media items have been attached and uploaded with ((and mastodon-toot--max-toot-chars (> (length toot) mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.")) - ((mastodon-toot-empty-p) + ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t (let ((response (mastodon-http--post endpoint args nil))) @@ -1160,7 +1160,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (setq mastodon-toot--reply-to-id reply-to-id) (unless (equal mastodon-toot--visibility reply-visibility) (setq mastodon-toot--visibility reply-visibility)) - (mastodon-toot-set-cw reply-cw)))) + (mastodon-toot--set-cw reply-cw)))) (defun mastodon-toot--update-status-fields (&rest _args) "Update the status fields in the header based on the current state." @@ -1206,15 +1206,15 @@ Added to `after-change-functions' in new toot buffers." (unless (string-empty-p text) (setq mastodon-toot-current-toot-text text)))) -(defun mastodon-toot-open-draft-toot () +(defun mastodon-toot--open-draft-toot () "Prompt for a draft and compose a toot with it." (interactive) (if mastodon-toot-draft-toots-list (let ((text (completing-read "Select draft toot: " mastodon-toot-draft-toots-list nil t))) - (if (mastodon-toot-compose-buffer-p) - (when (and (not (mastodon-toot-empty-p :text-only)) + (if (mastodon-toot--compose-buffer-p) + (when (and (not (mastodon-toot--empty-p :text-only)) (y-or-n-p "Replace current text with draft?")) (cl-pushnew mastodon-toot-current-toot-text mastodon-toot-draft-toots-list) @@ -1226,11 +1226,11 @@ Added to `after-change-functions' in new toot buffers." ;; (delete-region (point) (point-max)) (insert text)) (mastodon-toot--compose-buffer nil nil nil text))) - (unless (mastodon-toot-compose-buffer-p) + (unless (mastodon-toot--compose-buffer-p) (mastodon-toot--compose-buffer)) (message "No drafts available."))) -(defun mastodon-toot-delete-draft-toot () +(defun mastodon-toot--delete-draft-toot () "Prompt for a draft toot and delete it." (interactive) (if mastodon-toot-draft-toots-list @@ -1243,7 +1243,7 @@ Added to `after-change-functions' in new toot buffers." (message "Draft deleted!")) (message "No drafts to delete."))) -(defun mastodon-toot-delete-all-drafts () +(defun mastodon-toot--delete-all-drafts () "Delete all drafts." (interactive) (setq mastodon-toot-draft-toots-list nil) @@ -1252,7 +1252,7 @@ Added to `after-change-functions' in new toot buffers." (defun mastodon-toot--propertize-tags-and-handles (&rest _args) "Propertize tags and handles in toot compose buffer. Added to `after-change-functions'." - (when (mastodon-toot-compose-buffer-p) + (when (mastodon-toot--compose-buffer-p) (let ((header-region (mastodon-tl--find-property-range 'toot-post-header (point-min)))) @@ -1280,7 +1280,7 @@ Added to `after-change-functions'." (match-end 2) `(face ,face))))) -(defun mastodon-toot-compose-buffer-p () +(defun mastodon-toot--compose-buffer-p () "Return t if compose buffer is current." (equal (buffer-name (current-buffer)) "*new toot*")) -- 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') 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') 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 fbf796a7bdf98babfdbfc879c49db3defdc2577d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:27:34 +0100 Subject: http build array args docstring --- lisp/mastodon-http.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d9e1d80..e67cf2d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -125,7 +125,8 @@ Unless UNAUTHENTICATED-P is non-nil." "&")) (defun mastodon-http--build-array-args-alist (param-str array) - "Return parameters alist using PARAM-STR and ARRAY param values." + "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 collect (cons param-str x))) -- 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') 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 f49ef7a5647fadc64e3f8af3abce7c95454fe04b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:29:24 +0100 Subject: fix merge remnants --- lisp/mastodon.el | 3 --- 1 file changed, 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 6b56341..57d5bd4 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -193,11 +193,8 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) (define-key map (kbd "I") #'mastodon-tl--view-filters) (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) -<<<<<<< HEAD (define-key map (kbd "X") #'mastodon-tl--view-lists) -======= (define-key map (kbd "@") #'mastodon-notifications--get-mentions) ->>>>>>> develop (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3 From 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') 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') 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 d5e91d63d130d69c6fc45fb90962a31733004f94 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 12:40:23 +0100 Subject: notifs: don't remove "status" from types, add other notifs views --- lisp/mastodon-notifications.el | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index a33a96b..24a8492 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -286,10 +286,35 @@ Optionally only print notifications of type TYPE, a string." (interactive) (mastodon-notifications--get "mention" "mentions")) +(defun mastodon-notifications--get-favourites () + "Display favourite notifications in buffer." + (interactive) + (mastodon-notifications--get "favourite" "favourites")) + +(defun mastodon-notifications--get-boosts () + "Display boost notifications in buffer." + (interactive) + (mastodon-notifications--get "reblog" "boosts")) + +(defun mastodon-notifications--get-polls () + "Display poll notifications in buffer." + (interactive) + (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")) + (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)))) + "Return a list of notification types with TYPE removed." + (let ((types + ;; the docs don't mention "status" as an options + ;; but we do need to exclude it, so keep it in the list here + ;;(remove "status" + (mapcar #'car mastodon-notifications--types-alist))) (remove type types))) (defun mastodon-notifications--clear-all () -- cgit v1.2.3 From 61024cb96750f11ade4c42f872f3d6b44f53423b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 13:48:05 +0100 Subject: notifs--get: switch and update if we already have the buffer --- lisp/mastodon-notifications.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 24a8492..b23e3c5 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -273,13 +273,17 @@ of the toot responded to." "Display NOTIFICATIONS in buffer. Optionally only print notifications of type TYPE, a string." (interactive) - (message "Loading your notifications...") - (mastodon-tl--init-sync - (or buffer-name "notifications") - "notifications" - 'mastodon-notifications--timeline - type) - (use-local-map mastodon-notifications--map)) + (let ((buffer "*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." -- cgit v1.2.3 From 6575858c101a7536a265c89534137692e5488265 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 15:53:29 +0100 Subject: refactor search--propertize-user --- lisp/mastodon-search.el | 46 +++++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 6422716..31fcae3 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -167,29 +167,33 @@ user's profile note. This is also called by `mastodon-tl--get-follow-suggestions' and `mastodon-profile--insert-follow-requests'." (mapc (lambda (acct) - (let ((user (mastodon-search--get-user-info acct))) - (insert - (propertize - (concat (propertize (car user) - 'face 'mastodon-display-name-face - 'byline t - 'toot-id "0") - " : \n : " - (propertize (concat "@" (cadr user)) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" (cadr user)) - 'help-echo (concat "Browse user profile of @" (cadr user))) - " : \n" - (if note - (mastodon-tl--render-text (cadddr user) nil) - "") - "\n") - 'toot-json acct)))) ; so named for compat w other processing functions + (insert (mastodon-search--propertize-user acct note))) json)) +(defun mastodon-search--propertize-user (acct &optional note) + "Propertize display string for ACCT, optionally including profile +NOTE." + (let ((user (mastodon-search--get-user-info acct))) + (propertize + (concat (propertize (car user) + 'face 'mastodon-display-name-face + 'byline t + 'toot-id "0") + " : \n : " + (propertize (concat "@" (cadr user)) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" (cadr user)) + 'help-echo (concat "Browse user profile of @" (cadr user))) + " : \n" + (if note + (mastodon-tl--render-text (cadddr user) nil) + "") + "\n") + 'toot-json acct))) ; so named for compat w other processing functions + (defun mastodon-search--print-tags-list (tags) "Insert a propertized list of TAGS." (mapc (lambda (el) -- 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') 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 2666d729310c8f058bfaad75c1bc28e37703fef7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 16:54:07 +0100 Subject: toot count: URLs = 23 chars, handes = no domain --- lisp/mastodon-toot.el | 43 +++++++++++++++++++++++++++++++++---------- 1 file changed, 33 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b45a84f..53e60bd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1165,21 +1165,23 @@ REPLY-JSON is the full JSON of the toot being replied to." (defun mastodon-toot--update-status-fields (&rest _args) "Update the status fields in the header based on the current state." (ignore-errors ;; called from after-change-functions so let's not leak errors - (let ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'toot-post-header + (let* ((inhibit-read-only t) + (header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'toot-post-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'toot-post-counter + (visibility-region (mastodon-tl--find-property-range + 'toot-post-visibility (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag (point-min))) - (visibility-region (mastodon-tl--find-property-range - 'toot-post-visibility (point-min))) - (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - (point-min))) - (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag - (point-min)))) + (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag + (point-min))) + (toot-string (buffer-substring-no-properties (cdr header-region) + (point-max)))) (add-text-properties (car count-region) (cdr count-region) (list 'display (format "%s/%s characters" - (- (point-max) (cdr header-region)) + (mastodon-toot--count-toot-chars toot-string) (number-to-string mastodon-toot--max-toot-chars)))) (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display @@ -1199,6 +1201,27 @@ REPLY-JSON is the full JSON of the toot being replied to." (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face))))) +(defun mastodon-toot--count-toot-chars (toot-string) + "Count the characters in the current toot. +URLs always = 23, and domain names of handles are not counted. +This is how mastodon does it." + (with-temp-buffer + (switch-to-buffer (current-buffer)) + (insert toot-string) + (goto-char (point-min)) + ;; handle URLs + (while (search-forward-regexp "\\w+://[^ \n]*" nil t) ; URL + (replace-match "xxxxxxxxxxxxxxxxxxxxxxx")) ; 23 x's + ;; handle @handles + (goto-char (point-min)) + (while (search-forward-regexp (concat "\\(?2:@[^ @\n]+\\)" ; a handle only + "\\(@[^ \n]+\\)?" ; with poss domain + "\\b") + nil t) + (replace-match (match-string 2))) ; replace with handle only + (length (buffer-substring (point-min) (point-max))))) + + (defun mastodon-toot--save-toot-text (&rest _args) "Save the current toot text in `mastodon-toot-current-toot-text'. Added to `after-change-functions' in new toot buffers." -- 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') 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') 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') 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 519c47e28c66a22b5c2b07bebf704ca4dcef5a2a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 12:30:11 +0100 Subject: mastodon-handle-regex: use for company + propertizing --- lisp/mastodon-toot.el | 48 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 33 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d0eb143..4344e68 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -188,6 +188,14 @@ For the moment we just put all composed toots in here, as we want to also capture toots that are 'sent' but that don't successfully send.") +(defvar mastodon-handle-regex + (concat + ;; preceding space or bol [boundary doesn't work with @] + "\\([\n\t ]\\|^\\)" + "\\(?2:@[1-9a-zA-Z._-]+" ; a handle + "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ + "\\b")) + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -773,17 +781,30 @@ for matches, CANDIDATES-FUN, ANNOT-FUN, and META-FUN are functions called on ARG to generate formatted candidates, annotation, and meta fields respectively." (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend (quote backend-name))) - (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - (save-excursion - (forward-whitespace -1) - (forward-whitespace 1) - (looking-at str-prefix))) - (concat str-prefix (company-grab-symbol)))) - (candidates (funcall candidates-fun arg)) - (annotation (funcall annot-fun arg)) - (meta (funcall meta-fun arg)))) + (let ((handle-before + ;; hack to handle @handles@with.domains, as "@" is a word/symbol boundary + (if (string= str-prefix "@") + (save-match-data + (save-excursion + (re-search-backward mastodon-handle-regex nil :no-error) + (if (match-string-no-properties 2) + ;; match full handle inc. domain (see the regex for subexp 2) + (buffer-substring-no-properties (match-beginning 2) (match-end 2)) + "")))))) + (cl-case command + (interactive (company-begin-backend (quote backend-name))) + (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (forward-whitespace -1) + (forward-whitespace 1) + (looking-at str-prefix))) + (if (and (string= str-prefix "@") + (> (length handle-before) 1)) ; more than just @ + (concat str-prefix (substring-no-properties handle-before 1)) ;handle + (concat str-prefix (company-grab-symbol))))) ; tag + (candidates (funcall candidates-fun arg)) + (annotation (funcall annot-fun arg)) + (meta (funcall meta-fun arg))))) (defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions. @@ -1287,10 +1308,7 @@ Added to `after-change-functions'." 'success (cdr header-region)) (mastodon-toot--propertize-item - (concat "\\([\n\t ]\\|^\\)" ; preceding space or bol - "\\(?2:@[1-9a-zA-Z._-]+" ; a handle - "\\(@[1-9a-zA-Z._-]+\\)?\\)" ; with poss domain - "\\b") ; boundary + mastodon-handle-regex 'mastodon-display-name-face (cdr header-region))))) -- cgit v1.2.3 From ea155f08605f422c0e6dc96657ce00547b12d67f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 21:17:08 +0100 Subject: delete/redraft/pin toots from notifications we simply fetch 'base-toot or 'toot-json --- lisp/mastodon-toot.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4344e68..f7fea75 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -418,7 +418,8 @@ Uses `lingva.el'." (defun mastodon-toot--pin-toot-toggle () "Pin or unpin user's toot at point." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs + (mastodon-tl--property 'toot-json))) (pinnable-p (mastodon-toot--own-toot-p toot)) (pinned-p (equal (alist-get 'pinned toot) t)) (action (if pinned-p "unpin" "pin")) @@ -443,7 +444,8 @@ Uses `lingva.el'." "Delete and redraft user's toot at point synchronously. NO-REDRAFT means delete toot only." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (or (mastodon-tl--property 'base-toot) ;fave/boost notifs + (mastodon-tl--property 'toot-json))) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) (toot-cw (alist-get 'spoiler_text toot)) -- 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') 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') 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 9fe26b121470bb1182a239a102f82c5117395791 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 21:01:04 +0100 Subject: edit toot at point edit from notifs we fetch 'base-toot or 'toot-json --- lisp/mastodon-toot.el | 56 ++++++++++++++++++++++++++++++++++++++++++++++----- lisp/mastodon.el | 2 ++ 2 files changed, 53 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4344e68..aa0ea39 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -81,6 +81,7 @@ (autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") +(autoload 'mastodon-http--put "mastodon-http") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -171,6 +172,8 @@ change the setting on the server, see (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") +(defvar-local mastodon-toot--edit-toot-id nil + "The id of the toot being edited.") (defvar-local mastodon-toot-previous-window-config nil "A list of window configuration prior to composing a toot. @@ -635,13 +638,21 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with -`mastodon-toot--attach-media', they are attached to the toot." +`mastodon-toot--attach-media', they are attached to the toot. +If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to instance to edit a toot." (interactive) - (let* ((toot (mastodon-toot--remove-docs)) - (endpoint (mastodon-http--api "statuses")) + (let* ((edit-p (if mastodon-toot--edit-toot-id t nil)) + (toot (mastodon-toot--remove-docs)) + (endpoint + (if edit-p + ;; we are sending an edit: + (mastodon-http--api (format "statuses/%s" + mastodon-toot--edit-toot-id)) + (mastodon-http--api "statuses"))) (spoiler (when (and (not (mastodon-toot--empty-p)) mastodon-toot--content-warning) - (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) + (read-string "Warning: " + mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -674,13 +685,48 @@ If media items have been attached and uploaded with ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (mastodon-http--post endpoint args))) + (let ((response (if edit-p + ;; we are sending an edit: + (mastodon-http--put endpoint args) + (mastodon-http--post endpoint args)))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) (message "Toot toot!") (mastodon-toot--restore-previous-window-config prev-window-config)))))))) +;; EDITING TOOTS: + +(defun mastodon-toot--edit-toot-at-point () + "Edit the user's toot at point." + (interactive) + (let ((toot (or (mastodon-tl--property 'base-toot); fave/boost notifs + (mastodon-tl--property 'toot-json)))) + (if (not (mastodon-toot--own-toot-p toot)) + (message "You can only edit your own toots.") + (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (source (mastodon-toot--get-toot-source id)) + (content (alist-get 'text source)) + (source-cw (alist-get 'spoiler_text source)) + (toot-visibility (alist-get 'visibility toot)) + (reply-id (alist-get 'in_reply_to_id toot))) + (when (y-or-n-p "Edit this toot? ") + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert content) + ;; adopt reply-to-id, visibility and CW: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) + (setq mastodon-toot--visibility toot-visibility) + (mastodon-toot--set-cw source-cw) + (mastodon-toot--update-status-fields) + (setq mastodon-toot--edit-toot-id id)))))) + +(defun mastodon-toot--get-toot-source (id) + "Fetch the source JSON of toot with ID." + (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) + (mastodon-http--get-json url :silent))) + (defun mastodon-toot--restore-previous-window-config (config) "Restore the window CONFIG after killing the toot compose buffer. Buffer-local variable `mastodon-toot-previous-window-config' holds the config." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 57d5bd4..d10932b 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -92,6 +92,7 @@ (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") (autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (defgroup mastodon nil "Interface with Mastodon." @@ -195,6 +196,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) (define-key map (kbd "X") #'mastodon-tl--view-lists) (define-key map (kbd "@") #'mastodon-notifications--get-mentions) + (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point) (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) -- cgit v1.2.3 From ec3821d4a0126d978a052a522ab161a40c689cf3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 21:01:29 +0100 Subject: docstrings + autoloads --- lisp/mastodon-toot.el | 11 ++++++----- lisp/mastodon.el | 6 +++++- 2 files changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index aa0ea39..628a546 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -191,7 +191,7 @@ For the moment we just put all composed toots in here, as we want to also capture toots that are 'sent' but that don't successfully send.") -(defvar mastodon-handle-regex +(defvar mastodon-toot-handle-regex (concat ;; preceding space or bol [boundary doesn't work with @] "\\([\n\t ]\\|^\\)" @@ -639,7 +639,8 @@ to `emojify-user-emojis', and the emoji data is updated." "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with `mastodon-toot--attach-media', they are attached to the toot. -If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to instance to edit a toot." +If `mastodon-toot--edit-toot-id' is non-nil, PUT contents to +instance to edit a toot." (interactive) (let* ((edit-p (if mastodon-toot--edit-toot-id t nil)) (toot (mastodon-toot--remove-docs)) @@ -832,7 +833,7 @@ meta fields respectively." (if (string= str-prefix "@") (save-match-data (save-excursion - (re-search-backward mastodon-handle-regex nil :no-error) + (re-search-backward mastodon-toot-handle-regex nil :no-error) (if (match-string-no-properties 2) ;; match full handle inc. domain (see the regex for subexp 2) (buffer-substring-no-properties (match-beginning 2) (match-end 2)) @@ -1269,7 +1270,7 @@ REPLY-JSON is the full JSON of the toot being replied to." 'face 'mastodon-cw-face))))) (defun mastodon-toot--count-toot-chars (toot-string) - "Count the characters in the current toot. + "Count the characters in TOOT-STRING. URLs always = 23, and domain names of handles are not counted. This is how mastodon does it." (with-temp-buffer @@ -1354,7 +1355,7 @@ Added to `after-change-functions'." 'success (cdr header-region)) (mastodon-toot--propertize-item - mastodon-handle-regex + mastodon-toot-handle-regex 'mastodon-display-name-face (cdr header-region))))) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d10932b..393d7b6 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -92,6 +92,8 @@ (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) (autoload 'mastodon-search--trending-tags "mastodon-search") (autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") +(autoload 'mastodon-tl--view-lists "mastodon-tl") (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (defgroup mastodon nil @@ -250,7 +252,9 @@ Use. e.g. \"%c\" for your locale's date and time format." (if buffer (switch-to-buffer buffer) (mastodon-tl--get-home-timeline) - (message "Loading Mastodon account %s on %s..." (mastodon-auth--user-acct) mastodon-instance-url)))) + (message "Loading Mastodon account %s on %s..." + (mastodon-auth--user-acct) + mastodon-instance-url)))) ;;;###autoload (defun mastodon-toot (&optional user reply-to-id reply-json) -- cgit v1.2.3 From d61ec5793e1866765f4b85e157e20122491b43e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 22:04:24 +0100 Subject: get toot edits --- lisp/mastodon-toot.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 628a546..069c914 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -728,6 +728,14 @@ 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)))) + (mastodon-http--get-json url))) + (defun mastodon-toot--restore-previous-window-config (config) "Restore the window CONFIG after killing the toot compose buffer. Buffer-local variable `mastodon-toot-previous-window-config' holds the config." -- cgit v1.2.3 From b5436e732676fe79f8f2642d20d22b275b2999e6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 22:21:50 +0100 Subject: toot--edited-at --- lisp/mastodon-toot.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 069c914..9714854 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -736,6 +736,13 @@ instance to edit a toot." (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--restore-previous-window-config (config) "Restore the window CONFIG after killing the toot compose buffer. Buffer-local variable `mastodon-toot-previous-window-config' holds the config." -- cgit v1.2.3 From f1c083bcf68106ff2de7e6532f8db7e3888eed18 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 20 Nov 2022 22:23:55 +0100 Subject: display edit notifications --- lisp/mastodon-notifications.el | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 127a9e2..c4570ea 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -61,7 +61,8 @@ ("mention" . mastodon-notifications--mention) ("poll" . mastodon-notifications--poll) ("follow_request" . mastodon-notifications--follow-request) - ("status" . mastodon-notifications--status)) + ("status" . mastodon-notifications--status) + ("update" . mastodon-notifications--edit)) "Alist of notification types and their corresponding function.") (defvar mastodon-notifications--response-alist @@ -71,7 +72,8 @@ ("Mentioned" . "you") ("Posted a poll" . "that has now ended") ("Requested to follow" . "you") - ("Posted" . "a post")) + ("Posted" . "a post") + ("Edited" . "a post")) "Alist of subjects for notification types.") (defvar mastodon-notifications--map @@ -172,6 +174,10 @@ Status notifications are given when "Format for a `poll' NOTE." (mastodon-notifications--format-note note 'poll)) +(defun mastodon-notifications--edit (note) + "Format for an `edit' NOTE." + (mastodon-notifications--format-note note 'edit)) + (defun mastodon-notifications--format-note (note type) "Format for a NOTE of TYPE." (let ((id (alist-get 'id note)) @@ -196,7 +202,7 @@ Status notifications are given when "Congratulations, you have a new follower!" (format "You have a follow request from... %s" follower)) - 'face 'default) + 'face 'default) (mastodon-tl--clean-tabs-and-nl (if (mastodon-tl--has-spoiler status) (mastodon-tl--spoiler status) @@ -223,7 +229,9 @@ Status notifications are given when ((equal type 'status) "Posted") ((equal type 'poll) - "Posted a poll")))) + "Posted a poll") + ((equal type 'edit) + "Edited")))) id (when (or (equal type 'favourite) (equal type 'boost)) @@ -314,9 +322,6 @@ Status notifications are created when you call (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE removed." (let ((types - ;; the docs don't mention "status" as an options - ;; but we do need to exclude it, so keep it in the list here - ;;(remove "status" (mapcar #'car mastodon-notifications--types-alist))) (remove type types))) -- 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') 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 6e75db20584272ee4a9954129359f5e19d737d75 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 10:09:01 +0100 Subject: notifs: switch to filtered view when already in notifs view we just have to set the let var propertly for filtered views. --- lisp/mastodon-notifications.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index c4570ea..62cdfe7 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -280,7 +280,8 @@ of the toot responded to." "Display NOTIFICATIONS in buffer. Optionally only print notifications of type TYPE, a string." (interactive) - (let ((buffer "*mastodon-notifications*")) + (let ((buffer (or (concat "*mastodon-" buffer-name) + "*mastodon-notifications*"))) (if (get-buffer buffer) (progn (switch-to-buffer buffer) (mastodon-tl--update)) -- cgit v1.2.3