with-mastodon-buffer macro

4 files changed, 202 insertions, 218 deletions

diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 35a9ebb..fe7d7d2 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -39,6 +39,7 @@
 (require 'persist)
 (require 'parse-time)
 
+(autoload 'with-mastodon-buffer "mastodon")
 (autoload 'mastodon-auth--get-account-id "mastodon-auth")
 (autoload 'mastodon-auth--get-account-name "mastodon-auth.el")
 (autoload 'mastodon-http--api "mastodon-http.el")
@@ -605,95 +606,92 @@ HEADERS means also fetch link headers for pagination."
          (fields (mastodon-profile--fields-get account))
          (pinned (mastodon-profile--get-statuses-pinned account))
          (joined (mastodon-profile--account-field account 'created_at)))
-    (with-current-buffer (get-buffer-create buffer)
-      (let ((inhibit-read-only t))
-        (switch-to-buffer buffer)
-        (erase-buffer)
-        (mastodon-mode)
-        (mastodon-profile-mode)
-        (setq mastodon-profile--account account)
-        (mastodon-tl--set-buffer-spec buffer
-                                      endpoint
-                                      update-function
-                                      link-header)
-        (let* ((inhibit-read-only t)
-               (is-statuses (string= endpoint-type "statuses"))
-               (is-followers (string= endpoint-type "followers"))
-               (is-following (string= endpoint-type "following"))
-               (endpoint-name (cond
-                               (is-statuses (if no-reblogs
-                                                "  TOOTS (no boosts)"
-                                              "    TOOTS    "))
-                               (is-followers "  FOLLOWERS  ")
-                               (is-following "  FOLLOWING  "))))
-          (insert
-           (propertize
-            (concat
-             "\n"
-             (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)
-                         'face 'mastodon-display-name-face)
-             "\n"
-             (propertize (concat "@" acct)
-                         'face 'default)
-             (if (equal locked t)
-                 (concat " " (mastodon-tl--symbol 'locked))
-               "")
-             "\n " mastodon-tl--horiz-bar "\n"
-             ;; profile note:
-             ;; account here to enable tab-stops in profile note
-             (mastodon-tl--render-text note account)
-             ;; meta fields:
-             (if fields
-                 (concat "\n"
-                         (mastodon-tl--set-face
-                          (mastodon-profile--fields-insert fields)
-                          'success))
-               "")
-             "\n"
-             ;; Joined date:
-             (propertize
-              (mastodon-profile--format-joined-date-string joined)
-              'face 'success)
-             "\n\n")
-            'profile-json account)
-           ;; insert counts
-           (mastodon-tl--set-face
-            (concat " " mastodon-tl--horiz-bar "\n"
-                    " TOOTS: " toots-count " | "
-                    "FOLLOWERS: " followers-count " | "
-                    "FOLLOWING: " following-count "\n"
-                    " " mastodon-tl--horiz-bar "\n\n")
-            'success)
-           ;; insert relationship (follows)
-           (if followsp
-               (mastodon-tl--set-face
-                (concat (when (equal follows-you 't)
-                          " | FOLLOWS YOU")
-                        (when (equal followed-by-you 't)
-                          " | FOLLOWED BY YOU")
-                        (when (equal requested-you 't)
-                          " | REQUESTED TO FOLLOW YOU")
-                        "\n\n")
-                'success)
-             "") ; if no followsp we still need str-or-char-p for insert
-           ;; insert endpoint
-           (mastodon-tl--set-face
-            (concat " " mastodon-tl--horiz-bar "\n"
-                    endpoint-name "\n"
-                    " " mastodon-tl--horiz-bar "\n")
-            'success))
-          (setq mastodon-tl--update-point (point))
-          (mastodon-media--inline-images (point-min) (point))
-          ;; insert pinned toots first
-          (when (and pinned (equal endpoint-type "statuses"))
-            (mastodon-profile--insert-statuses-pinned pinned)
-            (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots
-          (funcall update-function json)))
-      (goto-char (point-min)))))
+    (with-mastodon-buffer
+     buffer
+     (mastodon-profile-mode)
+     (setq mastodon-profile--account account)
+     (mastodon-tl--set-buffer-spec buffer
+                                   endpoint
+                                   update-function
+                                   link-header)
+     (let* ((inhibit-read-only t)
+            (is-statuses (string= endpoint-type "statuses"))
+            (is-followers (string= endpoint-type "followers"))
+            (is-following (string= endpoint-type "following"))
+            (endpoint-name (cond
+                            (is-statuses (if no-reblogs
+                                             "  TOOTS (no boosts)"
+                                           "    TOOTS    "))
+                            (is-followers "  FOLLOWERS  ")
+                            (is-following "  FOLLOWING  "))))
+       (insert
+        (propertize
+         (concat
+          "\n"
+          (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)
+                      'face 'mastodon-display-name-face)
+          "\n"
+          (propertize (concat "@" acct)
+                      'face 'default)
+          (if (equal locked t)
+              (concat " " (mastodon-tl--symbol 'locked))
+            "")
+          "\n " mastodon-tl--horiz-bar "\n"
+          ;; profile note:
+          ;; account here to enable tab-stops in profile note
+          (mastodon-tl--render-text note account)
+          ;; meta fields:
+          (if fields
+              (concat "\n"
+                      (mastodon-tl--set-face
+                       (mastodon-profile--fields-insert fields)
+                       'success))
+            "")
+          "\n"
+          ;; Joined date:
+          (propertize
+           (mastodon-profile--format-joined-date-string joined)
+           'face 'success)
+          "\n\n")
+         'profile-json account)
+        ;; insert counts
+        (mastodon-tl--set-face
+         (concat " " mastodon-tl--horiz-bar "\n"
+                 " TOOTS: " toots-count " | "
+                 "FOLLOWERS: " followers-count " | "
+                 "FOLLOWING: " following-count "\n"
+                 " " mastodon-tl--horiz-bar "\n\n")
+         'success)
+        ;; insert relationship (follows)
+        (if followsp
+            (mastodon-tl--set-face
+             (concat (when (equal follows-you 't)
+                       " | FOLLOWS YOU")
+                     (when (equal followed-by-you 't)
+                       " | FOLLOWED BY YOU")
+                     (when (equal requested-you 't)
+                       " | REQUESTED TO FOLLOW YOU")
+                     "\n\n")
+             'success)
+          "") ; if no followsp we still need str-or-char-p for insert
+        ;; insert endpoint
+        (mastodon-tl--set-face
+         (concat " " mastodon-tl--horiz-bar "\n"
+                 endpoint-name "\n"
+                 " " mastodon-tl--horiz-bar "\n")
+         'success))
+       (setq mastodon-tl--update-point (point))
+       (mastodon-media--inline-images (point-min) (point))
+       ;; insert pinned toots first
+       (when (and pinned (equal endpoint-type "statuses"))
+         (mastodon-profile--insert-statuses-pinned pinned)
+         (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots
+       (funcall update-function json)))
+    (goto-char (point-min))))
 
 (defun mastodon-profile--format-joined-date-string (joined)
   "Format a human-readable Joined string from timestamp JOINED.
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 8cfa3cb..86ebb90 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -35,6 +35,7 @@
 (autoload 'mastodon-http--get-json "mastodon-http")
 (autoload 'mastodon-http--get-search-json "mastodon-http")
 (autoload 'mastodon-mode "mastodon")
+(autoload 'with-mastodon-buffer "mastodon")
 (autoload 'mastodon-tl--as-string "mastodon-tl")
 (autoload 'mastodon-tl--as-string "mastodon-tl")
 (autoload 'mastodon-tl--render-text "mastodon-tl")
@@ -153,36 +154,33 @@ PRINT-FUN is the function used to print the data from the response."
                             tags))
          (toots-list-json
           (mastodon-search--get-full-statuses-data statuses)))
-    (with-current-buffer (get-buffer-create buffer)
-      (switch-to-buffer buffer)
-      (mastodon-mode)
-      (let ((inhibit-read-only t))
-        (erase-buffer)
-        (mastodon-tl--set-buffer-spec buffer
-                                      "api/v2/search"
-                                      nil)
-        ;; user results:
-        (insert (mastodon-tl--set-face
-                 (concat "\n " mastodon-tl--horiz-bar "\n"
-                         " USERS\n"
-                         " " mastodon-tl--horiz-bar "\n\n")
-                 'success))
-        (mastodon-search--insert-users-propertized accts :note)
-        ;; hashtag results:
-        (insert (mastodon-tl--set-face
-                 (concat "\n " mastodon-tl--horiz-bar "\n"
-                         " HASHTAGS\n"
-                         " " mastodon-tl--horiz-bar "\n\n")
-                 'success))
-        (mastodon-search--print-tags-list tags-list)
-        ;; status results:
-        (insert (mastodon-tl--set-face
-                 (concat "\n " mastodon-tl--horiz-bar "\n"
-                         " STATUSES\n"
-                         " " mastodon-tl--horiz-bar "\n")
-                 'success))
-        (mapc #'mastodon-tl--toot toots-list-json)
-        (goto-char (point-min))))))
+    (with-mastodon-buffer
+     buffer
+     (mastodon-tl--set-buffer-spec buffer
+                                   "api/v2/search"
+                                   nil)
+     ;; user results:
+     (insert (mastodon-tl--set-face
+              (concat "\n " mastodon-tl--horiz-bar "\n"
+                      " USERS\n"
+                      " " mastodon-tl--horiz-bar "\n\n")
+              'success))
+     (mastodon-search--insert-users-propertized accts :note)
+     ;; hashtag results:
+     (insert (mastodon-tl--set-face
+              (concat "\n " mastodon-tl--horiz-bar "\n"
+                      " HASHTAGS\n"
+                      " " mastodon-tl--horiz-bar "\n\n")
+              'success))
+     (mastodon-search--print-tags-list tags-list)
+     ;; status results:
+     (insert (mastodon-tl--set-face
+              (concat "\n " mastodon-tl--horiz-bar "\n"
+                      " STATUSES\n"
+                      " " mastodon-tl--horiz-bar "\n")
+              'success))
+     (mapc #'mastodon-tl--toot toots-list-json)
+     (goto-char (point-min)))))
 
 (defun mastodon-search--insert-users-propertized (json &optional note)
   "Insert users list into the buffer.
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index f72c6fb..ed1940b 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -42,6 +42,7 @@
 (autoload 'mastodon-mode "mastodon")
 (autoload 'mastodon-notifications-get "mastodon")
 (autoload 'mastodon-url-lookup "mastodon")
+(autoload 'with-mastodon-buffer "mastodon")
 (autoload 'mastodon-auth--get-account-id "mastodon-auth")
 (autoload 'mastodon-auth--get-account-name "mastodon-auth")
 (autoload 'mastodon-http--api "mastodon-http")
@@ -1709,16 +1710,13 @@ ID is that of the toot to view."
                 (mastodon-http--api (concat "statuses/" id)))))
     (if (equal (caar toot) 'error)
         (message "Error: %s" (cdar toot))
-      (with-current-buffer (get-buffer-create buffer)
-        (let ((inhibit-read-only t))
-          (erase-buffer)
-          (switch-to-buffer buffer)
-          (mastodon-mode)
-          (mastodon-tl--set-buffer-spec buffer
-                                        (format "statuses/%s" id)
-                                        nil)
-          (let ((inhibit-read-only t))
-            (mastodon-tl--toot toot :detailed-p)))))))
+      (with-mastodon-buffer
+       buffer
+       (mastodon-tl--set-buffer-spec buffer
+                                     (format "statuses/%s" id)
+                                     nil)
+       (let ((inhibit-read-only t))
+         (mastodon-tl--toot toot :detailed-p))))))
 
 (defun mastodon-tl--view-whole-thread ()
   "From a thread view, view entire thread.
@@ -1758,27 +1756,23 @@ view all branches of a thread."
                     (length (alist-get 'descendants context)))
                  0)
               ;; if we have a thread:
-              (progn
-                (with-current-buffer (get-buffer-create buffer)
-                  (let ((inhibit-read-only t)
-                        (marker (make-marker)))
-                    (switch-to-buffer buffer)
-                    (erase-buffer)
-                    (mastodon-mode)
-                    (mastodon-tl--set-buffer-spec buffer
-                                                  endpoint
-                                                  #'mastodon-tl--thread)
-                    (mastodon-tl--timeline (alist-get 'ancestors context)
-                                           :thread)
-                    (goto-char (point-max))
-                    (move-marker marker (point))
-                    ;; print re-fetched toot:
-                    (mastodon-tl--toot toot :detailed-p :thread)
-                    (mastodon-tl--timeline (alist-get 'descendants context)
-                                           :thread)
-                    ;; put point at the toot:
-                    (goto-char (marker-position marker))
-                    (mastodon-tl--goto-next-toot))))
+              (with-mastodon-buffer
+               buffer
+               (let ((marker (make-marker)))
+                 (mastodon-tl--set-buffer-spec buffer
+                                               endpoint
+                                               #'mastodon-tl--thread)
+                 (mastodon-tl--timeline (alist-get 'ancestors context)
+                                        :thread)
+                 (goto-char (point-max))
+                 (move-marker marker (point))
+                 ;; print re-fetched toot:
+                 (mastodon-tl--toot toot :detailed-p :thread)
+                 (mastodon-tl--timeline (alist-get 'descendants context)
+                                        :thread)
+                 ;; 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)))))))
 
@@ -2572,44 +2566,31 @@ JSON and http headers, without it just the JSON."
 	(message "Looks like nothing returned from endpoint: %s" endpoint)
       (let* ((headers (if headers (cdr response) nil))
              (link-header (mastodon-tl--get-link-header-from-response headers)))
-        (with-current-buffer (get-buffer-create buffer)
-          (let ((inhibit-read-only t))
-            (erase-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
-                                          update-params
-                                          hide-replies)
-            (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)
-            (mastodon-tl--set-buffer-spec buffer
-                                          endpoint
-                                          update-function
-                                          link-header
-                                          update-params
-                                          hide-replies)
-            (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 (mastodon-tl--profile-buffer-p)
-              (mastodon-tl--goto-first-item))))))))
+        (with-mastodon-buffer
+         buffer
+         (mastodon-tl--set-buffer-spec buffer
+                                       endpoint
+                                       update-function
+                                       link-header
+                                       update-params
+                                       hide-replies)
+         (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)
+         (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 (mastodon-tl--profile-buffer-p)
+           (mastodon-tl--goto-first-item)))))))
 
 (defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type)
   "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
@@ -2625,36 +2606,33 @@ Optional arg NOTE-TYPE means only get that type of note."
          (url (mastodon-http--api endpoint))
          (buffer (concat "*mastodon-" buffer-name "*"))
          (json (mastodon-http--get-json url args)))
-    (with-current-buffer (get-buffer-create buffer)
-      (let ((inhibit-read-only t))
-        (erase-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)
-        (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)
-        (mastodon-tl--set-buffer-spec buffer endpoint update-function nil args)
-        (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 (mastodon-tl--profile-buffer-p)
-          ;; FIXME: this breaks test (because test has empty buffer)
-          (mastodon-tl--goto-first-item)))
-      buffer)))
+    (with-mastodon-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)
+     (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-tl--set-buffer-spec buffer endpoint update-function nil args)
+     (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 (mastodon-tl--profile-buffer-p)
+       ;; FIXME: this breaks test (because test has empty buffer)
+       (mastodon-tl--goto-first-item)))
+    buffer))
 
 (provide 'mastodon-tl)
 ;;; mastodon-tl.el ends here
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 722e927..fca376d 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -255,6 +255,16 @@ mastodon.el needs to be re-loaded for this to be correctly set.")
   "Face used for reply text in toot compose buffer.
 See `mastodon-toot-display-orig-in-reply-buffer'.")
 
+(defmacro with-mastodon-buffer (buffer &rest body)
+  "Evaluate BODY in a new `mastodon-mode' buffer called BUFFER."
+  (declare (debug 'body))
+  `(with-current-buffer (get-buffer-create ,buffer)
+     (let ((inhibit-read-only t))
+       (erase-buffer)
+       (switch-to-buffer ,buffer)
+       (mastodon-mode)
+       ,@body)))
+
 ;;;###autoload
 (defun mastodon ()
   "Connect Mastodon client to `mastodon-instance-url' instance."