paginate favourites view using Link header

1 files 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