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(-) 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(-) 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(-) 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(+) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(+) 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 433e5334fd4336fc35d04e44e309d434e0443625 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 13:39:01 +0100 Subject: readme re mentions notifs view --- README.org | 1 + 1 file changed, 1 insertion(+) diff --git a/README.org b/README.org index a310f97..d5ce8b3 100644 --- a/README.org +++ b/README.org @@ -122,6 +122,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | =H= | Open home timeline | | =L= | Open local timeline | | =N= | Open notifications timeline | +| =@= | Open mentions-only notifications timeline | | =u= | Update current timeline | | =T= | Open thread for toot under =point= | | =#= | Prompt for tag and open its timeline | -- 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(-) 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 4c596da597b1fd926736dfab25d4bd111997296a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 13:55:22 +0100 Subject: readme --- README.org | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/README.org b/README.org index d5ce8b3..b6425de 100644 --- a/README.org +++ b/README.org @@ -299,19 +299,11 @@ Optional dependencies: - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots -** Nota Bene regarding work on this library - -I resurrected this library a few years ago, and have added stacks of features and fixes over time. I do it in my spare time and tend to implement features I want to use. I am not a professional programmer. I never aimed to implement all Mastodon features, nor to provide a professional service to others. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. - -Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and start a discussion, but don't try to order things from me. - -The better option is to look at the code and seeing how you can implement the feature yourself. A lot of the functionality you'll need is already implemented. I'm happy to give pointers on what you might use. - ** Contributing PRs, issues, feature requests, and general feedback are very welcome! -*** Bugs +*** Bug reports 1. =mastodon.el= has bugs, as well as lots of room for improvement. 2. I receive very little feedback, so if I don't run into the bug it often doesn't get fixed. @@ -323,13 +315,15 @@ PRs, issues, feature requests, and general feedback are very welcome! 1. Create an [[https://github.com/jdenen/mastodon.el/issues][issue]] detailing the feature you'd like to add. 2. Fork the repository and create a branch off of =develop=. -3. Create a pull request referencing the issue created in step 1. +3. Run the tests and ensure that your code doesn't break any of them. +4. Create a pull request referencing the issue created in step 1. *** Fixes 1. In an [[https://github.com/jdenen/mastodon.el/issues][issue]], let me know that you're working to fix it. 2. Fork the repository and create a branch off of =develop=. -3. Create a pull request referencing the issue from step 1. +3. Run the tests and ensure that your code doesn't break any of them. +4. Create a pull request referencing the issue from step 1. ** Contributors: -- 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(-) 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 784f5d258db820481bc468a8cb1aa9e59793340f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 15:39:16 +0100 Subject: woodpecker branches fix --- .woodpecker.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.woodpecker.yml b/.woodpecker.yml index ba2c7b5..01b1cba 100644 --- a/.woodpecker.yml +++ b/.woodpecker.yml @@ -12,4 +12,4 @@ pipeline: - cask install - cask emacs -batch -l test/ert-helper.el -f ert-run-tests-batch-and-exit -+branches: [ main, develop ] +branches: [ main, develop ] -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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 d2f7fa8e50cdf8d6e5deffcb1f417380184a9bbb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 18 Nov 2022 13:57:01 +0100 Subject: readme -- separator for all funs --- README.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index 6e8dc07..6ad02b1 100644 --- a/README.org +++ b/README.org @@ -222,12 +222,12 @@ You can download and use your instance's custom emoji - =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-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-user-profile-note=: Update your bio note. +- =mastodon-profile--update-user-profile-note=: Update your bio note. - =mastodon-profile--update-meta-fields=: Update your metadata fields. -- =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. +- =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. -- 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(-) 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 653bf0e90b5f1b281d689f2411fda16876df0c0b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 10:08:54 +0100 Subject: readme typo --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 9fb4643..2684baa 100644 --- a/README.org +++ b/README.org @@ -257,7 +257,7 @@ See =M-x customize-group RET mastodon= to view all customize options. Works for federated, local, and home timelines and for notifications. It's a little touchy, one thing to avoid is trying to load a timeline more than once at a time. It can go off the rails a bit, but it's still pretty cool. The -current maintainer of =mastodon.el= is unable to debug improve this feature. +current maintainer of =mastodon.el= is unable to debug or improve this feature. To enable, it, add =(require 'mastodon-async)= to your =init.el=. Then you can view a timeline with one of the commands that begin with -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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 4ca74a8142ca78f8b5332825f134a442103bbcf0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 12:48:13 +0100 Subject: readme --- README.org | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.org b/README.org index 2684baa..362bd6c 100644 --- a/README.org +++ b/README.org @@ -138,6 +138,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | =G= | view follow suggestions | | =V= | view your favourited toots | | =K= | view bookmarked toots | +| =X= | view/edit/create/delete lists | |---------------+-----------------------------------------------------------------------| | | *Toot actions* | | =t= | Compose a new toot | @@ -157,6 +158,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 | +| | see =mastodon-notifications--get-*= functions for filtered views | |---------------+-----------------------------------------------------------------------| | | *Quitting* | | =q= | Quit mastodon buffer, leave window open | -- 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(-) 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(-) 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(-) 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(-) 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(+) 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(-) 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 0f5bbfe887f3ab253a6436914b1cf35fa6753a47 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 19:05:10 +0100 Subject: readme re support --- README.org | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.org b/README.org index 362bd6c..8a057d2 100644 --- a/README.org +++ b/README.org @@ -327,6 +327,12 @@ PRs, issues, feature requests, and general feedback are very welcome! 3. Run the tests and ensure that your code doesn't break any of them. 4. Create a pull request referencing the issue from step 1. +** Supporting mastodon.el + +If you'd like to support continued development of =mastodon.el=, I accept donations via paypal at martianhiatus [ at ] riseup [ dot ] net. If you would prefer a different payment method, write to me at that address and I can provide IBAN or other details. + +I don't have a tech worker's income, so even a small tip would help out. + ** Contributors: =mastodon.el= is the work of a number of people. -- 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(+) 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 47343cb7ef526107423a9cfe3be3e03bd834bf83 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 19:17:07 +0100 Subject: readme re following tags --- README.org | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/README.org b/README.org index 8a057d2..bfb1641 100644 --- a/README.org +++ b/README.org @@ -222,10 +222,17 @@ 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-search--trending-tags=: View a list of trending hashtags on your instance. + +- =mastodon-tl--follow-tag=: Follow a tag (works like following a user) +- =mastodon-tl--unfollow-tag=: Unfollow a tag +- =mastodon-tl--list-followed-tags=: View a list of tags you're following. + + - =mastodon-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. -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(+) 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(+) 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(-) 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(-) 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(-) 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 From cc5b8b36588d2c7caa6bc013580aaf01ef0a880d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 10:27:13 +0100 Subject: fix toot del/pin tests --- test/mastodon-toot-tests.el | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 9741964..b88510c 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -120,11 +120,12 @@ mention string." "Should refuse to delete toot." (let ((toot mastodon-toot-test-base-toot)) (with-mock - (mock (mastodon-auth--user-acct) => "joebogus") - ;; (mock (mastodon-toot--own-toot-p toot) => nil) - (mock (mastodon-tl--property 'toot-json) => mastodon-toot-test-base-toot) - (should (equal (mastodon-toot--delete-toot) - "You can only delete (and redraft) your own toots."))))) + (mock (mastodon-auth--user-acct) => "joebogus") + ;; (mock (mastodon-toot--own-toot-p toot) => nil) + (mock (mastodon-tl--property 'toot-json) => mastodon-toot-test-base-toot) + (mock (mastodon-tl--property 'base-toot) => toot) + (should (equal (mastodon-toot--delete-toot) + "You can only delete (and redraft) your own toots."))))) (ert-deftest mastodon-toot--delete-toot () "Should return correct triaged response to a legitimate DELETE request." @@ -133,16 +134,17 @@ mention string." (let ((delete-response (current-buffer)) (toot mastodon-toot-test-base-toot)) (with-mock - (mock (mastodon-tl--property 'toot-json) => toot) - ;; (mock (mastodon-toot--own-toot-p toot) => t) - (mock (mastodon-auth--user-acct) => "acct42@example.space") - (mock (mastodon-http--api (format "statuses/61208")) - => "https://example.space/statuses/61208") - (mock (y-or-n-p "Delete this toot? ") => t) - (mock (mastodon-http--delete "https://example.space/statuses/61208") - => delete-response) - (should (equal (mastodon-toot--delete-toot) - "Toot deleted!")))))) + (mock (mastodon-tl--property 'toot-json) => toot) + (mock (mastodon-tl--property 'base-toot) => toot) + ;; (mock (mastodon-toot--own-toot-p toot) => t) + (mock (mastodon-auth--user-acct) => "acct42@example.space") + (mock (mastodon-http--api (format "statuses/61208")) + => "https://example.space/statuses/61208") + (mock (y-or-n-p "Delete this toot? ") => t) + (mock (mastodon-http--delete "https://example.space/statuses/61208") + => delete-response) + (should (equal (mastodon-toot--delete-toot) + "Toot deleted!")))))) (ert-deftest mastodon-toot-action-pin () "Should return callback provided by `mastodon-toot--pin-toot-toggle'." @@ -167,7 +169,8 @@ mention string." (let ((pin-response (current-buffer)) (toot mastodon-toot-test-base-toot)) (with-mock - (mock (mastodon-tl--property 'toot-json) => toot) - (mock (mastodon-auth--user-acct) => "joebogus@example.space") - (should (equal (mastodon-toot--pin-toot-toggle) - "You can only pin your own toots.")))))) + (mock (mastodon-tl--property 'toot-json) => toot) + (mock (mastodon-tl--property 'base-toot) => toot) + (mock (mastodon-auth--user-acct) => "joebogus@example.space") + (should (equal (mastodon-toot--pin-toot-toggle) + "You can only pin your own toots.")))))) -- cgit v1.2.3 From 51c2e36901fda077a438b311d7618e637bae3ee7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:31:39 +0100 Subject: autoload notifs--get, clean up buffer-name arg/handling in same --- lisp/mastodon-notifications.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 62cdfe7..ae82b60 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -50,6 +50,7 @@ (autoload 'mastodon-http--get-params-async-json "mastodon-http.el") (autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--update "mastodon-tl") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -276,11 +277,13 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) +;;;###autoload (defun mastodon-notifications--get (&optional type buffer-name) "Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string." +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." (interactive) - (let ((buffer (or (concat "*mastodon-" buffer-name) + (let ((buffer (or (concat "*mastodon-" buffer-name "*") "*mastodon-notifications*"))) (if (get-buffer buffer) (progn (switch-to-buffer buffer) -- cgit v1.2.3 From de20da981c13fe29f5451f056d735a7b07ba156a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:38:41 +0100 Subject: readme bookmark emoji --- README.org | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/README.org b/README.org index c6df5ed..97e2f4f 100644 --- a/README.org +++ b/README.org @@ -169,13 +169,13 @@ take place if your =mastodon-token-file= does not contain =:client_id= and **** Toot byline legend -|----------------+------------------------| -| Marker | Meaning | -|----------------+------------------------| -| =(B)= | I boosted this toot | -| =(F)= | I favourited this toot | -| (=K=) (or emoji) | I bookmarked this toot | -|----------------+------------------------| +|---------------+------------------------| +| Marker | Meaning | +|---------------+------------------------| +| =(B)= | I boosted this toot | +| =(F)= | I favourited this toot | +| =(🔖)= (or (=K=)) | I bookmarked this toot | +|---------------+------------------------| *** Composing toots -- cgit v1.2.3 From c19cd695b3f40a9de508e066989cb23438c9c7f7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 11:46:20 +0100 Subject: make mastodon-notifications-get a global function so we can view notifs without first openin other masto buffers - move it to mastodon.el - autoload cookie - rename all instances - pray the keymap works --- README.org | 5 ++++- lisp/mastodon-discover.el | 2 +- lisp/mastodon-notifications.el | 34 ++++++++-------------------------- lisp/mastodon-tl.el | 4 ++-- lisp/mastodon.el | 26 ++++++++++++++++++++++++-- test/mastodon-notifications-tests.el | 2 +- 6 files changed, 40 insertions(+), 33 deletions(-) diff --git a/README.org b/README.org index 97e2f4f..8eb9242 100644 --- a/README.org +++ b/README.org @@ -222,7 +222,10 @@ You can download and use your instance's custom emoji *** Other commands and account settings: -- =mastodon-url-lookup=: Attempt to load URL in =mastodon.el=. URL may be the one at point or provided in the minibuffer. Should also work if =mastodon.el= is not yet loaded. +In addition to =mastodon=, the following functions are autoloaded and should work without first loading =mastodon.el=: +- =mastodon-toot=: Compose new toot +- =mastodon-notifications-get=: View all notifications +- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at point or provided in the minibuffer. - =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 5d1a86e..dc8a924 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -76,7 +76,7 @@ ("F" "Federated" mastodon-tl--get-federated-timeline) ("H" "Home" mastodon-tl--get-home-timeline) ("L" "Local" mastodon-tl--get-local-timeline) - ("N" "Notifications" mastodon-notifications--get) + ("N" "Notifications" mastodon-notifications-get) ("u" "Update timeline" mastodon-tl--update) ("S" "Search" mastodon-search--search-query) ("O" "Jump to your profile" mastodon-profile--my-profile) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ae82b60..a11513e 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -51,6 +51,7 @@ (autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-notifications-get "mastodon") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -83,7 +84,7 @@ (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) (define-key map (kbd "c") #'mastodon-notifications--clear-current) - (define-key map (kbd "g") #'mastodon-notifications--get) + (define-key map (kbd "g") #'mastodon-notifications-get) (keymap-canonicalize map)) "Keymap for viewing notifications.") @@ -125,7 +126,7 @@ follow-requests view." (lambda () (if f-reqs-view-p (mastodon-profile--view-follow-requests) - (mastodon-notifications--get)) + (mastodon-notifications-get)) (message "Follow request of %s (@%s) %s!" name handle (if reject "rejected" @@ -277,51 +278,32 @@ of the toot responded to." (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) -;;;###autoload -(defun mastodon-notifications--get (&optional type buffer-name) - "Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string. -BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." - (interactive) - (let ((buffer (or (concat "*mastodon-" buffer-name "*") - "*mastodon-notifications*"))) - (if (get-buffer buffer) - (progn (switch-to-buffer buffer) - (mastodon-tl--update)) - (message "Loading your notifications...") - (mastodon-tl--init-sync - (or buffer-name "notifications") - "notifications" - 'mastodon-notifications--timeline - type) - (use-local-map mastodon-notifications--map)))) - (defun mastodon-notifications--get-mentions () "Display mention notifications in buffer." (interactive) - (mastodon-notifications--get "mention" "mentions")) + (mastodon-notifications-get "mention" "mentions")) (defun mastodon-notifications--get-favourites () "Display favourite notifications in buffer." (interactive) - (mastodon-notifications--get "favourite" "favourites")) + (mastodon-notifications-get "favourite" "favourites")) (defun mastodon-notifications--get-boosts () "Display boost notifications in buffer." (interactive) - (mastodon-notifications--get "reblog" "boosts")) + (mastodon-notifications-get "reblog" "boosts")) (defun mastodon-notifications--get-polls () "Display poll notifications in buffer." (interactive) - (mastodon-notifications--get "poll" "polls")) + (mastodon-notifications-get "poll" "polls")) (defun mastodon-notifications--get-statuses () "Display status notifications in buffer. Status notifications are created when you call `mastodon-tl--enable-notify-user-posts'." (interactive) - (mastodon-notifications--get "status" "statuses")) + (mastodon-notifications-get "status" "statuses")) (defun mastodon-notifications--filter-types-list (type) "Return a list of notification types with TYPE removed." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 34048e7..aa58771 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -61,7 +61,7 @@ (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") ;; make notifications--get available via M-x and outside our keymap: -(autoload 'mastodon-notifications--get "mastodon-notifications" +(autoload 'mastodon-notifications-get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive (autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-search--insert-users-propertized "mastodon-search") @@ -2238,7 +2238,7 @@ For use after e.g. deleting a toot." ((equal (mastodon-tl--get-endpoint) "timelines/public?local=true") (mastodon-tl--get-local-timeline)) ((equal (mastodon-tl--get-endpoint) "notifications") - (mastodon-notifications--get)) + (mastodon-notifications-get)) ((equal (mastodon-tl--buffer-name) (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) (mastodon-profile--my-profile)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 5be168c..527de18 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -57,7 +57,6 @@ (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-notifications--get "mastodon-notifications") (autoload 'mastodon-profile--get-toot-author "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--show-user "mastodon-profile") @@ -96,6 +95,10 @@ (autoload 'mastodon-tl--view-lists "mastodon-tl") (autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (autoload 'mastodon-toot--view-toot-history "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") + +(defvar mastodon-notifications--map) (defgroup mastodon nil "Interface with Mastodon." @@ -160,7 +163,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "F") #'mastodon-tl--get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl--get-home-timeline) (define-key map (kbd "L") #'mastodon-tl--get-local-timeline) - (define-key map (kbd "N") #'mastodon-notifications--get) + (define-key map (kbd "N") #'mastodon-notifications-get) (define-key map (kbd "P") #'mastodon-profile--show-user) (define-key map (kbd "T") #'mastodon-tl--thread) ;; navigation out of mastodon @@ -267,6 +270,25 @@ If REPLY-JSON is the json of the toot being replied to." (interactive) (mastodon-toot--compose-buffer user reply-to-id reply-json)) +;;;###autoload +(defun mastodon-notifications-get (&optional type buffer-name) + "Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." + (interactive) + (let ((buffer (or (concat "*mastodon-" buffer-name "*") + "*mastodon-notifications*"))) + (if (get-buffer buffer) + (progn (switch-to-buffer buffer) + (mastodon-tl--update)) + (message "Loading your notifications...") + (mastodon-tl--init-sync + (or buffer-name "notifications") + "notifications" + 'mastodon-notifications--timeline + type) + (use-local-map mastodon-notifications--map)))) + ;; URL lookup: should be available even if `mastodon.el' not loaded: ;;;###autoload diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index bc70e49..1275c72 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -191,7 +191,7 @@ (mock (mastodon-profile--fetch-server-account-settings) => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (mastodon-notifications--get)))) + (mastodon-notifications-get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. -- cgit v1.2.3 From 50d77f205861cb5cdd4a4c97d5f320073303b81b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 16:48:05 +0100 Subject: masto mode map: 'g' calls --update --- lisp/mastodon.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 5be168c..225565a 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -171,11 +171,13 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) (define-key map (kbd "r") #'mastodon-toot--reply) + ;; this is now duplicated by 'g', cd remove/use for else: (define-key map (kbd "u") #'mastodon-tl--update) ;; new toot (define-key map (kbd "t") #'mastodon-toot) ;; override special mode binding (define-key map (kbd "g") #'undefined) + (define-key map (kbd "g") #'mastodon-tl--update) ;; mousebot additions (define-key map (kbd "W") #'mastodon-tl--follow-user) (define-key map (kbd "C-S-W") #'mastodon-tl--unfollow-user) -- cgit v1.2.3 From 01d44daa21cc24e99e61bba36e0dc2a111e46586 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 16:48:05 +0100 Subject: masto mode map: 'g' calls --update also remove notifs-get from same key in notifs map, for consistency --- lisp/mastodon-notifications.el | 1 - lisp/mastodon.el | 3 ++- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index a11513e..f5ddea3 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -84,7 +84,6 @@ (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.") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 527de18..04330f6 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -174,11 +174,13 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) (define-key map (kbd "r") #'mastodon-toot--reply) + ;; this is now duplicated by 'g', cd remove/use for else: (define-key map (kbd "u") #'mastodon-tl--update) ;; new toot (define-key map (kbd "t") #'mastodon-toot) ;; override special mode binding (define-key map (kbd "g") #'undefined) + (define-key map (kbd "g") #'mastodon-tl--update) ;; mousebot additions (define-key map (kbd "W") #'mastodon-tl--follow-user) (define-key map (kbd "C-S-W") #'mastodon-tl--unfollow-user) @@ -207,7 +209,6 @@ Use. e.g. \"%c\" for your locale's date and time format." (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) - "Keymap for `mastodon-mode'.") (defcustom mastodon-mode-hook nil -- cgit v1.2.3 From 7d9453c72e94159b06b4059e3444cd65267805d8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 16:48:05 +0100 Subject: masto mode map: 'g' calls --update also remove notifs-get from same key in notifs map, for consistency --- lisp/mastodon-notifications.el | 1 - lisp/mastodon.el | 1 - 2 files changed, 2 deletions(-) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ae82b60..f9e2fe5 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -83,7 +83,6 @@ (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.") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 225565a..d8591e1 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -206,7 +206,6 @@ Use. e.g. \"%c\" for your locale's date and time format." (when (require 'lingva nil :no-error) (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) - "Keymap for `mastodon-mode'.") (defcustom mastodon-mode-hook nil -- cgit v1.2.3 From bf7cc6fd0cde8b3caba850bad7c9b217bef481a7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 17:49:12 +0100 Subject: hack separator and propertizing for lists properties mean that the list-at-point functions also work on accounts/whitespace within the particular list. --- lisp/mastodon-tl.el | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 34048e7..b1cbce1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1594,7 +1594,9 @@ If ID is provided, delete that list." \n E - edit a list\n n/p - go to next/prev item]\n\n" 'font-lock-comment-face)) (mapc (lambda (x) - (mastodon-tl--print-list-accounts x)) + (mastodon-tl--print-list-accounts x) + (insert (propertize " ------------\n\n" + 'face 'success))) lists-names) (goto-char (point-min)))) ;; (mastodon-tl--goto-next-item))) ; causes another request! @@ -1609,8 +1611,17 @@ If ID is provided, delete that list." 'toot-id "0" ; so we nav here 'help-echo "RET: view list timeline, d: delete this list, \ a: add account to this list, r: remove account from this list" - 'face 'link) ; '((:underline t :inherit success))) - "\n\n" + 'list t + 'face 'link + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + "\n\n" + 'list t + 'keymap mastodon-tl--list-name-keymap + 'list-name list-name + 'list-id id) (propertize (mapconcat #'mastodon-search--propertize-user accounts " ") -- cgit v1.2.3 From 62e18cd138f322b0e1b8ce1139b4d129f6929b9a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 18:25:35 +0100 Subject: no switch to response buffer on non-200 http response --- lisp/mastodon-http.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 6e7bfb3..37770ef 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -88,11 +88,13 @@ Message status and JSON error from RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - (switch-to-buffer response) - ;; 404 returns http response not JSON: + ;; don't switch to buffer, just with-current-buffer the response: + ;; (switch-to-buffer response) + ;; 404 sometimes returns http response so --process-json fails: (if (string-prefix-p "404" status) (message "Error %s: page not found" status) - (let ((json-response (mastodon-http--process-json))) + (let ((json-response (with-current-buffer response + (mastodon-http--process-json)))) (message "Error %s: %s" status (alist-get 'error json-response))))))) (defun mastodon-http--read-file-as-string (filename) -- cgit v1.2.3 From 4f022007b8b1000c78881c5633c35f3f09afd955 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:36:20 +0100 Subject: add joined date to profile pages --- lisp/mastodon-profile.el | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index f81441e..e0b8279 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -555,7 +555,9 @@ FIELDS means provide a fields vector fetched by other means." (alist-get 'followed_by relationships))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) - (pinned (mastodon-profile--get-statuses-pinned account))) + (pinned (mastodon-profile--get-statuses-pinned account)) + (joined-ts (ts-parse + (mastodon-profile--account-field account 'created_at)))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) @@ -600,7 +602,15 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-profile--fields-insert fields) 'success) "\n") - "")) + "") + (propertize + (format "Joined %s" + (format "%s" (concat (ts-month-name joined-ts) + " " + (number-to-string + (ts-year joined-ts))))) + 'face 'success) + "\n\n") 'profile-json account) ;; insert counts (mastodon-tl--set-face -- cgit v1.2.3 From bd2ac7aa1b896717a8455776936b9f5ca0dd6000 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:52:29 +0100 Subject: add fun to display profile statuses without boosts --- lisp/mastodon-profile.el | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index e0b8279..512aae4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -150,10 +150,10 @@ contains") ;; or handle --property failing (mastodon-tl--property 'toot-json)) -(defun mastodon-profile--make-author-buffer (account) +(defun mastodon-profile--make-author-buffer (account &optional no-reblogs) "Take an ACCOUNT json and insert a user account into a new buffer." (mastodon-profile--make-profile-buffer-for - account "statuses" #'mastodon-tl--timeline)) + account "statuses" #'mastodon-tl--timeline no-reblogs)) ;; TODO: we shd just load all views' data then switch coz this is slow af: (defun mastodon-profile--account-view-cycle () @@ -164,9 +164,17 @@ contains") (mastodon-profile--open-followers)) ((string-suffix-p "followers" endpoint) (mastodon-profile--open-following)) + ((string-suffix-p "following" endpoint) + (mastodon-profile--open-statuses-no-reblogs)) (t - (mastodon-profile--make-profile-buffer-for - mastodon-profile--account "statuses" #'mastodon-tl--timeline))))) + (mastodon-profile--make-author-buffer mastodon-profile--account))))) + +(defun mastodon-profile--open-statuses-no-reblogs () + "Open a profile buffer showing statuses without reblogs." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer mastodon-profile--account :no-reblogs) + (error "Not in a mastodon profile"))) (defun mastodon-profile--open-following () "Open a profile buffer showing the accounts that current profile follows." @@ -530,10 +538,14 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-tl--toot pinned-status)) pinned-statuses)) -(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function) +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." (let* ((id (mastodon-profile--account-field account 'id)) - (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) + (args (when no-reblogs '(("exclude_reblogs" . "t")))) + (base-url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) + (url (if no-reblogs + (concat base-url "?" (mastodon-http--build-query-string args)) + base-url)) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) (note (mastodon-profile--account-field account 'note)) -- cgit v1.2.3 From cba97969ea0c21acd8ddf5d5c531aaf252092e97 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:56:19 +0100 Subject: fix joined date in profile-tests --- test/mastodon-profile-tests.el | 118 +++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 58 deletions(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 9d1ec72..3e238f1 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,66 @@ 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" + "Joined March 2016" + "\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 9b9431b130c1d8d1a03e445ae1f7803d2a511d70 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 22:01:07 +0100 Subject: params always in http.el, only ever send alists from elsewhere. probably incomplete but mostly done. --- lisp/mastodon-http.el | 85 +++++++++++++++++++++--------------- lisp/mastodon-profile.el | 28 ++++++------ lisp/mastodon-search.el | 4 +- lisp/mastodon-tl.el | 51 ++++++++-------------- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- test/mastodon-notifications-tests.el | 8 ++-- 7 files changed, 91 insertions(+), 89 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 37770ef..259432e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,27 +151,34 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (mastodon-http--url-retrieve-synchronously url))) unauthenticated-p)) -(defun mastodon-http--get (url &optional silent) +(defun mastodon-http--get (url &optional params silent) "Make synchronous GET request to URL. -Pass response buffer to CALLBACK function. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." (mastodon-http--authorized-request "GET" - (mastodon-http--url-retrieve-synchronously url silent))) + ;; url-request-data doesn't seem to work with GET requests: + (let ((url (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) + (mastodon-http--url-retrieve-synchronously url silent)))) -(defun mastodon-http--get-response (url &optional no-headers silent vector) +(defun mastodon-http--get-response (url &optional params no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. NO-HEADERS means don't collect http response headers. VECTOR means return json arrays as vectors." - (with-current-buffer (mastodon-http--get url silent) + (with-current-buffer (mastodon-http--get url params silent) (mastodon-http--process-response no-headers vector))) -(defun mastodon-http--get-json (url &optional silent vector) +(defun mastodon-http--get-json (url &optional params silent vector) "Return only JSON data from URL request. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message. VECTOR means return json arrays as vectors." - (car (mastodon-http--get-response url :no-headers silent vector))) + (car (mastodon-http--get-response url params :no-headers silent vector))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. @@ -214,35 +221,37 @@ Callback to `mastodon-http--get-response-async', usually (cons (car list) (cadr list)))) head-list))) -(defun mastodon-http--delete (url &optional args) - "Make DELETE request to URL." - (let ((url-request-data - (when args - (mastodon-http--build-query-string args)))) +(defun mastodon-http--delete (url &optional params) + "Make DELETE request to URL. +PARAMS is an alist of any extra parameters to send with the request." + ;; url-request-data only works with POST requests? + (let ((url + (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) (mastodon-http--authorized-request "DELETE" (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) -(defun mastodon-http--put (url &optional args headers) - "Make PUT request to URL." +(defun mastodon-http--put (url &optional params headers) + "Make PUT request to URL. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args - (mastodon-http--build-query-string args))) + (when args (mastodon-http--build-query-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: (unless (assoc "Content-Type" headers) '(("Content-Type" . "application/x-www-form-urlencoded"))) headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))))) + (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. - PARAMS should be an alist as required by `url-build-query-string'." (let ((query-string (url-build-query-string params))) (concat url "?" query-string))) @@ -259,24 +268,25 @@ PARAMS should be an alist as required by `url-build-query-string'." (kill-buffer) (json-read-from-string json-string))) -(defun mastodon-http--get-search-json (url query &optional param silent) +(defun mastodon-http--get-search-json (url query &optional params silent) "Make GET request to URL, searching for QUERY and return JSON response. -PARAM is any extra parameters to send with the request. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." - (let ((buffer (mastodon-http--get-search url query param silent))) + (let ((buffer (mastodon-http--get-search url query params silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) -(defun mastodon-http--get-search (base-url query &optional param silent) +(defun mastodon-http--get-search (base-url query &optional params silent) "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function. -PARAM is a formatted request parameter, eg 'following=true'. +PARAMS is an alist of any extra parameters to send with the request. SILENT means don't message." (mastodon-http--authorized-request "GET" - (let ((url (if param - (concat base-url "?" param "&q=" (url-hexify-string query)) - (concat base-url "?q=" (url-hexify-string query))))) + (let* ((query-str (mastodon-http--build-query-string + `(("q" . ,(url-hexify-string query))))) + (params-str (mastodon-http--build-query-string params)) + (url (concat base-url "?" query-str params-str))) (mastodon-http--url-retrieve-synchronously url silent)))) ;; profile update functions @@ -299,12 +309,17 @@ Optionally specify the PARAMS to send." ;; Asynchronous functions -(defun mastodon-http--get-async (url &optional callback &rest cbargs) +(defun mastodon-http--get-async (url &optional params callback &rest cbargs) "Make GET request to URL. -Pass response buffer to CALLBACK function with args CBARGS." - (mastodon-http--authorized-request - "GET" - (url-retrieve url callback cbargs))) +Pass response buffer to CALLBACK function with args CBARGS. +PARAMS is an alist of any extra parameters to send with the request." + (let ((url (if params + (concat url "?" + (mastodon-http--build-query-string params)) + url))) + (mastodon-http--authorized-request + "GET" + (url-retrieve url callback cbargs)))) (defun mastodon-http--get-response-async (url callback &rest args) "Make GET request to URL. Call CALLBACK with http response and ARGS." @@ -314,9 +329,11 @@ Pass response buffer to CALLBACK function with args CBARGS." (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-response) args))))) -(defun mastodon-http--get-json-async (url callback &rest args) - "Make GET request to URL. Call CALLBACK with json-list and ARGS." +(defun mastodon-http--get-json-async (url &optional params callback &rest args) + "Make GET request to URL. Call CALLBACK with json-list and ARGS. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async + params url (lambda (status) (when status ;; only when we actually get sth? diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 512aae4..975f7b7 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -36,6 +36,7 @@ (require 'seq) (require 'cl-lib) (require 'persist) +(require 'ts) (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") @@ -492,11 +493,10 @@ This endpoint only holds a few preferences. For others, see (defun mastodon-profile--relationships-get (id) "Fetch info about logged-in user's relationship to user with id ID." (let* ((their-id id) - (url (mastodon-http--api (format - "accounts/relationships?id[]=%s" - their-id)))) + (args `(("id[]" . ,their-id))) + (url (mastodon-http--api "accounts/relationships"))) ;; FIXME: not sure why we need to do this for relationships only! - (car (mastodon-http--get-json url)))) + (car (mastodon-http--get-json url args)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -527,8 +527,9 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--get-statuses-pinned (account) "Fetch the pinned toots for ACCOUNT." (let* ((id (mastodon-profile--account-field account 'id)) - (url (mastodon-http--api (format "accounts/%s/statuses?pinned=true" id)))) - (mastodon-http--get-json url))) + (args `(("pinned" . "true"))) + (url (mastodon-http--api (format "accounts/%s/statuses" id)))) + (mastodon-http--get-json url args))) (defun mastodon-profile--insert-statuses-pinned (pinned-statuses) "Insert each of the PINNED-STATUSES for a given account." @@ -538,18 +539,17 @@ FIELDS means provide a fields vector fetched by other means." (mastodon-tl--toot pinned-status)) pinned-statuses)) -(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type + update-function + &optional no-reblogs) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." (let* ((id (mastodon-profile--account-field account 'id)) (args (when no-reblogs '(("exclude_reblogs" . "t")))) - (base-url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) - (url (if no-reblogs - (concat base-url "?" (mastodon-http--build-query-string args)) - base-url)) + (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) (note (mastodon-profile--account-field account 'note)) - (json (mastodon-http--get-json url)) + (json (mastodon-http--get-json url args)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string (mastodon-profile--account-field @@ -751,12 +751,14 @@ If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) (substring handle 1 (length handle)) handle)) + (args `(("q" . ,handle))) (matching-account (seq-remove (lambda (x) (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json - (mastodon-http--api (format "accounts/search?q=%s" handle)))))) + (mastodon-http--api "accounts/search") + args)))) (when (equal 1 (length matching-account)) (elt matching-account 0)))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 31fcae3..fee79c4 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -61,7 +61,7 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query "following=true") + (mastodon-http--get-search-json url query '(("following" . "true"))) (mastodon-http--get-search-json url query)))) (mapcar #'mastodon-search--get-user-info-@ response))) @@ -72,7 +72,7 @@ Returns a nested list containing user handle, display name, and URL." QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (type-param (concat "type=hashtags")) + (type-param '(("type" . "hashtags"))) (response (mastodon-http--get-search-json url query type-param)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1cbce1..fd74ed5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -77,6 +77,7 @@ (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-http--build-query-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -1305,38 +1306,23 @@ LINK-HEADER is the http Link header if present." (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." - (let* ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "max_id=" - (mastodon-tl--as-string id))))) - (mastodon-http--get-json url))) + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) (defun mastodon-tl--more-json-async (endpoint id callback &rest cbargs) "Return JSON for timeline ENDPOINT before ID. Then run CALLBACK with arguments CBARGS." - (let* ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "max_id=" - (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url callback cbargs))) + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (apply 'mastodon-http--get-json-async url params callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local (defun mastodon-tl--updated-json (endpoint id) "Return JSON for timeline ENDPOINT since ID." - (let ((url (mastodon-http--api (concat - endpoint - (if (string-match-p "?" endpoint) - "&" - "?") - "since_id=" - (mastodon-tl--as-string id))))) + (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) (mastodon-http--get-json url))) (defun mastodon-tl--property (prop &optional backward) @@ -1417,8 +1403,9 @@ ID is that of the toot to view." ;; refetch current toot in case we just faved/boosted: (mastodon-http--get-json (mastodon-http--api (concat "statuses/" id)) + nil :silent)) - (context (mastodon-http--get-json url :silent)) + (context (mastodon-http--get-json url nil :silent)) (marker (make-marker))) (if (equal (caar toot) 'error) (message "Error: %s" (cdar toot)) @@ -1690,13 +1677,9 @@ If ID is provided, use that list." (account (completing-read "Account to remove: " handles nil t)) (account-id (alist-get account handles nil nil 'equal)) - ;; letting --delete handle the params doesn't work - ;; so we do it here for now: - (base-url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) - (query-str (mastodon-http--build-query-string args)) - (url (concat base-url "?" query-str)) - (response (mastodon-http--delete url))) + (response (mastodon-http--delete url args))) (mastodon-tl--list-action-triage response (message "%s removed from list %s!" account list-name)))) @@ -2535,14 +2518,14 @@ Optional arg NOTE-TYPE means only get that type of note." (mastodon-notifications--filter-types-list note-type))) (args (when note-type (mastodon-http--build-array-args-alist "exclude_types[]" exclude-types))) - (query-string (when note-type - (mastodon-http--build-query-string args))) + ;; (query-string (when note-type + ;; (mastodon-http--build-query-string args))) ;; add note-type exclusions to endpoint so it works in `mastodon-tl--buffer-spec' ;; that way `mastodon-tl--more' works seamlessly too: - (endpoint (if note-type (concat endpoint "?" query-string) endpoint)) + ;; (endpoint (if note-type (concat endpoint "?" query-string) endpoint)) (url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*")) - (json (mastodon-http--get-json url))) + (json (mastodon-http--get-json url args))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5a735dc..24c6c75 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -728,7 +728,7 @@ instance to edit a toot." (defun mastodon-toot--get-toot-source (id) "Fetch the source JSON of toot with ID." (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) - (mastodon-http--get-json url :silent))) + (mastodon-http--get-json url nil :silent))) (defun mastodon-toot--get-toot-edits (id) "Return the edit history of toot with ID." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d8591e1..cfe6681 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -291,7 +291,7 @@ not, just browse the URL in the normal fashion." (browse-url query) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (param (concat "resolve=t")) ; webfinger + (param '(("resolve" . "t"))) ; webfinger (response (mastodon-http--get-search-json url query param :silent))) (cond ((not (seq-empty-p (alist-get 'statuses response))) diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index bc70e49..18fc757 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -187,11 +187,11 @@ "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) - (mock (mastodon-profile--fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" nil)) + (mock (mastodon-profile--fetch-server-account-settings) + => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - (mastodon-notifications--get)))) + (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. -- cgit v1.2.3 From d47a5ebab961be106d1745cbb36037787edcbbba Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 20:56:19 +0100 Subject: fix joined date in profile-tests fix profile test joined date --- test/mastodon-profile-tests.el | 118 +++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 58 deletions(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 9d1ec72..bf0bc3f 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -227,64 +227,66 @@ 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" + "Joined March 2016" + "\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 8b45a7a83de0747029b6cd1d1cf7628afef0ad6c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 21 Nov 2022 23:33:28 +0100 Subject: fix some tests due to params --- lisp/mastodon-http.el | 2 +- lisp/mastodon-tl.el | 9 ++++----- lisp/mastodon-toot.el | 1 + test/mastodon-profile-tests.el | 11 ++++++++--- test/mastodon-tl-tests.el | 45 ++++++++++++++++++++++-------------------- 5 files changed, 38 insertions(+), 30 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 259432e..d56f3ad 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -333,8 +333,8 @@ PARAMS is an alist of any extra parameters to send with the request." "Make GET request to URL. Call CALLBACK with json-list and ARGS. PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async - params url + params (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-json) args))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index fd74ed5..d0c2b0b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1315,7 +1315,7 @@ LINK-HEADER is the http Link header if present." Then run CALLBACK with arguments CBARGS." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) (url (mastodon-http--api endpoint))) - (apply 'mastodon-http--get-json-async url params callback cbargs))) + (apply 'mastodon-http--get-json-async url args callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local @@ -1323,7 +1323,7 @@ Then run CALLBACK with arguments CBARGS." "Return JSON for timeline ENDPOINT since ID." (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) + (mastodon-http--get-json url args))) (defun mastodon-tl--property (prop &optional backward) "Get property PROP for toot at point. @@ -1873,8 +1873,7 @@ INSTANCE is an instance domain name." (response (mastodon-http--get-json (if user (mastodon-http--api "instance") - (concat instance - "/api/v1/instance")) + (concat instance "/api/v1/instance")) nil :vector))) (when response @@ -2462,7 +2461,7 @@ favourites." (mastodon-http--get-response-async url 'mastodon-tl--init* buffer endpoint update-function headers) (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function)))) + url nil 'mastodon-tl--init* buffer endpoint update-function)))) (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "Initialize BUFFER with timeline targeted by ENDPOINT. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 24c6c75..8ac75f9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -227,6 +227,7 @@ send.") NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") + nil 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 3e238f1..f65661e 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -172,7 +172,8 @@ The search will happen as if called without the \"@\"." (with-mock (mock (mastodon-http--get-json - "https://instance.url/api/v1/accounts/search?q=gargron")) + "https://instance.url/api/v1/accounts/search" + '(("q" . "gargron")))) (let ((mastodon-instance-url "https://instance.url")) ;; We don't check anything from the return value. We only care @@ -182,7 +183,9 @@ The search will happen as if called without the \"@\"." (ert-deftest mastodon-profile--search-account-by-handle--filters-out-false-results () "Should ignore results that don't match the searched handle." (with-mock - (mock (mastodon-http--get-json *) + (mock (mastodon-http--get-json + "https://instance.url/api/v1/accounts/search" + '(("q" . "Gargron"))) => (vector ccc-profile-json gargron-profile-json)) @@ -197,7 +200,9 @@ The search will happen as if called without the \"@\"." TODO: We need to decide if this is actually desired or not." (with-mock - (mock (mastodon-http--get-json *) => (vector gargron-profile-json)) + (mock (mastodon-http--get-json * + '(("q" . "gargron"))) + => (vector gargron-profile-json)) (let ((mastodon-instance-url "https://instance.url")) (should diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 19934dd..0ac5caf 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -175,27 +175,30 @@ Strict-Transport-Security: max-age=31536000 "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" 12345)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("max_id" . "12345")))) + (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--more-json-id-string () "Should request toots older than max_id. -`mastodon-tl--more-json' should accept and id that is either -a string or a numeric." + `mastodon-tl--more-json' should accept and id that is either + a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("max_id" . "12345")))) (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--update-json-id-string () "Should request toots more recent than since_id. -`mastodon-tl--updated-json' should accept and id that is either -a string or a numeric." + `mastodon-tl--updated-json' should accept and id that is either + a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo" + '(("since_id" . "12345")))) (mastodon-tl--updated-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--relative-time-description () @@ -314,7 +317,7 @@ a string or a numeric." byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -")) + ")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -337,7 +340,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-boosted () "Should format the boosted toot correctly." @@ -354,7 +357,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-favorited () "Should format the favourited toot correctly." @@ -371,7 +374,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -389,7 +392,7 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-reblogged () "Should format the reblogged toot correctly." @@ -413,9 +416,9 @@ a string or a numeric." (handle2-location 65)) (should (string= (substring-no-properties byline) "Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -")) + ")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) @@ -446,9 +449,9 @@ a string or a numeric." 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited () "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -470,9 +473,9 @@ a string or a numeric." 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) - Boosted Account 43 (@acct43@example.space) original time + Boosted Account 43 (@acct43@example.space) original time ------------ -"))))) + "))))) (ert-deftest mastodon-tl--byline-timestamp-has-relative-display () "Should display the timestamp with a relative time." @@ -808,8 +811,8 @@ a string or a numeric." (defun tl-tests--property-values-at (property ranges) "Returns a list with property values at the given ranges. -The property value for PROPERTY within a region is assumed to be -constant." + The property value for PROPERTY within a region is assumed to be + constant." (let (result) (dolist (range ranges (nreverse result)) (push (get-text-property (car range) property) result)))) -- cgit v1.2.3 From 2b07cf720d4766b39584bff0d82125335f73f824 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 10:01:26 +0100 Subject: fix --get-response-async re params --- lisp/mastodon-http.el | 3 ++- lisp/mastodon-tl.el | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d56f3ad..d1bf573 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -321,10 +321,11 @@ PARAMS is an alist of any extra parameters to send with the request." "GET" (url-retrieve url callback cbargs)))) -(defun mastodon-http--get-response-async (url callback &rest args) +(defun mastodon-http--get-response-async (url &optional params callback &rest args) "Make GET request to URL. Call CALLBACK with http response and ARGS." (mastodon-http--get-async url + params (lambda (status) (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-response) args))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d0c2b0b..8d4bba4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2459,7 +2459,7 @@ favourites." (buffer (concat "*mastodon-" buffer-name "*"))) (if headers (mastodon-http--get-response-async - url 'mastodon-tl--init* buffer endpoint update-function headers) + url nil 'mastodon-tl--init* buffer endpoint update-function headers) (mastodon-http--get-json-async url nil 'mastodon-tl--init* buffer endpoint update-function)))) -- cgit v1.2.3 From 4e483bd8862282991793409ca49fb6fa66bb8109 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 10:08:46 +0100 Subject: fix list-name grabbing in list add/delete/edit --- lisp/mastodon-tl.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1cbce1..f75398f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1493,7 +1493,7 @@ If ID is provided, use that list." (interactive) (let* ((list-names (unless id (mastodon-tl--get-lists-names))) (name-old (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Edit list: " list-names))) (id (or id (mastodon-tl--get-list-id name-old))) @@ -1648,7 +1648,7 @@ a: add account to this list, r: remove account from this list" If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Add account to list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) @@ -1678,7 +1678,7 @@ If ID is provided, use that list." If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-id) + (get-text-property (point) 'list-name) (completing-read "Remove account from list: " (mastodon-tl--get-lists-names) nil t))) (list-id (or id (mastodon-tl--get-list-id list-name))) -- cgit v1.2.3 From 348a917b8bafb2b6dafbdfa0a6945c6803b0d806 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:04:46 +0100 Subject: try setting mastodon-mode in view-instance buffers --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index f75398f..027b7e8 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1914,6 +1914,7 @@ INSTANCE is an instance domain name." (assoc 'rules response) (assoc 'stats response)))) (mastodon-tl--print-json-keys response) + (mastodon-mode) (goto-char (point-min))))))))) (defun mastodon-tl--format-key (el pad) -- cgit v1.2.3 From e069ff64f62d7324a7c65a9701657fe1c873b80d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:09:59 +0100 Subject: fix joined date in profile tests 2 --- test/mastodon-profile-tests.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index bf0bc3f..edfecce 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -265,12 +265,12 @@ content generation in the function under test." " ------------\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" + "Joined March 2016" + "\n\n" " ------------\n" " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" " ------------\n" "\n" - "Joined March 2016" - "\n\n" " ------------\n" " TOOTS \n" " ------------\n" -- cgit v1.2.3 From d84f6f5ef17320ef2312b4bb29e383014f36ee91 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:46:03 +0100 Subject: refactor mastodon-profile--format-joined-date-string --- lisp/mastodon-profile.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 512aae4..3a869ed 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -568,8 +568,7 @@ FIELDS means provide a fields vector fetched by other means." (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) (pinned (mastodon-profile--get-statuses-pinned account)) - (joined-ts (ts-parse - (mastodon-profile--account-field account 'created_at)))) + (joined (mastodon-profile--account-field account 'created_at))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) @@ -616,11 +615,7 @@ FIELDS means provide a fields vector fetched by other means." "\n") "") (propertize - (format "Joined %s" - (format "%s" (concat (ts-month-name joined-ts) - " " - (number-to-string - (ts-year joined-ts))))) + (mastodon-profile--format-joined-date-string joined) 'face 'success) "\n\n") 'profile-json account) @@ -657,6 +652,14 @@ FIELDS means provide a fields vector fetched by other means." (funcall update-function json))) (goto-char (point-min)))) +(defun mastodon-profile--format-joined-date-string (joined) + "Format a Joined timestamp." + (let ((joined-ts (ts-parse joined))) + (format "Joined %s" (concat (ts-month-name joined-ts) + " " + (number-to-string + (ts-year joined-ts)))))) + (defun mastodon-profile--get-toot-author () "Open profile of author of toot under point. -- cgit v1.2.3 From 9d1d2fc3746a87cf9e841da58a5c7641599650a0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:46:15 +0100 Subject: mock mastodon-profile--format-joined-date-string in profie test --- test/mastodon-profile-tests.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index edfecce..704f2ce 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -249,6 +249,8 @@ content generation in the function under test." (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-profile--format-joined-date-string *) => "Joined March 2016") + (let ((mastodon-tl--show-avatars t) (mastodon-tl--display-media-p t) (mastodon-instance-url "https://instance.url")) -- cgit v1.2.3 From 6d11b36f890be413c0126aa09566646d6a74d571 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 12:29:29 +0100 Subject: tl fix a -get-json call that :vector arg --- lisp/mastodon-tl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8d4bba4..0de925f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1874,7 +1874,8 @@ INSTANCE is an instance domain name." (if user (mastodon-http--api "instance") (concat instance "/api/v1/instance")) - nil + nil ; params + nil ; silent :vector))) (when response (let ((buf (get-buffer-create "*mastodon-instance*"))) -- cgit v1.2.3 From 09e38ba8b61c9a50e50453535d1e1f409a61a7ab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:04:46 +0100 Subject: try setting mastodon-mode in view-instance buffers --- lisp/mastodon-tl.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0de925f..15943ba 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1897,6 +1897,7 @@ INSTANCE is an instance domain name." (assoc 'rules response) (assoc 'stats response)))) (mastodon-tl--print-json-keys response) + (mastodon-mode) (goto-char (point-min))))))))) (defun mastodon-tl--format-key (el pad) -- cgit v1.2.3 From 2256d29650521deac96dad531c5e7384cb0304ff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:05:47 +0100 Subject: add mastodon-iso.el containing ISO language lists iso.el typo and provide --- lisp/mastodon-iso.el | 246 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 246 insertions(+) create mode 100644 lisp/mastodon-iso.el diff --git a/lisp/mastodon-iso.el b/lisp/mastodon-iso.el new file mode 100644 index 0000000..8baff3c --- /dev/null +++ b/lisp/mastodon-iso.el @@ -0,0 +1,246 @@ +;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Marty Hiatt +;; Author: Marty Hiatt +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1") (request "0.3.0")) +;; Homepage: https://codeberg.org/martianh/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see . + +;;; Commentary: + +;;; Code: + +;; via +;; https://github.com/VyrCossont/mastodon/blob/0836f4a656d5486784cadfd7d0cd717bb67ede4c/app/helpers/languages_helper.rb +;; and +;; https://github.com/Shinmera/language-codes/blob/master/data/iso-639-3.lisp + +(defvar mastodon-iso-639-1 + '(("ab" "Abkhazian") + ("aa" "Afar") + ("af" "Afrikaans") + ("ak" "Akan") + ("sq" "Albanian") + ("am" "Amharic") + ("ar" "Arabic") + ("an" "Aragonese") + ("hy" "Armenian") + ("as" "Assamese") + ("av" "Avaric") + ("ae" "Avestan") + ("ay" "Aymara") + ("az" "Azerbaijani") + ("bm" "Bambara") + ("ba" "Bashkir") + ("eu" "Basque") + ("be" "Belarusian") + ("bn" "Bengali") + ("bh" "Bihari languages") + ("bi" "Bislama") + ("bs" "Bosnian") + ("br" "Breton") + ("bg" "Bulgarian") + ("my" "Burmese") + ("km" "Central Khmer") + ("ch" "Chamorro") + ("ce" "Chechen") + ("zh" "Chinese") + ("cv" "Chuvash") + ("kw" "Cornish") + ("co" "Corsican") + ("cr" "Cree") + ("hr" "Croatian") + ("cs" "Czech") + ("da" "Danish") + ("dz" "Dzongkha") + ("en" "English") + ("eo" "Esperanto") + ("et" "Estonian") + ("ee" "Ewe") + ("fo" "Faroese") + ("fj" "Fijian") + ("fi" "Finnish") + ("nl" "Dutch" "Flemish") + ("fr" "French") + ("ff" "Fulah") + ("gl" "Galician") + ("lg" "Ganda") + ("ka" "Georgian") + ("de" "German") + ("el" "Greek") + ("gn" "Guarani") + ("gu" "Gujarati") + ("ht" "Haitian" "Haitian Creole") + ("ha" "Hausa") + ("he" "Hebrew") + ("hz" "Herero") + ("hi" "Hindi") + ("ho" "Hiri Motu") + ("hu" "Hungarian") + ("is" "Icelandic") + ("io" "Ido") + ("ig" "Igbo") + ("id" "Indonesian") + ("ia" "Interlingua" "Interlingua (International Auxiliary Language Association)") + ("iu" "Inuktitut") + ("ik" "Inupiaq") + ("ga" "Irish") + ("it" "Italian") + ("ja" "Japanese") + ("jp" "Japanese") + ("jv" "Javanese") + ("kl" "Kalaallisut" "Greenlandic") + ("kn" "Kannada") + ("kr" "Kanuri") + ("ks" "Kashmiri") + ("kk" "Kazakh") + ("ki" "Kikuyu" "Gikuyu") + ("rw" "Kinyarwanda") + ("kv" "Komi") + ("kg" "Kongo") + ("ko" "Korean") + ("ku" "Kurdish") + ("kj" "Kuanyama" "Kwanyama") + ("ky" "Kirghiz" "Kyrgyz") + ("lo" "Lao") + ("la" "Latin") + ("lv" "Latvian") + ("li" "Limburgan" "Limburger" "Limburgish") + ("ln" "Lingala") + ("lt" "Lithuanian") + ("lu" "Luba-Katanga") + ("lb" "Luxembourgish" "Letzeburgesch") + ("mk" "Macedonian") + ("mg" "Malagasy") + ("ms" "Malay") + ("ml" "Malayalam") + ("dv" "Divehi" "Dhivehi" "Maldivian") + ("mt" "Maltese") + ("gv" "Manx") + ("mi" "Maori") + ("mr" "Marathi") + ("mh" "Marshallese") + ("mn" "Mongolian") + ("na" "Nauru") + ("nv" "Navajo" "Navaho") + ("ng" "Ndonga") + ("ne" "Nepali") + ("nd" "Ndebele, North" "North Ndebele") + ("se" "Northern Sami") + ("no" "Norwegian") + ("nb" "Bokmål, Norwegian" "Norwegian Bokmål") + ("ny" "Chichewa" "Chewa" "Nyanja") + ("nn" "Norwegian Nynorsk" "Nynorsk, Norwegian") + ("ie" "Interlingue" "Occidental") + ("oc" "Occitan") + ("oj" "Ojibwa") + ("cu" "Church Slavic" "Old Slavonic" "Church Slavonic" "Old Bulgarian" "Old Church Slavonic") + ("or" "Oriya") + ("om" "Oromo") + ("os" "Ossetian" "Ossetic") + ("pi" "Pali") + ("fa" "Persian") + ("pl" "Polish") + ("pt" "Portuguese") + ("pa" "Panjabi" "Punjabi") + ("ps" "Pushto" "Pashto") + ("qu" "Quechua") + ("ro" "Romanian" "Moldavian" "Moldovan") + ("rm" "Romansh") + ("rn" "Rundi") + ("ru" "Russian") + ("sm" "Samoan") + ("sg" "Sango") + ("sa" "Sanskrit") + ("sc" "Sardinian") + ("gd" "Gaelic" "Scottish Gaelic") + ("sr" "Serbian") + ("sn" "Shona") + ("ii" "Sichuan Yi" "Nuosu") + ("sd" "Sindhi") + ("si" "Sinhala" "Sinhalese") + ("sk" "Slovak") + ("sl" "Slovenian") + ("so" "Somali") + ("st" "Sotho, Southern") + ("nr" "Ndebele, South" "South Ndebele") + ("es" "Spanish" "Castilian") + ("su" "Sundanese") + ("sw" "Swahili") + ("ss" "Swati") + ("sv" "Swedish") + ("tl" "Tagalog") + ("ty" "Tahitian") + ("tg" "Tajik") + ("ta" "Tamil") + ("tt" "Tatar") + ("te" "Telugu") + ("th" "Thai") + ("bo" "Tibetan") + ("ti" "Tigrinya") + ("to" "Tonga (Tonga Islands)") + ("ts" "Tsonga") + ("tn" "Tswana") + ("tr" "Turkish") + ("tk" "Turkmen") + ("tw" "Twi") + ("uk" "Ukrainian") + ("ur" "Urdu") + ("ug" "Uighur" "Uyghur") + ("uz" "Uzbek") + ("ca" "Catalan" "Valencian") + ("ve" "Venda") + ("vi" "Vietnamese") + ("vo" "Volapük") + ("wa" "Walloon") + ("cy" "Welsh") + ("fy" "Western Frisian") + ("wo" "Wolof") + ("xh" "Xhosa") + ("yi" "Yiddish") + ("yo" "Yoruba") + ("za" "Zhuang" "Chuang") + ("zu" "Zulu"))) + +;; web UI doesn't respect these for now +(defvar mastodon-iso-639-regional + '(("es-AR" "Español (Argentina)") + ("es-MX" "Español (México)") + ("pt-BR" "Português (Brasil)") + ("pt-PT" "Português (Portugal)") + ("sr-Latn" "Srpski (latinica)") + ("zh-CN" "简体中文") + ("zh-HK" "繁體中文（香港）") + ("zh-TW" "繁體中文（臺灣）"))) + +(defvar mastodon-iso-639-3 + '(("ast" "Asturian" "Asturianu") + ("ckb" "Sorani (Kurdish)" "سۆرانی") + ("jbo" "Lojban" "la .lojban.") + ("kab" "Kabyle" "Taqbaylit") + ("kmr" "Kurmanji (Kurdish)" "Kurmancî") + ("ldn" "Láadan" "Láadan") + ("lfn" "Lingua Franca Nova" "lingua franca nova") + ("tok" "Toki Pona" "toki pona") + ("zba" "Balaibalan" "باليبلن") + ("zgh" "Standard Moroccan Tamazight" "ⵜⴰⵎⴰⵣⵉⵖⵜ"))) + +(provide 'mastodon-iso) +;;; mastodon-iso.el ends here -- cgit v1.2.3 From 523efc5bc6630cdcd455513aa3640492c41ab6ef Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 11:09:59 +0100 Subject: fix joined date in profile tests 2 --- test/mastodon-profile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index bf0bc3f..f603203 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -268,7 +268,7 @@ content generation in the function under test." " ------------\n" " TOOTS: 70741 | FOLLOWERS: 470905 | FOLLOWING: 451\n" " ------------\n" - "\n" + "\n\n" "Joined March 2016" "\n\n" " ------------\n" -- cgit v1.2.3 From 12cc327e7361065fa2b280e670496250e5163834 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 13:27:16 +0100 Subject: choose language, return ISO code --- lisp/mastodon-toot.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5a735dc..b3d8860 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -47,6 +47,8 @@ (declare-function company-grab-symbol "company") (defvar company-backends)) +(require 'mastodon-iso) + (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--enable-proportional-fonts) @@ -1141,6 +1143,16 @@ LENGTH is the maximum character length allowed for a poll option." ("14 days" . ,(number-to-string (* 60 60 24 14))) ("30 days" . ,(number-to-string (* 60 60 24 30))))) +(defun mastodon-toot--prompt-toot-lang () + "Prompt for a language and return its two letter ISO 639 1 code." + (let* ((langs (mapcar (lambda (x) + (cons (cadr x) + (car x))) + mastodon-iso-639-1)) + (choice (completing-read "Language for this toot: " + langs))) + (alist-get choice langs nil nil 'equal))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -1329,7 +1341,6 @@ This is how mastodon does it." (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 ee65d8afcbd113c7a1104cf84b214fb87722b474 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:06:13 +0100 Subject: attempt to fix --get-search params --- lisp/mastodon-http.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d1bf573..c94ea7a 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -286,7 +286,8 @@ SILENT means don't message." (let* ((query-str (mastodon-http--build-query-string `(("q" . ,(url-hexify-string query))))) (params-str (mastodon-http--build-query-string params)) - (url (concat base-url "?" query-str params-str))) + (url (concat base-url "?" query-str (when params-str + (concat "&" params-str))))) (mastodon-http--url-retrieve-synchronously url silent)))) ;; profile update functions -- cgit v1.2.3 From 19051d7ada81e5abc56b42de838ab7b26c31bd9b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:34:59 +0100 Subject: remove redundant --get-search(-json) funs, use new params --get-json --- lisp/mastodon-http.el | 34 ---------------------------------- lisp/mastodon-search.el | 12 +++++++----- lisp/mastodon.el | 5 +++-- 3 files changed, 10 insertions(+), 41 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index c94ea7a..c1ab3fb 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -256,40 +256,6 @@ PARAMS should be an alist as required by `url-build-query-string'." (let ((query-string (url-build-query-string params))) (concat url "?" query-string))) -;; search functions: -(defun mastodon-http--process-json-search () - "Process JSON returned by a search query to the server." - (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) - (kill-buffer) - (json-read-from-string json-string))) - -(defun mastodon-http--get-search-json (url query &optional params silent) - "Make GET request to URL, searching for QUERY and return JSON response. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message." - (let ((buffer (mastodon-http--get-search url query params silent))) - (with-current-buffer buffer - (mastodon-http--process-json-search)))) - -(defun mastodon-http--get-search (base-url query &optional params silent) - "Make GET request to BASE-URL, searching for QUERY. -Pass response buffer to CALLBACK function. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message." - (mastodon-http--authorized-request - "GET" - (let* ((query-str (mastodon-http--build-query-string - `(("q" . ,(url-hexify-string query))))) - (params-str (mastodon-http--build-query-string params)) - (url (concat base-url "?" query-str (when params-str - (concat "&" params-str))))) - (mastodon-http--url-retrieve-synchronously url silent)))) - ;; profile update functions (defun mastodon-http--patch-json (url &optional params) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index fee79c4..f83cccb 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -61,8 +61,8 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query '(("following" . "true"))) - (mastodon-http--get-search-json url query)))) + (mastodon-http--get-json url `(("q" . ,query) ("following" . "true"))) + (mastodon-http--get-json url `(("q" . ,query)))))) (mapcar #'mastodon-search--get-user-info-@ response))) ;; functions for tags completion: @@ -72,8 +72,10 @@ Returns a nested list containing user handle, display name, and URL." QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (type-param '(("type" . "hashtags"))) - (response (mastodon-http--get-search-json url query type-param)) + ;; (type-param '(("type" . "hashtags"))) + (params `(("q" . ,query) + ("type" . "hashtags"))) + (response (mastodon-http--get-json url params)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) @@ -112,7 +114,7 @@ QUERY is the string to search." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) (buffer (format "*mastodon-search-%s*" query)) - (response (mastodon-http--get-search-json url query)) + (response (mastodon-http--get-json url `(("q" . ,query)))) (accts (alist-get 'accounts response)) (tags (alist-get 'hashtags response)) (statuses (alist-get 'statuses response)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index cfe6681..4097b27 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -291,8 +291,9 @@ not, just browse the URL in the normal fashion." (browse-url query) (message "Performing lookup...") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (param '(("resolve" . "t"))) ; webfinger - (response (mastodon-http--get-search-json url query param :silent))) + (params `(("q" . ,query) + ("resolve" . "t"))) ; webfinger + (response (mastodon-http--get-json url params :silent))) (cond ((not (seq-empty-p (alist-get 'statuses response))) (let* ((statuses (assoc 'statuses response)) -- cgit v1.2.3 From d0c7a2f330bb5ef22eb9956255e2fb4c171e7e59 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:36:24 +0100 Subject: rename build-query-string to -params-str, + build-array-params-alist --- lisp/mastodon-http.el | 28 ++++++++++++++-------------- lisp/mastodon-tl.el | 10 +++++----- lisp/mastodon-toot.el | 6 +++--- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index c1ab3fb..69a571d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -114,19 +114,19 @@ Unless UNAUTHENTICATED-P is non-nil." (concat "Bearer " (mastodon-auth--access-token))))))) ,body)) -(defun mastodon-http--build-query-string (args) - "Build a request query string from ARGS." +(defun mastodon-http--build-params-string (params) + "Build a request parameters string from parameters alist PARAMS." ;; (url-build-query-string args nil)) ;; url-build-query-string adds 'nil' to empty params so lets stay with our ;; own: - (mapconcat (lambda (arg) - (concat (url-hexify-string (car arg)) + (mapconcat (lambda (p) + (concat (url-hexify-string (car p)) "=" - (url-hexify-string (cdr arg)))) - args + (url-hexify-string (cdr p)))) + params "&")) -(defun mastodon-http--build-array-args-alist (param-str array) +(defun mastodon-http--build-array-params-alist (param-str array) "Return parameters alist using PARAM-STR and ARRAY param values. Used for API form data parameters that take an array." (cl-loop for x in array @@ -140,7 +140,7 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. "POST" (let ((url-request-data (when args - (mastodon-http--build-query-string args))) + (mastodon-http--build-params-string args))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -160,7 +160,7 @@ SILENT means don't message." ;; url-request-data doesn't seem to work with GET requests: (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--url-retrieve-synchronously url silent)))) @@ -228,7 +228,7 @@ PARAMS is an alist of any extra parameters to send with the request." (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--authorized-request "DELETE" @@ -241,7 +241,7 @@ PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args (mastodon-http--build-query-string params))) + (when args (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -271,7 +271,7 @@ Optionally specify the PARAMS to send." "PATCH" (let ((url (concat base-url "?" - (mastodon-http--build-query-string params)))) + (mastodon-http--build-params-string params)))) (mastodon-http--url-retrieve-synchronously url)))) ;; Asynchronous functions @@ -282,7 +282,7 @@ Pass response buffer to CALLBACK function with args CBARGS. PARAMS is an alist of any extra parameters to send with the request." (let ((url (if params (concat url "?" - (mastodon-http--build-query-string params)) + (mastodon-http--build-params-string params)) url))) (mastodon-http--authorized-request "GET" @@ -316,7 +316,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((request-timeout 5) (url-request-data (when args - (mastodon-http--build-query-string args)))) + (mastodon-http--build-params-string args)))) (with-temp-buffer (url-retrieve url callback cbargs))))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 15943ba..efb6612 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -74,8 +74,8 @@ (autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--build-array-args-alist "mastodon-http") -(autoload 'mastodon-http--build-query-string "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") (autoload 'mastodon-toot--get-toot-edits "mastodon-toot") @@ -1678,7 +1678,7 @@ If ID is provided, use that list." handles nil t)) (account-id (alist-get account handles nil nil 'equal)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (args (mastodon-http--build-array-args-alist "account_ids[]" `(,account-id))) + (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) (response (mastodon-http--delete url args))) (mastodon-tl--list-action-triage response @@ -2517,10 +2517,10 @@ Runs synchronously. Optional arg NOTE-TYPE means only get that type of note." (let* ((exclude-types (when note-type (mastodon-notifications--filter-types-list note-type))) - (args (when note-type (mastodon-http--build-array-args-alist + (args (when note-type (mastodon-http--build-array-params-alist "exclude_types[]" exclude-types))) ;; (query-string (when note-type - ;; (mastodon-http--build-query-string args))) + ;; (mastodon-http--build-params-string args))) ;; add note-type exclusions to endpoint so it works in `mastodon-tl--buffer-spec' ;; that way `mastodon-tl--more' works seamlessly too: ;; (endpoint (if note-type (concat endpoint "?" query-string) endpoint)) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8ac75f9..c870092 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -79,7 +79,7 @@ (autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") -(autoload 'mastodon-http--build-array-args-alist "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") @@ -631,7 +631,7 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append - (mastodon-http--build-array-args-alist + (mastodon-http--build-array-params-alist "poll[options][]" (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) @@ -664,7 +664,7 @@ instance to edit a toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-http--build-array-args-alist + (mastodon-http--build-array-params-alist "media_ids[]" mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll -- cgit v1.2.3 From feaa4d34a30da292e9a7f61187449252b4932171 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:49:11 +0100 Subject: speculatively fix byline tests --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index efb6612..0abf996 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -499,7 +499,7 @@ The result is added as an attachments property to author-byline." (let ((reblog (alist-get 'reblog toot))) (when reblog (concat - "\n " + "\n " (propertize "Boosted" 'face 'mastodon-boosted-face) " " (mastodon-tl--byline-author reblog))))) -- cgit v1.2.3 From 70aaeaebed48d07b6966c3633bea955f6b047828 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 15:49:59 +0100 Subject: if not when for edited-time in byline (for tests) --- lisp/mastodon-tl.el | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0abf996..35a9dfa 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -666,24 +666,25 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) - (when edited-time - (concat - (if (fontp (char-displayable-p #10r128274)) - " ✍ " - " [edited] ") - (propertize - (format-time-string mastodon-toot-timestamp-format - edited-parsed) - 'face 'font-lock-comment-face - 'timestamp edited-parsed - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description edited-parsed) - edited-parsed)))) - (propertize "\n ------------\n" 'face 'default)) + 'keymap mastodon-tl--shr-map-replacement))))) + (if edited-time + (concat + (if (fontp (char-displayable-p #10r128274)) + " ✍ " + " [edited] ") + (propertize + (format-time-string mastodon-toot-timestamp-format + edited-parsed) + 'face 'font-lock-comment-face + 'timestamp edited-parsed + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description edited-parsed) + edited-parsed))) + "") + (propertize "\n ------------\n " 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked -- cgit v1.2.3 From 54bf253a26c899a21dec819033b51831684a6eb5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:12:00 +0100 Subject: add missing nil params arg to tl--more --- lisp/mastodon-tl.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 35a9dfa..e4f2dc9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2259,9 +2259,9 @@ For use after e.g. deleting a toot." (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers) ;; link-header: can't build a URL with --more-json-async, endpoint/id: (let* ((next (car (mastodon-tl--link-header))) - ;(prev (cadr (mastodon-tl--link-header))) + ;;(prev (cadr (mastodon-tl--link-header))) (url (mastodon-tl--build-link-header-url next))) - (mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer) + (mastodon-http--get-response-async url nil 'mastodon-tl--more* (current-buffer) (point) :headers)) (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) 'mastodon-tl--more* (current-buffer) (point)))) -- cgit v1.2.3 From 77b8a2ea379e10ed8df316c116a72c476bb9af50 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:47:21 +0100 Subject: set toot language in compose buffer like the other settings, we just save to a buffer local variable then fetch it to send manual testing shows that delete and redraft preserves and repeats the setting. --- lisp/mastodon-toot.el | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b3d8860..18dba06 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -171,6 +171,9 @@ change the setting on the server, see (defvar-local mastodon-toot-poll nil "A list of poll options for the toot being composed.") +(defvar-local mastodon-toot--language nil + "The language of the toot being composed, in ISO 639 (two-letter).") + (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") @@ -213,6 +216,7 @@ send.") (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) (define-key map (kbd "C-c C-p") #'mastodon-toot--create-poll) + (define-key map (kbd "C-c C-l") #'mastodon-toot--set-toot-lang) map) "Keymap for `mastodon-toot'.") @@ -663,7 +667,8 @@ instance to edit a toot." ("visibility" . ,mastodon-toot--visibility) ("sensitive" . ,(when mastodon-toot--content-nsfw (symbol-name t))) - ("spoiler_text" . ,spoiler))) + ("spoiler_text" . ,spoiler) + ("language" . ,mastodon-toot--language))) (args-media (when mastodon-toot--media-attachments (mastodon-http--build-array-args-alist "media_ids[]" @@ -1143,15 +1148,17 @@ LENGTH is the maximum character length allowed for a poll option." ("14 days" . ,(number-to-string (* 60 60 24 14))) ("30 days" . ,(number-to-string (* 60 60 24 30))))) -(defun mastodon-toot--prompt-toot-lang () +(defun mastodon-toot--set-toot-lang () "Prompt for a language and return its two letter ISO 639 1 code." + (interactive) (let* ((langs (mapcar (lambda (x) (cons (cadr x) (car x))) mastodon-iso-639-1)) (choice (completing-read "Language for this toot: " langs))) - (alist-get choice langs nil nil 'equal))) + (setq mastodon-toot--language + (alist-get choice langs nil nil 'equal)))) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From 5df90da80741714a7b5b49c054564dcc6c221c8b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 16:54:42 +0100 Subject: copy-toot-url/text - handle fave/boost notifs --- lisp/mastodon-toot.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 18dba06..38f86b3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -385,9 +385,12 @@ TYPE is a symbol, either 'favourite or 'boost." (message (format "Nothing to %s here?!?" action))))) (defun mastodon-toot--copy-toot-url () - "Copy URL of toot at point." + "Copy URL of toot at point. +If the toot is a fave/boost notification, copy the URLof the +base toot." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) + (let* ((toot (or (mastodon-tl--property 'base-toot) + (mastodon-tl--property 'toot-json))) (url (if (mastodon-tl--field 'reblog toot) (alist-get 'url (alist-get 'reblog toot)) (alist-get 'url toot)))) @@ -395,9 +398,12 @@ TYPE is a symbol, either 'favourite or 'boost." (message "Toot URL copied to the clipboard."))) (defun mastodon-toot--copy-toot-text () - "Copy text of toot at point." + "Copy text of toot at point. +If the toot is a fave/boost notification, copy the text of the +base toot." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json))) + (let* ((toot (or (mastodon-tl--property 'base-toot) + (mastodon-tl--property 'toot-json)))) (kill-new (mastodon-tl--content toot)) (message "Toot content copied to the clipboard."))) -- cgit v1.2.3 From 0d94aba8baadcfa6337ed6b6a6a54caa3a0540a3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 17:24:52 +0100 Subject: only enable company-mode if corfu-mode is off they conflict and hang the buffer. see #314 --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 38f86b3..6162f52 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1475,7 +1475,8 @@ a draft into the buffer." (set (make-local-variable 'company-backends) (add-to-list 'company-backends 'mastodon-toot-mentions)) (add-to-list 'company-backends 'mastodon-toot-tags)) - (company-mode-on)) + (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode + (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From d3cda98308f5bdf604d3d69800454d827fe814e9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 18:57:50 +0100 Subject: a rough crack at handling company to capf conversion if cape/corfu --- lisp/mastodon-toot.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6162f52..92cbc53 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1469,14 +1469,24 @@ a draft into the buffer." ;; no need to fetch from `mastodon-profile-account-settings' as ;; `mastodon-toot--max-toot-chars' is set when we set it (mastodon-toot--get-max-toot-chars)) - ;; set up company backends: + ;; set up completion backends: (when (require 'company nil :noerror) (when mastodon-toot--enable-completion - (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) - (add-to-list 'company-backends 'mastodon-toot-tags)) - (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode - (company-mode-on))) + ;; convert our company backends into capfs for use with corfu: + ;; FIXME replace this with a customize + (if (and (require 'cape nil :noerror) + (bound-and-true-p corfu-mode)) + (dolist (company-backend (list #'mastodon-toot-tags #'mastodon-toot-mentions)) + (add-hook 'completion-at-point-functions + (cape-company-to-capf company-backend) + nil + 'local)) + ;; else stick with company: + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot-mentions)) + (add-to-list 'company-backends 'mastodon-toot-tags)) + (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode + (company-mode-on)))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From b3269374ada3255e7bf4a0e7ff0cfa4084083773 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 20:47:28 +0100 Subject: defvar mastodon-toot-tag-regex --- lisp/mastodon-toot.el | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 92cbc53..f195a87 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -204,6 +204,13 @@ send.") "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) +(defvar mastodon-toot-tag-regex + (concat + ;; preceding space or bol [boundary doesn't work with #] + "\\([\n\t ]\\|^\\)" + "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag + "\\b")) ; boundary + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -1415,13 +1422,12 @@ 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_]+\\)\\b" + (mastodon-toot--propertize-item mastodon-toot-tag-regex 'success (cdr header-region)) - (mastodon-toot--propertize-item - mastodon-toot-handle-regex - 'mastodon-display-name-face - (cdr header-region))))) + (mastodon-toot--propertize-item mastodon-toot-handle-regex + '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 04221419595887ad2ac84e4531310235986075e3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 20:48:21 +0100 Subject: a first go at capf completion backends for mentions and tags the regex searches still fail sometimes, and completions don't show urls or usernames like the old company backends. --- lisp/mastodon-search.el | 12 +++++-- lisp/mastodon-toot.el | 87 +++++++++++++++++++++++++++++++++++++------------ 2 files changed, 77 insertions(+), 22 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 31fcae3..fc7bd8e 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -49,13 +49,19 @@ ;; functions for company completion of mentions in mastodon-toot +(defun mastodon-search--get-user-info-@-capf (account) + "Get user handle, display name and account URL from ACCOUNT." + (list (concat "@" (cdr (assoc 'acct account))) + (cdr (assoc 'url account)) + (cdr (assoc 'display_name account)))) + (defun mastodon-search--get-user-info-@ (account) "Get user handle, display name and account URL from ACCOUNT." (list (cdr (assoc 'display_name account)) (concat "@" (cdr (assoc 'acct account))) (cdr (assoc 'url account)))) -(defun mastodon-search--search-accounts-query (query) +(defun mastodon-search--search-accounts-query (query &optional capf) "Prompt for a search QUERY and return accounts synchronously. Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") @@ -63,7 +69,9 @@ Returns a nested list containing user handle, display name, and URL." (response (if (equal mastodon-toot--completion-style-for-mentions "following") (mastodon-http--get-search-json url query "following=true") (mastodon-http--get-search-json url query)))) - (mapcar #'mastodon-search--get-user-info-@ response))) + (if capf + (mapcar #'mastodon-search--get-user-info-@-capf response) + (mapcar #'mastodon-search--get-user-info-@ response)))) ;; functions for tags completion: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f195a87..6ba3a75 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -108,13 +108,14 @@ (defcustom mastodon-toot--enable-completion (if (require 'company nil :noerror) t nil) "Whether to enable completion of mentions and hashtags. - Used for completion in toot compose buffer. - This is only used if company mode is installed." :group 'mastodon-toot :type 'boolean) +(defcustom mastodon-toot--use-company-for-completion t + "Whether to use company for completion.") + (defcustom mastodon-toot--completion-style-for-mentions (if (require 'company nil :noerror) "following" "off") "The company completion style to use for mentions." @@ -913,6 +914,56 @@ meta fields respectively." (annotation (funcall annot-fun arg)) (meta (funcall meta-fun arg))))) +(defun mastodon-toot-mentions-capf () + "Build a mentions completion backend for `completion-at-point-functions'." + (let* ((handle-bounds + ;; hack for @handles@with.domains, as "@" is not inc in any thing at pt! + (save-match-data + (save-excursion + ;; match full handle inc. domain (see the regex for subexp 2) + (when (re-search-backward mastodon-toot-handle-regex nil :no-error) + ;; (when (match-string-no-properties 2) + (cons (match-beginning 2) + (match-end 2)))))) + (start (car handle-bounds)) + (end (cdr handle-bounds))) + (when handle-bounds + (list start + end + ;; only search when necessary: + (completion-table-dynamic + (lambda (_) + (mastodon-search--search-accounts-query + (buffer-substring-no-properties start end) + :capf))) + :exclusive 'no)))) + +(defun mastodon-toot-tags-capf () + "Build a tags completion backend for `completion-at-point-functions'." + (let* ((tag-bounds + (save-match-data + (save-excursion + ;; match full tag with # (see regex for subexp) + (re-search-backward mastodon-toot-tag-regex nil :no-error) + (when (match-string-no-properties 2) + (cons (match-beginning 2) + (match-end 2)))))) + (start (car tag-bounds)) + (end (cdr tag-bounds))) + (when tag-bounds + (list start + end + ;; only search when necessary: + (completion-table-dynamic + (lambda (_) + (let ((tags (mastodon-search--search-tags-query + (buffer-substring-no-properties start end)))) + (mapcar (lambda (x) + (list (concat "#" (car x)) + (cdr x))) + tags)))) + :exclusive 'no)))) + (defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions. COMMAND is either prefix, to fetch a prefix query, candidates, to @@ -1475,24 +1526,20 @@ a draft into the buffer." ;; no need to fetch from `mastodon-profile-account-settings' as ;; `mastodon-toot--max-toot-chars' is set when we set it (mastodon-toot--get-max-toot-chars)) - ;; set up completion backends: - (when (require 'company nil :noerror) - (when mastodon-toot--enable-completion - ;; convert our company backends into capfs for use with corfu: - ;; FIXME replace this with a customize - (if (and (require 'cape nil :noerror) - (bound-and-true-p corfu-mode)) - (dolist (company-backend (list #'mastodon-toot-tags #'mastodon-toot-mentions)) - (add-hook 'completion-at-point-functions - (cape-company-to-capf company-backend) - nil - 'local)) - ;; else stick with company: - (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) - (add-to-list 'company-backends 'mastodon-toot-tags)) - (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode - (company-mode-on)))) + ;; set up completion: + (when mastodon-toot--enable-completion + ;; (setq-local + (set + (make-local-variable 'completion-at-point-functions) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot-mentions-capf)) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot-tags-capf) + (when mastodon-toot--use-company-for-completion + (company-mode-on))) + ;; after-change: (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From 468add918b8e1e790294cdc7ff5e34cf1bf862f6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 22 Nov 2022 21:44:43 +0100 Subject: silence the tags/handles searche queries --- lisp/mastodon-search.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index fc7bd8e..8530b5c 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -67,8 +67,8 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-search-json url query "following=true") - (mastodon-http--get-search-json url query)))) + (mastodon-http--get-search-json url query "following=true" :silent) + (mastodon-http--get-search-json url query nil :silent)))) (if capf (mapcar #'mastodon-search--get-user-info-@-capf response) (mapcar #'mastodon-search--get-user-info-@ response)))) @@ -81,7 +81,7 @@ QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) (type-param (concat "type=hashtags")) - (response (mastodon-http--get-search-json url query type-param)) + (response (mastodon-http--get-search-json url query type-param :silent)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) -- cgit v1.2.3 From 264230f58acd1dea38eae29c57b555a5b48d5b35 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 10:46:07 +0100 Subject: working capf completion --- lisp/mastodon-toot.el | 52 +++++++++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6ba3a75..5abe362 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -914,20 +914,24 @@ meta fields respectively." (annotation (funcall annot-fun arg)) (meta (funcall meta-fun arg))))) -(defun mastodon-toot-mentions-capf () +(defun mastodon-toot--get-bounds (regex) + "Get bounds of tag or handle before point." + ;; needed because # and @ are not part of any existing thing at point + (save-match-data + (save-excursion + ;; match full handle inc. domain, or tag including # + ;; (see the regexes for subexp 2) + (when (re-search-backward regex nil :no-error) + (cons (match-beginning 2) + (match-end 2)))))) + +(defun mastodon-toot--mentions-capf () "Build a mentions completion backend for `completion-at-point-functions'." - (let* ((handle-bounds - ;; hack for @handles@with.domains, as "@" is not inc in any thing at pt! - (save-match-data - (save-excursion - ;; match full handle inc. domain (see the regex for subexp 2) - (when (re-search-backward mastodon-toot-handle-regex nil :no-error) - ;; (when (match-string-no-properties 2) - (cons (match-beginning 2) - (match-end 2)))))) - (start (car handle-bounds)) - (end (cdr handle-bounds))) - (when handle-bounds + (let* ((bounds + (mastodon-toot--get-bounds mastodon-toot-handle-regex)) + (start (car bounds)) + (end (cdr bounds))) + (when bounds (list start end ;; only search when necessary: @@ -938,19 +942,13 @@ meta fields respectively." :capf))) :exclusive 'no)))) -(defun mastodon-toot-tags-capf () +(defun mastodon-toot--tags-capf () "Build a tags completion backend for `completion-at-point-functions'." - (let* ((tag-bounds - (save-match-data - (save-excursion - ;; match full tag with # (see regex for subexp) - (re-search-backward mastodon-toot-tag-regex nil :no-error) - (when (match-string-no-properties 2) - (cons (match-beginning 2) - (match-end 2)))))) - (start (car tag-bounds)) - (end (cdr tag-bounds))) - (when tag-bounds + (let* ((bounds + (mastodon-toot--get-bounds mastodon-toot-tag-regex)) + (start (car bounds)) + (end (cdr bounds))) + (when bounds (list start end ;; only search when necessary: @@ -1533,10 +1531,10 @@ a draft into the buffer." (make-local-variable 'completion-at-point-functions) (add-to-list 'completion-at-point-functions - #'mastodon-toot-mentions-capf)) + #'mastodon-toot--mentions-capf)) (add-to-list 'completion-at-point-functions - #'mastodon-toot-tags-capf) + #'mastodon-toot--tags-capf) (when mastodon-toot--use-company-for-completion (company-mode-on))) ;; after-change: -- cgit v1.2.3 From 2249680459ad9c46bfddb2c28c277b73ee9c4aa5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 10:49:16 +0100 Subject: disable company completion by default --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5abe362..96ff8fc 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -113,7 +113,7 @@ This is only used if company mode is installed." :group 'mastodon-toot :type 'boolean) -(defcustom mastodon-toot--use-company-for-completion t +(defcustom mastodon-toot--use-company-for-completion nil "Whether to use company for completion.") (defcustom mastodon-toot--completion-style-for-mentions -- cgit v1.2.3 From 9dd3db84b9164517239121188e58e188fe13b393 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 11:03:12 +0100 Subject: clean up compose-buffer capf control flow --- lisp/mastodon-toot.el | 39 ++++++++++++++++++++++++++++----------- 1 file changed, 28 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 96ff8fc..c13d43b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -114,7 +114,19 @@ This is only used if company mode is installed." :type 'boolean) (defcustom mastodon-toot--use-company-for-completion nil - "Whether to use company for completion.") + "Whether to use company completion backends directly. +When non-nil, company backends `mastodon-toot-mentions' and +`mastodon-toot-tags' are used for completion. + +A nil setting will use `completion-at-point-functions' for +completion, which also work with company, provided that the +backend `company-capf' is enabled. + +If setting this to non-nil, ensure `corfu-mode' is disabled as the +two are incompatible. + +When the `completion-at-point-functions' backends are more +complete, direct company backends will be removed.") (defcustom mastodon-toot--completion-style-for-mentions (if (require 'company nil :noerror) "following" "off") @@ -1526,16 +1538,21 @@ a draft into the buffer." (mastodon-toot--get-max-toot-chars)) ;; set up completion: (when mastodon-toot--enable-completion - ;; (setq-local - (set - (make-local-variable 'completion-at-point-functions) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--mentions-capf)) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--tags-capf) - (when mastodon-toot--use-company-for-completion + (if (not mastodon-toot--use-company-for-completion) + ;; capf + (progn + (set ; (setq-local + (make-local-variable 'completion-at-point-functions) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--mentions-capf)) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--tags-capf)) + ;; company + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot-mentions)) + (add-to-list 'company-backends 'mastodon-toot-tags) (company-mode-on))) ;; after-change: (make-local-variable 'after-change-functions) -- cgit v1.2.3 From 6aa934389c6644c84196f75ee51f294b5264ef6d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 12:21:40 +0100 Subject: add account to list from profile buffer --- lisp/mastodon-tl.el | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d8a5417..0928b1b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1643,9 +1643,10 @@ a: add account to this list, r: remove account from this list" (let ((id (get-text-property (point) 'list-id))) (mastodon-tl--add-account-to-list id))) -(defun mastodon-tl--add-account-to-list (&optional id) +(defun mastodon-tl--add-account-to-list (&optional id account-id handle) "Prompt for a list and for an account, add account to list. -If ID is provided, use that list." +If ID is provided, use that list. +If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (interactive) (let* ((list-name (if id (get-text-property (point) 'list-name) @@ -1657,9 +1658,9 @@ If ID is provided, use that list." (cons (alist-get 'acct x) (alist-get 'id x))) followings)) - (account (completing-read "Account to add: " - handles nil t)) - (account-id (alist-get account handles nil nil 'equal)) + (account (or handle (completing-read "Account to add: " + handles nil t))) + (account-id (or account-id (alist-get account handles nil nil 'equal))) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) @@ -1715,6 +1716,15 @@ If ID is provided, use that list." (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) +(defun mastodon-tl--add-profile-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; FILTERS (defun mastodon-tl--create-filter () -- cgit v1.2.3 From ebefa1141e0ebd2a2d217e4b5b00720d8c60530a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 12:51:36 +0100 Subject: move add account to list profile to profile.el, + readme --- README.org | 120 ++++++++++++++++++++++++----------------------- lisp/mastodon-profile.el | 11 +++++ lisp/mastodon-tl.el | 16 ++----- 3 files changed, 77 insertions(+), 70 deletions(-) diff --git a/README.org b/README.org index 8eb9242..a757706 100644 --- a/README.org +++ b/README.org @@ -107,65 +107,69 @@ take place if your =mastodon-token-file= does not contain =:client_id= and **** Keybindings -|---------------+-----------------------------------------------------------------------| -| Key | Action | -|---------------+-----------------------------------------------------------------------| -| | *Help* | -| =?= | Open context menu if =discover= is available | -|---------------+-----------------------------------------------------------------------| -| | *Timeline actions* | -| =n= | Go to next item (toot, notification) | -| =p= | Go to previous item (toot, notification) | -| =M-n=/== | Go to the next interesting thing that has an action | -| =M-p=/== | Go to the previous interesting thing that has an action | -| =F= | Open federated timeline | -| =H= | Open home timeline | -| =L= | Open local timeline | -| =N= | Open notifications timeline | -| =@= | Open mentions-only notifications timeline | -| =u= | Update current timeline | -| =T= | Open thread for toot under =point= | -| =#= | Prompt for tag and open its timeline | -| =A= | Open author profile of toot under =point= | -| =P= | Open profile of user attached to toot under =point= | -| =O= | View own profile | -| =U= | update your profile bio note | -|---------------+-----------------------------------------------------------------------| -| | *Other views* | -| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | -| =I=, =c=, =d= | view, create, and delete filters | -| =R=, =a=, =j= | view/accept/reject follow requests | -| =G= | view follow suggestions | -| =V= | view your favourited toots | -| =K= | view bookmarked toots | -| =X= | view/edit/create/delete lists | -|---------------+-----------------------------------------------------------------------| -| | *Toot actions* | -| =t= | Compose a new toot | -| =c= | Toggle content warning content | -| =b= | Boost toot under =point= | -| =f= | Favourite toot under =point= | -| =k= | toggle bookmark of toot at point | -| =r= | Reply to toot under =point= | -| =v= | Vote on poll at point | -| =C= | copy url of toot at point | -| =C-RET= | play video/gif at point (requires =mpv=) | -| =e= | edit your toot at point | -| =E= | view edits of toot at point | -| =i= | (un)pin your toot at point | -| =d= | delete your toot at point, and reload current timeline | -| =D= | delete and redraft toot at point, preserving reply/CW/visibility | +|----------------+-----------------------------------------------------------------------| +| Key | Action | +|----------------+-----------------------------------------------------------------------| +| | *Help* | +| =?= | Open context menu if =discover= is available | +|----------------+-----------------------------------------------------------------------| +| | *Timeline actions* | +| =n= | Go to next item (toot, notification) | +| =p= | Go to previous item (toot, notification) | +| =M-n=/== | Go to the next interesting thing that has an action | +| =M-p=/== | Go to the previous interesting thing that has an action | +| =F= | Open federated timeline | +| =H= | Open home timeline | +| =L= | Open local timeline | +| =N= | Open notifications timeline | +| =@= | Open mentions-only notifications timeline | +| =u= | Update current timeline | +| =T= | Open thread for toot under =point= | +| =#= | Prompt for tag and open its timeline | +| =A= | Open author profile of toot under =point= | +| =P= | Open profile of user attached to toot under =point= | +| =O= | View own profile | +| =U= | update your profile bio note | +|----------------+-----------------------------------------------------------------------| +| | *Other views* | +| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | +| =I=, =c=, =d= | view, create, and delete filters | +| =R=, =a=, =j= | view/accept/reject follow requests | +| =G= | view follow suggestions | +| =V= | view your favourited toots | +| =K= | view bookmarked toots | +| =X= | view/edit/create/delete lists | +|----------------+-----------------------------------------------------------------------| +| | *Toot actions* | +| =t= | Compose a new toot | +| =c= | Toggle content warning content | +| =b= | Boost toot under =point= | +| =f= | Favourite toot under =point= | +| =k= | toggle bookmark of toot at point | +| =r= | Reply to toot under =point= | +| =v= | Vote on poll at point | +| =C= | copy url of toot at point | +| =C-RET= | play video/gif at point (requires =mpv=) | +| =e= | edit your toot at point | +| =E= | view edits of toot at point | +| =i= | (un)pin your toot at point | +| =d= | delete your toot at point, and reload current timeline | +| =D= | delete and redraft toot at point, preserving reply/CW/visibility | | (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | -|---------------+-----------------------------------------------------------------------| -| | Notifications view | -| =a=, =j= | accept/reject follow request | -| =c= | clear notification at point | -| | see =mastodon-notifications--get-*= functions for filtered views | -|---------------+-----------------------------------------------------------------------| -| | *Quitting* | -| =q= | Quit mastodon buffer, leave window open | -| =Q= | Quit mastodon buffer and kill window | -|---------------+-----------------------------------------------------------------------| +|----------------+-----------------------------------------------------------------------| +| | *Profile view* | +| =C-c C-c= | cycle between statuses, followers, following, and statuses without boosts | +| | =mastodon-profile--account-account-to-list= (see lists view) | +|----------------+-----------------------------------------------------------------------| +| | *Notifications view* | +| =a=, =j= | accept/reject follow request | +| =c= | clear notification at point | +| | see =mastodon-notifications--get-*= functions for filtered views | +|----------------+-----------------------------------------------------------------------| +| | *Quitting* | +| =q= | Quit mastodon buffer, leave window open | +| =Q= | Quit mastodon buffer and kill window | +|----------------+-----------------------------------------------------------------------| **** Toot byline legend diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3a869ed..c604bcd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -69,6 +69,8 @@ (autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") +(autoload 'mastodon-tl--add-account-to-list "mastodon-tl") + (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) @@ -243,6 +245,15 @@ JSON is the data returned by the server." (mastodon-search--insert-users-propertized json :note))) ;; (mastodon-profile--add-author-bylines json))) +(defun mastodon-profile--add-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (when mastodon-profile--account + (let* ((profile mastodon-profile--account) + (id (alist-get 'id profile)) + (handle (alist-get 'acct profile))) + (mastodon-tl--add-account-to-list nil id handle)))) + ;;; ACCOUNT PREFERENCES (defun mastodon-profile--get-json-value (val) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 0928b1b..e3a2665 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -77,6 +77,7 @@ (autoload 'mastodon-http--build-array-args-alist "mastodon-http") (autoload 'mastodon-http--build-query-string "mastodon-http") (autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -665,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (when edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -1716,15 +1717,6 @@ If ID is provided, use that list." (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) (mastodon-http--get-json url))) -(defun mastodon-tl--add-profile-account-to-list () - "Add account of current profile buffer to a list." - (interactive) - (when mastodon-profile--account - (let* ((profile mastodon-profile--account) - (id (alist-get 'id profile)) - (handle (alist-get 'acct profile))) - (mastodon-tl--add-account-to-list nil id handle)))) - ;;; FILTERS (defun mastodon-tl--create-filter () -- cgit v1.2.3 From 81ecff802190fc1040e331630f6648765ea7320a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 23 Nov 2022 15:27:23 +0100 Subject: use unicode star if poss for faves. --return-fave-char --- lisp/mastodon-tl.el | 13 ++++++++++++- lisp/mastodon-toot.el | 4 +++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e3a2665..d829015 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -619,7 +619,8 @@ this just means displaying toot client." (concat (when boosted (mastodon-tl--format-faved-or-boosted-byline "B")) (when faved - (mastodon-tl--format-faved-or-boosted-byline "F")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-fave-char))) (when bookmarked (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) ;; we remove avatars from the byline also, so that they also do not mess @@ -692,6 +693,16 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--return-fave-char () + "" + (cond + ((fontp (char-displayable-p #10r11088)) + "⭐") + ((fontp (char-displayable-p #10r9733)) + "★") + (t + "F"))) + (defun mastodon-tl--format-edit-timestamp (timestamp) "Convert edit TIMESTAMP into a descriptive string." (let ((parsed (ts-human-duration diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6162f52..36d08fd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -332,7 +332,9 @@ TYPE is a symbol, either 'favourite or 'boost." (list 'boosted-p (not boosted)) (list 'favourited-p (not faved)))) (mastodon-toot--action-success - (if boost-p "B" "F") + (if boost-p + "B" + (mastodon-tl--return-fave-char)) byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) (message (format "Nothing to %s here?!?" action-string))))) -- cgit v1.2.3 From f5420dd98a335d434f3cdc2c8456504f25c6ac9d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 11:42:13 +0100 Subject: add annotation to completions (URL for tag, username for mention) this is still rough, uses a defvar-local which may be avoidable. --- lisp/mastodon-toot.el | 47 ++++++++++++++++++++++++++++++++++++----------- 1 file changed, 36 insertions(+), 11 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c13d43b..6855280 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -949,10 +949,17 @@ meta fields respectively." ;; only search when necessary: (completion-table-dynamic (lambda (_) - (mastodon-search--search-accounts-query - (buffer-substring-no-properties start end) - :capf))) - :exclusive 'no)))) + ;; TODO: do we really need to set a local var here + ;; just for the annotation-function? + (setq mastodon-toot-completions + (mastodon-search--search-accounts-query + (buffer-substring-no-properties start end) + :capf)))) + :exclusive 'no + :annotation-function + (lambda (candidate) + (concat " " + (mastodon-toot--mentions-annotation-fun candidate))))))) (defun mastodon-toot--tags-capf () "Build a tags completion backend for `completion-at-point-functions'." @@ -966,13 +973,31 @@ meta fields respectively." ;; only search when necessary: (completion-table-dynamic (lambda (_) - (let ((tags (mastodon-search--search-tags-query - (buffer-substring-no-properties start end)))) - (mapcar (lambda (x) - (list (concat "#" (car x)) - (cdr x))) - tags)))) - :exclusive 'no)))) + (setq mastodon-toot-completions + (let ((tags (mastodon-search--search-tags-query + (buffer-substring-no-properties start end)))) + (mapcar (lambda (x) + (list (concat "#" (car x)) + (cdr x))) + tags))))) + :exclusive 'no + :annotation-function + (lambda (candidate) + (concat " " + (mastodon-toot--tags-annotation-fun candidate))))))) + +(defvar-local mastodon-toot-completions nil + "The data of completion candidates for the current completion at point.") + +(defun mastodon-toot--mentions-annotation-fun (candidate) + "Given a handle completion CANDIDATE, return its annotation string, a username." + (caddr (assoc candidate mastodon-toot-completions))) + +(defun mastodon-toot--tags-annotation-fun (candidate) + "Given a tag string CANDIDATE, return an annotation, the tag's URL." + ;; FIXME check the list returned here? should be cadr + ;;or make it an alist and use cdr + (caadr (assoc candidate mastodon-toot-completions))) (defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions. -- cgit v1.2.3 From 1713abbe28c4a8ad684b651450b2c6e06a512c9a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 12:58:22 +0100 Subject: discover.el - remove (when (require and RET, both break it --- lisp/mastodon-discover.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 5d1a86e..5b8141b 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -57,8 +57,8 @@ ("p" "Prev" mastodon-tl--goto-prev-toot) ("TAB" "Next link item" mastodon-tl--next-tab-item) ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) - (when (require 'mpv nil :noerror) - ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point)) + ;; NB: (when (require 'mpv etc. calls don't work here + ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) ("C" "Copy toot URL" mastodon-toot--copy-toot-url) @@ -66,8 +66,7 @@ ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) - (when (require 'lingva nil :noerror) - "s" "Translate toot at point" mastodon-toot--translate-toot-text) + ("s" "Translate toot at point" mastodon-toot--translate-toot-text) ("T" "View thread" mastodon-tl--thread) ("v" "Vote on poll" mastodon-tl--poll-vote)) ("Views" @@ -94,7 +93,8 @@ ("B" "Block" mastodon-tl--block-user) ("C-S-B" "Unblock" mastodon-tl--unblock-user)) ("Images" - ("RET/i" "Load full image in browser" 'shr-browse-image) + ;; RET errors here also :/ + ("/i" "Load full image in browser" 'shr-browse-image) ("r" "rotate" 'image-rotate) ("+" "zoom in" 'image-increase-size) ("-" "zoom out" 'image-decrease-size) -- cgit v1.2.3 From dd54eccecd6c5360fc1d24828323d2e84e3a2e74 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 12:58:22 +0100 Subject: discover.el - remove (when (require and RET, both break it --- lisp/mastodon-discover.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index dc8a924..08df46e 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -57,8 +57,8 @@ ("p" "Prev" mastodon-tl--goto-prev-toot) ("TAB" "Next link item" mastodon-tl--next-tab-item) ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) - (when (require 'mpv nil :noerror) - ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point)) + ;; NB: (when (require 'mpv etc. calls don't work here + ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) ("C" "Copy toot URL" mastodon-toot--copy-toot-url) @@ -66,8 +66,7 @@ ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) - (when (require 'lingva nil :noerror) - "s" "Translate toot at point" mastodon-toot--translate-toot-text) + ("s" "Translate toot at point" mastodon-toot--translate-toot-text) ("T" "View thread" mastodon-tl--thread) ("v" "Vote on poll" mastodon-tl--poll-vote)) ("Views" @@ -94,7 +93,8 @@ ("B" "Block" mastodon-tl--block-user) ("C-S-B" "Unblock" mastodon-tl--unblock-user)) ("Images" - ("RET/i" "Load full image in browser" 'shr-browse-image) + ;; RET errors here also :/ + ("/i" "Load full image in browser" 'shr-browse-image) ("r" "rotate" 'image-rotate) ("+" "zoom in" 'image-increase-size) ("-" "zoom out" 'image-decrease-size) -- cgit v1.2.3 From 69c817d1a901f0aaa871f2679659f64fc438c40b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 13:34:08 +0100 Subject: readme read compatability --- README.org | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index a757706..bacab59 100644 --- a/README.org +++ b/README.org @@ -6,7 +6,7 @@ * README -=mastodon.el= is an Emacs client for the Mastodon and Pleroma social networks. For info see https://joinmastodon.org/. +=mastodon.el= is an Emacs client for the AcitivityPub social networks that implement the Mastodon API. For info see https://joinmastodon.org/. ** Installation @@ -317,6 +317,12 @@ Optional dependencies: - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots +** Network compatibility. + +=mastodon.el= should work with ActivityPub servers that implement the Mastodon API. + +Apart from Mastodon itself, it is currently known to work with Pleroma and Gotosocial. If you attempt to use =mastodon.el= with another server that implements the Mastodon API and run into problems, feel free to open an issue. + ** Contributing PRs, issues, feature requests, and general feedback are very welcome! -- cgit v1.2.3 From b2b8fe39b6863a1398bf7d50e9ee9bc3143d2fe2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 15:03:20 +0100 Subject: display icon for boosts will later follow rougier's lead on this, but just wanted to see how it looked --- lisp/mastodon-tl.el | 29 +++++++++++++++++++++-------- lisp/mastodon-toot.el | 2 +- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..e65d3a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -600,9 +600,6 @@ this just means displaying toot client." (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot))) (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot))) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) (visibility (mastodon-tl--field 'visibility toot)) (account (alist-get 'account toot)) (avatar-url (alist-get 'avatar account)) @@ -617,12 +614,14 @@ this just means displaying toot client." ;; displayed for an already boosted/favourited toot or as the result of ;; the toot having just been favourited/boosted. (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline "B")) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-boost-char))) (when faved (mastodon-tl--format-faved-or-boosted-byline (mastodon-tl--return-fave-char))) (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline bookmark-str))) + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--return-bookmark-char)))) ;; we remove avatars from the byline also, so that they also do not mess ;; with `mastodon-tl--goto-next-toot': (when (and mastodon-tl--show-avatars @@ -667,10 +666,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat (if (fontp (char-displayable-p #10r128274)) @@ -694,6 +693,14 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) +(defun mastodon-tl--return-boost-char () + "" + (cond + ((fontp (char-displayable-p #10r128257)) + "🔁") + (t + "B"))) + (defun mastodon-tl--return-fave-char () "" (cond @@ -704,6 +711,12 @@ this just means displaying toot client." (t "F"))) +(defun mastodon-tl--return-bookmark-char () + "" + (if (fontp (char-displayable-p #10r128278)) + "🔖" + "K")) + (defun mastodon-tl--format-edit-timestamp (timestamp) "Convert edit TIMESTAMP into a descriptive string." (let ((parsed (ts-human-duration diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4f9fb1b..7211183 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -334,7 +334,7 @@ TYPE is a symbol, either 'favourite or 'boost." (list 'favourited-p (not faved)))) (mastodon-toot--action-success (if boost-p - "B" + (mastodon-tl--return-boost-char) (mastodon-tl--return-fave-char)) byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) -- cgit v1.2.3 From 78f1100f5651e498468d42d9830daed924b1237b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 17:28:24 +0100 Subject: http: always use PARAMS or CBARGS, never ARGS anywhere --- lisp/mastodon-http.el | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 69a571d..d677e57 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -132,15 +132,15 @@ 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 &optional args headers unauthenticated-p) - "POST synchronously to URL, optionally with ARGS and HEADERS. +(defun mastodon-http--post (url &optional params headers unauthenticated-p) + "POST synchronously to URL, optionally with PARAMS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request "POST" (let ((url-request-data - (when args - (mastodon-http--build-params-string args))) + (when params + (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -237,11 +237,12 @@ PARAMS is an alist of any extra parameters to send with the request." (defun mastodon-http--put (url &optional params headers) "Make PUT request to URL. -PARAMS is an alist of any extra parameters to send with the request." +PARAMS is an alist of any extra parameters to send with the request. +HEADERS is an alist of any extra headers to send with the request." (mastodon-http--authorized-request "PUT" (let ((url-request-data - (when args (mastodon-http--build-params-string params))) + (when params (mastodon-http--build-params-string params))) (url-request-extra-headers (append url-request-extra-headers ; auth set in macro ;; pleroma compat: @@ -288,35 +289,36 @@ PARAMS is an alist of any extra parameters to send with the request." "GET" (url-retrieve url callback cbargs)))) -(defun mastodon-http--get-response-async (url &optional params callback &rest args) - "Make GET request to URL. Call CALLBACK with http response and ARGS." +(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with http response and CBARGS. +PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async url params (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-response) args))))) + (apply callback (mastodon-http--process-response) cbargs))))) -(defun mastodon-http--get-json-async (url &optional params callback &rest args) - "Make GET request to URL. Call CALLBACK with json-list and ARGS. +(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with json-list and CBARGS. PARAMS is an alist of any extra parameters to send with the request." (mastodon-http--get-async url params (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json) args))))) + (apply callback (mastodon-http--process-json) cbargs))))) -(defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) - "POST asynchronously to URL with ARGS and HEADERS. +(defun mastodon-http--post-async (url params headers &optional callback &rest cbargs) + "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (mastodon-http--authorized-request "POST" (let ((request-timeout 5) (url-request-data - (when args - (mastodon-http--build-params-string args)))) + (when params + (mastodon-http--build-params-string params)))) (with-temp-buffer (url-retrieve url callback cbargs))))) -- cgit v1.2.3 From e311d491977fb9012d30ed146231f95ea52008af Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 17:28:52 +0100 Subject: docstrings and autoloads --- lisp/mastodon-profile.el | 8 +++++--- lisp/mastodon-search.el | 3 +-- lisp/mastodon-toot.el | 1 + 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 69cd65d..d5ef7a8 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -154,7 +154,8 @@ contains") (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account &optional no-reblogs) - "Take an ACCOUNT json and insert a user account into a new buffer." + "Take an ACCOUNT json and insert a user account into a new buffer. +NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for account "statuses" #'mastodon-tl--timeline no-reblogs)) @@ -553,7 +554,8 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function &optional no-reblogs) - "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION." + "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. +NO-REBLOGS means do not display boosts in statuses." (let* ((id (mastodon-profile--account-field account 'id)) (args (when no-reblogs '(("exclude_reblogs" . "t")))) (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) @@ -664,7 +666,7 @@ FIELDS means provide a fields vector fetched by other means." (goto-char (point-min)))) (defun mastodon-profile--format-joined-date-string (joined) - "Format a Joined timestamp." + "Format a human-readable Joined string from timestamp JOINED." (let ((joined-ts (ts-parse joined))) (format "Joined %s" (concat (ts-month-name joined-ts) " " diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index f83cccb..b037faa 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -173,8 +173,7 @@ user's profile note. This is also called by json)) (defun mastodon-search--propertize-user (acct &optional note) - "Propertize display string for ACCT, optionally including profile -NOTE." + "Propertize display string for ACCT, optionally including profile NOTE." (let ((user (mastodon-search--get-user-info acct))) (propertize (concat (propertize (car user) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4f9fb1b..0e21b0e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -84,6 +84,7 @@ (autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-tl--get-endpoint "mastodon-tl") (autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-tl--return-fave-char "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") -- cgit v1.2.3 From a176e6b7668cbd93df6aaa9280da7145c80fcb86 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 24 Nov 2022 17:42:12 +0100 Subject: no blank lines in docstrings in profile.el --- lisp/mastodon-profile.el | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index d5ef7a8..fa9642e 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -113,7 +113,6 @@ (define-minor-mode mastodon-profile-mode "Toggle mastodon profile minor mode. - This minor mode is used for mastodon profile pages and adds a couple of extra keybindings." :init-value nil @@ -675,7 +674,6 @@ NO-REBLOGS means do not display boosts in statuses." (defun mastodon-profile--get-toot-author () "Open profile of author of toot under point. - If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer @@ -731,7 +729,6 @@ IMG_TYPE is the JSON key from the account data." (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. - FIELD is used to identify regions under 'account" (cdr (assoc field account))) @@ -762,7 +759,6 @@ Used to view a user's followers and those they're following." (defun mastodon-profile--search-account-by-handle (handle) "Return an account based on a user's HANDLE. - If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) (substring handle 1 (length handle)) @@ -785,15 +781,14 @@ If the handle does not match a search return then retun NIL." (defun mastodon-profile--extract-users-handles (status) "Return all user handles found in STATUS. - These include the author, author of reblogged entries and any user mentioned." (when status (let ((this-account (or (alist-get 'account status) ; status is a toot status)) ; status is a user listing - (mentions (or (alist-get 'mentions (alist-get 'status status)) + (mentions (or (alist-get 'mentions (alist-get 'status status)) (alist-get 'mentions status))) - (reblog (or (alist-get 'reblog (alist-get 'status status)) + (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter 'stringp -- cgit v1.2.3 From c9d799a80486f3604a5eb2b877c1faa54bf4c87d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 11:54:29 +0100 Subject: tl-tests: fix stray double space after separator --- test/mastodon-tl-tests.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 0ac5caf..f9b315c 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -340,7 +340,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-boosted () "Should format the boosted toot correctly." @@ -357,7 +357,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-favorited () "Should format the favourited toot correctly." @@ -374,7 +374,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -392,7 +392,7 @@ Strict-Transport-Security: max-age=31536000 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-reblogged () "Should format the reblogged toot correctly." @@ -451,7 +451,7 @@ Strict-Transport-Security: max-age=31536000 "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited () "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -475,7 +475,7 @@ Strict-Transport-Security: max-age=31536000 "(B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - "))))) +"))))) (ert-deftest mastodon-tl--byline-timestamp-has-relative-display () "Should display the timestamp with a relative time." -- cgit v1.2.3 From 143232e53d05bd42560d5ee9265bcb74245a29e2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:02:01 +0100 Subject: remove trailing double space from sparator tl-tests: remove trailing double spaces from separator again --- lisp/mastodon-tl.el | 2 +- test/mastodon-tl-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 46ec8fe..159c2cc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -685,7 +685,7 @@ this just means displaying toot client." (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n " 'face 'default)) + (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index f9b315c..a80c3ee 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -317,7 +317,7 @@ Strict-Transport-Security: max-age=31536000 byline) "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ - ")) +")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) @@ -418,7 +418,7 @@ Strict-Transport-Security: max-age=31536000 "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ - ")) +")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) -- cgit v1.2.3 From 83231a8e0dbce439e0d98a158291c7be9fb4525b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:03:03 +0100 Subject: tweak joined date newlines printing + test --- lisp/mastodon-profile.el | 9 ++++++--- test/mastodon-profile-tests.el | 3 ++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index fa9642e..3ba00b9 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -617,15 +617,18 @@ NO-REBLOGS means do not display boosts in statuses." " [locked]") "") "\n ------------\n" - (mastodon-tl--render-text note account) + ;; profile note: ;; account here to enable tab-stops in profile note + (mastodon-tl--render-text note account) + ;; meta fields: (if fields (concat "\n" (mastodon-tl--set-face (mastodon-profile--fields-insert fields) - 'success) - "\n") + 'success)) "") + "\n" + ;; Joined date: (propertize (mastodon-profile--format-joined-date-string joined) 'face 'success) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 7478aaf..d53e1f4 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -271,7 +271,8 @@ content generation in the function under test." "@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" + "_ Patreon __ :: https://www.patreon.com/mastodon_ Homepage _ :: https://zeonfederated.com" + "\n" "Joined March 2016" "\n\n" " ------------\n" -- cgit v1.2.3 From 97f409cf600278900ebf439d4efb87cb22e17182 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 12:14:33 +0100 Subject: profile-tests add nil call to get-json --- test/mastodon-profile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index d53e1f4..1ce9514 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -237,7 +237,7 @@ content generation in the function under test." (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") + (mock (mastodon-http--get-json "https://instance.url/api/v1/accounts/1/statuses" nil) => gargon-statuses-json) (mock (mastodon-profile--get-statuses-pinned *) -- cgit v1.2.3 From 383f31d06cbf8327507aabfa71d6d6fd85618873 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:37:33 +0100 Subject: caption + props for media urls as well as actual media adds fun mastodon-tl--propertize-img-str-or-url, to prop both. --- lisp/mastodon-media.el | 35 +++++++++++------------------ lisp/mastodon-tl.el | 60 +++++++++++++++++++++++++++++++++++++------------- 2 files changed, 58 insertions(+), 37 deletions(-) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9715a6c..c783130 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -35,6 +35,8 @@ ;;; Code: (require 'url-cache) +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") + (defvar url-show-status) (defvar mastodon-tl--shr-image-map-replacement) @@ -306,34 +308,23 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url + type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. TYPE is the attachment's type field on the server. CAPTION is the image caption if provided." (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") - (help-echo (if caption - (concat help-echo-base - "\n\"" - caption "\"") - help-echo-base))) + (help-echo (if caption + (concat help-echo-base + "\n\"" + caption "\"") + help-echo-base))) (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'mastodon-media-type type - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (if (or (string= type "image") - (string= type nil) - (string= type "unknown")) ;handle borked images - help-echo - (concat help-echo "\nC-RET: play " type " with mpv"))) - " "))) + (mastodon-tl--propertize-img-str-or-url + "[img]" media-url full-remote-url type help-echo + (create-image mastodon-media--generic-broken-image-data nil t)) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 159c2cc..b74ac84 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1019,26 +1019,56 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string (mapconcat - (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat "Media::" preview-url "\n")))) - media-attachements ""))) + (media-string + (mapconcat + (lambda (media-attachement) + (let ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) + preview-url remote-url type caption nil 'shr-link) + "\n")))) + media-attachements ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type + help-echo &optional display face) + "Propertize an media placeholder string \"[img]\" or media URL. + +STR is the string to propertize, MEDIA-URL is the preview link, +FULL-REMOTE-URL is the link to the full resolution image on the +server, TYPE is the media type. +HELP-ECHO, DISPLAY, and FACE are the text properties to add." + (propertize str + 'media-url media-url + 'media-state (when (string= str "[img]") 'needs-loading) + 'media-type 'media-link + 'mastodon-media-type type + 'display display + 'face face + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (or (string= type "image") + (string= type nil) + (string= type "unknown")) ;handle borked images + help-echo + (concat help-echo "\nC-RET: play " type " with mpv")))) + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." -- cgit v1.2.3 From 021ae971f25a96428927cf5b3d82980b5464d820 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 13:50:51 +0100 Subject: set 'display to the image caption if we have one --- lisp/mastodon-tl.el | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b74ac84..aac5761 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1022,21 +1022,29 @@ message is a link which unhides/hides the main body." (media-string (mapconcat (lambda (media-attachement) - (let ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement))) + (let* ((preview-url + (alist-get 'preview_url media-attachement)) + (remote-url + (or (alist-get 'remote_url media-attachement) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement)) + (display-str (if caption + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering preview-url remote-url type caption) ; 2nd arg for shr-browse-url (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) - preview-url remote-url type caption nil 'shr-link) + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p -- cgit v1.2.3 From 3717b6cb86c8d0037ca49d4f500a44560c9ac5ae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 16:19:19 +0100 Subject: refactor tl--media-attachment + customize to display caption not URL --- lisp/mastodon-tl.el | 70 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 29 deletions(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index aac5761..d907915 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -107,6 +107,13 @@ By default fixed width fonts are used." :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) +(defcustom mastodon-tl--display-caption-not-url-when-no-media t + "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." + :group 'mastodon-tl + :type 'boolean) + (defvar-local mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -1018,40 +1025,45 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." - (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) - (media-string - (mapconcat - (lambda (media-attachement) - (let* ((preview-url - (alist-get 'preview_url media-attachement)) - (remote-url - (or (alist-get 'remote_url media-attachement) - ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement)) - (caption (alist-get 'description media-attachement)) - (display-str (if caption - (concat "Media:: " caption) - (concat "Media:: " preview-url)))) - (if mastodon-tl--display-media-p - (mastodon-media--get-media-link-rendering - preview-url remote-url type caption) ; 2nd arg for shr-browse-url - (concat - (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " preview-url) ;; string - preview-url remote-url type caption - display-str ;; display - ;; FIXME: shr-link underlining is awful for captions with - ;; newlines, as the underlining runs to the edge of the - ;; frame even if the text doesn' - 'shr-link) - "\n")))) - media-attachements ""))) + (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) + (media-string (mapconcat #'mastodon-tl--media-attachment + media-attachments ""))) (if (not (and mastodon-tl--display-media-p (string-empty-p media-string))) (concat "\n" media-string) ""))) +(defun mastodon-tl--media-attachment (media-attachment) + "Return a propertized string for MEDIA-ATTACHMENT." + (let* ((preview-url + (alist-get 'preview_url media-attachment)) + (remote-url + (or (alist-get 'remote_url media-attachment) + ;; fallback b/c notifications don't have remote_url + (alist-get 'url media-attachment))) + (type (alist-get 'type media-attachment)) + (caption (alist-get 'description media-attachment)) + (display-str + (if (and mastodon-tl--display-caption-not-url-when-no-media + caption) + (concat "Media:: " caption) + (concat "Media:: " preview-url)))) + (if mastodon-tl--display-media-p + ;; return placeholder [img]: + (mastodon-media--get-media-link-rendering + preview-url remote-url type caption) ; 2nd arg for shr-browse-url + ;; return URL/caption: + (concat + (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " preview-url) ;; string + preview-url remote-url type caption + display-str ;; display + ;; FIXME: shr-link underlining is awful for captions with + ;; newlines, as the underlining runs to the edge of the + ;; frame even if the text doesn' + 'shr-link) + "\n")))) + (defun mastodon-tl--propertize-img-str-or-url (str media-url full-remote-url type help-echo &optional display face) "Propertize an media placeholder string \"[img]\" or media URL. -- cgit v1.2.3 From 9b0fdec55f6770d7c270e0a1e501ceb5e3ebcd95 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 16:33:43 +0100 Subject: remove all company backends, use company-capf + use-company custom --- lisp/mastodon-toot.el | 182 ++++++-------------------------------------------- 1 file changed, 21 insertions(+), 161 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8e6f4df..b12e7e1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -41,12 +41,6 @@ (require 'cl-lib) (require 'persist) -(when (require 'company nil :noerror) - (declare-function company-mode-on "company") - (declare-function company-begin-backend "company") - (declare-function company-grab-symbol "company") - (defvar company-backends)) - (require 'mastodon-iso) (defvar mastodon-instance-url) @@ -105,31 +99,24 @@ :group 'mastodon-toot :type 'integer) -(defcustom mastodon-toot--enable-completion - (if (require 'company nil :noerror) t nil) +(defcustom mastodon-toot--enable-completion t "Whether to enable completion of mentions and hashtags. -Used for completion in toot compose buffer. -This is only used if company mode is installed." +Used for completion in toot compose buffer." :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot--use-company-for-completion nil - "Whether to use company completion backends directly. -When non-nil, company backends `mastodon-toot-mentions' and -`mastodon-toot-tags' are used for completion. - -A nil setting will use `completion-at-point-functions' for -completion, which also work with company, provided that the -backend `company-capf' is enabled. + "Whether to enable company for completion. -If setting this to non-nil, ensure `corfu-mode' is disabled as the -two are incompatible. +When non-nil, `company-mode' is enabled in the toot compose +buffer, and mastodon completion backends are added to +`company-capf'. -When the `completion-at-point-functions' backends are more -complete, direct company backends will be removed.") +You need to install company yourself to use this." + :group 'mastodon-toot + :type 'boolean) -(defcustom mastodon-toot--completion-style-for-mentions - (if (require 'company nil :noerror) "following" "off") +(defcustom mastodon-toot--completion-style-for-mentions "all" "The company completion style to use for mentions." :group 'mastodon-toot :type '(choice @@ -837,98 +824,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (reverse (append mentions nil)) ""))) -(defun mastodon-toot--mentions-company-meta (candidate) - "Format company completion CANDIDATE's meta field." - (format " %s" - (get-text-property 0 'meta candidate))) - -(defun mastodon-toot--mentions-company-annotation (candidate) - "Format company completion CANDIDATE's annotation." - (format " %s" (get-text-property 0 'annot candidate))) - -(defun mastodon-toot--mentions-company-make-candidate (candidate) - "Construct a company completion CANDIDATE for display." - (let ((display-name (car candidate)) - (handle (cadr candidate)) - (url (caddr candidate))) - (propertize handle 'annot display-name 'meta url))) - -(defun mastodon-toot--tags-company-make-candidate (candidate) - "Construct a company completion CANDIDATE for display." - (let ((tag (concat "#" (car candidate))) - (url (cadr candidate))) - (propertize tag 'annot url 'meta url))) - -(defun mastodon-toot--company-build-candidates (query list-fun make-fun) - "Build a list of completion candidates for a company backend. -QUERY is the search prefix, LIST-FUN builds a list of items to -match against, and MAKE-FUN builds the actual cadidate list item -for display by company." - (let ((query (substring query 1)) ; remove @ or # for search - (res)) - (dolist (item (funcall list-fun query)) - (when (or (string-prefix-p query (substring (cadr item) 1) t) - (string-prefix-p query (car item) t)) - (push (funcall make-fun item) res))) - res)) - -(defun mastodon-toot--mentions-company-candidates (query) - "Given a company QUERY, build a list of candidates. -The query can match both user handles and display names." - (mastodon-toot--company-build-candidates - query - 'mastodon-search--search-accounts-query - 'mastodon-toot--mentions-company-make-candidate)) - -(defun mastodon-toot--tags-company-candidates (query) - "Given a company QUERY, build a list of candidates. -The query is matched against a tag search on the server." - (mastodon-toot--company-build-candidates - query - 'mastodon-search--search-tags-query - 'mastodon-toot--tags-company-make-candidate)) - -(defun mastodon-toot--make-company-backend - (command _backend-name str-prefix candidates-fun annot-fun meta-fun - &optional arg - &rest ignored) - "Make a company backend for `mastodon-toot-mode'. -COMMAND, ARG, IGNORED are all company backend args. -COMMAND is either prefix, to fetch a prefix query, candidates, to -build a list of candidates with query ARG, annotation, to format -an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery. - -BACKEND-NAME is the backend's name, STR-PREFIX is used to search -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)) - (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-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)) - "")))))) - (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--get-bounds (regex) "Get bounds of tag or handle before point." ;; needed because # and @ are not part of any existing thing at point @@ -1002,38 +897,6 @@ meta fields respectively." ;;or make it an alist and use cdr (caadr (assoc candidate mastodon-toot-completions))) -(defun mastodon-toot-mentions (command &optional arg &rest ignored) - "A company completion backend for toot mentions. -COMMAND is either prefix, to fetch a prefix query, candidates, to -build a list of candidates with query ARG, annotation, to format -an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery." - (mastodon-toot--make-company-backend - command - 'mastodon-toot-mentions - "@" - 'mastodon-toot--mentions-company-candidates - 'mastodon-toot--mentions-company-annotation - 'mastodon-toot--mentions-company-meta - arg - ignored)) - -(defun mastodon-toot-tags (command &optional arg &rest ignored) - "A company completion backend for toot tags. -COMMAND is either prefix, to fetch a prefix query, candidates, to -build a list of candidates with query ARG, annotation, to format -an annotation for candidate ARG, or meta, to format meta info for -candidate ARG. IGNORED remains a mystery." - (mastodon-toot--make-company-backend - command - 'mastodon-toot-tags - "#" - 'mastodon-toot--tags-company-candidates - 'mastodon-toot--mentions-company-annotation - 'mastodon-toot--mentions-company-meta - arg - ignored)) - (defun mastodon-toot--reply () "Reply to toot at `point'. Customize `mastodon-toot-display-orig-in-reply-buffer' to display @@ -1566,21 +1429,18 @@ a draft into the buffer." (mastodon-toot--get-max-toot-chars)) ;; set up completion: (when mastodon-toot--enable-completion - (if (not mastodon-toot--use-company-for-completion) - ;; capf - (progn - (set ; (setq-local - (make-local-variable 'completion-at-point-functions) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--mentions-capf)) - (add-to-list - 'completion-at-point-functions - #'mastodon-toot--tags-capf)) - ;; company + (set ; (setq-local + (make-local-variable 'completion-at-point-functions) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--mentions-capf)) + (add-to-list + 'completion-at-point-functions + #'mastodon-toot--tags-capf) + ;; company + (when mastodon-toot--use-company-for-completion (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot-mentions)) - (add-to-list 'company-backends 'mastodon-toot-tags) + (add-to-list 'company-backends 'company-capf)) (company-mode-on))) ;; after-change: (make-local-variable 'after-change-functions) -- cgit v1.2.3 From d1242bec43a65a8e7f53a53c1a38cbb4816533f3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:06:54 +0100 Subject: capf readme --- README.org | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/README.org b/README.org index bacab59..06473f4 100644 --- a/README.org +++ b/README.org @@ -189,9 +189,7 @@ Pops a new buffer/window in =mastodon-toot= minor mode. Enter the contents of your toot here. =C-c C-c= sends the toot. =C-c C-k= cancels. Both actions kill the buffer and window. -Autocompletion of mentions and tags is provided by mastodon company backends -(requires =company-mode= and =mastodon-toot--enable-completion= must be set to =t=) -. Type =@= or =#= followed by two or more characters for candidates to appear. +Autocompletion of mentions and tags is provided by =completion-at-point-functions= (capf) backends. =mastodon-toot--enable-completion= is enabled by default. If you want to enable =company-mode= in the toot compose buffer, set =mastodon-toot--use-company-for-completion= to =t=. (=mastodon.el= used to run its own native company backends, but these have been removed in favour of capfs.) Replies preserve visibility status/content warnings, and include boosters by default. @@ -312,7 +310,6 @@ Hard dependencies (should all install with =mastodon.el=): - =ts= for poll relative expiry times Optional dependencies: -- =company= for autocompletion of mentions and tags when composing a toot - =emojify= for inserting and viewing emojis - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots -- cgit v1.2.3 From 0e06be9ffae90962aa18e7d6bfb40e7007028705 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:08:00 +0100 Subject: readme toot lang --- README.org | 1 + 1 file changed, 1 insertion(+) diff --git a/README.org b/README.org index bacab59..c15159b 100644 --- a/README.org +++ b/README.org @@ -214,6 +214,7 @@ You can download and use your instance's custom emoji | =C-c != | Remove all attachments | | =C-c C-e= | Add emoji (if =emojify= installed) | | =C-c C-p= | Create a poll | +| =C-c C-l= | Set toot language | |---------+----------------------------------| **** draft toots -- cgit v1.2.3 From 28b73ab054b15de2cdc4943dea125431c1866a5b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:12:18 +0100 Subject: move mastodon-toot-completions to top of file --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1e364df..59a3813 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -188,6 +188,9 @@ Takes its form from `window-configuration-to-register'.") (defvar mastodon-toot--max-toot-chars nil "The maximum allowed characters count for a single toot.") +(defvar-local mastodon-toot-completions nil + "The data of completion candidates for the current completion at point.") + (defvar mastodon-toot-current-toot-text nil "The text of the toot being composed.") @@ -885,9 +888,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (concat " " (mastodon-toot--tags-annotation-fun candidate))))))) -(defvar-local mastodon-toot-completions nil - "The data of completion candidates for the current completion at point.") - (defun mastodon-toot--mentions-annotation-fun (candidate) "Given a handle completion CANDIDATE, return its annotation string, a username." (caddr (assoc candidate mastodon-toot-completions))) -- cgit v1.2.3 From b009c13325a57e53f6fcd8f71f9e88d492ea243d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:14:37 +0100 Subject: readme re completion style --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index b5c4a93..10627ff 100644 --- a/README.org +++ b/README.org @@ -263,7 +263,7 @@ See =M-x customize-group RET mastodon= to view all customize options. - Enable image caching - Compose options: - - Completion for mentions and tags + - Completion style for mentions and tags - Enable custom emoji - Display toot being replied to -- cgit v1.2.3 From eca8401b6ed04ed0f787efcd8517b022c55f9ed7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 17:25:03 +0100 Subject: comment remove company mention --- lisp/mastodon-search.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 9d8ee65..65c5aba 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -47,7 +47,7 @@ (defvar mastodon-toot--enable-completion-for-mentions) (defvar mastodon-tl--buffer-spec) -;; functions for company completion of mentions in mastodon-toot +;; functions for completion of mentions in mastodon-toot (defun mastodon-search--get-user-info-@-capf (account) "Get user handle, display name and account URL from ACCOUNT." -- cgit v1.2.3 From 91836e01b1598923c7a6a8e17fba74ff92d2587e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 25 Nov 2022 23:48:01 +0100 Subject: toot--set-toot-lang docstring --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 59a3813..27e7ce5 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1115,7 +1115,8 @@ LENGTH is the maximum character length allowed for a poll option." ("30 days" . ,(number-to-string (* 60 60 24 30))))) (defun mastodon-toot--set-toot-lang () - "Prompt for a language and return its two letter ISO 639 1 code." + "Prompt for a language and set `mastodon-toot--language'. +Return its two letter ISO 639 1 code." (interactive) (let* ((langs (mapcar (lambda (x) (cons (cadr x) -- cgit v1.2.3 From 0c889fd275b8338aed5f173f0a7df78e23801b92 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 09:34:20 +0100 Subject: paginate profile view followers/following with link header --- lisp/mastodon-profile.el | 36 ++++++++++++++++++++++++++---------- lisp/mastodon-tl.el | 23 +++++++++++++++-------- 2 files changed, 41 insertions(+), 18 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3ba00b9..658b1d4 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -71,6 +71,9 @@ (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") (autoload 'mastodon-tl--add-account-to-list "mastodon-tl") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) @@ -186,7 +189,9 @@ NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for mastodon-profile--account "following" - #'mastodon-profile--add-author-bylines) + #'mastodon-profile--add-author-bylines + nil + :headers) (error "Not in a mastodon profile"))) (defun mastodon-profile--open-followers () @@ -196,7 +201,9 @@ NO-REBLOGS means do not display boosts in statuses." (mastodon-profile--make-profile-buffer-for mastodon-profile--account "followers" - #'mastodon-profile--add-author-bylines) + #'mastodon-profile--add-author-bylines + nil + :headers) (error "Not in a mastodon profile"))) (defun mastodon-profile--view-favourites () @@ -552,16 +559,25 @@ FIELDS means provide a fields vector fetched by other means." (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function - &optional no-reblogs) + &optional no-reblogs headers) "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. -NO-REBLOGS means do not display boosts in statuses." +NO-REBLOGS means do not display boosts in statuses. +HEADERS means also fetch link headers for pagination." (let* ((id (mastodon-profile--account-field account 'id)) (args (when no-reblogs '(("exclude_reblogs" . "t")))) (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type))) (acct (mastodon-profile--account-field account 'acct)) (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) + (response (if headers + (mastodon-http--get-response url args) + (mastodon-http--get-json url args))) + (json (if headers (car response) response)) + (endpoint (format "accounts/%s/%s" id endpoint-type)) + (link-header (when headers + (mastodon-tl--get-link-header-from-response + (cdr response)))) + (note (mastodon-profile--account-field account 'note)) - (json (mastodon-http--get-json url args)) (locked (mastodon-profile--account-field account 'locked)) (followers-count (mastodon-tl--as-string (mastodon-profile--account-field @@ -585,11 +601,11 @@ NO-REBLOGS means do not display boosts in statuses." (switch-to-buffer buffer) (mastodon-mode) (mastodon-profile-mode) - (setq mastodon-profile--account account - mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "accounts/%s/%s" id endpoint-type) - update-function ,update-function)) + (setq mastodon-profile--account account) + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) (let* ((inhibit-read-only t) (is-statuses (string= endpoint-type "statuses")) (is-followers (string= endpoint-type "followers")) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1a726c4..a87cd73 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -136,10 +136,6 @@ If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--timestamp-update-timer nil "The timer that, when set will scan the buffer to update the timestamps.") -(defvar mastodon-tl--link-header-buffers - '("*mastodon-favourites*" "*mastodon-bookmarks*") - "A list of buffers that use link headers for pagination.") - ;; KEYMAPS (defvar mastodon-tl--link-keymap @@ -2327,11 +2323,22 @@ For use after e.g. deleting a toot." (param (cadr split))) (concat url-base "&" param))) +(defun mastodon-tl--use-link-header-p () + "Return t if we are in a view that uses Link header pagination. +Currently this includes favourites, bookmarks, and profile pages +when showing followers or accounts followed." + (let ((buf (buffer-name (current-buffer))) + (endpoint (mastodon-tl--get-endpoint))) + (or (member buf '("*mastodon-favourites*" "*mastodon-bookmarks*")) + (and (string-prefix-p "accounts" endpoint) + (or (string-suffix-p "followers" endpoint) + (string-suffix-p "following" endpoint)))))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) (message "Loading older toots...") - (if (member (buffer-name (current-buffer)) mastodon-tl--link-header-buffers) + (if (mastodon-tl--use-link-header-p) ;; link-header: can't build a URL with --more-json-async, endpoint/id: (let* ((next (car (mastodon-tl--link-header))) ;;(prev (cadr (mastodon-tl--link-header))) @@ -2532,7 +2539,7 @@ from the start if it is nil." "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots. HEADERS means to also collect the response headers. Used for paginating -favourites." +favourites and bookmarks." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (if headers @@ -2545,8 +2552,8 @@ favourites." "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by -`mastodon-http--process-json', a cons cell of JSON and http -headers." +`mastodon-http--process-json', with arg HEADERS a cons cell of +JSON and http headers, without it just the JSON." (let* ((json (if headers (car response) response)) (headers (if headers (cdr response) nil)) (link-header (mastodon-tl--get-link-header-from-response headers))) -- cgit v1.2.3 From 55c91270734da9e6a11060b3bea7aad152d40680 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 26 Nov 2022 10:09:39 +0100 Subject: readme fill paras --- README.org | 62 ++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 42 insertions(+), 20 deletions(-) diff --git a/README.org b/README.org index 10627ff..b02db2a 100644 --- a/README.org +++ b/README.org @@ -6,7 +6,8 @@ * README -=mastodon.el= is an Emacs client for the AcitivityPub social networks that implement the Mastodon API. For info see https://joinmastodon.org/. +=mastodon.el= is an Emacs client for the AcitivityPub social networks that +implement the Mastodon API. For info see https://joinmastodon.org/. ** Installation @@ -25,7 +26,8 @@ Or, with =use-package=: :ensure t) #+END_SRC -The minimum Emacs version is now 27.1. But if you are running an older version it shouldn't be very hard to get it working. +The minimum Emacs version is now 27.1. But if you are running an older version +it shouldn't be very hard to get it working. *** MELPA @@ -100,10 +102,10 @@ restart Emacs and follow the steps again. =M-x mastodon= -Opens a =*mastodon-home*= buffer in the major mode and displays toots. If your credentials are not yet saved, you -will be prompted for email and password. The app registration process will -take place if your =mastodon-token-file= does not contain =:client_id= and -=:client_secret=. +Opens a =*mastodon-home*= buffer in the major mode and displays toots. If your +credentials are not yet saved, you will be prompted for email and password. +The app registration process will take place if your =mastodon-token-file= does +not contain =:client_id= and =:client_secret=. **** Keybindings @@ -225,15 +227,19 @@ You can download and use your instance's custom emoji *** Other commands and account settings: -In addition to =mastodon=, the following functions are autoloaded and should work without first loading =mastodon.el=: +In addition to =mastodon=, the following functions are autoloaded and should +work without first loading =mastodon.el=: - =mastodon-toot=: Compose new toot - =mastodon-notifications-get=: View all notifications -- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at point or provided in the minibuffer. +- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at + point or provided in the minibuffer. -- =mastodon-tl--view-instance-description=: View information about the instance that the author of the toot at point is on. +- =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-search--trending-tags=: View a list of trending hashtags on your + instance. - =mastodon-tl--follow-tag=: Follow a tag (works like following a user) @@ -241,14 +247,21 @@ In addition to =mastodon=, the following functions are autoloaded and should wor - =mastodon-tl--list-followed-tags=: View a list of tags you're following. -- =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--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--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. *** Customization @@ -319,7 +332,9 @@ Optional dependencies: =mastodon.el= should work with ActivityPub servers that implement the Mastodon API. -Apart from Mastodon itself, it is currently known to work with Pleroma and Gotosocial. If you attempt to use =mastodon.el= with another server that implements the Mastodon API and run into problems, feel free to open an issue. +Apart from Mastodon itself, it is currently known to work with Pleroma and +Gotosocial. If you attempt to use =mastodon.el= with another server that +implements the Mastodon API and run into problems, feel free to open an issue. ** Contributing @@ -329,8 +344,12 @@ PRs, issues, feature requests, and general feedback are very welcome! 1. =mastodon.el= has bugs, as well as lots of room for improvement. 2. I receive very little feedback, so if I don't run into the bug it often doesn't get fixed. -3. If you run into something that seems broken, first try running =mastodon.el= in emacs with no init file (i.e. =emacs -q= (instructions and code for doing this are [[https://codeberg.org/martianh/mastodon.el/issues/300][here]]) to see if it also happens independently of your own config (it probably does). -4. Enable debug on error (=toggle-debug-on-error=), make the bug happen again, and copy the backtrace that appears. +3. If you run into something that seems broken, first try running =mastodon.el= + in emacs with no init file (i.e. =emacs -q= (instructions and code for doing + this are [[https://codeberg.org/martianh/mastodon.el/issues/300][here]]) to see if it also happens independently of your own config + (it probably does). +4. Enable debug on error (=toggle-debug-on-error=), make the bug happen again, + and copy the backtrace that appears. 5. Open an issue here and explain what is going on. *** Features @@ -349,7 +368,10 @@ PRs, issues, feature requests, and general feedback are very welcome! ** Supporting mastodon.el -If you'd like to support continued development of =mastodon.el=, I accept donations via paypal at martianhiatus [ at ] riseup [ dot ] net. If you would prefer a different payment method, write to me at that address and I can provide IBAN or other details. +If you'd like to support continued development of =mastodon.el=, I accept +donations via paypal at martianhiatus [ at ] riseup [ dot ] net. If you would +prefer a different payment method, write to me at that address and I can +provide IBAN or other details. I don't have a tech worker's income, so even a small tip would help out. -- cgit v1.2.3