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(-) 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(-) 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(-) 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(-) 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(+) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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 7b89445dd841b57a0f1d1483053fe6163adf8c83 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:33:35 +0100 Subject: readme: Nota Bene --- README.org | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/README.org b/README.org index 2db8681..b13bb17 100644 --- a/README.org +++ b/README.org @@ -297,6 +297,14 @@ Optional dependencies: - =mpv= and =mpv.el= for viewing videos and gifs - =lingva.el= for translating toots +** Nota Bene regarding work on this library + +I resurrected this library a few years ago, and have added stacks of features and fixes over time. But I was also only scratching my own itch, in my spare time, implementing features that I wanted to use and learning Elisp. I am not a professional programmer. I never aimed to make a full-featured client, nor do I aim to provide a professional service to anyone. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. My main thought was that if it was at least functioning and someone was picking some low hanging fruit, and making it look less moribund, then some more capable programmer(s) might come along and dive in also. + +Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and to discuss it. But please do not feel free to order things from me as though I was a service provider, unless you are willing to consider also paying me as though I were a service provider. + +The better option is most likely going to be looking at the code a little bit and seeing how you can implement the feature yourself, especially as a lot of the functionality you're likely to need is already implemented for other features. + ** Contributing PRs, issues, feature requests, and general feedback are very welcome! -- cgit v1.2.3 From a02c22a6e1602eaf72422c06d1c772377c9a129d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:33:43 +0100 Subject: readme typos --- README.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index b13bb17..b26e1f7 100644 --- a/README.org +++ b/README.org @@ -135,7 +135,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | =I=, =c=, =d= | view, create, and delete filters | | =R=, =a=, =r= | view/accept/reject follow requests | | =G= | view follow suggestions | -| =V= | view your favorited toots | +| =V= | view your favourited toots | | =K= | view bookmarked toots | |---------------+-----------------------------------------------------------------------| | | *Toot actions* | @@ -240,7 +240,7 @@ See =M-x customize-group RET mastodon= to view all customize options. - Timestamp format - Relative timestamps - Display user avatars - - Avatar image hight + - Avatar image height - Enable image caching - Compose options: @@ -267,7 +267,7 @@ You can translate toots with =mastodon-toot--translate-toot-text=. At the moment this requires [[https://codeberg.org/martianh/lingva.el][lingva.el]], a little interface I wrote to https://lingva.ml, to be installed to work. -You could easily modify the simple function to use your emacs translator of +You could easily modify the simple function to use your Emacs translator of choice (=libretrans.el= , =google-translate=, =babel=, =go-translate=, etc.), you just need to fetch the toot's content with =(mastodon-tl--content toot)= and pass it to your translator function as its text argument. Here's what -- 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(-) 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(-) 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(-) 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(-) 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 ce52d212432efa0ce2f238b605c868b67f24236b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 10:37:11 +0100 Subject: readme nota bene --- README.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index b26e1f7..3a27f09 100644 --- a/README.org +++ b/README.org @@ -299,11 +299,11 @@ Optional dependencies: ** Nota Bene regarding work on this library -I resurrected this library a few years ago, and have added stacks of features and fixes over time. But I was also only scratching my own itch, in my spare time, implementing features that I wanted to use and learning Elisp. I am not a professional programmer. I never aimed to make a full-featured client, nor do I aim to provide a professional service to anyone. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. My main thought was that if it was at least functioning and someone was picking some low hanging fruit, and making it look less moribund, then some more capable programmer(s) might come along and dive in also. +I resurrected this library a few years ago, and have added stacks of features and fixes over time. But I only do it in my spare time, and I tend to implement features I want to use. I am not a professional programmer. I never aimed to implement all Mastodon features, nor do I aim to provide a professional service of any kind. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. -Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and to discuss it. But please do not feel free to order things from me as though I was a service provider, unless you are willing to consider also paying me as though I were a service provider. +Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and start a discussion. But please do not feel free to order things from me as though I was a service provider, unless you are willing to consider also paying me as though I were a service provider. -The better option is most likely going to be looking at the code a little bit and seeing how you can implement the feature yourself, especially as a lot of the functionality you're likely to need is already implemented for other features. +The better option is most likely going to be looking at the code and seeing how you can implement the feature yourself, especially as a lot of the functionality you're likely to need is already implemented. I'm happy to give pointers on what you might use. If that's not an option, then finding other contributors in order to cover more ground is what is needed. ** Contributing -- cgit v1.2.3 From bbfd03e8d6c6ecc9cd80dd73025f1176db02d2a0 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 11 Nov 2022 10:48:42 +0100 Subject: readme bug reports --- README.org | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index 3a27f09..9f50042 100644 --- a/README.org +++ b/README.org @@ -309,6 +309,14 @@ The better option is most likely going to be looking at the code and seeing how PRs, issues, feature requests, and general feedback are very welcome! +*** Bugs + +1. =mastodon.el= has bugs, as well as lots of room for improvement. +2. I receive very little feedback, so if I don't run into the bug it often doesn't get fixed. +3. If you run into something that seems broken, first try running =mastodon.el= in emacs with no init file (i.e. =emacs -q= (instructions and code for doing this are [[https://codeberg.org/martianh/mastodon.el/issues/300][here]]) to see if it also happens independently of your own config (it probably does). +4. Enable debug on error (=toggle-debug-on-error=), make the bug happen again, and copy the backtrace that appears. +5. Open an issue here and explain what is going on. + *** Features 1. Create an [[https://github.com/jdenen/mastodon.el/issues][issue]] detailing the feature you'd like to add. @@ -323,7 +331,7 @@ PRs, issues, feature requests, and general feedback are very welcome! ** Contributors: -=mastodon.el= is a the work of a number of people. +=mastodon.el= is the work of a number of people. Some significant contributors are: -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(+) 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(-) 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 5ec596afc00a6bd9263ff64447df443815883967 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 16:28:12 +0100 Subject: fix profile--make-author-buffer test: json array list not vector --- test/mastodon-profile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 640afb7..74d5248 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -240,7 +240,7 @@ content generation in the function under test." []) (mock (mastodon-profile--relationships-get "1") => - [((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . ""))]) + '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) ;; Let's not do formatting as that makes it hard to not rely on ;; window width and reflowing the text. (mock (shr-render-region * *) => nil) -- cgit v1.2.3 From 4354b7dd3a6205018d3dc99cba547d5862da7889 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 16:28:48 +0100 Subject: hack fix -toot--kill test: set mastodon-toot-previous-window-config --- test/mastodon-toot-tests.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 5b95cdc..39e0984 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -92,10 +92,13 @@ mention string." ;; TODO: test y-or-no-p with mastodon-toot--cancel (ert-deftest mastodon-toot--kill () "Should kill the buffer when cancelling the toot." - (with-mock - (mock (kill-buffer-and-window)) - (mastodon-toot--kill) - (mock-verify))) + (let ((mastodon-toot-previous-window-config + (list (current-window-configuration) + (point-marker)))) + (with-mock + (mock (kill-buffer-and-window)) + (mastodon-toot--kill) + (mock-verify)))) (ert-deftest mastodon-toot--own-toot-p-fail () "Should not return t if not own toot." -- cgit v1.2.3 From 9911006343fdb4290b2cd510bbc05a6cf1cdbaae Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 16:32:38 +0100 Subject: fix make-author-buffer test: include header img --- test/mastodon-profile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 74d5248..267e48b 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -259,7 +259,7 @@ content generation in the function under test." (buffer-substring-no-properties (point-min) (point-max)) (concat "\n" - "[img] \n" + "[img] [img] \n" "Eugen\n" "@Gargron\n" " ------------\n" -- cgit v1.2.3 From ad6e038ce45f946e25d3a58bbcbc012176aea5a9 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 12 Nov 2022 16:57:50 +0100 Subject: readme NB --- README.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index 9f50042..fc238a1 100644 --- a/README.org +++ b/README.org @@ -299,11 +299,11 @@ Optional dependencies: ** Nota Bene regarding work on this library -I resurrected this library a few years ago, and have added stacks of features and fixes over time. But I only do it in my spare time, and I tend to implement features I want to use. I am not a professional programmer. I never aimed to implement all Mastodon features, nor do I aim to provide a professional service of any kind. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. +I resurrected this library a few years ago, and have added stacks of features and fixes over time. I do it in my spare time and tend to implement features I want to use. I am not a professional programmer. I never aimed to implement all Mastodon features, nor to provide a professional service to others. I have implemented some things I don't use, such as filters, but mostly I can only fix bugs with things that I regularly rely on. -Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and start a discussion. But please do not feel free to order things from me as though I was a service provider, unless you are willing to consider also paying me as though I were a service provider. +Please keep this in mind when requesting features that are not implemented. Feel free to open an issue and start a discussion, but don't try to order things from me. -The better option is most likely going to be looking at the code and seeing how you can implement the feature yourself, especially as a lot of the functionality you're likely to need is already implemented. I'm happy to give pointers on what you might use. If that's not an option, then finding other contributors in order to cover more ground is what is needed. +The better option is to look at the code and seeing how you can implement the feature yourself. A lot of the functionality you'll need is already implemented. I'm happy to give pointers on what you might use. ** Contributing -- 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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(-) 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