SWAG at moving to an async network model.

2 files changed, 95 insertions, 43 deletions

diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index a6e9c92..a5f88d7 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -113,18 +113,57 @@ Pass response buffer to CALLBACK function."
       (url-retrieve-synchronously url))))
 
 (defun mastodon-http--get-json (url)
-  "Make GET request to URL. Return JSON response vector."
-  (let ((json-vector
-         (with-current-buffer (mastodon-http--get url)
-           (goto-char (point-min))
-           (re-search-forward "^$" nil 'move)
-           (let ((json-string
-                  (decode-coding-string
-                   (buffer-substring-no-properties (point) (point-max))
-                   'utf-8)))
-             (kill-buffer)
-             (json-read-from-string json-string)))))
-    json-vector))
+  "Make GET request to URL. Return JSON response"
+  (with-current-buffer (mastodon-http--get url)
+    (mastodon-http--process-json)))
+
+(defun mastodon-http--process-json ()
+  (goto-char (point-min))
+  (re-search-forward "^$" nil 'move)
+  (let ((json-string
+         (decode-coding-string
+          (buffer-substring-no-properties (point) (point-max))
+          'utf-8)))
+    (kill-buffer)
+    (json-read-from-string json-string)))
+
+ ;; Asynchronous functions
+
+(defun mastodon-http--get-async (url &optional callback &rest cbargs)
+  "Make GET request to URL.
+
+Pass response buffer to CALLBACK function."
+  (let ((url-request-method "GET")
+        (url-request-extra-headers
+         `(("Authorization" . ,(concat "Bearer "
+                                       (mastodon-auth--access-token))))))
+    (url-retrieve url callback cbargs mastodon-http--timeout)))
+
+(defun mastodon-http--get-json-async (url &optional callback &rest args)
+  "Make GET request to URL. Call CALLBACK with json-vector and ARGS."
+  (mastodon-http--get-async
+   url
+   (lambda (status)
+     (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.
+
+Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
+  (let ((url-request-method "POST")
+        (url-request-data
+         (when args
+           (mapconcat (lambda (arg)
+                        (concat (url-hexify-string (car arg))
+                                "="
+                                (url-hexify-string (cdr arg))))
+                      args
+                      "&")))
+        (url-request-extra-headers
+	     (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))
+	             headers)))
+    (with-temp-buffer
+      (url-retrieve url callback cbargs mastodon-http--timeout))))
 
 (provide 'mastodon-http)
 ;;; mastodon-http.el ends here
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 30982a2..a1c6495 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -703,6 +703,17 @@ it is `mastodon-tl--byline-boosted'"
                                    (mastodon-tl--as-string id)))))
     (mastodon-http--get-json url)))
 
+(defun mastodon-tl--more-json-async (endpoint id callback &rest cbargs)
+  "Return JSON for timeline ENDPOINT before ID."
+  (let* ((url (mastodon-http--api (concat
+                                   endpoint
+                                   (if (string-match-p "?" endpoint)
+                                       "&"
+                                     "?")
+                                   "max_id="
+                                   (mastodon-tl--as-string id)))))
+    (apply 'mastodon-http--get-json-async url callback cbargs)))
+
 ;; TODO
 ;; Look into the JSON returned here by Local
 (defun mastodon-tl--updated-json (endpoint id)
@@ -945,15 +956,15 @@ webapp"
 (defun mastodon-tl--more ()
   "Append older toots to timeline."
   (interactive)
-  (let* ((point-before (point))
-         (endpoint (mastodon-tl--get-endpoint))
-         (update-function (mastodon-tl--get-update-function))
-         (id (mastodon-tl--oldest-id))
-         (json (mastodon-tl--more-json endpoint id)))
+  (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)
+  (with-current-buffer buffer
     (when json
       (let ((inhibit-read-only t))
         (goto-char (point-max))
-        (funcall update-function json)
+        (funcall (mastodon-tl--get-update-function) json)
         (goto-char point-before)))))
 
 (defun mastodon-tl--find-property-range (property start-point &optional search-backwards)
@@ -1114,31 +1125,33 @@ from the start if it is nil."
   "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
 
 UPDATE-FUNCTION is used to recieve more toots."
-  (let* ((url (mastodon-http--api endpoint))
-         (buffer (concat "*mastodon-" buffer-name "*"))
-         (json (mastodon-http--get-json url)))
-    (with-output-to-temp-buffer buffer
-      (switch-to-buffer buffer)
-      (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
-      (setq mastodon-tl--buffer-spec
-            `(buffer-name ,buffer-name
-                          endpoint ,endpoint update-function
-                          ,update-function)
-            mastodon-tl--timestamp-update-timer
-            (when mastodon-tl--enable-relative-timestamps
-              (run-at-time mastodon-tl--timestamp-next-update
-                           nil ;; don't repeat
-                           #'mastodon-tl--update-timestamps-callback
-                           (current-buffer)
-                           nil))))
-    buffer))
+  (let ((url (mastodon-http--api endpoint))
+        (buffer (concat "*mastodon-" buffer-name "*")))
+    (mastodon-http--get-json-async
+     url 'mastodon-tl--init* buffer endpoint update-function)))
+
+(defun mastodon-tl--init* (json buffer endpoint update-function)
+  (with-output-to-temp-buffer buffer
+    (switch-to-buffer buffer)
+    (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
+    (setq mastodon-tl--buffer-spec
+          `(buffer-name ,buffer
+                        endpoint ,endpoint update-function
+                        ,update-function)
+          mastodon-tl--timestamp-update-timer
+          (when mastodon-tl--enable-relative-timestamps
+            (run-at-time mastodon-tl--timestamp-next-update
+                         nil ;; don't repeat
+                         #'mastodon-tl--update-timestamps-callback
+                         (current-buffer)
+                         nil)))))
 
 (provide 'mastodon-tl)
 ;;; mastodon-tl.el ends here