Merge branch 'develop'

4 files changed, 159 insertions, 144 deletions

diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 4db18be..49b2375 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -97,39 +97,47 @@ Message status and JSON error from RESPONSE if unsuccessful."
     (insert-file-contents filename)
     (string-to-unibyte (buffer-string))))
 
-(defun mastodon-http--post (url args headers &optional unauthenticed-p)
+(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p)
+  "Make a METHOD type request using BODY, with Mastodon authorization.
+Unless UNAUTHENTICATED-P is non-nil."
+  `(let ((url-request-method ,method)
+         (url-request-extra-headers
+          (unless ,unauthenticated-p
+            (list (cons "Authorization"
+                        (concat "Bearer " (mastodon-auth--access-token)))))))
+     ,body))
+
+(defun mastodon-http--post (url args headers &optional unauthenticated-p)
   "POST synchronously 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
-	  (unless unauthenticed-p
-	    `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))
-          ;; pleroma compatibility:
-          (unless (assoc "Content-Type" headers)
-            '(("Content-Type" . "application/x-www-form-urlencoded")))
-	  headers)))
-    (with-temp-buffer
-      (mastodon-http--url-retrieve-synchronously url))))
+Authorization header is included by default unless UNAUTHENTICATED-P is non-nil."
+  (mastodon-http--authorized-request
+   "POST"
+   (let ((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 url-request-extra-headers ; auth set in macro
+                  ;; pleroma compat:
+                  (unless (assoc "Content-Type" headers)
+                    '(("Content-Type" . "application/x-www-form-urlencoded")))
+                  headers)))
+     (with-temp-buffer
+       (mastodon-http--url-retrieve-synchronously url)))
+   unauthenticated-p))
 
 (defun mastodon-http--get (url)
   "Make synchronous 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))))))
-    (mastodon-http--url-retrieve-synchronously url)))
+  (mastodon-http--authorized-request
+   "GET"
+   (mastodon-http--url-retrieve-synchronously url)))
 
 (defun mastodon-http--get-json (url)
   "Make synchronous GET request to URL. Return JSON response."
@@ -138,6 +146,8 @@ Pass response buffer to CALLBACK function."
 
 (defun mastodon-http--process-json ()
   "Process JSON response."
+  ;; view raw response:
+  ;; (switch-to-buffer (current-buffer))
   (goto-char (point-min))
   (re-search-forward "^$" nil 'move)
   (let ((json-string
@@ -150,12 +160,10 @@ Pass response buffer to CALLBACK function."
 
 (defun mastodon-http--delete (url)
   "Make DELETE request to URL."
-  (let ((url-request-method "DELETE")
-        (url-request-extra-headers
-         `(("Authorization" . ,(concat "Bearer "
-                                       (mastodon-auth--access-token))))))
-    (with-temp-buffer
-      (mastodon-http--url-retrieve-synchronously url))))
+  (mastodon-http--authorized-request
+   "DELETE"
+   (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.
@@ -187,14 +195,12 @@ PARAM is any extra parameters to send with the request."
   "Make GET request to BASE-URL, searching for QUERY.
 Pass response buffer to CALLBACK function.
 PARAM is a formatted request parameter, eg 'following=true'."
-  (let ((url-request-method "GET")
-        (url (if param
-                 (concat base-url "?" param "&q=" (url-hexify-string query))
-               (concat base-url "?q=" (url-hexify-string query))))
-        (url-request-extra-headers
-         `(("Authorization" . ,(concat "Bearer "
-                                       (mastodon-auth--access-token))))))
-    (mastodon-http--url-retrieve-synchronously url)))
+  (mastodon-http--authorized-request
+   "GET"
+   (let ((url (if param
+                  (concat base-url "?" param "&q=" (url-hexify-string query))
+                (concat base-url "?q=" (url-hexify-string query)))))
+     (mastodon-http--url-retrieve-synchronously url))))
 
 ;; profile update functions
 
@@ -208,25 +214,21 @@ PARAM is a formatted request parameter, eg 'following=true'."
   "Make synchronous PATCH request to BASE-URL.
 Optionally specify the NOTE to edit.
 Pass response buffer to CALLBACK function."
-  (let ((url-request-method "PATCH")
-        (url (if note
+  (mastodon-http--authorized-request
+   "PATCH"
+   (let ((url (if note
                  (concat base-url "?note=" (url-hexify-string note))
-               base-url))
-        (url-request-extra-headers
-         `(("Authorization" . ,(concat "Bearer "
-                                       (mastodon-auth--access-token))))))
-    (mastodon-http--url-retrieve-synchronously url)))
+               base-url)))
+     (mastodon-http--url-retrieve-synchronously url))))
 
  ;; Asynchronous functions
 
 (defun mastodon-http--get-async (url &optional callback &rest cbargs)
   "Make GET request to URL.
 Pass response buffer to CALLBACK function with args CBARGS."
-  (let ((url-request-method "GET")
-        (url-request-extra-headers
-         `(("Authorization" . ,(concat "Bearer "
-                                       (mastodon-auth--access-token))))))
-    (url-retrieve url callback cbargs)))
+  (mastodon-http--authorized-request
+   "GET"
+   (url-retrieve url callback cbargs)))
 
 (defun mastodon-http--get-json-async (url &optional callback &rest args)
   "Make GET request to URL. Call CALLBACK with json-vector and ARGS."
@@ -240,21 +242,19 @@ Pass response buffer to CALLBACK function with args CBARGS."
   "POST asynchronously to URL with ARGS and HEADERS.
 Then run function CALLBACK with arguements CBARGS.
 Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
-  (let ((url-request-method "POST")
-        (request-timeout 5)
-        (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--authorized-request
+   "POST"
+   (let ((request-timeout 5)
+         (url-request-data
+          (when args
+            (mapconcat (lambda (arg)
+                         (concat (url-hexify-string (car arg))
+                                 "="
+                                 (url-hexify-string (cdr arg))))
+                       args
+                       "&"))))
+     (with-temp-buffer
+       (url-retrieve url callback cbargs)))))
 
 ;; TODO: test for curl first?
 (defun mastodon-http--post-media-attachment (url filename caption)
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index b8a6114..f7a46d5 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -416,7 +416,10 @@ If toot is a boost, opens the profile of the booster."
                          user-handles
                          nil ; predicate
                          'confirm)))))
-  (if (not (get-text-property (point) 'toot-json))
+  (if (not (or
+            ;; own profile has no need for toot-json test:
+            (equal user-handle (mastodon-auth--get-account-name))
+            (get-text-property (point) 'toot-json)))
       (message "Looks like there's no toot or user at point?")
     (let ((account (mastodon-profile--lookup-account-in-status
                     user-handle (mastodon-profile--toot-json))))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 1d18b01..4b81a3b 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -533,6 +533,9 @@ By default it is `mastodon-tl--byline-boosted'"
          (faved (equal 't (mastodon-tl--field 'favourited toot)))
          (boosted (equal 't (mastodon-tl--field 'reblogged toot)))
          (bookmarked (equal 't (mastodon-tl--field 'bookmarked toot)))
+         (bookmark-str (if (fontp (char-displayable-p #10r128278))
+                           "🔖"
+                         "K"))
          (visibility (mastodon-tl--field 'visibility toot)))
     (concat
      ;; Boosted/favourited markers are not technically part of the byline, so
@@ -547,10 +550,7 @@ By default it is `mastodon-tl--byline-boosted'"
              (when faved
                (mastodon-tl--format-faved-or-boosted-byline "F"))
              (when bookmarked
-               (mastodon-tl--format-faved-or-boosted-byline
-                (if (fontp (char-displayable-p #10r128278))
-                    "🔖"
-                  "K"))))
+               (mastodon-tl--format-faved-or-boosted-byline bookmark-str)))
      (propertize
       (concat
        ;; we propertize help-echo format faves for author name
@@ -577,6 +577,7 @@ By default it is `mastodon-tl--byline-boosted'"
        (propertize "\n  ------------\n" 'face 'default))
       'favourited-p faved
       'boosted-p    boosted
+      'bookmarked-p bookmarked
       'byline       t))))
 
 (defun mastodon-tl--format-faved-or-boosted-byline (letter)
@@ -898,7 +899,9 @@ PARENT-TOOT is the JSON of the toot responded to."
               (mastodon-tl--byline toot author-byline action-byline))
       'toot-id      (or id ; for notifications
                         (alist-get 'id toot))
-      'base-toot-id (mastodon-tl--toot-id toot)
+      'base-toot-id (mastodon-tl--toot-id
+                     ;; if a favourite/boost notif, get ID of toot responded to:
+                     (or parent-toot toot))
       'toot-json    toot
       'parent-toot parent-toot)
      "\n")
@@ -1294,28 +1297,31 @@ RESPONSE is the JSON returned by the server."
   (mastodon-search--insert-users-propertized response :note)
   (goto-char (point-min)))
 
+(defmacro mastodon-tl--do-if-toot (&rest body)
+  "Execute BODY if we have a toot or user at point."
+  `(if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
+            (not (mastodon-tl--property 'toot-json)))
+       (message "Looks like there's no toot or user at point?")
+     ,@body))
+
 (defun mastodon-tl--follow-user (user-handle &optional notify)
   "Query for USER-HANDLE from current status and follow that user.
 If NOTIFY is \"true\", enable notifications when that user posts.
 If NOTIFY is \"false\", disable notifications when that user posts.
 Can be called to toggle NOTIFY on users already being followed."
-    (interactive
-     (list
-      (mastodon-tl--interactive-user-handles-get "follow")))
-    (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
-             (not (get-text-property (point) 'toot-json)))
-        (message "Looks like there's no toot or user at point?")
-      (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify)))
+  (interactive
+   (list
+    (mastodon-tl--interactive-user-handles-get "follow")))
+  (mastodon-tl--do-if-toot
+   (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify)))
 
 (defun mastodon-tl--enable-notify-user-posts (user-handle)
   "Query for USER-HANDLE and enable notifications when they post."
   (interactive
    (list
     (mastodon-tl--interactive-user-handles-get "enable")))
-  (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
-           (not (get-text-property (point) 'toot-json)))
-      (message "Looks like there's no toot or user at point?")
-    (mastodon-tl--follow-user user-handle "true")))
+  (mastodon-tl--do-if-toot
+   (mastodon-tl--follow-user user-handle "true")))
 
 (defun mastodon-tl--disable-notify-user-posts (user-handle)
   "Query for USER-HANDLE and disable notifications when they post."
@@ -1329,20 +1335,16 @@ Can be called to toggle NOTIFY on users already being followed."
   (interactive
    (list
     (mastodon-tl--interactive-user-handles-get "unfollow")))
-  (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
-           (not (get-text-property (point) 'toot-json)))
-      (message "Looks like there's no toot or user at point?")
-    (mastodon-tl--do-user-action-and-response user-handle "unfollow" t)))
+  (mastodon-tl--do-if-toot
+   (mastodon-tl--do-user-action-and-response user-handle "unfollow" t)))
 
 (defun mastodon-tl--block-user (user-handle)
   "Query for USER-HANDLE from current status and block that user."
   (interactive
    (list
     (mastodon-tl--interactive-user-handles-get "block")))
-  (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
-           (not (get-text-property (point) 'toot-json)))
-      (message "Looks like there's no toot or user at point?")
-    (mastodon-tl--do-user-action-and-response user-handle "block")))
+  (mastodon-tl--do-if-toot
+   (mastodon-tl--do-user-action-and-response user-handle "block")))
 
 (defun mastodon-tl--unblock-user (user-handle)
   "Query for USER-HANDLE from list of blocked users and unblock that user."
@@ -1358,10 +1360,8 @@ Can be called to toggle NOTIFY on users already being followed."
   (interactive
    (list
     (mastodon-tl--interactive-user-handles-get "mute")))
-  (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
-           (not (get-text-property (point) 'toot-json)))
-      (message "Looks like there's no toot or user at point?")
-    (mastodon-tl--do-user-action-and-response user-handle "mute")))
+  (mastodon-tl--do-if-toot
+   (mastodon-tl--do-user-action-and-response user-handle "mute")))
 
 (defun mastodon-tl--unmute-user (user-handle)
   "Query for USER-HANDLE from list of muted users and unmute that user."
@@ -1374,31 +1374,29 @@ Can be called to toggle NOTIFY on users already being followed."
 
 (defun mastodon-tl--interactive-user-handles-get (action)
   "Get the list of user-handles for ACTION from the current toot."
-  (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view
-           (not (get-text-property (point) 'toot-json)))
-      (message "Looks like there's no toot or user at point?")
-    (let ((user-handles
-           (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*")
-                      ;; follow suggests / search / foll requests compat:
-                      (string-prefix-p "*mastodon-search" (buffer-name))
-                      (equal (buffer-name) "*mastodon-follow-requests*")
-                      ;; profile view follows/followers compat:
-                      ;; but not for profile statuses:
-                      (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint))
-                           (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint)))))
-                  ;; avoid tl--property here because it calls next-toot
-                  ;; which breaks non-toot buffers like foll reqs etc.:
-                  (list (alist-get 'acct (get-text-property (point) 'toot-json))))
-                 (t
-                  (mastodon-profile--extract-users-handles
-                   (mastodon-profile--toot-json))))))
-      (completing-read (if (or (equal action "disable")
-                               (equal action "enable"))
-                           (format "%s notifications when user posts: " action)
-                         (format "Handle of user to %s: " action))
-                       user-handles
-                       nil ; predicate
-                       'confirm))))
+  (mastodon-tl--do-if-toot
+   (let ((user-handles
+          (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*")
+                     ;; follow suggests / search / foll requests compat:
+                     (string-prefix-p "*mastodon-search" (buffer-name))
+                     (equal (buffer-name) "*mastodon-follow-requests*")
+                     ;; profile view follows/followers compat:
+                     ;; but not for profile statuses:
+                     (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint))
+                          (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint)))))
+                 ;; avoid tl--property here because it calls next-toot
+                 ;; which breaks non-toot buffers like foll reqs etc.:
+                 (list (alist-get 'acct (get-text-property (point) 'toot-json))))
+                (t
+                 (mastodon-profile--extract-users-handles
+                  (mastodon-profile--toot-json))))))
+     (completing-read (if (or (equal action "disable")
+                              (equal action "enable"))
+                          (format "%s notifications when user posts: " action)
+                        (format "Handle of user to %s: " action))
+                      user-handles
+                      nil ; predicate
+                      'confirm))))
 
 (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action)
   "Fetch the list of accounts for ACTION from the server.
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 56b9417..b89b01e 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -216,8 +216,6 @@ Makes a POST request to the server."
     (let ((response (mastodon-http--post url nil nil)))
       (mastodon-http--triage response callback))))
 
-
-
 (defun mastodon-toot--toggle-boost-or-favourite (type)
   "Toggle boost or favourite of toot at `point'.
 TYPE is a symbol, either 'favourite or 'boost."
@@ -273,6 +271,43 @@ TYPE is a symbol, either 'favourite or 'boost."
   (interactive)
   (mastodon-toot--toggle-boost-or-favourite 'favourite))
 
+;; TODO maybe refactor into boost/fave fun
+(defun mastodon-toot--bookmark-toot-toggle ()
+  "Bookmark or unbookmark toot at point."
+  (interactive)
+  (let* ((toot (mastodon-tl--property 'toot-json))
+         (id (mastodon-tl--property 'base-toot-id))
+         ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
+         (bookmarked-p (mastodon-tl--property 'bookmarked-p))
+         (prompt (if bookmarked-p
+                     (format "Toot already bookmarked. Remove? ")
+                   (format "Bookmark this toot? ")))
+         (byline-region
+          (when id
+            (mastodon-tl--find-property-range 'byline (point))))
+         (action (if bookmarked-p "unbookmark" "bookmark"))
+         (bookmark-str (if (fontp (char-displayable-p #10r128278))
+                           "🔖"
+                         "K"))
+         (message (if bookmarked-p
+                      "Bookmark removed!"
+                    "Toot bookmarked!"))
+         (remove (when bookmarked-p t)))
+    (if byline-region
+        (when (y-or-n-p prompt)
+          (mastodon-toot--action
+           action
+           (lambda ()
+             (let ((inhibit-read-only t))
+               (add-text-properties (car byline-region)
+                                    (cdr byline-region)
+                                    (list 'bookmarked-p (not bookmarked-p))))
+             (mastodon-toot--action-success
+              bookmark-str
+              byline-region remove)
+             (message (format "%s #%s" message id)))))
+      (message (format "Nothing to %s here?!?" action)))))
+
 (defun mastodon-toot--copy-toot-url ()
   "Copy URL of toot at point."
   (interactive)
@@ -388,27 +423,6 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
       (mastodon-toot-set-cw toot-cw)
       (mastodon-toot--update-status-fields))))
 
-(defun mastodon-toot--bookmark-toot-toggle ()
-  "Bookmark or unbookmark toot at point synchronously."
-  (interactive)
-  (let* ((toot (mastodon-tl--property 'toot-json))
-         (id (mastodon-tl--as-string (mastodon-tl--toot-id toot)))
-         (bookmarked (alist-get 'bookmarked toot))
-         (url (mastodon-http--api (if (equal bookmarked t)
-                                      (format "statuses/%s/unbookmark" id)
-                                    (format "statuses/%s/bookmark" id))))
-         (prompt (if (equal bookmarked t)
-                     (format "Toot already bookmarked. Remove? ")
-                   (format "Bookmark this toot? ")))
-         (message (if (equal bookmarked t)
-                      "Bookmark removed!"
-                    "Toot bookmarked!")))
-    (when (y-or-n-p prompt)
-      (let ((response (mastodon-http--post url nil nil)))
-        (mastodon-http--triage response
-                               (lambda ()
-                                 (message message)))))))
-
 (defun mastodon-toot--kill ()
   "Kill `mastodon-toot-mode' buffer and window."
   (kill-buffer-and-window))