From 411d57853a026d08493b93b674e2a8b7d7a7bae3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:35:00 +0100 Subject: convert :json-false to nil in account settings handling :json-false isn't nil, so doesn't work as we want --- lisp/mastodon-profile.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index cfb3bdb..4aa9310 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -228,7 +228,9 @@ JSON is the data returned by the server." "Fetch current VAL ue from account." (let* ((url (mastodon-http--api "accounts/verify_credentials")) (response (mastodon-http--get-json url))) - (alist-get val response))) + (if (eq (alist-get val response) ':json-false) + nil + (alist-get val response)))) (defun mastodon-profile--get-source-values () "Return the \"source\" preferences from the server." @@ -237,7 +239,9 @@ JSON is the data returned by the server." (defun mastodon-profile--get-source-value (pref) "Return account PREF erence from the \"source\" section on the server." (let ((source (mastodon-profile--get-source-values))) - (alist-get pref source))) + (if (eq (alist-get pref source) ':json-false) + nil + (alist-get pref source)))) (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." @@ -348,7 +352,7 @@ Current settings are fetched from the server." (mastodon-profile--get-source-value key) (mastodon-profile--get-json-value key))) (prompt (format "Account setting %s is %s. Toggle?" key val))) - (if (not (equal val :json-false)) + (if val (when (y-or-n-p prompt) (mastodon-profile--update-preference (symbol-name key) "false" source)) (when (y-or-n-p prompt) -- cgit v1.2.3 From 996cc9ad7773f7e8d2fc592b69e7d3d3ad2c40de Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:42:40 +0100 Subject: toot--kill: fix delete after change funs fun name --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9d2d02d..bcb4af1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -474,7 +474,7 @@ CANCEL means the toot was not sent, so we save the toot text as a draft." (cl-pushnew mastodon-toot-current-toot-text mastodon-toot-draft-toots-list :test 'equal))) ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot-save-toot-text after-change-functions) + (delete #'mastodon-toot--save-toot-text after-change-functions) (kill-buffer-and-window)) (defun mastodon-toot--cancel () -- cgit v1.2.3 From 45a986444101db52dca599f90da7ed063b09d9e8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 11:47:03 +0100 Subject: flycheck requires / thingatpt fun --- lisp/mastodon.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index bc624d9..a5ba9e4 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -37,6 +37,8 @@ (require 'mastodon-http) (require 'mastodon-toot) (require 'url) +(require 'thingatpt) +(require 'shr) (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") @@ -279,7 +281,7 @@ If a status or account is found, load it in `mastodon.el', if not, just browse the URL in the normal fashion." (interactive) (let* ((query (or query-url - (url-get-url-at-point) + (thing-at-point-url-at-point) (get-text-property (point) 'shr-url) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) -- cgit v1.2.3 From 554dc37b36de840d60d66caf5539c90c02ac2f91 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 31 Oct 2022 12:48:32 +0100 Subject: http.el docstrings --- lisp/mastodon-http.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index f32ccd4..eebfa85 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -74,7 +74,8 @@ This is a thin abstraction over the system `url-retrieve-synchronously'. Depending on which version of this -is available we will call it with or without a timeout." +is available we will call it with or without a timeout. +SILENT means don't message." (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) @@ -141,14 +142,15 @@ Authorization header is included by default unless UNAUTHENTICATED-P is non-nil. (defun mastodon-http--get (url &optional silent) "Make synchronous GET request to URL. - -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function. +SILENT means don't message." (mastodon-http--authorized-request "GET" (mastodon-http--url-retrieve-synchronously url silent))) (defun mastodon-http--get-json (url &optional silent) - "Make synchronous GET request to URL. Return JSON response." + "Make synchronous GET request to URL. Return JSON response. +SILENT means don't message." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-json))) @@ -187,7 +189,8 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--get-search-json (url query &optional param silent) "Make GET request to URL, searching for QUERY and return JSON response. -PARAM is any extra parameters to send with the request." +PARAM is any extra parameters to send with the request. +SILENT means don't message." (let ((buffer (mastodon-http--get-search url query param silent))) (with-current-buffer buffer (mastodon-http--process-json-search)))) @@ -195,7 +198,8 @@ PARAM is any extra parameters to send with the request." (defun mastodon-http--get-search (base-url query &optional param silent) "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function. -PARAM is a formatted request parameter, eg 'following=true'." +PARAM is a formatted request parameter, eg 'following=true'. +SILENT means don't message." (mastodon-http--authorized-request "GET" (let ((url (if param -- cgit v1.2.3 From dde052a436b0c8fddf3a026fbcdfaaa74063029a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 21:44:06 +0100 Subject: Revert "remove unused --append-query-string" This reverts commit e2fd67b16104ab772a4ef962613cb9f3cb3cea52. --- lisp/mastodon-http.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index eebfa85..e3efabe 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -175,6 +175,13 @@ SILENT means don't message." (with-temp-buffer (mastodon-http--url-retrieve-synchronously url)))) +(defun mastodon-http--append-query-string (url params) + "Append PARAMS to URL as query strings and return it. + +PARAMS should be an alist as required by `url-build-query-string'." + (let ((query-string (url-build-query-string params))) + (concat url "?" query-string))) + ;; search functions: (defun mastodon-http--process-json-search () "Process JSON returned by a search query to the server." -- cgit v1.2.3 From 4de094ccce07042f68596ac9dd436c453248dd6a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 22:09:02 +0100 Subject: display profile header image [rough start] plant header image to right of avatar --- lisp/mastodon-profile.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 4aa9310..2e4807c 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -556,7 +556,8 @@ FIELDS means provide a fields vector fetched by other means." (propertize (concat "\n" - (mastodon-profile--image-from-account account) + (mastodon-profile--image-from-account account 'avatar_static) + (mastodon-profile--image-from-account account 'header_static) "\n" (propertize (mastodon-profile--account-field account 'display_name) @@ -621,11 +622,12 @@ If toot is a boost, opens the profile of the booster." (mastodon-profile--make-author-buffer (alist-get 'account (mastodon-profile--toot-json)))) -(defun mastodon-profile--image-from-account (status) - "Generate an image from a STATUS." - (let ((url (alist-get 'avatar_static status))) - (unless (equal url "/avatars/original/missing.png") - (mastodon-media--get-media-link-rendering url)))) +(defun mastodon-profile--image-from-account (account img_type) + "Return a avatar image from ACCOUNT. +IMG_TYPE is the JSON key from the account data." + (let ((img (alist-get img_type account))) + (unless (equal img "/avatars/original/missing.png") + (mastodon-media--get-media-link-rendering img)))) (defun mastodon-profile--show-user (user-handle) "Query for USER-HANDLE from current status and show that user's profile." -- cgit v1.2.3 From 0b53ae93426b09c44299f5158da66e9e24a94308 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 3 Nov 2022 23:37:53 +0100 Subject: basic poll create funs --- lisp/mastodon-toot.el | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bcb4af1..a17fabb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -162,6 +162,9 @@ change the setting on the server, see (defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") +(defvar-local mastodon-toot-poll-options nil + "A list of poll options for the toot being composed.") + (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") @@ -188,6 +191,7 @@ send.") (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) + (define-key map (kbd "C-c C-p") #'mastodon-toot--create-poll) map) "Keymap for `mastodon-toot'.") @@ -615,7 +619,17 @@ If media items have been attached and uploaded with (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) - (args (append args-media args-no-media))) + (args-poll (when mastodon-toot-poll-options + (append + (mastodon-toot--make-poll-params + mastodon-toot-poll-options) + `(("poll[expires_in]" . ,mastodon-toot-poll-expiry))))) + ;; media || polls: + (args (if mastodon-toot--media-attachments + (append args-media args-no-media) + (if mastodon-toot-poll-options + (append args-no-media args-poll) + args-no-media)))) (cond ((and mastodon-toot--media-attachments ;; make sure we have media args ;; and the same num of ids as attachments @@ -920,6 +934,27 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) +(defun mastodon-toot--make-poll-params (options) + "Returns an parameter query alist from poll OPTIONS." + (let ((key "poll[options][]")) + (cl-loop for o in options + collect `(,key . ,o)))) + +(defun mastodon-toot--create-poll () + "Prompt for new poll options and return as a list." + (interactive) + (let ((length (read-number "Number of poll options [2-4]: " 2))) + (setq mastodon-toot-poll-options + (cl-loop for x from 1 to length + collect (read-string (format "Poll option [%s/%s]: " x length)))) + (mastodon-toot--get-poll-expiry))) + +(defun mastodon-toot--get-poll-expiry () + "Prompt for a poll expiry time." + ;; API requires this in seconds + (setq mastodon-toot-poll-expiry + (read-string "poll ends in [seconds, min 5 mins]: "))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () -- cgit v1.2.3 From 26df74a1cdc4ef469d8d58006dd65bf7387bf04e Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 4 Nov 2022 12:33:12 +0100 Subject: basic poll creation, with all options polls docstrings etc cleanup --- lisp/mastodon-toot.el | 45 ++++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a17fabb..44386f7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -162,7 +162,7 @@ change the setting on the server, see (defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") -(defvar-local mastodon-toot-poll-options nil +(defvar-local mastodon-toot-poll nil "A list of poll options for the toot being composed.") (defvar-local mastodon-toot--reply-to-id nil @@ -599,6 +599,15 @@ to `emojify-user-emojis', and the emoji data is updated." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) +(defun mastodon-toot--build-poll-params () + "Return an alist of parameters for POSTing a poll status." + (append + (mastodon-toot--make-poll-params + (plist-get mastodon-toot-poll :options)) + `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) + `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) + `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))) + (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached and uploaded with @@ -619,15 +628,12 @@ If media items have been attached and uploaded with (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) - (args-poll (when mastodon-toot-poll-options - (append - (mastodon-toot--make-poll-params - mastodon-toot-poll-options) - `(("poll[expires_in]" . ,mastodon-toot-poll-expiry))))) + (args-poll (when mastodon-toot-poll + (mastodon-toot--build-poll-params))) ;; media || polls: (args (if mastodon-toot--media-attachments (append args-media args-no-media) - (if mastodon-toot-poll-options + (if mastodon-toot-poll (append args-no-media args-poll) args-no-media)))) (cond ((and mastodon-toot--media-attachments @@ -935,7 +941,7 @@ which is used to attach it to a toot when posting." (list "None"))) (defun mastodon-toot--make-poll-params (options) - "Returns an parameter query alist from poll OPTIONS." + "Return an parameter query alist from poll OPTIONS." (let ((key "poll[options][]")) (cl-loop for o in options collect `(,key . ,o)))) @@ -943,17 +949,26 @@ which is used to attach it to a toot when posting." (defun mastodon-toot--create-poll () "Prompt for new poll options and return as a list." (interactive) - (let ((length (read-number "Number of poll options [2-4]: " 2))) - (setq mastodon-toot-poll-options - (cl-loop for x from 1 to length - collect (read-string (format "Poll option [%s/%s]: " x length)))) - (mastodon-toot--get-poll-expiry))) + ;; re length, API docs show a poll 9 options. + (let* ((length (read-number "Number of poll options [2-9]: " 2)) + (multiple-p (y-or-n-p "Multiple choice poll? ")) + (options (mastodon-toot--read-poll-options length)) + (hide-totals (y-or-n-p "Hide votes until poll ends? ")) + (expiry (mastodon-toot--get-poll-expiry))) + (setq mastodon-toot-poll + `(:options ,options :length ,length :multi ,multiple-p :hide ,hide-totals :expiry ,expiry)) + (message "poll created!"))) + +(defun mastodon-toot--read-poll-options (length) + "Read a list of options for poll of LENGTH options." + (cl-loop for x from 1 to length + collect (read-string (format "Poll option [%s/%s]: " x length)))) (defun mastodon-toot--get-poll-expiry () "Prompt for a poll expiry time." ;; API requires this in seconds - (setq mastodon-toot-poll-expiry - (read-string "poll ends in [seconds, min 5 mins]: "))) + ;; TODO: offer sane poll expiry options + (read-string "poll ends in [seconds, min 5 mins]: ")) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings -- cgit v1.2.3 From a7fa1f599630aa0f49e8d0a91d400c6f267622f1 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 4 Nov 2022 13:03:34 +0100 Subject: small improvements to poll display in timeline --- lisp/mastodon-tl.el | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 130b01f..1986979 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -946,6 +946,9 @@ this just means displaying toot client." (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let* ((poll (mastodon-tl--field 'poll toot)) + (expiry (mastodon-tl--field 'expires_at poll)) + (expired-p (if (eq (mastodon-tl--field 'expired poll) :json-false) nil t)) + (multi (mastodon-tl--field 'multiple poll)) (options (mastodon-tl--field 'options poll)) (option-titles (mapcar (lambda (x) (alist-get 'title x)) @@ -958,18 +961,27 @@ this just means displaying toot client." (concat "\nPoll: \n\n" (mapconcat (lambda (option) (progn - (format "Option %s: %s%s [%s votes].\n" + (format "%s: %s%s%s\n" (setq option-counter (1+ option-counter)) - (alist-get 'title option) + (propertize (alist-get 'title option) + 'face 'success) (make-string (1+ (- (length longest-option) (length (alist-get 'title option)))) ?\ ) - (alist-get 'votes_count option)))) + (if (eq (alist-get 'votes_count option) nil) + "" + (format "[%s votes]" (alist-get 'votes_count option)))))) options "\n") + (unless expired-p + (propertize (format "Expires: %s" expiry) + 'face 'font-lock-comment-face)) + (when expired-p + (propertize "Poll expired." + 'face 'font-lock-comment-face)) "\n"))) (defun mastodon-tl--poll-vote (option) -- cgit v1.2.3 From 40cf1038e386cfe62cfcc81234794b3a13102176 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 5 Nov 2022 10:40:26 +0100 Subject: add headers arg to http--process-json and --get-json-async --- lisp/mastodon-http.el | 17 +++++++++++++---- lisp/mastodon-profile.el | 3 ++- lisp/mastodon-tl.el | 11 ++++++----- lisp/mastodon-toot.el | 5 +++-- 4 files changed, 24 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e3efabe..46a6398 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -154,10 +154,19 @@ SILENT means don't message." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-json))) -(defun mastodon-http--process-json () +(defun mastodon-http--process-json (&optional headers) "Process JSON response." ;; view raw response: - ;; (switch-to-buffer (current-buffer)) + (switch-to-buffer (current-buffer)) + (when headers + (let* ((head-str (buffer-substring-no-properties + (point-min) + (re-search-forward "^$" nil 'move))) + (head-list (split-string head-str "\n")) + (head-alist (mapcar (lambda (x) + (split-string x ": ")) + head-list))) + (setq mastodon-http-headers-alist head-alist))) (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-string @@ -241,13 +250,13 @@ Pass response buffer to CALLBACK function with args CBARGS." "GET" (url-retrieve url callback cbargs))) -(defun mastodon-http--get-json-async (url &optional callback &rest args) +(defun mastodon-http--get-json-async (url &optional headers callback &rest args) "Make GET request to URL. Call CALLBACK with json-vector and ARGS." (mastodon-http--get-async url (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json) args))))) + (apply callback (mastodon-http--process-json headers) args))))) (defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) "POST asynchronously to URL with ARGS and HEADERS. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 2e4807c..ebd1b37 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -183,7 +183,8 @@ contains") (message "Loading your favourited toots...") (mastodon-tl--init "favourites" "favourites" - 'mastodon-tl--timeline)) + 'mastodon-tl--timeline + :headers)) (defun mastodon-profile--view-bookmarks () "Open a new buffer displaying the user's bookmarks." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1986979..a9c8b39 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1139,7 +1139,7 @@ Then run CALLBACK with arguments CBARGS." "?") "max_id=" (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url callback cbargs))) + (apply 'mastodon-http--get-json-async url nil callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local @@ -1907,14 +1907,15 @@ from the start if it is nil." (goto-char (or mastodon-tl--update-point (point-min))) (funcall update-function json))))) -(defun mastodon-tl--init (buffer-name endpoint update-function) +(defun mastodon-tl--init (buffer-name endpoint update-function &optional headers) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. - -UPDATE-FUNCTION is used to recieve more toots." +UPDATE-FUNCTION is used to recieve more toots. +HEADERS means to also collect the response headers. Used for paginating +favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function))) + url headers 'mastodon-tl--init* buffer endpoint update-function))) (defun mastodon-tl--init* (json buffer endpoint update-function) "Initialize BUFFER with timeline targeted by ENDPOINT. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 44386f7..25446ef 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -203,12 +203,13 @@ send.") nil t))) (mastodon-profile--update-preference "privacy" vis :source))) -(defun mastodon-toot--get-max-toot-chars (&optional _no-toot) +(defun mastodon-toot--get-max-toot-chars (&optional no-toot) "Fetch max_toot_chars from `mastodon-instance-url' asynchronously. NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") - 'mastodon-toot--get-max-toot-chars-callback 'no-toot)) + nil + 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response &optional no-toot) -- cgit v1.2.3 From 0de46facbcb7f1467b381c030a4c0551686f25b6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:13:36 +0100 Subject: factor out tl--set-buffer-spec function in -tl.el only for now --- lisp/mastodon-tl.el | 67 ++++++++++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a3ef2ae..af5a9a4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1232,11 +1232,9 @@ ID is that of the toot to view." (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s" id) - update-function - (lambda (toot) (message "END of thread.")))) + (mastodon-tl--set-buffer-spec buffer + (format "statuses/%s" id) + (lambda (toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--toot toot :detailed-p)))))) @@ -1273,11 +1271,10 @@ ID is that of the toot to view." (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s/context" id) - update-function - (lambda (toot) (message "END of thread.")))) + (mastodon-tl--set-buffer-spec + buffer + (format "statuses/%s/context" id) + (lambda (toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--timeline (alist-get 'ancestors context)) (goto-char (point-max)) @@ -1942,21 +1939,26 @@ favourites." (mastodon-http--get-json-async url headers 'mastodon-tl--init* buffer endpoint update-function))) -(defun mastodon-tl--init* (json buffer endpoint update-function) +(defun mastodon-tl--init* (response buffer endpoint update-function) "Initialize BUFFER with timeline targeted by ENDPOINT. - UPDATE-FUNCTION is used to recieve more toots. -JSON is the data returned from the server." +RESPONSE is the data returned from the server by `mastodon-http--process-json', a cons cell of JSON and http headers." + (let* ((json (car response)) + (headers (cdr response)) + (link-header (when headers + (split-string + (car (alist-get "Link" headers nil nil 'equal)) + ",")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. ;; which means we cannot use buffer-spec for update-function ;; unless we set it both before and after the others - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function)) + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1965,11 +1967,11 @@ JSON is the data returned from the server." (funcall update-function json)) (mastodon-mode) (with-current-buffer buffer - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function) - mastodon-tl--timestamp-update-timer + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds (time-subtract mastodon-tl--timestamp-next-update @@ -2000,10 +2002,7 @@ Runs synchronously." ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. ;; which means we cannot use buffer-spec for update-function ;; unless we set it both before and after the others - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function)) + (mastodon-tl--set-buffer-spec buffer endpoint update-function) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -2012,11 +2011,8 @@ Runs synchronously." (funcall update-function json)) (mastodon-mode) (with-current-buffer buffer - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer-name - endpoint ,endpoint update-function - ,update-function) - mastodon-tl--timestamp-update-timer + (mastodon-tl--set-buffer-spec buffer endpoint update-function) + (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds (time-subtract mastodon-tl--timestamp-next-update @@ -2031,5 +2027,14 @@ Runs synchronously." (mastodon-tl--goto-first-item))) buffer)) +(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function + &optional link-header) + "Set `mastodon-tl--buffer-spec' for the current buffer." + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function + link-header ,link-header))) + (provide 'mastodon-tl) ;;; mastodon-tl.el ends here -- cgit v1.2.3 From 439e2ac0522881cb8861aa9a8ba6c03bb28a3311 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:47:09 +0100 Subject: remove all 'headers' args in -toot and -tl --- lisp/mastodon-tl.el | 21 ++++++++++----------- lisp/mastodon-toot.el | 1 - 2 files changed, 10 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index af5a9a4..e2c2013 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1937,18 +1937,17 @@ favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) (mastodon-http--get-json-async - url headers 'mastodon-tl--init* buffer endpoint update-function))) + url 'mastodon-tl--init* buffer endpoint update-function))) (defun mastodon-tl--init* (response buffer endpoint update-function) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by `mastodon-http--process-json', a cons cell of JSON and http headers." - (let* ((json (car response)) - (headers (cdr response)) - (link-header (when headers - (split-string - (car (alist-get "Link" headers nil nil 'equal)) - ",")))) + (let* ((json response)) + ;; (link-header (when headers + ;; (split-string + ;; (car (alist-get "Link" headers nil nil 'equal)) + ;; ",")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: @@ -1957,8 +1956,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', ;; unless we set it both before and after the others (mastodon-tl--set-buffer-spec buffer endpoint - update-function - link-header) + update-function) + ;; link-header) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1969,8 +1968,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (with-current-buffer buffer (mastodon-tl--set-buffer-spec buffer endpoint - update-function - link-header) + update-function) + ;; link-header) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 70aaf14..9a65439 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -208,7 +208,6 @@ send.") NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") - nil 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response -- cgit v1.2.3 From 467f61817c27a1c001ec911d278d3c64770f708a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:48:20 +0100 Subject: http: add response layer to requests: - response is a cons of JSON list and http response headers alist - existing --get-json functions now just car the response - we also process JSON array as a list not a vector - this should open the way to handling response headers if we want to, eg for paginating favorites with the Link: header --- lisp/mastodon-http.el | 75 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 50 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 46a6398..5546325 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,34 +148,51 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) +(defun mastodon-http--get-response (url &optional silent) + "Make synchronous GET request to URL. Return JSON and response headers. +SILENT means don't message. +HEADERS means also return http response headers." + (with-current-buffer (mastodon-http--get url silent) + (mastodon-http--process-response))) + (defun mastodon-http--get-json (url &optional silent) - "Make synchronous GET request to URL. Return JSON response. + "Return only JSON data from URL request. SILENT means don't message." - (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-json))) + (car (mastodon-http--get-response url silent))) -(defun mastodon-http--process-json (&optional headers) - "Process JSON response." +(defun mastodon-http--process-json () + "Return only JSON data from async URL request. +Callback for `mastodon-http--get-json-async'." + (car (mastodon-http--process-response))) + +(defun mastodon-http--process-response () + "Process http response. +Return a cons of JSON list and http response headers." ;; view raw response: + ;; (switch-to-buffer (current-buffer)) + (let ((headers (mastodon-http--process-headers))) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-array-type 'list) + (json-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) + (kill-buffer) + (unless (or (string-empty-p json-string) (null json-string)) + `(,(json-read-from-string json-string) . ,headers))))) + +(defun mastodon-http--process-headers () + "Return an alist of http response headers." (switch-to-buffer (current-buffer)) - (when headers - (let* ((head-str (buffer-substring-no-properties - (point-min) - (re-search-forward "^$" nil 'move))) - (head-list (split-string head-str "\n")) - (head-alist (mapcar (lambda (x) - (split-string x ": ")) - head-list))) - (setq mastodon-http-headers-alist head-alist))) (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) - (kill-buffer) - (unless (or (string-empty-p json-string) (null json-string)) - (json-read-from-string json-string)))) + (let* ((head-str (buffer-substring-no-properties + (point-min) + (re-search-forward "^$" nil 'move))) + (head-list (split-string head-str "\n"))) + (mapcar (lambda (x) + (split-string x ": ")) + head-list))) (defun mastodon-http--delete (url) "Make DELETE request to URL." @@ -250,13 +267,21 @@ Pass response buffer to CALLBACK function with args CBARGS." "GET" (url-retrieve url callback cbargs))) -(defun mastodon-http--get-json-async (url &optional headers callback &rest args) - "Make GET request to URL. Call CALLBACK with json-vector and ARGS." +(defun mastodon-http--get-response-async (url callback &rest args) + "Make GET request to URL. Call CALLBACK with http response and ARGS." + (mastodon-http--get-async + url + (lambda (status) + (when status ;; only when we actually get sth? + (apply callback (mastodon-http--process-response) args))))) + +(defun mastodon-http--get-json-async (url callback &rest args) + "Make GET request to URL. Call CALLBACK with json-list and ARGS." (mastodon-http--get-async url (lambda (status) (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json headers) args))))) + (apply callback (mastodon-http--process-json) args))))) (defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) "POST asynchronously to URL with ARGS and HEADERS. -- cgit v1.2.3 From 14eb275b966395b04da438a804b0a9a4a5d0dcab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:52:40 +0100 Subject: relationships in print profile buffer - get json list not vect --- lisp/mastodon-profile.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index ebd1b37..e664ee5 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -466,7 +466,8 @@ This endpoint only holds a few preferences. For others, see (url (mastodon-http--api (format "accounts/relationships?id[]=%s" their-id)))) - (mastodon-http--get-json url))) + ;; FIXME: not sure why we need to do this for relationships only! + (car (mastodon-http--get-json url)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -528,11 +529,9 @@ FIELDS means provide a fields vector fetched by other means." account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) (followed-by-you (when (not (seq-empty-p relationships)) - (alist-get 'following - (aref relationships 0)))) + (alist-get 'following relationships))) (follows-you (when (not (seq-empty-p relationships)) - (alist-get 'followed_by - (aref relationships 0)))) + (alist-get 'followed_by relationships))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) (pinned (mastodon-profile--get-statuses-pinned account))) -- cgit v1.2.3 From d3538d7553557350b7bee1743f5403f69ffd89db Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 11:54:28 +0100 Subject: -tl--init* revert json > response arg for now --- lisp/mastodon-tl.el | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e2c2013..813c18c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1939,15 +1939,10 @@ favourites." (mastodon-http--get-json-async url 'mastodon-tl--init* buffer endpoint update-function))) -(defun mastodon-tl--init* (response buffer endpoint update-function) +(defun mastodon-tl--init* (json buffer endpoint update-function) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by `mastodon-http--process-json', a cons cell of JSON and http headers." - (let* ((json response)) - ;; (link-header (when headers - ;; (split-string - ;; (car (alist-get "Link" headers nil nil 'equal)) - ;; ",")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: @@ -1982,10 +1977,6 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (unless (string-prefix-p "accounts" endpoint) ;; for everything save profiles (mastodon-tl--goto-first-item)))) -;;(or (equal endpoint "notifications") -;; (string-prefix-p "timelines" endpoint) -;; (string-prefix-p "favourites" endpoint) -;; (string-prefix-p "statuses" endpoint)) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. -- cgit v1.2.3 From 596a9498a8dcc2aecb28f94f9ba57766583f5fab Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 12:22:04 +0100 Subject: --init: handle json or full response and handle Link header --- lisp/mastodon-http.el | 1 + lisp/mastodon-tl.el | 26 ++++++++++++++++++-------- 2 files changed, 19 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 5546325..fedbe95 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -191,6 +191,7 @@ Return a cons of JSON list and http response headers." (re-search-forward "^$" nil 'move))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) + ;; FIXME: use dotted notation so alist-get doesn't return a list (split-string x ": ")) head-list))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 813c18c..a2194b7 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1936,13 +1936,23 @@ HEADERS means to also collect the response headers. Used for paginating favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) - (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function))) + (if headers + (mastodon-http--get-response-async + url 'mastodon-tl--init* buffer endpoint update-function headers) + (mastodon-http--get-json-async + url 'mastodon-tl--init* buffer endpoint update-function)))) -(defun mastodon-tl--init* (json buffer endpoint update-function) +(defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. RESPONSE is the data returned from the server by `mastodon-http--process-json', a cons cell of JSON and http headers." + (let* ((json (if headers (car response) response)) + (headers (if headers (cdr response) nil)) + (link-header (when headers + (split-string + (car + (alist-get "Link" headers nil nil 'equal)) + ", ")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: @@ -1951,8 +1961,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', ;; unless we set it both before and after the others (mastodon-tl--set-buffer-spec buffer endpoint - update-function) - ;; link-header) + update-function + link-header) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1963,8 +1973,8 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (with-current-buffer buffer (mastodon-tl--set-buffer-spec buffer endpoint - update-function) - ;; link-header) + update-function + link-header) (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds @@ -1976,7 +1986,7 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', nil))) (unless (string-prefix-p "accounts" endpoint) ;; for everything save profiles - (mastodon-tl--goto-first-item)))) + (mastodon-tl--goto-first-item))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. -- cgit v1.2.3 From e847059950308eea45bb70736a33a6d4c348bfff Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 14:00:39 +0100 Subject: use a proper dotted alist for response headers list --- lisp/mastodon-http.el | 4 ++-- lisp/mastodon-tl.el | 5 +---- 2 files changed, 3 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index fedbe95..1c6e1ae 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -191,8 +191,8 @@ Return a cons of JSON list and http response headers." (re-search-forward "^$" nil 'move))) (head-list (split-string head-str "\n"))) (mapcar (lambda (x) - ;; FIXME: use dotted notation so alist-get doesn't return a list - (split-string x ": ")) + (let ((list (split-string x ": "))) + (cons (car list) (cadr list)))) head-list))) (defun mastodon-http--delete (url) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a2194b7..4a0f40c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1949,10 +1949,7 @@ RESPONSE is the data returned from the server by `mastodon-http--process-json', (let* ((json (if headers (car response) response)) (headers (if headers (cdr response) nil)) (link-header (when headers - (split-string - (car - (alist-get "Link" headers nil nil 'equal)) - ", ")))) + (split-string (alist-get "Link" headers nil nil 'equal) ", ")))) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: -- cgit v1.2.3 From 5cb9b991c0b59c572640ded6d1ce53f4ed408797 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 9 Nov 2022 20:22:12 +0100 Subject: opt no-headers arg, only fetch when nil --- lisp/mastodon-http.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1c6e1ae..36d53c9 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,29 +148,31 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) -(defun mastodon-http--get-response (url &optional silent) +(defun mastodon-http--get-response (url &optional no-headers silent) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. HEADERS means also return http response headers." (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-response))) + (mastodon-http--process-response no-headers))) (defun mastodon-http--get-json (url &optional silent) "Return only JSON data from URL request. SILENT means don't message." - (car (mastodon-http--get-response url silent))) + (car (mastodon-http--get-response url :no-headers silent))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. -Callback for `mastodon-http--get-json-async'." - (car (mastodon-http--process-response))) +Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." + (car (mastodon-http--process-response :no-headers))) -(defun mastodon-http--process-response () +(defun mastodon-http--process-response (&optional no-headers) "Process http response. -Return a cons of JSON list and http response headers." +Return a cons of JSON list and http response headers. +Callback to `mastodon-http--get-response-async', usually `mastodon-tl--init*', is run on the result." ;; view raw response: ;; (switch-to-buffer (current-buffer)) - (let ((headers (mastodon-http--process-headers))) + (let ((headers (unless no-headers + (mastodon-http--process-headers)))) (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-array-type 'list) -- cgit v1.2.3 From 04ba8ebdf01b07331340f4c1e8f14987156a0cf8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 10:23:49 +0100 Subject: paginate favourites view using Link header --- lisp/mastodon-tl.el | 151 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 96 insertions(+), 55 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 4a0f40c..03ee41e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -68,6 +68,7 @@ (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-http--get-response-async "mastodon-http") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) @@ -1123,7 +1124,12 @@ Optionally set it for BUFFER." (defun mastodon-tl--buffer-name (&optional buffer) "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'buffer-name buffer )) + (mastodon-tl--get-buffer-property 'buffer-name buffer)) + +(defun mastodon-tl--link-header (&optional buffer) + "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. +Optionally get it for BUFFER." + (mastodon-tl--get-buffer-property 'link-header buffer)) (defun mastodon-tl--get-buffer-property (property &optional buffer) "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'." @@ -1132,6 +1138,19 @@ Optionally get it for BUFFER." (error "Mastodon-tl--buffer-spec is not defined for buffer %s" (or buffer (current-buffer)))))) +(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function + &optional link-header) + "Set `mastodon-tl--buffer-spec' for the current buffer. + +BUFFER is buffer name, ENDPOINT is buffer's enpoint, +UPDATE-FUNCTION is its update function. +LINK-HEADER is the http Link header if present." + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function + link-header ,link-header))) + (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." (let* ((url (mastodon-http--api (concat @@ -1752,23 +1771,48 @@ For use after e.g. deleting a toot." (mastodon-tl--thread (match-string 2 (mastodon-tl--get-endpoint))))))) +(defun mastodon-tl--build-link-header-url (str) + "Return a URL from STR, an http Link header." + (let* ((split (split-string str "; ")) + (url-base (string-trim (car split) "<" ">")) + (param (cadr split))) + (concat url-base "&" param))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) (message "Loading older toots...") - (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) - 'mastodon-tl--more* (current-buffer) (point))) - -(defun mastodon-tl--more* (json buffer point-before) + (if (string= (buffer-name (current-buffer)) "*mastodon-favourites*") + ;; link-header: can't build a URL with --more-json-async, endpoint/id: + (let* ((next (car (mastodon-tl--link-header))) + (prev (cadr (mastodon-tl--link-header))) + (url (mastodon-tl--build-link-header-url next))) + (mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer) + (point) :headers)) + (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) + 'mastodon-tl--more* (current-buffer) (point)))) + +(defun mastodon-tl--more* (response buffer point-before &optional headers) "Append older toots to timeline, asynchronously. -Runs the timeline's update function on JSON, in BUFFER. -When done, places point at POINT-BEFORE." +Runs the timeline's update function on RESPONSE, in BUFFER. +When done, places point at POINT-BEFORE. +HEADERS is the http headers returned in the response, if any." (with-current-buffer buffer - (when json - (let ((inhibit-read-only t)) + (when response + (let* ((inhibit-read-only t) + (json (if headers (car response) response)) + (headers (if headers (cdr response) nil)) + (link-header (mastodon-tl--get-link-header-from-response headers))) (goto-char (point-max)) (funcall (mastodon-tl--get-update-function) json) (goto-char point-before) + ;; update buffer spec to new link-header: + ;; (other values should just remain as they were) + (when headers + (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) + (mastodon-tl--get-endpoint) + (mastodon-tl--get-update-function) + link-header)) (message "Loading older toots... done."))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) @@ -1929,6 +1973,11 @@ from the start if it is nil." (goto-char (or mastodon-tl--update-point (point-min))) (funcall update-function json))))) +(defun mastodon-tl--get-link-header-from-response (headers) + "Get http Link header from list of http HEADERS." + (when headers + (split-string (alist-get "Link" headers nil nil 'equal) ", "))) + (defun mastodon-tl--init (buffer-name endpoint update-function &optional headers) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots. @@ -1945,45 +1994,46 @@ favourites." (defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "Initialize BUFFER with timeline targeted by ENDPOINT. UPDATE-FUNCTION is used to recieve more toots. -RESPONSE is the data returned from the server by `mastodon-http--process-json', a cons cell of JSON and http headers." +RESPONSE is the data returned from the server by +`mastodon-http--process-json', a cons cell of JSON and http +headers." (let* ((json (if headers (car response) response)) (headers (if headers (cdr response) nil)) - (link-header (when headers - (split-string (alist-get "Link" headers nil nil 'equal) ", ")))) - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - ;; mastodon-mode wipes buffer-spec, so order must unforch be: - ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. - ;; which means we cannot use buffer-spec for update-function - ;; unless we set it both before and after the others - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header) - (setq - ;; Initialize with a minimal interval; we re-scan at least once - ;; every 5 minutes to catch any timestamps we may have missed - mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) - (funcall update-function json)) - (mastodon-mode) - (with-current-buffer buffer - (mastodon-tl--set-buffer-spec buffer - endpoint - update-function - link-header) - (setq mastodon-tl--timestamp-update-timer - (when mastodon-tl--enable-relative-timestamps - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil))) - (unless (string-prefix-p "accounts" endpoint) - ;; for everything save profiles - (mastodon-tl--goto-first-item))))) + (link-header (mastodon-tl--get-link-header-from-response headers))) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + ;; mastodon-mode wipes buffer-spec, so order must unforch be: + ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. + ;; which means we cannot use buffer-spec for update-function + ;; unless we set it both before and after the others + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq + ;; Initialize with a minimal interval; we re-scan at least once + ;; every 5 minutes to catch any timestamps we may have missed + mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300))) + (funcall update-function json)) + (mastodon-mode) + (with-current-buffer buffer + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil))) + (unless (string-prefix-p "accounts" endpoint) + ;; for everything save profiles + (mastodon-tl--goto-first-item))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. @@ -2024,14 +2074,5 @@ Runs synchronously." (mastodon-tl--goto-first-item))) buffer)) -(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function - &optional link-header) - "Set `mastodon-tl--buffer-spec' for the current buffer." - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function - link-header ,link-header))) - (provide 'mastodon-tl) ;;; mastodon-tl.el ends here -- cgit v1.2.3 From a19588719ccf0ec35d22acdf2ce349a5ef499691 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 10:25:52 +0100 Subject: http docstrings --- lisp/mastodon-http.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 36d53c9..0866248 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,7 +151,7 @@ SILENT means don't message." (defun mastodon-http--get-response (url &optional no-headers silent) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. -HEADERS means also return http response headers." +NO-HEADERS means don't collect http response headers." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-response no-headers))) @@ -162,13 +162,16 @@ SILENT means don't message." (defun mastodon-http--process-json () "Return only JSON data from async URL request. -Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." +Callback to `mastodon-http--get-json-async', usually +`mastodon-tl--init*', is run on the result." (car (mastodon-http--process-response :no-headers))) (defun mastodon-http--process-response (&optional no-headers) "Process http response. Return a cons of JSON list and http response headers. -Callback to `mastodon-http--get-response-async', usually `mastodon-tl--init*', is run on the result." +If NO-HEADERS is non-nil, just return the JSON. +Callback to `mastodon-http--get-response-async', usually +`mastodon-tl--init*', is run on the result." ;; view raw response: ;; (switch-to-buffer (current-buffer)) (let ((headers (unless no-headers -- cgit v1.2.3 From 1c068079574cd78c8bfd878f1d3fea5f54c7be98 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:07:54 +0100 Subject: process-response: optionally JSON array as vector, for instance desc --- lisp/mastodon-http.el | 12 ++++++------ lisp/mastodon-tl.el | 4 +++- 2 files changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 0866248..9525568 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,17 +148,17 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) -(defun mastodon-http--get-response (url &optional no-headers silent) +(defun mastodon-http--get-response (url &optional no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. NO-HEADERS means don't collect http response headers." (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-response no-headers))) + (mastodon-http--process-response no-headers vector))) -(defun mastodon-http--get-json (url &optional silent) +(defun mastodon-http--get-json (url &optional silent vector) "Return only JSON data from URL request. SILENT means don't message." - (car (mastodon-http--get-response url :no-headers silent))) + (car (mastodon-http--get-response url :no-headers silent vector))) (defun mastodon-http--process-json () "Return only JSON data from async URL request. @@ -166,7 +166,7 @@ Callback to `mastodon-http--get-json-async', usually `mastodon-tl--init*', is run on the result." (car (mastodon-http--process-response :no-headers))) -(defun mastodon-http--process-response (&optional no-headers) +(defun mastodon-http--process-response (&optional no-headers vector) "Process http response. Return a cons of JSON list and http response headers. If NO-HEADERS is non-nil, just return the JSON. @@ -178,7 +178,7 @@ Callback to `mastodon-http--get-response-async', usually (mastodon-http--process-headers)))) (goto-char (point-min)) (re-search-forward "^$" nil 'move) - (let ((json-array-type 'list) + (let ((json-array-type (if vector 'vector 'list)) (json-string (decode-coding-string (buffer-substring-no-properties (point) (point-max)) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 03ee41e..338f227 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1466,7 +1466,9 @@ INSTANCE is an instance domain name." (if user (mastodon-http--api "instance") (concat instance - "/api/v1/instance"))))) + "/api/v1/instance")) + nil + :vector))) (when response (let ((buf (get-buffer-create "*mastodon-instance*"))) (with-current-buffer buf -- cgit v1.2.3 From 57678cf452c868f835a2e197995b44edea503565 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:08:29 +0100 Subject: cull stray nil arg from old --get-json-async args form --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 338f227..be3ac1e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1172,7 +1172,7 @@ Then run CALLBACK with arguments CBARGS." "?") "max_id=" (mastodon-tl--as-string id))))) - (apply 'mastodon-http--get-json-async url nil callback cbargs))) + (apply 'mastodon-http--get-json-async url callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local -- cgit v1.2.3 From 085ade5f958250886e8c96c2538f689a8278ec02 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 10 Nov 2022 11:16:10 +0100 Subject: http vector docstrings --- lisp/mastodon-http.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 9525568..66707b7 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -151,13 +151,15 @@ SILENT means don't message." (defun mastodon-http--get-response (url &optional no-headers silent vector) "Make synchronous GET request to URL. Return JSON and response headers. SILENT means don't message. -NO-HEADERS means don't collect http response headers." +NO-HEADERS means don't collect http response headers. +VECTOR means return json arrays as vectors." (with-current-buffer (mastodon-http--get url silent) (mastodon-http--process-response no-headers vector))) (defun mastodon-http--get-json (url &optional silent vector) "Return only JSON data from URL request. -SILENT means don't message." +SILENT means don't message. +VECTOR means return json arrays as vectors." (car (mastodon-http--get-response url :no-headers silent vector))) (defun mastodon-http--process-json () @@ -170,6 +172,7 @@ Callback to `mastodon-http--get-json-async', usually "Process http response. Return a cons of JSON list and http response headers. If NO-HEADERS is non-nil, just return the JSON. +VECTOR means return json arrays as vectors. Callback to `mastodon-http--get-response-async', usually `mastodon-tl--init*', is run on the result." ;; view raw response: -- cgit v1.2.3