From 411d57853a026d08493b93b674e2a8b7d7a7bae3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:35:00 +0100 Subject: convert :json-false to nil in account settings handling :json-false isn't nil, so doesn't work as we want --- lisp/mastodon-profile.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index cfb3bdb..4aa9310 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -228,7 +228,9 @@ JSON is the data returned by the server." "Fetch current VAL ue from account." (let* ((url (mastodon-http--api "accounts/verify_credentials")) (response (mastodon-http--get-json url))) - (alist-get val response))) + (if (eq (alist-get val response) ':json-false) + nil + (alist-get val response)))) (defun mastodon-profile--get-source-values () "Return the \"source\" preferences from the server." @@ -237,7 +239,9 @@ JSON is the data returned by the server." (defun mastodon-profile--get-source-value (pref) "Return account PREF erence from the \"source\" section on the server." (let ((source (mastodon-profile--get-source-values))) - (alist-get pref source))) + (if (eq (alist-get pref source) ':json-false) + nil + (alist-get pref source)))) (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." @@ -348,7 +352,7 @@ Current settings are fetched from the server." (mastodon-profile--get-source-value key) (mastodon-profile--get-json-value key))) (prompt (format "Account setting %s is %s. Toggle?" key val))) - (if (not (equal val :json-false)) + (if val (when (y-or-n-p prompt) (mastodon-profile--update-preference (symbol-name key) "false" source)) (when (y-or-n-p prompt) -- cgit v1.2.3 From 996cc9ad7773f7e8d2fc592b69e7d3d3ad2c40de Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:42:40 +0100 Subject: toot--kill: fix delete after change funs fun name --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9d2d02d..bcb4af1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -474,7 +474,7 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." (cl-pushnew mastodon-toot-current-toot-text mastodon-toot-draft-toots-list :test 'equal))) ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot-save-toot-text after-change-functions) + (delete #'mastodon-toot--save-toot-text after-change-functions) (kill-buffer-and-window)) (defun mastodon-toot--cancel () -- cgit v1.2.3 From 45a986444101db52dca599f90da7ed063b09d9e8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:47:03 +0100 Subject: flycheck requires / thingatpt fun --- lisp/mastodon.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bc624d9..a5ba9e4 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -37,6 +37,8 @@ (require 'mastodon-http) (require 'mastodon-toot) (require 'url) +(require 'thingatpt) +(require 'shr) (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") @@ -279,7 +281,7 @@ If a status or account is found, load it in `mastodon.el', if not, just browse the URL in the normal fashion." (interactive) (let* ((query (or query-url - (url-get-url-at-point) + (thing-at-point-url-at-point) (get-text-property (point) 'shr-url) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) -- cgit v1.2.3 From 554dc37b36de840d60d66caf5539c90c02ac2f91 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 12:48:32 +0100 Subject: http.el docstrings --- lisp/mastodon-http.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index f32ccd4..eebfa85 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -74,7 +74,8 @@ This is a thin abstraction over the system `url-retrieve-synchronously'. Depending on which version of this -is available we will call it with or without a timeout." +is available we will call it with or without a timeout. +SILENT means don't message." (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) @@ -141,14 +142,15 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (defun mastodon-http--get (url &optional silent) "Make synchronous GET request to URL. - -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function. +SILENT means don't message." (mastodon-http--authorized-request "GET" (mastodon-http--url-retrieve-synchronously url silent))) (defun mastodon-http--get-json (url &optional silent) - "Make synchronous GET request to URL. Return JSON response." + "Make synchronous GET request to URL. Return JSON response. +SILENT means don't message." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-json))) @@ -187,7 +189,8 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--get-search-json (url query &optional param silent) "Make GET request to URL, searching for QUERY and return JSON response. -PARAM is any extra parameters to send with the request." +PARAM is any extra parameters to send with the request. +SILENT means don't message." (let ((buffer (mastodon-http--get-search url query param silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) @@ -195,7 +198,8 @@ PARAM is any extra parameters to send with the request." (defun mastodon-http--get-search (base-url query &optional param 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'." +PARAM is a formatted request parameter, eg 'following=true'. +SILENT means don't message." (mastodon-http--authorized-request "GET" (let ((url (if param -- cgit v1.2.3 From dde052a436b0c8fddf3a026fbcdfaaa74063029a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 21:44:06 +0100 Subject: Revert "remove unused --append-query-string" This reverts commit e2fd67b16104ab772a4ef962613cb9f3cb3cea52. --- lisp/mastodon-http.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index eebfa85..e3efabe 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -175,6 +175,13 @@ SILENT means don't message." (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))) + ;; search functions: (defun mastodon-http--process-json-search () "Process JSON returned by a search query to the server." -- cgit v1.2.3 From 4de094ccce07042f68596ac9dd436c453248dd6a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 22:09:02 +0100 Subject: display profile header image [rough start] plant header image to right of avatar --- lisp/mastodon-profile.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 4aa9310..2e4807c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -556,7 +556,8 @@ FIELDS means provide a fields vector fetched by other means." (propertize (concat "\n" - (mastodon-profile--image-from-account account) + (mastodon-profile--image-from-account account 'avatar_static) + (mastodon-profile--image-from-account account 'header_static) "\n" (propertize (mastodon-profile--account-field account 'display_name) @@ -621,11 +622,12 @@ If toot is a boost, opens the profile of the booster." (mastodon-profile--make-author-buffer (alist-get 'account (mastodon-profile--toot-json)))) -(defun mastodon-profile--image-from-account (status) - "Generate an image from a STATUS." - (let ((url (alist-get 'avatar_static status))) - (unless (equal url "/avatars/original/missing.png") - (mastodon-media--get-media-link-rendering url)))) +(defun mastodon-profile--image-from-account (account img_type) + "Return a avatar image from ACCOUNT. +IMG_TYPE is the JSON key from the account data." + (let ((img (alist-get img_type account))) + (unless (equal img "/avatars/original/missing.png") + (mastodon-media--get-media-link-rendering img)))) (defun mastodon-profile--show-user (user-handle) "Query for USER-HANDLE from current status and show that user's profile." -- cgit v1.2.3 From 0b53ae93426b09c44299f5158da66e9e24a94308 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 23:37:53 +0100 Subject: basic poll create funs --- lisp/mastodon-toot.el | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bcb4af1..a17fabb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -162,6 +162,9 @@ change the setting on the server, see (defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") +(defvar-local mastodon-toot-poll-options nil + "A list of poll options for the toot being composed.") + (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") @@ -188,6 +191,7 @@ send.") (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) (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) map) "Keymap for `mastodon-toot'.") @@ -615,7 +619,17 @@ If media items have been attached and uploaded with (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) - (args (append args-media args-no-media))) + (args-poll (when mastodon-toot-poll-options + (append + (mastodon-toot--make-poll-params + mastodon-toot-poll-options) + `(("poll[expires_in]" . ,mastodon-toot-poll-expiry))))) + ;; media || polls: + (args (if mastodon-toot--media-attachments + (append args-media args-no-media) + (if mastodon-toot-poll-options + (append args-no-media args-poll) + args-no-media)))) (cond ((and mastodon-toot--media-attachments ;; make sure we have media args ;; and the same num of ids as attachments @@ -920,6 +934,27 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) +(defun mastodon-toot--make-poll-params (options) + "Returns an parameter query alist from poll OPTIONS." + (let ((key "poll[options][]")) + (cl-loop for o in options + collect `(,key . ,o)))) + +(defun mastodon-toot--create-poll () + "Prompt for new poll options and return as a list." + (interactive) + (let ((length (read-number "Number of poll options [2-4]: " 2))) + (setq mastodon-toot-poll-options + (cl-loop for x from 1 to length + collect (read-string (format "Poll option [%s/%s]: " x length)))) + (mastodon-toot--get-poll-expiry))) + +(defun mastodon-toot--get-poll-expiry () + "Prompt for a poll expiry time." + ;; API requires this in seconds + (setq mastodon-toot-poll-expiry + (read-string "poll ends in [seconds, min 5 mins]: "))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () -- cgit v1.2.3 From 26df74a1cdc4ef469d8d58006dd65bf7387bf04e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 4 Nov 2022 12:33:12 +0100 Subject: basic poll creation, with all options polls docstrings etc cleanup --- lisp/mastodon-toot.el | 45 ++++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a17fabb..44386f7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -162,7 +162,7 @@ change the setting on the server, see (defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") -(defvar-local mastodon-toot-poll-options nil +(defvar-local mastodon-toot-poll nil "A list of poll options for the toot being composed.") (defvar-local mastodon-toot--reply-to-id nil @@ -599,6 +599,15 @@ to `emojify-user-emojis', and the emoji data is updated." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) +(defun mastodon-toot--build-poll-params () + "Return an alist of parameters for POSTing a poll status." + (append + (mastodon-toot--make-poll-params + (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)))) + `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))) + (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 @@ -619,15 +628,12 @@ If media items have been attached and uploaded with (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) - (args-poll (when mastodon-toot-poll-options - (append - (mastodon-toot--make-poll-params - mastodon-toot-poll-options) - `(("poll[expires_in]" . ,mastodon-toot-poll-expiry))))) + (args-poll (when mastodon-toot-poll + (mastodon-toot--build-poll-params))) ;; media || polls: (args (if mastodon-toot--media-attachments (append args-media args-no-media) - (if mastodon-toot-poll-options + (if mastodon-toot-poll (append args-no-media args-poll) args-no-media)))) (cond ((and mastodon-toot--media-attachments @@ -935,7 +941,7 @@ which is used to attach it to a toot when posting." (list "None"))) (defun mastodon-toot--make-poll-params (options) - "Returns an parameter query alist from poll OPTIONS." + "Return an parameter query alist from poll OPTIONS." (let ((key "poll[options][]")) (cl-loop for o in options collect `(,key . ,o)))) @@ -943,17 +949,26 @@ which is used to attach it to a toot when posting." (defun mastodon-toot--create-poll () "Prompt for new poll options and return as a list." (interactive) - (let ((length (read-number "Number of poll options [2-4]: " 2))) - (setq mastodon-toot-poll-options - (cl-loop for x from 1 to length - collect (read-string (format "Poll option [%s/%s]: " x length)))) - (mastodon-toot--get-poll-expiry))) + ;; re length, API docs show a poll 9 options. + (let* ((length (read-number "Number of poll options [2-9]: " 2)) + (multiple-p (y-or-n-p "Multiple choice poll? ")) + (options (mastodon-toot--read-poll-options length)) + (hide-totals (y-or-n-p "Hide votes until poll ends? ")) + (expiry (mastodon-toot--get-poll-expiry))) + (setq mastodon-toot-poll + `(:options ,options :length ,length :multi ,multiple-p :hide ,hide-totals :expiry ,expiry)) + (message "poll created!"))) + +(defun mastodon-toot--read-poll-options (length) + "Read a list of options for poll of LENGTH options." + (cl-loop for x from 1 to length + collect (read-string (format "Poll option [%s/%s]: " x length)))) (defun mastodon-toot--get-poll-expiry () "Prompt for a poll expiry time." ;; API requires this in seconds - (setq mastodon-toot-poll-expiry - (read-string "poll ends in [seconds, min 5 mins]: "))) + ;; TODO: offer sane poll expiry options + (read-string "poll ends in [seconds, min 5 mins]: ")) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From a7fa1f599630aa0f49e8d0a91d400c6f267622f1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 4 Nov 2022 13:03:34 +0100 Subject: small improvements to poll display in timeline --- lisp/mastodon-tl.el | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 130b01f..1986979 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -946,6 +946,9 @@ this just means displaying toot client." (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let* ((poll (mastodon-tl--field 'poll toot)) + (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)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -958,18 +961,27 @@ this just means displaying toot client." (concat "\nPoll: \n\n" (mapconcat (lambda (option) (progn - (format "Option %s: %s%s [%s votes].\n" + (format "%s: %s%s%s\n" (setq option-counter (1+ option-counter)) - (alist-get 'title option) + (propertize (alist-get 'title option) + 'face 'success) (make-string (1+ (- (length longest-option) (length (alist-get 'title option)))) ?\ ) - (alist-get 'votes_count option)))) + (if (eq (alist-get 'votes_count option) nil) + "" + (format "[%s votes]" (alist-get 'votes_count option)))))) options "\n") + (unless expired-p + (propertize (format "Expires: %s" expiry) + 'face 'font-lock-comment-face)) + (when expired-p + (propertize "Poll expired." + 'face 'font-lock-comment-face)) "\n"))) (defun mastodon-tl--poll-vote (option) -- cgit v1.2.3 From 40cf1038e386cfe62cfcc81234794b3a13102176 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 10:40:26 +0100 Subject: add headers arg to http--process-json and --get-json-async --- lisp/mastodon-http.el | 17 +++++++++++++---- lisp/mastodon-profile.el | 3 ++- lisp/mastodon-tl.el | 11 ++++++----- lisp/mastodon-toot.el | 5 +++-- 4 files changed, 24 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e3efabe..46a6398 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -154,10 +154,19 @@ SILENT means don't message." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-json))) -(defun mastodon-http--process-json () +(defun mastodon-http--process-json (&optional headers) "Process JSON response." ;; view raw response: - ;; (switch-to-buffer (current-buffer)) + (switch-to-buffer (current-buffer)) + (when headers + (let* ((head-str (buffer-substring-no-properties + (point-min) + (re-search-forward "^$" nil 'move))) + (head-list (split-string head-str "\n")) + (head-alist (mapcar (lambda (x) + (split-string x ": ")) + head-list))) + (setq mastodon-http-headers-alist head-alist))) (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-string @@ -241,13 +250,13 @@ Pass response buffer to CALLBACK function with args CBARGS." "GET" (url-retrieve url callback cbargs))) -(defun mastodon-http--get-json-async (url &optional callback &rest args) +(defun mastodon-http--get-json-async (url &optional headers callback &rest args) "Make GET request to URL. Call CALLBACK with json-vector and ARGS." (mastodon-http--get-async url (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json) args))))) + (apply callback (mastodon-http--process-json headers) args))))) (defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) "POST asynchronously to URL with ARGS and HEADERS. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 2e4807c..ebd1b37 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -183,7 +183,8 @@ contains") (message "Loading your favourited toots...") (mastodon-tl--init "favourites" "favourites" - 'mastodon-tl--timeline)) + 'mastodon-tl--timeline + :headers)) (defun mastodon-profile--view-bookmarks () "Open a new buffer displaying the user's bookmarks." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1986979..a9c8b39 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1139,7 +1139,7 @@ Then run CALLBACK with arguments CBARGS." "?") "max_id=" (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url callback cbargs))) + (apply 'mastodon-http--get-json-async url nil callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local @@ -1907,14 +1907,15 @@ from the start if it is nil." (goto-char (or mastodon-tl--update-point (point-min))) (funcall update-function json))))) -(defun mastodon-tl--init (buffer-name endpoint update-function) +(defun mastodon-tl--init (buffer-name endpoint update-function &optional headers) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. - -UPDATE-FUNCTION is used to recieve more toots." +UPDATE-FUNCTION is used to recieve more toots. +HEADERS means to also collect the response headers. Used for paginating +favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function))) + url headers 'mastodon-tl--init* buffer endpoint update-function))) (defun mastodon-tl--init* (json buffer endpoint update-function) "Initialize BUFFER with timeline targeted by ENDPOINT. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 44386f7..25446ef 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -203,12 +203,13 @@ send.") nil t))) (mastodon-profile--update-preference "privacy" vis :source))) -(defun mastodon-toot--get-max-toot-chars (&optional _no-toot) +(defun mastodon-toot--get-max-toot-chars (&optional no-toot) "Fetch max_toot_chars from `mastodon-instance-url' asynchronously. NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") - 'mastodon-toot--get-max-toot-chars-callback 'no-toot)) + nil + 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response &optional no-toot) -- cgit v1.2.3 From ee7905ec23a09db8917675e0f02fe047f0b812fb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 7 Nov 2022 13:58:34 +0100 Subject: add dash to handles regex --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 60cc4da..7a40354 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1217,7 +1217,7 @@ Added to `after-change-functions'." (mastodon-toot--propertize-item "#[1-9a-zA-Z_]+" 'success (cdr header-region)) - (mastodon-toot--propertize-item "@[1-9a-zA-Z._]+" + (mastodon-toot--propertize-item "@[1-9a-zA-Z._-]+" 'mastodon-display-name-face (cdr header-region))))) -- cgit v1.2.3 From 50723a18f7103afd10ca57a8506d9adad75c4481 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 8 Nov 2022 21:10:58 +0100 Subject: run --render-text before checking newline-if-long --- lisp/mastodon-tl.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6f53f93..788cd43 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1533,7 +1533,7 @@ IND is the optional indentation level to print at." (when ind (indent-to ind)) (insert (mastodon-tl--format-key el pad) " " - (mastodon-tl--newline-if-long el) + (mastodon-tl--newline-if-long (cdr el)) ;; only send strings straight to --render-text ;; this makes hyperlinks work: (if (not (stringp val)) @@ -1551,17 +1551,18 @@ IND is the optional indentation level to print at." (format "%-5s: " (propertize (alist-get key alist) 'face '(:underline t))) - (mastodon-tl--newline-if-long (assoc value alist)) + (mastodon-tl--newline-if-long (alist-get value alist)) (format "%s" (mastodon-tl--render-text (alist-get value alist))) "\n"))) (defun mastodon-tl--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." - (if (and (sequencep (cdr el)) - (< 50 (length (cdr el)))) - "\n" - "")) + (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) + (if (and (sequencep rend) + (< 50 (length rend))) + "\n" + ""))) (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. -- cgit v1.2.3 From 7ffd7b5bad2c265228439f92f1ce8bdc91ff2fe7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 8 Nov 2022 21:12:27 +0100 Subject: instance describe: handle emojis properly --- lisp/mastodon-tl.el | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 788cd43..3f117bc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1543,9 +1543,19 @@ IND is the optional indentation level to print at." "\n")))))))) (defun mastodon-tl--print-instance-rules-or-fields (alist) - "Print ALIST of instance rules or contact account fields." - (let ((key (if (alist-get 'id alist) 'id 'name)) - (value (if (alist-get 'id alist) 'text 'value))) + "Print ALIST of instance rules or contact account or emoji fields." + (let ((key (cond ((alist-get 'id alist) + 'id) + ((alist-get 'name alist) + 'name) + ((alist-get 'shortcode alist) + 'shortcode))) + (value (cond ((alist-get 'id alist) + 'text) + ((alist-get 'value alist) + 'value) + ((alist-get 'url alist) + 'url)))) (indent-to 4) (insert (format "%-5s: " -- cgit v1.2.3 From dc05ae39d5044d79d8288b36a71f90dba4b85724 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 8 Nov 2022 21:13:01 +0100 Subject: indent -tl.el --- lisp/mastodon-tl.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3f117bc..a8c466d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -372,12 +372,12 @@ Used on initializing a timeline or thread." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--format-faves-count (toot) @@ -593,10 +593,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))))) (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted @@ -1561,10 +1561,10 @@ IND is the optional indentation level to print at." (format "%-5s: " (propertize (alist-get key alist) 'face '(:underline t))) - (mastodon-tl--newline-if-long (alist-get value alist)) - (format "%s" (mastodon-tl--render-text - (alist-get value alist))) - "\n"))) + (mastodon-tl--newline-if-long (alist-get value alist)) + (format "%s" (mastodon-tl--render-text + (alist-get value alist))) + "\n"))) (defun mastodon-tl--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." -- cgit v1.2.3 From 0de46facbcb7f1467b381c030a4c0551686f25b6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:13:36 +0100 Subject: factor out tl--set-buffer-spec function in -tl.el only for now --- lisp/mastodon-tl.el | 67 ++++++++++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a3ef2ae..af5a9a4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1232,11 +1232,9 @@ ID is that of the toot to view." (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s" id) - update-function - (lambda (toot) (message "END of thread.")))) + (mastodon-tl--set-buffer-spec buffer + (format "statuses/%s" id) + (lambda (toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--toot toot :detailed-p)))))) @@ -1273,11 +1271,10 @@ ID is that of the toot to view." (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s/context" id) - update-function - (lambda (toot) (message "END of thread.")))) + (mastodon-tl--set-buffer-spec + buffer + (format "statuses/%s/context" id) + (lambda (toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--timeline (alist-get 'ancestors context)) (goto-char (point-max)) @@ -1942,21 +1939,26 @@ favourites." (mastodon-http--get-json-async url headers 'mastodon-tl--init* buffer endpoint update-function))) -(defun mastodon-tl--init* (json buffer endpoint update-function) +(defun mastodon-tl--init* (response buffer endpoint update-function) "Initialize BUFFER with timeline targeted by ENDPOINT. - UPDATE-FUNCTION is used to recieve more toots. -JSON is the data returned from the server." +RESPONSE is the data returned from the server by `mastodon-http--process-json', a cons cell of JSON and http headers." + (let* ((json (car response)) + (headers (cdr response)) + (link-header (when headers + (split-string + (car (alist-get "Link" headers nil nil 'equal)) + ",")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. ;; which means we cannot use buffer-spec for update-function ;; unless we set it both before and after the others - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function)) + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1965,11 +1967,11 @@ JSON is the data returned from the server." (funcall update-function json)) (mastodon-mode) (with-current-buffer buffer - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function) - mastodon-tl--timestamp-update-timer + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds (time-subtract mastodon-tl--timestamp-next-update @@ -2000,10 +2002,7 @@ Runs synchronously." ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. ;; which means we cannot use buffer-spec for update-function ;; unless we set it both before and after the others - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function)) + (mastodon-tl--set-buffer-spec buffer endpoint update-function) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -2012,11 +2011,8 @@ Runs synchronously." (funcall update-function json)) (mastodon-mode) (with-current-buffer buffer - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer-name - endpoint ,endpoint update-function - ,update-function) - mastodon-tl--timestamp-update-timer + (mastodon-tl--set-buffer-spec buffer endpoint update-function) + (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds (time-subtract mastodon-tl--timestamp-next-update @@ -2031,5 +2027,14 @@ Runs synchronously." (mastodon-tl--goto-first-item))) buffer)) +(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function + &optional link-header) + "Set `mastodon-tl--buffer-spec' for the current buffer." + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function + link-header ,link-header))) + (provide 'mastodon-tl) ;;; mastodon-tl.el ends here -- cgit v1.2.3 From 439e2ac0522881cb8861aa9a8ba6c03bb28a3311 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:47:09 +0100 Subject: remove all 'headers' args in -toot and -tl --- lisp/mastodon-tl.el | 21 ++++++++++----------- lisp/mastodon-toot.el | 1 - 2 files changed, 10 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index af5a9a4..e2c2013 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1937,18 +1937,17 @@ favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (mastodon-http--get-json-async - url headers 'mastodon-tl--init* buffer endpoint update-function))) + url 'mastodon-tl--init* buffer endpoint update-function))) (defun mastodon-tl--init* (response buffer endpoint update-function) "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." - (let* ((json (car response)) - (headers (cdr response)) - (link-header (when headers - (split-string - (car (alist-get "Link" headers nil nil 'equal)) - ",")))) + (let* ((json response)) + ;; (link-header (when headers + ;; (split-string + ;; (car (alist-get "Link" headers nil nil 'equal)) + ;; ",")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: @@ -1957,8 +1956,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', ;; unless we set it both before and after the others (mastodon-tl--set-buffer-spec buffer endpoint - update-function - link-header) + update-function) + ;; link-header) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1969,8 +1968,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (with-current-buffer buffer (mastodon-tl--set-buffer-spec buffer endpoint - update-function - link-header) + update-function) + ;; link-header) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 70aaf14..9a65439 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -208,7 +208,6 @@ 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 -- cgit v1.2.3 From 467f61817c27a1c001ec911d278d3c64770f708a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:48:20 +0100 Subject: http: add response layer to requests: - response is a cons of JSON list and http response headers alist - existing --get-json functions now just car the response - we also process JSON array as a list not a vector - this should open the way to handling response headers if we want to, eg for paginating favorites with the Link: header --- lisp/mastodon-http.el | 75 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 50 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 46a6398..5546325 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,34 +148,51 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) +(defun mastodon-http--get-response (url &optional silent) + "Make synchronous GET request to URL. Return JSON and response headers. +SILENT means don't message. +HEADERS means also return http response headers." + (with-current-buffer (mastodon-http--get url silent) + (mastodon-http--process-response))) + (defun mastodon-http--get-json (url &optional silent) - "Make synchronous GET request to URL. Return JSON response. + "Return only JSON data from URL request. SILENT means don't message." - (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-json))) + (car (mastodon-http--get-response url silent))) -(defun mastodon-http--process-json (&optional headers) - "Process JSON response." +(defun mastodon-http--process-json () + "Return only JSON data from async URL request. +Callback for `mastodon-http--get-json-async'." + (car (mastodon-http--process-response))) + +(defun mastodon-http--process-response () + "Process http response. +Return a cons of JSON list and http response headers." ;; view raw response: + ;; (switch-to-buffer (current-buffer)) + (let ((headers (mastodon-http--process-headers))) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-array-type 'list) + (json-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) + (kill-buffer) + (unless (or (string-empty-p json-string) (null json-string)) + `(,(json-read-from-string json-string) . ,headers))))) + +(defun mastodon-http--process-headers () + "Return an alist of http response headers." (switch-to-buffer (current-buffer)) - (when headers - (let* ((head-str (buffer-substring-no-properties - (point-min) - (re-search-forward "^$" nil 'move))) - (head-list (split-string head-str "\n")) - (head-alist (mapcar (lambda (x) - (split-string x ": ")) - head-list))) - (setq mastodon-http-headers-alist head-alist))) (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) - (unless (or (string-empty-p json-string) (null json-string)) - (json-read-from-string json-string)))) + (let* ((head-str (buffer-substring-no-properties + (point-min) + (re-search-forward "^$" nil 'move))) + (head-list (split-string head-str "\n"))) + (mapcar (lambda (x) + (split-string x ": ")) + head-list))) (defun mastodon-http--delete (url) "Make DELETE request to URL." @@ -250,13 +267,21 @@ Pass response buffer to CALLBACK function with args CBARGS." "GET" (url-retrieve url callback cbargs))) -(defun mastodon-http--get-json-async (url &optional headers callback &rest args) - "Make GET request to URL. Call CALLBACK with json-vector and ARGS." +(defun mastodon-http--get-response-async (url callback &rest args) + "Make GET request to URL. Call CALLBACK with http response and ARGS." + (mastodon-http--get-async + url + (lambda (status) + (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." (mastodon-http--get-async url (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json headers) args))))) + (apply callback (mastodon-http--process-json) args))))) (defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) "POST asynchronously to URL with ARGS and HEADERS. -- cgit v1.2.3 From 14eb275b966395b04da438a804b0a9a4a5d0dcab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:52:40 +0100 Subject: relationships in print profile buffer - get json list not vect --- lisp/mastodon-profile.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index ebd1b37..e664ee5 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -466,7 +466,8 @@ This endpoint only holds a few preferences. For others, see (url (mastodon-http--api (format "accounts/relationships?id[]=%s" their-id)))) - (mastodon-http--get-json url))) + ;; FIXME: not sure why we need to do this for relationships only! + (car (mastodon-http--get-json url)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -528,11 +529,9 @@ FIELDS means provide a fields vector fetched by other means." account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) (followed-by-you (when (not (seq-empty-p relationships)) - (alist-get 'following - (aref relationships 0)))) + (alist-get 'following relationships))) (follows-you (when (not (seq-empty-p relationships)) - (alist-get 'followed_by - (aref relationships 0)))) + (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))) -- cgit v1.2.3 From d3538d7553557350b7bee1743f5403f69ffd89db Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:54:28 +0100 Subject: -tl--init* revert json > response arg for now --- lisp/mastodon-tl.el | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e2c2013..813c18c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1939,15 +1939,10 @@ favourites." (mastodon-http--get-json-async url 'mastodon-tl--init* buffer endpoint update-function))) -(defun mastodon-tl--init* (response buffer endpoint update-function) +(defun mastodon-tl--init* (json buffer endpoint update-function) "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." - (let* ((json response)) - ;; (link-header (when headers - ;; (split-string - ;; (car (alist-get "Link" headers nil nil 'equal)) - ;; ",")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: @@ -1982,10 +1977,6 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (unless (string-prefix-p "accounts" endpoint) ;; for everything save profiles (mastodon-tl--goto-first-item)))) -;;(or (equal endpoint "notifications") -;; (string-prefix-p "timelines" endpoint) -;; (string-prefix-p "favourites" endpoint) -;; (string-prefix-p "statuses" endpoint)) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. -- cgit v1.2.3 From 596a9498a8dcc2aecb28f94f9ba57766583f5fab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 12:22:04 +0100 Subject: --init: handle json or full response and handle Link header --- lisp/mastodon-http.el | 1 + lisp/mastodon-tl.el | 26 ++++++++++++++++++-------- 2 files changed, 19 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 5546325..fedbe95 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -191,6 +191,7 @@ Return a cons of JSON list and http response headers." (re-search-forward "^$" nil 'move))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) + ;; FIXME: use dotted notation so alist-get doesn't return a list (split-string x ": ")) head-list))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 813c18c..a2194b7 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1936,13 +1936,23 @@ HEADERS means to also collect the response headers. Used for paginating favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) - (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function))) + (if headers + (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)))) -(defun mastodon-tl--init* (json buffer endpoint update-function) +(defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "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." + (let* ((json (if headers (car response) response)) + (headers (if headers (cdr response) nil)) + (link-header (when headers + (split-string + (car + (alist-get "Link" headers nil nil 'equal)) + ", ")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: @@ -1951,8 +1961,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', ;; unless we set it both before and after the others (mastodon-tl--set-buffer-spec buffer endpoint - update-function) - ;; link-header) + update-function + link-header) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1963,8 +1973,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (with-current-buffer buffer (mastodon-tl--set-buffer-spec buffer endpoint - update-function) - ;; link-header) + update-function + link-header) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds @@ -1976,7 +1986,7 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', nil))) (unless (string-prefix-p "accounts" endpoint) ;; for everything save profiles - (mastodon-tl--goto-first-item)))) + (mastodon-tl--goto-first-item))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. -- cgit v1.2.3 From e847059950308eea45bb70736a33a6d4c348bfff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 14:00:39 +0100 Subject: use a proper dotted alist for response headers list --- lisp/mastodon-http.el | 4 ++-- lisp/mastodon-tl.el | 5 +---- 2 files changed, 3 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index fedbe95..1c6e1ae 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -191,8 +191,8 @@ Return a cons of JSON list and http response headers." (re-search-forward "^$" nil 'move))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) - ;; FIXME: use dotted notation so alist-get doesn't return a list - (split-string x ": ")) + (let ((list (split-string x ": "))) + (cons (car list) (cadr list)))) head-list))) (defun mastodon-http--delete (url) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a2194b7..4a0f40c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1949,10 +1949,7 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (let* ((json (if headers (car response) response)) (headers (if headers (cdr response) nil)) (link-header (when headers - (split-string - (car - (alist-get "Link" headers nil nil 'equal)) - ", ")))) + (split-string (alist-get "Link" headers nil nil 'equal) ", ")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: -- cgit v1.2.3 From 5cb9b991c0b59c572640ded6d1ce53f4ed408797 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 20:22:12 +0100 Subject: opt no-headers arg, only fetch when nil --- lisp/mastodon-http.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1c6e1ae..36d53c9 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,29 +148,31 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) -(defun mastodon-http--get-response (url &optional silent) +(defun mastodon-http--get-response (url &optional no-headers silent) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. HEADERS means also return http response headers." (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-response))) + (mastodon-http--process-response no-headers))) (defun mastodon-http--get-json (url &optional silent) "Return only JSON data from URL request. SILENT means don't message." - (car (mastodon-http--get-response url silent))) + (car (mastodon-http--get-response url :no-headers silent))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. -Callback for `mastodon-http--get-json-async'." - (car (mastodon-http--process-response))) +Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." + (car (mastodon-http--process-response :no-headers))) -(defun mastodon-http--process-response () +(defun mastodon-http--process-response (&optional no-headers) "Process http response. -Return a cons of JSON list and http response headers." +Return a cons of JSON list and http response headers. +Callback to `mastodon-http--get-response-async', usually `mastodon-tl--init*', is run on the result." ;; view raw response: ;; (switch-to-buffer (current-buffer)) - (let ((headers (mastodon-http--process-headers))) + (let ((headers (unless no-headers + (mastodon-http--process-headers)))) (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-array-type 'list) -- cgit v1.2.3 From f8db62d65a25f6ca8e878ae186206629a65d1f00 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 21:02:27 +0100 Subject: store and restore window-config before and after composing a toot --- lisp/mastodon-toot.el | 39 +++++++++++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7a40354..99c202e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -168,6 +168,11 @@ 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-previous-window-config nil + "A list of window configuration prior to composing a toot. +Takes its form from `window-configuration-to-register'.") + (defvar mastodon-toot--max-toot-chars nil "The maximum allowed characters count for a single toot.") @@ -473,13 +478,15 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (defun mastodon-toot--kill (&optional cancel) "Kill `mastodon-toot-mode' buffer and window. CANCEL means the toot was not sent, so we save the toot text as a draft." - (unless (eq mastodon-toot-current-toot-text nil) - (when cancel - (cl-pushnew mastodon-toot-current-toot-text - mastodon-toot-draft-toots-list :test 'equal))) - ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot--save-toot-text after-change-functions) - (kill-buffer-and-window)) + (let ((prev-window-config mastodon-toot-previous-window-config)) + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot--save-toot-text after-change-functions) + (kill-buffer-and-window) + (mastodon-toot--restore-previous-window-config prev-window-config))) (defun mastodon-toot--cancel () "Kill new-toot buffer/window. Does not POST content to Mastodon. @@ -635,7 +642,8 @@ If media items have been attached and uploaded with (append args-media args-no-media) (if mastodon-toot-poll (append args-no-media args-poll) - args-no-media)))) + args-no-media))) + (prev-window-config mastodon-toot-previous-window-config)) (cond ((and mastodon-toot--media-attachments ;; make sure we have media args ;; and the same num of ids as attachments @@ -653,7 +661,14 @@ If media items have been attached and uploaded with (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!")))))))) + (message "Toot toot!") + (mastodon-toot--restore-previous-window-config prev-window-config)))))))) + +(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." + (set-window-configuration (car config)) + (goto-char (cadr config))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -1247,7 +1262,9 @@ a draft into the buffer." (let* ((buffer-exists (get-buffer "*new toot*")) (buffer (or buffer-exists (get-buffer-create "*new toot*"))) (inhibit-read-only t) - (reply-text (alist-get 'content reply-json))) + (reply-text (alist-get 'content reply-json)) + (previous-window-config (list (current-window-configuration) + (point-marker)))) (switch-to-buffer-other-window buffer) (text-mode) (mastodon-toot-mode t) @@ -1280,6 +1297,8 @@ a draft into the buffer." (setq mastodon-toot-current-toot-text nil) (push #'mastodon-toot--save-toot-text after-change-functions) (push #'mastodon-toot--propertize-tags-and-handles after-change-functions) + ;; if we set this before changing modes, it gets nuked: + (setq mastodon-toot-previous-window-config previous-window-config) (when initial-text (insert initial-text)))) -- cgit v1.2.3 From 04ba8ebdf01b07331340f4c1e8f14987156a0cf8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 10:23:49 +0100 Subject: paginate favourites view using Link header --- lisp/mastodon-tl.el | 151 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 96 insertions(+), 55 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4a0f40c..03ee41e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -68,6 +68,7 @@ (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-http--get-response-async "mastodon-http") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -1123,7 +1124,12 @@ Optionally set it for BUFFER." (defun mastodon-tl--buffer-name (&optional buffer) "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'buffer-name 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'. +Optionally get it for BUFFER." + (mastodon-tl--get-buffer-property 'link-header buffer)) (defun mastodon-tl--get-buffer-property (property &optional buffer) "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'." @@ -1132,6 +1138,19 @@ Optionally get it for BUFFER." (error "Mastodon-tl--buffer-spec is not defined for buffer %s" (or buffer (current-buffer)))))) +(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function + &optional link-header) + "Set `mastodon-tl--buffer-spec' for the current buffer. + +BUFFER is buffer name, ENDPOINT is buffer's enpoint, +UPDATE-FUNCTION is its update function. +LINK-HEADER is the http Link header if present." + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function + link-header ,link-header))) + (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." (let* ((url (mastodon-http--api (concat @@ -1752,23 +1771,48 @@ For use after e.g. deleting a toot." (mastodon-tl--thread (match-string 2 (mastodon-tl--get-endpoint))))))) +(defun mastodon-tl--build-link-header-url (str) + "Return a URL from STR, an http Link header." + (let* ((split (split-string str "; ")) + (url-base (string-trim (car split) "<" ">")) + (param (cadr split))) + (concat url-base "&" param))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) (message "Loading older toots...") - (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) - 'mastodon-tl--more* (current-buffer) (point))) - -(defun mastodon-tl--more* (json buffer point-before) + (if (string= (buffer-name (current-buffer)) "*mastodon-favourites*") + ;; link-header: can't build a URL with --more-json-async, endpoint/id: + (let* ((next (car (mastodon-tl--link-header))) + (prev (cadr (mastodon-tl--link-header))) + (url (mastodon-tl--build-link-header-url next))) + (mastodon-http--get-response-async url '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)))) + +(defun mastodon-tl--more* (response buffer point-before &optional headers) "Append older toots to timeline, asynchronously. -Runs the timeline's update function on JSON, in BUFFER. -When done, places point at POINT-BEFORE." +Runs the timeline's update function on RESPONSE, in BUFFER. +When done, places point at POINT-BEFORE. +HEADERS is the http headers returned in the response, if any." (with-current-buffer buffer - (when json - (let ((inhibit-read-only t)) + (when response + (let* ((inhibit-read-only t) + (json (if headers (car response) response)) + (headers (if headers (cdr response) nil)) + (link-header (mastodon-tl--get-link-header-from-response headers))) (goto-char (point-max)) (funcall (mastodon-tl--get-update-function) json) (goto-char point-before) + ;; update buffer spec to new link-header: + ;; (other values should just remain as they were) + (when headers + (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) + (mastodon-tl--get-endpoint) + (mastodon-tl--get-update-function) + link-header)) (message "Loading older toots... done."))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) @@ -1929,6 +1973,11 @@ from the start if it is nil." (goto-char (or mastodon-tl--update-point (point-min))) (funcall update-function json))))) +(defun mastodon-tl--get-link-header-from-response (headers) + "Get http Link header from list of http HEADERS." + (when headers + (split-string (alist-get "Link" headers nil nil 'equal) ", "))) + (defun mastodon-tl--init (buffer-name endpoint update-function &optional headers) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots. @@ -1945,45 +1994,46 @@ favourites." (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "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." +RESPONSE is the data returned from the server by +`mastodon-http--process-json', a cons cell of JSON and http +headers." (let* ((json (if headers (car response) response)) (headers (if headers (cdr response) nil)) - (link-header (when headers - (split-string (alist-get "Link" headers nil nil 'equal) ", ")))) - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - ;; mastodon-mode wipes buffer-spec, so order must unforch be: - ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. - ;; which means we cannot use buffer-spec for update-function - ;; unless we set it both before and after the others - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header) - (setq - ;; Initialize with a minimal interval; we re-scan at least once - ;; every 5 minutes to catch any timestamps we may have missed - mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) - (funcall update-function json)) - (mastodon-mode) - (with-current-buffer buffer - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header) - (setq mastodon-tl--timestamp-update-timer - (when mastodon-tl--enable-relative-timestamps - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil))) - (unless (string-prefix-p "accounts" endpoint) - ;; for everything save profiles - (mastodon-tl--goto-first-item))))) + (link-header (mastodon-tl--get-link-header-from-response headers))) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + ;; mastodon-mode wipes buffer-spec, so order must unforch be: + ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. + ;; which means we cannot use buffer-spec for update-function + ;; unless we set it both before and after the others + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq + ;; Initialize with a minimal interval; we re-scan at least once + ;; every 5 minutes to catch any timestamps we may have missed + mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300))) + (funcall update-function json)) + (mastodon-mode) + (with-current-buffer buffer + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil))) + (unless (string-prefix-p "accounts" endpoint) + ;; for everything save profiles + (mastodon-tl--goto-first-item))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. @@ -2024,14 +2074,5 @@ Runs synchronously." (mastodon-tl--goto-first-item))) buffer)) -(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function - &optional link-header) - "Set `mastodon-tl--buffer-spec' for the current buffer." - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function - link-header ,link-header))) - (provide 'mastodon-tl) ;;; mastodon-tl.el ends here -- cgit v1.2.3 From a19588719ccf0ec35d22acdf2ce349a5ef499691 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 10:25:52 +0100 Subject: http docstrings --- lisp/mastodon-http.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 36d53c9..0866248 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,7 +151,7 @@ SILENT means don't message." (defun mastodon-http--get-response (url &optional no-headers silent) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. -HEADERS means also return http response headers." +NO-HEADERS means don't collect http response headers." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-response no-headers))) @@ -162,13 +162,16 @@ SILENT means don't message." (defun mastodon-http--process-json () "Return only JSON data from async URL request. -Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." +Callback to `mastodon-http--get-json-async', usually +`mastodon-tl--init*', is run on the result." (car (mastodon-http--process-response :no-headers))) (defun mastodon-http--process-response (&optional no-headers) "Process http response. Return a cons of JSON list and http response headers. -Callback to `mastodon-http--get-response-async', usually `mastodon-tl--init*', is run on the result." +If NO-HEADERS is non-nil, just return the JSON. +Callback to `mastodon-http--get-response-async', usually +`mastodon-tl--init*', is run on the result." ;; view raw response: ;; (switch-to-buffer (current-buffer)) (let ((headers (unless no-headers -- cgit v1.2.3 From 1c068079574cd78c8bfd878f1d3fea5f54c7be98 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:07:54 +0100 Subject: process-response: optionally JSON array as vector, for instance desc --- lisp/mastodon-http.el | 12 ++++++------ lisp/mastodon-tl.el | 4 +++- 2 files changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 0866248..9525568 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,17 +148,17 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) -(defun mastodon-http--get-response (url &optional no-headers silent) +(defun mastodon-http--get-response (url &optional no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. NO-HEADERS means don't collect http response headers." (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-response no-headers))) + (mastodon-http--process-response no-headers vector))) -(defun mastodon-http--get-json (url &optional silent) +(defun mastodon-http--get-json (url &optional silent vector) "Return only JSON data from URL request. SILENT means don't message." - (car (mastodon-http--get-response url :no-headers silent))) + (car (mastodon-http--get-response url :no-headers silent vector))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. @@ -166,7 +166,7 @@ Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." (car (mastodon-http--process-response :no-headers))) -(defun mastodon-http--process-response (&optional no-headers) +(defun mastodon-http--process-response (&optional no-headers vector) "Process http response. Return a cons of JSON list and http response headers. If NO-HEADERS is non-nil, just return the JSON. @@ -178,7 +178,7 @@ Callback to `mastodon-http--get-response-async', usually (mastodon-http--process-headers)))) (goto-char (point-min)) (re-search-forward "^$" nil 'move) - (let ((json-array-type 'list) + (let ((json-array-type (if vector 'vector 'list)) (json-string (decode-coding-string (buffer-substring-no-properties (point) (point-max)) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 03ee41e..338f227 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1466,7 +1466,9 @@ INSTANCE is an instance domain name." (if user (mastodon-http--api "instance") (concat instance - "/api/v1/instance"))))) + "/api/v1/instance")) + nil + :vector))) (when response (let ((buf (get-buffer-create "*mastodon-instance*"))) (with-current-buffer buf -- cgit v1.2.3 From 57678cf452c868f835a2e197995b44edea503565 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:08:29 +0100 Subject: cull stray nil arg from old --get-json-async args form --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 338f227..be3ac1e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1172,7 +1172,7 @@ Then run CALLBACK with arguments CBARGS." "?") "max_id=" (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url nil callback cbargs))) + (apply 'mastodon-http--get-json-async url callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local -- cgit v1.2.3 From 085ade5f958250886e8c96c2538f689a8278ec02 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:16:10 +0100 Subject: http vector docstrings --- lisp/mastodon-http.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9525568..66707b7 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,13 +151,15 @@ SILENT means don't message." (defun mastodon-http--get-response (url &optional no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. -NO-HEADERS means don't collect http response headers." +NO-HEADERS means don't collect http response headers. +VECTOR means return json arrays as vectors." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-response no-headers vector))) (defun mastodon-http--get-json (url &optional silent vector) "Return only JSON data from URL request. -SILENT means don't message." +SILENT means don't message. +VECTOR means return json arrays as vectors." (car (mastodon-http--get-response url :no-headers silent vector))) (defun mastodon-http--process-json () @@ -170,6 +172,7 @@ Callback to `mastodon-http--get-json-async', usually "Process http response. Return a cons of JSON list and http response headers. If NO-HEADERS is non-nil, just return the JSON. +VECTOR means return json arrays as vectors. Callback to `mastodon-http--get-response-async', usually `mastodon-tl--init*', is run on the result." ;; view raw response: -- cgit v1.2.3 From 3ca11d498d1bf386ce302972c202a6222128534d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 21:23:22 +0100 Subject: masto-toot-mode-hook - only fetch acc settings if not set the idea is to be able to start composing a toot without making any unnecessary requests. masto-mode-hook still always fetches (in case settings changed elsewhere). and we always fetch when we change a setting. --- lisp/mastodon-profile.el | 52 ++++++++++++++++++++++++++++-------------------- lisp/mastodon-toot.el | 3 ++- 2 files changed, 32 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 4aa9310..99af63a 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -296,30 +296,38 @@ 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 () +(defun mastodon-profile-fetch-server-account-settings-maybe () + "Fetch account settings from the server if `mastodon-profile-account-settings' is nil." + (mastodon-profile-fetch-server-account-settings :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'." - (let ((keys '(locked discoverable display_name bot)) - (source-keys '(privacy sensitive language))) - (mapc (lambda (k) - (mastodon-profile-update-preference-plist - k - (mastodon-profile--get-json-value k))) - keys) - (mapc (lambda (sk) - (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) - ;; 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)) +Run in `mastodon-mode-hook'. +If NO-FORCE is non-nil, only fetch if `mastodon-profile-account-settings' is nil." + (unless + (and no-force + mastodon-profile-account-settings) + (let ((keys '(locked discoverable display_name bot)) + (source-keys '(privacy sensitive language))) + (mapc (lambda (k) + (mastodon-profile-update-preference-plist + k + (mastodon-profile--get-json-value k))) + keys) + (mapc (lambda (sk) + (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) + ;; 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 () "Toggle the locked status of your account. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7a40354..30f4a25 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -78,6 +78,7 @@ (autoload 'mastodon-profile--update-preference "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") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -1284,7 +1285,7 @@ a draft into the buffer." (insert initial-text)))) ;;;###autoload -(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings) +(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." -- cgit v1.2.3 From 82c247728ab3ff71d92b689c8fd3bebe1c526331 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 19:02:36 +0100 Subject: FIX: -tl--get-poll - add a fallback format string --- lisp/mastodon-tl.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index be3ac1e..93f2d0f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -997,7 +997,12 @@ this just means displaying toot client." ((> (plist-get parsed :hours) 0) (format "%s hours, %s minutes left" (plist-get parsed :hours) (plist-get parsed :minutes))) ((> (plist-get parsed :minutes) 0) - (format "%s minutes left" (plist-get parsed :minutes)))))) + (format "%s minutes left" (plist-get parsed :minutes))) + (t ;; we failed to guess: + (format "%s days, %s hours, %s minutes left" + (plist-get parsed :days) + (plist-get parsed :hours) + (plist-get parsed :minutes)))))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." -- cgit v1.2.3 From 699cc27b3a141544fbf48603eff4fbfea0911cd7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 20:44:41 +0100 Subject: FIX update profile note - params alist format --- lisp/mastodon-profile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index ba3a0d3..5b243d1 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -271,7 +271,7 @@ JSON is the data returned by the server." (let* ((note (buffer-substring-no-properties (point-min) (point-max))) (url (mastodon-http--api "accounts/update_credentials"))) (kill-buffer-and-window) - (let ((response (mastodon-http--patch url `((note ,note))))) + (let ((response (mastodon-http--patch url `(("note" . ,note))))) (mastodon-http--triage response (lambda () (message "Profile note updated!")))))) -- cgit v1.2.3 From 7dc13db0a929f8fe4b2c3b8e8a9b88b361914aa8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 20:48:11 +0100 Subject: GET verify_cred not PATCH update_creds for fetch profile note --- lisp/mastodon-profile.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 5b243d1..553c21d 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -247,8 +247,8 @@ JSON is the data returned by the server." (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." (interactive) - (let* ((url (mastodon-http--api "accounts/update_credentials")) - (json (mastodon-http--patch-json url)) + (let* ((url (mastodon-http--api "accounts/verify_credentials")) + (json (mastodon-http--get-json url)) (source (alist-get 'source json)) (note (alist-get 'note source)) (buffer (get-buffer-create "*mastodon-update-profile*")) -- cgit v1.2.3 From 16f8c9c6e21bbe55d6c40099dab5253e4a165354 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 12:35:56 +0100 Subject: do-link-action optional url lookup if search can't find account --- lisp/mastodon-tl.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 93f2d0f..b0baa70 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -801,8 +801,7 @@ Used for hitting on a given link." (mastodon-tl--toggle-spoiler-text position)) ((eq link-type 'hashtag) (mastodon-tl--show-tag-timeline (get-text-property position 'mastodon-tag))) - ;; FIXME: 'account / 'account-id is not set for mentions - ;; only works for bylines, not mentions + ;; 'account / 'account-id is not set for mentions, only bylines ((eq link-type 'user-handle) (let ((account-json (get-text-property position 'account)) (account-id (get-text-property position 'account-id))) @@ -814,9 +813,17 @@ Used for hitting on a given link." (mastodon-profile--make-author-buffer (mastodon-profile--account-from-id account-id))) (t - (mastodon-profile--make-author-buffer - (mastodon-profile--search-account-by-handle - (get-text-property position 'mastodon-handle))))))) + (let ((account + (mastodon-profile--search-account-by-handle + (get-text-property position 'mastodon-handle)))) + ;; never call make-author-buffer on nil account: + (if account + (mastodon-profile--make-author-buffer account) + ;; optional webfinger lookup: + (if (y-or-n-p + "Search for account returned nothing. Perform URL lookup?") + (mastodon-url-lookup (get-text-property position 'shr-url)) + (message "Unable to find account.")))))))) (t (error "Unknown link type %s" link-type))))) -- cgit v1.2.3 From e0179b9ae26bcb7481959634b9ef91891c2a72eb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 12:36:45 +0100 Subject: add guppe groupe regex to --masto-url-p, lookup broken tho --- lisp/mastodon.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 3b0a7d0..da2d442 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -324,7 +324,8 @@ not, just browse the URL in the normal fashion." (string-match "^/display/[-a-f0-9]+$" query) (string-match "^/profile/[[:alpha:]]+$" query) (string-match "^/p/[[:alpha:]]+/[[:digit:]]+$" query) - (string-match "^/[[:alpha:]]+$" query))))) + (string-match "^/[[:alpha:]]+$" query) + (string-match "^/u/[[:alpha:]]+$" query))))) ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () -- cgit v1.2.3 From 606fbfc26a620f76bedea1d7bf033aea9690ead5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 14:09:57 +0100 Subject: Fetch user handles from mentions in JSON where possible. Fixes an issue where handles with subomain-hiding aliases would have broken links because they are fetched from the URL, which includes the subdomain. we sill use url extracting as a fallback, but it's probably not needed/useless. --- lisp/mastodon-tl.el | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b0baa70..9413a18 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -659,8 +659,15 @@ START and END are the boundaries of the link in the toot." mastodon-instance-url)) (maybe-hashtag (mastodon-tl--extract-hashtag-from-url url toot-instance-url)) - (maybe-userhandle (mastodon-tl--extract-userhandle-from-url - url (buffer-substring-no-properties start end)))) + (maybe-userhandle + (if (not (listp toot)) ; fails for profile buffers + (or (mastodon-tl--userhandle-from-mentions toot + (buffer-substring-no-properties start end)) + ;; FIXME: if prev always works, cut this: + (mastodon-tl--extract-userhandle-from-url + url (buffer-substring-no-properties start end))) + (mastodon-tl--extract-userhandle-from-url + url (buffer-substring-no-properties start end))))) (cond (;; Hashtags: maybe-hashtag (setq mastodon-tab-stop-type 'hashtag @@ -696,6 +703,23 @@ START and END are the boundaries of the link in the toot." 'help-echo help-echo) extra-properties)))) +;; TODO: refactor --userhandle-from-mentions and --extract-userid-toot +(defun mastodon-tl--userhandle-from-mentions (toot link) + "Extract a user handle from mentions in json TOOT. +LINK is the '@handle' to search for." + ;; TODO: ensure this doesn't error and returns nil if it doesn't work + ;; so that the 'or' that it is called in uses the following fallback + (let* ((mentions (append (alist-get 'mentions toot) nil)) ; alist + (mention (pop mentions)) + (name (substring-no-properties link 1)) ; cull @ + handle) + (while mention + (when (string= (alist-get 'username mention) + name) + (setq handle (alist-get 'acct mention))) + (setq mention (pop mentions))) + handle)) + (defun mastodon-tl--extract-userid-toot (toot acct) "Extract a user id for an ACCT from mentions in a TOOT." (let* ((mentions (append (alist-get 'mentions toot) nil)) -- cgit v1.2.3 From 6f64edff983daa8ab67283b8271c4dc0d36e9bd2 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 21:22:26 +0100 Subject: mastodon-toot-empty-p: count polls as non empty toot --- lisp/mastodon-toot.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f6a0f0a..86d3792 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -503,11 +503,12 @@ Pushes `mastodon-toot-current-toot-text' to (message "Draft saved!"))) (defun mastodon-toot-empty-p (&optional text-only) - "Return t if no text or attachments have been added to the compose buffer. + "Return t if no text, attachments, or polls have been added to the compose buffer. TEXT-ONLY means don't check for attachments." (and (if text-only t - (not mastodon-toot--media-attachments)) + (not mastodon-toot--media-attachments) + (not mastodon-toot-poll)) (string-empty-p (mastodon-tl--clean-tabs-and-nl (mastodon-toot--remove-docs))))) -- cgit v1.2.3 From 7a0d8a537559f12f784d8da1a1be6a4a5bd473cf Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 21:48:05 +0100 Subject: polls: fetch max options from instance, reject more than that --- lisp/mastodon-toot.el | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 86d3792..d592f08 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -948,11 +948,29 @@ which is used to attach it to a toot when posting." (cl-loop for o in options collect `(,key . ,o)))) +(defun mastodon-toot--fetch-max-poll-options () + "Return the maximum number of poll options from the user's instance. " + (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))) + (alist-get 'max_options + (alist-get 'polls + (alist-get 'configuration instance) + instance)))) + +(defun mastodon-toot--read-poll-options-count (max) + "Read the user's choice of the number of options the poll should have. +MAX is the maximum number set by their instance." + (let ((number (read-number + (format "Number of options [2-%s]: " max) 2))) + (if (> number max) + (error "You need to choose a number between 2 and %s" max) + number))) + (defun mastodon-toot--create-poll () "Prompt for new poll options and return as a list." (interactive) ;; re length, API docs show a poll 9 options. - (let* ((length (read-number "Number of options [2-4]: " 2)) + (let* ((max-options (mastodon-toot--fetch-max-poll-options)) + (length (mastodon-toot--read-poll-options-count max-options)) (multiple-p (y-or-n-p "Multiple choice? ")) (options (mastodon-toot--read-poll-options length)) (hide-totals (y-or-n-p "Hide votes until poll ends? ")) -- cgit v1.2.3 From b50a1a3458733c9f7976056494ec560111f59851 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 22:40:30 +0100 Subject: tl-process-link - refactor fetch EL from mentions --- lisp/mastodon-tl.el | 65 +++++++++++++++++++++++++---------------------------- 1 file changed, 31 insertions(+), 34 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9413a18..9563bd3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -657,17 +657,18 @@ START and END are the boundaries of the link in the toot." (concat (url-type toot-url) "://" (url-host toot-url)) mastodon-instance-url)) + (link-str (buffer-substring-no-properties start end)) (maybe-hashtag (mastodon-tl--extract-hashtag-from-url url toot-instance-url)) (maybe-userhandle - (if (not (listp toot)) ; fails for profile buffers + (if (proper-list-p toot) ; fails for profile buffers? (or (mastodon-tl--userhandle-from-mentions toot - (buffer-substring-no-properties start end)) + link-str) ;; FIXME: if prev always works, cut this: (mastodon-tl--extract-userhandle-from-url - url (buffer-substring-no-properties start end))) + url link-str)) (mastodon-tl--extract-userhandle-from-url - url (buffer-substring-no-properties start end))))) + url link-str)))) (cond (;; Hashtags: maybe-hashtag (setq mastodon-tab-stop-type 'hashtag @@ -677,10 +678,9 @@ START and END are the boundaries of the link in the toot." (;; User handles: maybe-userhandle ;; this fails on mentions in profile notes: - (let ((maybe-userid - (when (proper-list-p toot) - (mastodon-tl--extract-userid-toot - toot maybe-userhandle)))) + (let ((maybe-userid (when (proper-list-p toot) + (mastodon-tl--extract-userid-toot + toot link-str)))) (setq mastodon-tab-stop-type 'user-handle keymap mastodon-tl--link-keymap help-echo (concat "Browse user profile of " maybe-userhandle) @@ -703,35 +703,32 @@ START and END are the boundaries of the link in the toot." 'help-echo help-echo) extra-properties)))) -;; TODO: refactor --userhandle-from-mentions and --extract-userid-toot (defun mastodon-tl--userhandle-from-mentions (toot link) "Extract a user handle from mentions in json TOOT. -LINK is the '@handle' to search for." - ;; TODO: ensure this doesn't error and returns nil if it doesn't work - ;; so that the 'or' that it is called in uses the following fallback - (let* ((mentions (append (alist-get 'mentions toot) nil)) ; alist - (mention (pop mentions)) - (name (substring-no-properties link 1)) ; cull @ - handle) - (while mention - (when (string= (alist-get 'username mention) - name) - (setq handle (alist-get 'acct mention))) - (setq mention (pop mentions))) - handle)) - -(defun mastodon-tl--extract-userid-toot (toot acct) +LINK is maybe the '@handle' to search for." + (mastodon-tl--extract-el-from-mentions 'acct toot link)) + +(defun mastodon-tl--extract-userid-toot (toot link) "Extract a user id for an ACCT from mentions in a TOOT." - (let* ((mentions (append (alist-get 'mentions toot) nil)) - (mention (pop mentions)) - (short-acct (substring acct 1 (length acct))) - return) - (while mention - (when (string= (alist-get 'acct mention) - short-acct) - (setq return (alist-get 'id mention))) - (setq mention (pop mentions))) - return)) + (mastodon-tl--extract-el-from-mentions 'id toot link)) + +(defun mastodon-tl--extract-el-from-mentions (el toot link) + "Extract element EL from TOOT mentions that matches LINK. +LINK should be a simple handle string with no domain, i.e. @user. +Return nil if no matching element" + ;; Must return nil if nothing found! + ;; TODO: we should break the while loop as soon as we get sth + (let ((mentions (append (alist-get 'mentions toot) nil))) + (when mentions + (let* ((mention (pop mentions)) + (name (substring-no-properties link 1 (length link))) ; cull @ + return) + (while mention + (when (string= (alist-get 'username mention) + name) + (setq return (alist-get el mention))) + (setq mention (pop mentions))) + return)))) (defun mastodon-tl--extract-userhandle-from-url (url buffer-text) "Return the user hande the URL points to or nil if it is not a profile link. -- cgit v1.2.3 From cca9f1d70ca9e3f873e60d9b98065de74d026a3a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 10:32:50 +0100 Subject: flycheck -tl --- lisp/mastodon-tl.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9563bd3..e0268af 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -69,7 +69,7 @@ (autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (autoload 'mastodon-http--get-response-async "mastodon-http") - +(autoload 'mastodon-url-lookup "mastodon") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -709,7 +709,8 @@ LINK is maybe the '@handle' to search for." (mastodon-tl--extract-el-from-mentions 'acct toot link)) (defun mastodon-tl--extract-userid-toot (toot link) - "Extract a user id for an ACCT from mentions in a TOOT." + "Extract a user id for an ACCT from mentions in a TOOT. +LINK is maybe the '@handle' to search for." (mastodon-tl--extract-el-from-mentions 'id toot link)) (defun mastodon-tl--extract-el-from-mentions (el toot link) @@ -1286,7 +1287,7 @@ ID is that of the toot to view." (mastodon-mode) (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) - (lambda (toot) (message "END of thread."))) + (lambda (_toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--toot toot :detailed-p)))))) @@ -1326,7 +1327,7 @@ ID is that of the toot to view." (mastodon-tl--set-buffer-spec buffer (format "statuses/%s/context" id) - (lambda (toot) (message "END of thread."))) + (lambda (_toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--timeline (alist-get 'ancestors context)) (goto-char (point-max)) -- cgit v1.2.3 From 634860b49d8dcc982ad8a9ed4afd393768675ccb Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 10:32:58 +0100 Subject: poll votes - person/people --- lisp/mastodon-tl.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e0268af..df167be 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1009,7 +1009,9 @@ this just means displaying toot client." options "\n") "\n" - (propertize (format "%s people | " vote-count) + (propertize (if (= vote-count 1) + (format "%s person | " vote-count) + (format "%s people | " vote-count)) 'face 'font-lock-comment-face) (let ((str (if expired-p "Poll expired." -- cgit v1.2.3 From afac39423a82a93fa14f9084e211bea0d1e6ce50 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 10:33:46 +0100 Subject: -tl: make follow-user work on profile note when no toots --- lisp/mastodon-tl.el | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index df167be..80f9e02 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1706,11 +1706,17 @@ Can be called to toggle NOTIFY on users already being followed." (equal (buffer-name) "*mastodon-follow-requests*") ;; profile view follows/followers compat: ;; but not for profile statuses: + ;; fetch 'toot-json: (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint))))) - ;; avoid tl--property here because it calls next-toot - ;; which breaks non-toot buffers like foll reqs etc.: (list (alist-get 'acct (get-text-property (point) 'toot-json)))) + ;; profile view, no toots, point on profile note, ie. 'profile-json: + ;; needed for e.g. gup.pe groups which show no toots publically: + ((and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (get-text-property (point) 'profile-json)) + (list (alist-get 'acct (get-text-property (point) 'profile-json)))) + ;; avoid tl--property here because it calls next-toot + ;; which breaks non-toot buffers like foll reqs etc.: (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) @@ -1750,9 +1756,13 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." ;; if unmuting/unblocking, we got handle from mute/block list (mastodon-profile--search-account-by-handle user-handle) - ;; if muting/blocking, we select from handles in current status - (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json)))) + ;; if profile view, use 'profile-json as status: + (if (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (mastodon-profile--lookup-account-in-status + user-handle (get-text-property (point) 'profile-json)) + ;; if muting/blocking, we select from handles in current status + (mastodon-profile--lookup-account-in-status + user-handle (mastodon-profile--toot-json))))) (user-id (mastodon-profile--account-field account 'id)) (name (if (not (string-empty-p (mastodon-profile--account-field account 'display_name))) (mastodon-profile--account-field account 'display_name) -- cgit v1.2.3 From 256fcd5c929ac395337746ea88d102304aaa02ab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 10:57:39 +0100 Subject: add poll TODO --- lisp/mastodon-tl.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 80f9e02..3f5dd04 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1021,6 +1021,8 @@ this just means displaying toot client." (defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." + ;; TODO: this bugged when a timestamp was in the past + ;; despite the poll not being listed as expired (let ((parsed (ts-human-duration (ts-diff (ts-parse timestamp) (ts-now))))) (cond ((> (plist-get parsed :days) 0) -- cgit v1.2.3 From d5802f73a4878afea4d902fc973b19ab4c209bd5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 11:09:40 +0100 Subject: flycheck -profile / profile--toot-json todos --- lisp/mastodon-profile.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 553c21d..56e5fef 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -137,6 +137,11 @@ contains") (defun mastodon-profile--toot-json () "Get the next toot-json." (interactive) + ;; NB: we cannot add + ;; (or (mastodon-tl--property 'profile-json) + ;; here because it searches forward endlessly + ;; TODO: it would be nice to be able to do so tho + ;; or handle --property failing (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account) @@ -298,14 +303,15 @@ This is done after changing the setting on the server." (plist-put mastodon-profile-account-settings pref val))) (defun mastodon-profile-fetch-server-account-settings-maybe () - "Fetch account settings from the server if `mastodon-profile-account-settings' is nil." + "Fetch account settings from the server. +Only do so if `mastodon-profile-account-settings' is nil." (mastodon-profile-fetch-server-account-settings :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'. -If NO-FORCE is non-nil, only fetch if `mastodon-profile-account-settings' is nil." +If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." (unless (and no-force mastodon-profile-account-settings) -- cgit v1.2.3 From d34fb4179013ae26c23282c11506aeadcfb7c4f7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 17:38:34 +0100 Subject: allow boost/fave of base toot from notifs --- lisp/mastodon-toot.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e203cda..95eac31 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -294,9 +294,13 @@ TYPE is a symbol, either 'favourite or 'boost." (cond ;; actually there's nothing wrong with faving/boosting own toots! ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) ;;(error "You can't %s your own toots" action-string)) - ((equal "reblog" toot-type) + ;; & nothing wrong with faving/boosting own toots from notifs: + ;; this boosts/faves the base toot, not the notif status + ((and (equal "reblog" toot-type) + (not (string= (mastodon-tl--get-endpoint) "notifications"))) (error "You can't %s boosts" action-string)) - ((equal "favourite" toot-type) + ((and (equal "favourite" toot-type) + (not (string= (mastodon-tl--get-endpoint) "notifications"))) (error "Your can't %s favourites" action-string)) (t (mastodon-toot--action -- cgit v1.2.3 From 8f15d5c44e4d6fa9c92e7f13bd9b6073fc600411 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 17:30:55 +0100 Subject: don't try to load thread if status at point is foll_req don't try to load thread if status at point is follow notif --- lisp/mastodon-tl.el | 78 ++++++++++++++++++++++++++++------------------------- 1 file changed, 41 insertions(+), 37 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3f5dd04..48d238c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1307,43 +1307,47 @@ ID is that of the toot to view." (mastodon-tl--property 'parent-toot))) (mastodon-tl--property 'base-toot-id)) (mastodon-tl--property 'base-toot-id)))) - (url (mastodon-http--api (format "statuses/%s/context" id))) - (buffer (format "*mastodon-thread-%s*" id)) - (toot - ;; refetch current toot in case we just faved/boosted: - (mastodon-http--get-json - (mastodon-http--api (concat "statuses/" id)) - :silent)) - (context (mastodon-http--get-json url :silent)) - (marker (make-marker))) - (if (equal (caar toot) 'error) - (message "Error: %s" (cdar toot)) - (when (member (alist-get 'type toot) '("reblog" "favourite")) - (setq toot (alist-get 'status toot))) - (if (> (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))) - 0) - ;; if we have a thread: - (progn - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (mastodon-tl--set-buffer-spec - buffer - (format "statuses/%s/context" id) - (lambda (_toot) (message "END of thread."))) - (let ((inhibit-read-only t)) - (mastodon-tl--timeline (alist-get 'ancestors context)) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p) - (mastodon-tl--timeline (alist-get 'descendants context)))) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl--goto-next-toot)) - ;; else just print the lone toot: - (mastodon-tl--single-toot id))))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'toot-json)))) + (if (or (string= type "follow_request") + (string= type "follow")) ; no can thread these + (error "No thread") + (let* ((url (mastodon-http--api (format "statuses/%s/context" id))) + (buffer (format "*mastodon-thread-%s*" id)) + (toot + ;; refetch current toot in case we just faved/boosted: + (mastodon-http--get-json + (mastodon-http--api (concat "statuses/" id)) + :silent)) + (context (mastodon-http--get-json url :silent)) + (marker (make-marker))) + (if (equal (caar toot) 'error) + (message "Error: %s" (cdar toot)) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (> (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))) + 0) + ;; if we have a thread: + (progn + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (mastodon-mode) + (mastodon-tl--set-buffer-spec + buffer + (format "statuses/%s/context" id) + (lambda (_toot) (message "END of thread."))) + (let ((inhibit-read-only t)) + (mastodon-tl--timeline (alist-get 'ancestors context)) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p) + (mastodon-tl--timeline (alist-get 'descendants context)))) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl--goto-next-toot)) + ;; else just print the lone toot: + (mastodon-tl--single-toot id))))))) (defun mastodon-tl--create-filter () "Create a filter for a word. -- cgit v1.2.3 From d40c54d1748eb6e480fc2b9a5371fd9a6b3cf0c3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 10:25:16 +0100 Subject: remove extra defvar buffer-spec --- lisp/mastodon-notifications.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index c0ca684..22f74ef 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -52,7 +52,6 @@ (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) -(defvar mastodon-tl--buffer-spec) (defvar mastodon-notifications--types-alist '(("mention" . mastodon-notifications--mention) -- cgit v1.2.3 From 30bb20037bf6af1b1469718c256700a21d9724e7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 10:48:29 +0100 Subject: tl--goto-toot-pos - message help echo on moving to toot byline --- lisp/mastodon-tl.el | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 48d238c..a916bc5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -283,6 +283,18 @@ text, i.e. hidden spoiler text." (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. If search returns nil, execute REFRESH function. @@ -295,7 +307,9 @@ Optionally start from POS." (if npos (if (not (get-text-property npos 'toot-id)) (mastodon-tl--goto-toot-pos find-pos refresh npos) - (goto-char npos)) + (goto-char npos) + ;; force display of help-echo on moving to a toot byline: + (mastodon-tl--message-help-echo)) (funcall refresh)))) (defun mastodon-tl--goto-next-toot () -- cgit v1.2.3 From 7c893ba3fa9557402610b80198b1d8cea0249a0c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 11:16:17 +0100 Subject: tl-format-faves count: only get info if not foll-req/follow --- lisp/mastodon-tl.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a916bc5..3934803 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -412,22 +412,23 @@ image media from the byline." toot) (alist-get 'reblog toot) ; boosts toot)) ; everything else - (fol-req-p (equal (alist-get 'type toot-to-count) "follow")) - (media-types (mastodon-tl--get-media-types toot)) - (format-faves (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-count) - (alist-get 'reblogs_count toot-to-count) - (alist-get 'replies_count toot-to-count))) - (format-media (when media-types - (format " | media: %s" - (mapconcat #'identity media-types " ")))) - (format-media-binding (when (and (or - (member "video" media-types) - (member "gifv" media-types)) - (require 'mpv nil :no-error)) - (format " | C-RET to view with mpv")))) + (fol-req-p (or (string= (alist-get 'type toot-to-count) "follow") + (string= (alist-get 'type toot-to-count) "follow_request")))) (unless fol-req-p - (format "%s" (concat format-faves format-media format-media-binding))))) + (let* ((media-types (mastodon-tl--get-media-types toot)) + (format-faves (format "%s faves | %s boosts | %s replies" + (alist-get 'favourites_count toot-to-count) + (alist-get 'reblogs_count toot-to-count) + (alist-get 'replies_count toot-to-count))) + (format-media (when media-types + (format " | media: %s" + (mapconcat #'identity media-types " ")))) + (format-media-binding (when (and (or + (member "video" media-types) + (member "gifv" media-types)) + (require 'mpv nil :no-error)) + (format " | C-RET to view with mpv")))) + (format "%s" (concat format-faves format-media format-media-binding)))))) (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." -- cgit v1.2.3 From 66b37a1ad65caa1c6cbe3e7b6ad7bc3ad7084da4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 11:21:26 +0100 Subject: comment profile 's' and 'g' view followers/-ing bindings 's' conflicts with translate-toot-at-point. C-c C-c does the job anyway --- lisp/mastodon-profile.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 56e5fef..ea73b99 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -82,8 +82,11 @@ (defvar mastodon-profile-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "s") #'mastodon-profile--open-followers) - (define-key map (kbd "g") #'mastodon-profile--open-following) + ;; conflicts with `s' keybinding to translate toot at point + ;; seeing as we now have the C-c C-c cycle functionality, + ;; 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) map) "Keymap for `mastodon-profile-mode'.") -- cgit v1.2.3 From 447081217888977ecfcbe8a005566f44929a16e6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 11:23:39 +0100 Subject: change foll-reqs view reject binding to 'j', like notifs view then 'r' is only ever used for reply, even tho not avail in fr view --- README.org | 2 +- lisp/mastodon-profile.el | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/README.org b/README.org index fc238a1..ffe65df 100644 --- a/README.org +++ b/README.org @@ -133,7 +133,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | | *Other views* | | =S= | search (posts, users, tags) (NB: only posts you have interacted with) | | =I=, =c=, =d= | view, create, and delete filters | -| =R=, =a=, =r= | view/accept/reject follow requests | +| =R=, =a=, =j= | view/accept/reject follow requests | | =G= | view follow suggestions | | =V= | view your favourited toots | | =K= | view bookmarked toots | diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index ea73b99..63c062b 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -94,7 +94,10 @@ (defvar mastodon-profile--view-follow-requests-keymap (let ((map ;(make-sparse-keymap))) (copy-keymap mastodon-mode-map))) - (define-key map (kbd "r") #'mastodon-notifications--follow-request-reject) + ;; make reject binding match the binding in notifs view + ;; 'r' is then reserved for replying, even tho it is not avail + ;; in foll-reqs view + (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "n") #'mastodon-tl--goto-next-item) (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) -- cgit v1.2.3 From 001149bd3883c3848b5c79ccba93428888ac0256 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 11:38:23 +0100 Subject: update discover bindings --- lisp/mastodon-discover.el | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index f33b25d..0ef64e2 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -51,10 +51,14 @@ ("b" "Boost" mastodon-toot--boost) ("f" "Favourite" mastodon-toot--favourite) ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot) + ("k" "Bookmark toot" mastodon-toot--bookmark-toot-toggle) + ("v" "Vote on poll" mastodon-tl--poll-vote) ("n" "Next" mastodon-tl--goto-next-toot) ("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)) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) ("C" "Copy toot URL" mastodon-toot--copy-toot-url) @@ -62,10 +66,12 @@ ("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) ("T" "View thread" mastodon-tl--thread) ("v" "Vote on poll" mastodon-tl--poll-vote)) - ("Timelines" - ("h" "View mode help/keybindings" describe-mode) + ("Views" + ("h/?" "View mode help/keybindings" describe-mode) ("#" "Tag search" mastodon-tl--get-tag-timeline) ("F" "Federated" mastodon-tl--get-federated-timeline) ("H" "Home" mastodon-tl--get-home-timeline) @@ -73,8 +79,13 @@ ("N" "Notifications" mastodon-notifications--get) ("u" "Update timeline" mastodon-tl--update) ("S" "Search" mastodon-search--search-query) - ("C-S-P" "Jump to your profile" mastodon-profile--my-profile) - ("K" "View bookmarks" mastodon-profile--view-bookmarks)) + ("O" "Jump to your profile" mastodon-profile--my-profile) + ("U" "Update your profile note" mastodon-profile--update-user-profile-note) + ("K" "View bookmarks" mastodon-profile--view-bookmarks) + ("V" "View favourites" mastodon-profile--view-favourites) + ("R" "View follow requests" mastodon-profile--view-follow-requests) + ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) + ("I" "View filters" mastodon-tl--view-filters)) ("Users" ("W" "Follow" mastodon-tl--follow-user) ("C-S-W" "Unfollow" mastodon-tl--unfollow-user) @@ -89,16 +100,10 @@ ("-" "zoom out" 'image-decrease-size) ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) ("Profile view" - ("g" "Show following" mastodon-profile--open-following) - ("s" "Show followers" mastodon-profile--open-followers) - ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle) - ("R" "View follow requests" mastodon-profile--view-follow-requests) - ("a" "Accept follow request" mastodon-profile--follow-request-accept) - ("j" "Reject follow request" mastodon-profile--follow-request-reject) - ("U" "Update your profile note" mastodon-profile--update-user-profile-note)) + ("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))))))) -(provide 'mastodon-discover) + (provide 'mastodon-discover) ;;; mastodon-discover.el ends here -- cgit v1.2.3 From 93944c51aa4612987b85aec28e8707d598bc9c7c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 15:44:21 +0100 Subject: notifications--follow-request-process -- make non-interactive --- lisp/mastodon-notifications.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 22f74ef..510ef8c 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -86,7 +86,6 @@ With no argument, the request is accepted. Argument REJECT means reject the request. Can be called in notifications view or in follow-requests view." - (interactive) (if (not (mastodon-tl--find-property-range 'toot-json (point))) (message "No follow request at point?") (let* ((toot-json (mastodon-tl--property 'toot-json)) -- cgit v1.2.3 From 791cfb336891e9310dba010cee8afe8a728eda28 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 15:51:09 +0100 Subject: notifs - rename clear-all / clear-current, y-or-n-p --- lisp/mastodon-notifications.el | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 510ef8c..1ecdbfb 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -267,19 +267,20 @@ of the toot responded to." "notifications" 'mastodon-notifications--timeline)) -(defun mastodon-notifications-clear () +(defun mastodon-notifications--clear-all () "Clear all notifications." (interactive) - (let ((response - (mastodon-http--post (mastodon-http--api "notifications/clear") - nil nil))) - (mastodon-http--triage - response (lambda () - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "All notifications cleared!"))))) - -(defun mastodon-notifications-clear-current-notif () + (when (y-or-n-p "Clear all notifications?") + (let ((response + (mastodon-http--post (mastodon-http--api "notifications/clear") + nil nil))) + (mastodon-http--triage + response (lambda () + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "All notifications cleared!")))))) + +(defun mastodon-notifications--clear-current () "Dismiss the notification at point." (interactive) (let* ((id (or (mastodon-tl--property 'toot-id) -- cgit v1.2.3 From a344112c03f3d6c016f5f4c48e5c932b840f6ab1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sun, 13 Nov 2022 16:20:16 +0100 Subject: indent buffer -tl.el --- lisp/mastodon-tl.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 3934803..b352c6d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -387,12 +387,12 @@ Used on initializing a timeline or thread." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--format-faves-count (toot) @@ -609,10 +609,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))))) (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted -- cgit v1.2.3