Merge branch 'main'

1 files changed, 295 insertions, 46 deletions

diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 16fb1a9..05cacde 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -2,9 +2,10 @@
 
 ;; Copyright (C) 2017-2019 Johnson Denen
 ;; Author: Johnson Denen <johnson.denen@gmail.com>
-;; Version: 0.7.2
-;; Package-Requires: ((emacs "24.4"))
-;; Homepage: https://github.com/jdenen/mastodon.el
+;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
+;; Version: 0.10.0
+;; Package-Requires: ((emacs "27.1") (seq "1.0"))
+;; Homepage: https://git.blast.noho.st/mouse/mastodon.el
 
 ;; This file is not part of GNU Emacs.
 
@@ -36,24 +37,42 @@
 
 (autoload 'mastodon-http--api "mastodon-http.el")
 (autoload 'mastodon-http--get-json "mastodon-http.el")
+(autoload 'mastodon-http--post "mastodon-http.el")
+(autoload 'mastodon-http--triage "mastodon-http.el")
+(autoload 'mastodon-auth--get-account-name "mastodon-auth.el")
+(autoload 'mastodon-http--get-json-async "mastodon-http.el")
 (autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el")
 (autoload 'mastodon-media--inline-images "mastodon-media.el")
 (autoload 'mastodon-mode "mastodon.el")
 (autoload 'mastodon-tl--byline-author "mastodon-tl.el")
 (autoload 'mastodon-tl--goto-next-toot "mastodon-tl.el")
 (autoload 'mastodon-tl--property "mastodon-tl.el")
+(autoload 'mastodon-tl--find-property-range "mastodon-tl.el")
 (autoload 'mastodon-tl--render-text "mastodon-tl.el")
 (autoload 'mastodon-tl--set-face "mastodon-tl.el")
 (autoload 'mastodon-tl--timeline "mastodon-tl.el")
+(autoload 'mastodon-tl--as-string "mastodon-tl.el")
 (autoload 'mastodon-tl--toot-id "mastodon-tl")
+(autoload 'mastodon-tl--toot "mastodon-tl")
+(autoload 'mastodon-tl--init "mastodon-tl.el")
+(autoload 'mastodon-http--patch "mastodon-http")
+(autoload 'mastodon-http--patch-json "mastodon-http")
 
 (defvar mastodon-instance-url)
 (defvar mastodon-tl--buffer-spec)
 (defvar mastodon-tl--update-point)
 
-(defvar mastodon-profile--account nil
+(defvar-local mastodon-profile--account nil
   "The data for the account being described in the current profile buffer.")
-(make-variable-buffer-local 'mastodon-profile--account)
+
+(defvar mastodon-profile-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "s") #'mastodon-profile--open-followers)
+    (define-key map (kbd "g") #'mastodon-profile--open-following)
+    (define-key map (kbd "a") #'mastodon-profile--follow-request-accept)
+    (define-key map (kbd "j") #'mastodon-profile--follow-request-reject)
+    map)
+  "Keymap for `mastodon-profile-mode'.")
 
 (define-minor-mode mastodon-profile-mode
   "Toggle mastodon profile minor mode.
@@ -61,12 +80,24 @@
 This minor mode is used for mastodon profile pages and adds a couple of
 extra keybindings."
   :init-value nil
-  ;; The mode line indicator.
+  ;; modeline indicator:
   :lighter " Profile"
-  ;; The key bindings
-  :keymap '(((kbd "F") . mastodon-profile--open-followers)
-            ((kbd "f") . mastodon-profile--open-following))
-  :group 'mastodon)
+  :keymap mastodon-profile-mode-map
+  :group 'mastodon
+  :global nil)
+
+(defvar mastodon-profile-update-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-c C-c") #'mastodon-profile--user-profile-send-updated)
+    (define-key map (kbd "C-c C-k") #'kill-buffer-and-window)
+    map)
+  "Keymap for `mastodon-profile-update-mode'.")
+
+(define-minor-mode mastodon-profile-update-mode
+  "Minor mode to update Mastodon user profile."
+  :group 'mastodon-profile
+  :keymap mastodon-profile-update-mode-map
+  :global nil)
 
 (defun mastodon-profile--toot-json ()
   "Get the next toot-json."
@@ -74,13 +105,12 @@ extra keybindings."
   (mastodon-tl--property 'toot-json))
 
 (defun mastodon-profile--make-author-buffer (account)
-  "Take a ACCOUNT and inserts a user account into a new buffer."
+  "Take an ACCOUNT json and insert a user account into a new buffer."
   (mastodon-profile--make-profile-buffer-for
    account "statuses" #'mastodon-tl--timeline))
 
 (defun mastodon-profile--open-following ()
-  "Open a profile buffer for the current profile showing the accounts
-that current profile follows."
+  "Open a profile buffer showing the accounts that current profile follows."
   (interactive)
   (if mastodon-profile--account
       (mastodon-profile--make-profile-buffer-for
@@ -90,8 +120,7 @@ that current profile follows."
     (error "Not in a mastodon profile")))
 
 (defun mastodon-profile--open-followers ()
-  "Open a profile buffer for the current profile showing the accounts
-following the current profile."
+  "Open a profile buffer showing the accounts following the current profile."
   (interactive)
   (if mastodon-profile--account
       (mastodon-profile--make-profile-buffer-for
@@ -100,14 +129,186 @@ following the current profile."
        #'mastodon-profile--add-author-bylines)
     (error "Not in a mastodon profile")))
 
+(defun mastodon-profile--view-favourites ()
+  "Open a new buffer displaying the user's favourites."
+  (interactive)
+  (message "Loading your favourited toots...")
+  (mastodon-tl--init "favourites"
+                     "favourites"
+                     'mastodon-tl--timeline))
+
+(defun mastodon-profile--view-bookmarks ()
+  "Open a new buffer displaying the user's bookmarks."
+  (interactive)
+  (message "Loading your bookmarked toots...")
+  (mastodon-tl--init "bookmarks"
+                     "bookmarks"
+                     'mastodon-tl--timeline))
+
+(defun mastodon-profile--view-follow-requests ()
+  "Open a new buffer displaying the user's follow requests."
+  (interactive)
+  (mastodon-profile-mode)
+  (mastodon-tl--init "follow-requests"
+                     "follow_requests"
+                     'mastodon-profile--add-author-bylines))
+
+(defun mastodon-profile--follow-request-accept ()
+  "Accept the follow request of user at point."
+  (interactive)
+  (if (mastodon-tl--find-property-range 'toot-json (point))
+      (let* ((acct-json (mastodon-profile--toot-json))
+             (id (alist-get 'id acct-json))
+             (handle (alist-get 'acct acct-json))
+             (name (alist-get 'username acct-json)))
+        (if id
+            (let ((response
+                   (mastodon-http--post
+                    (concat
+                     (mastodon-http--api "follow_requests")
+                     (format "/%s/authorize" id))
+                    nil nil)))
+              (mastodon-http--triage response
+                                     (lambda ()
+                                       (message "Follow request of %s (@%s) accepted!"
+                                                name handle))))
+          (message "No account result at point?")))
+    (message "No follow request at point?")))
+
+(defun mastodon-profile--follow-request-reject ()
+  "Reject the follow request of user at point."
+  (interactive)
+  (if (mastodon-tl--find-property-range 'toot-json (point))
+      (let* ((acct-json (mastodon-profile--toot-json))
+             (id (alist-get 'id acct-json))
+             (handle (alist-get 'acct acct-json))
+             (name (alist-get 'username acct-json)))
+        (if id
+            (let ((response
+                   (mastodon-http--post
+                    (concat
+                     (mastodon-http--api "follow_requests")
+                     (format "/%s/reject" id))
+                    nil nil)))
+              (mastodon-http--triage response
+                                     (lambda ()
+                                       (message "Follow request of %s (@%s) rejected!"
+                                                name handle))))
+          (message "No account result at point?")))
+    (message "No follow request at point?")))
+
+(defun mastodon-profile--update-user-profile-note ()
+  "Fetch user's profile note and display for editing."
+  (interactive)
+  (let* ((url (concat mastodon-instance-url
+                      "/api/v1/accounts/update_credentials"))
+         ;; (buffer (mastodon-http--patch url))
+         (json (mastodon-http--patch-json url))
+         (source (alist-get 'source json))
+         (note (alist-get 'note source))
+         (buffer (get-buffer-create "*mastodon-update-profile*"))
+         (inhibit-read-only t))
+    (switch-to-buffer-other-window buffer)
+    (mastodon-profile-update-mode t)
+    (insert note)
+    (goto-char (point-min))
+    (delete-trailing-whitespace) ; remove all ^M's
+    (message "Edit your profile note. C-c C-c to send, C-c C-k to cancel.")))
+
+(defun mastodon-profile--user-profile-send-updated ()
+  "Send PATCH request with the updated profile note."
+  (interactive)
+  (let* ((note (buffer-substring-no-properties (point-min) (point-max)))
+         (url (concat mastodon-instance-url
+                      "/api/v1/accounts/update_credentials")))
+    (kill-buffer-and-window)
+    (let ((response (mastodon-http--patch url note)))
+      (mastodon-http--triage response
+                             (lambda () (message "Profile note updated!"))))))
+
+(defun mastodon-profile--relationships-get (id)
+  "Fetch info about logged-in user's relationship to user with id ID."
+  (let* ((their-id id)
+         (url (mastodon-http--api (format
+                                   "accounts/relationships?id[]=%s"
+                                   their-id))))
+    (mastodon-http--get-json url)))
+
+(defun mastodon-profile--fields-get (account)
+  "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT.
+
+Returns a list of lists."
+  (let ((fields (mastodon-profile--account-field account 'fields)))
+    (when fields
+      (mapcar
+       (lambda (el)
+         (list
+          (alist-get 'name el)
+          (alist-get 'value el)))
+       fields))))
+
+(defun mastodon-profile--fields-insert (fields)
+  "Format and insert field pairs (a.k.a profile metadata) in FIELDS."
+  (let* ((car-fields (mapcar 'car fields))
+         ;; (cdr-fields (mapcar 'cadr fields))
+         ;; (cdr-fields-rendered
+         ;; (list
+         ;; (mapcar (lambda (x)
+         ;; (mastodon-tl--render-text x nil))
+         ;; cdr-fields)))
+         (left-width (car (sort (mapcar 'length car-fields) '>))))
+    ;; (right-width (car (sort (mapcar 'length cdr-fields) '>))))
+    (mapconcat (lambda (field)
+                 (mastodon-tl--render-text
+                  (concat
+                   (format "_ %s " (car field))
+                   (make-string (- (+ 1 left-width) (length (car field))) ?_)
+                   (format " :: %s" (cadr field)))
+                  ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_)
+                  ;; " |")
+                  field)) ; nil)) ; hack to make links tabstops
+               fields "")))
+
+(defun mastodon-profile--get-statuses-pinned (account)
+  "Fetch the pinned toots for ACCOUNT."
+  (let* ((id (mastodon-profile--account-field account 'id))
+         (url (mastodon-http--api (format "accounts/%s/statuses?pinned=true" id))))
+    (mastodon-http--get-json url)))
+
+(defun mastodon-profile--insert-statuses-pinned (pinned-statuses)
+  "Insert each of the PINNED-STATUSES for a given account."
+  (mapc (lambda (pinned-status)
+          (insert (mastodon-tl--set-face
+                   "   :pinned: " 'success))
+          (mastodon-tl--toot pinned-status))
+        pinned-statuses))
+
 (defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function)
+  "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION."
   (let* ((id (mastodon-profile--account-field account 'id))
+         (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type)))
          (acct (mastodon-profile--account-field account 'acct))
-         (url (mastodon-http--api (format "accounts/%s/%s"
-                                          id endpoint-type)))
          (buffer (concat "*mastodon-" acct "-" endpoint-type  "*"))
          (note (mastodon-profile--account-field account 'note))
-         (json (mastodon-http--get-json url)))
+         (json (mastodon-http--get-json url))
+         (locked (mastodon-profile--account-field account 'locked))
+         (followers-count (mastodon-tl--as-string
+                           (mastodon-profile--account-field
+                            account 'followers_count)))
+         (following-count (mastodon-tl--as-string
+                           (mastodon-profile--account-field
+                            account 'following_count)))
+         (toots-count (mastodon-tl--as-string
+                       (mastodon-profile--account-field
+                        account 'statuses_count)))
+         (relationships (mastodon-profile--relationships-get id))
+         (followed-by-you (alist-get 'following
+                                     (aref relationships 0)))
+         (follows-you (alist-get 'followed_by
+                                 (aref relationships 0)))
+         (followsp (or (equal follows-you 't) (equal followed-by-you 't)))
+         (fields (mastodon-profile--fields-get account))
+         (pinned (mastodon-profile--get-statuses-pinned account)))
     (with-output-to-temp-buffer buffer
       (switch-to-buffer buffer)
       (mastodon-mode)
@@ -122,9 +323,9 @@ following the current profile."
              (is-followers (string= endpoint-type "followers"))
              (is-following (string= endpoint-type "following"))
              (endpoint-name (cond
-                              (is-statuses "     TOOTS   ")
-                              (is-followers "  FOLLOWERS  ")
-                              (is-following "  FOLLOWING  "))))
+                             (is-statuses "     TOOTS   ")
+                             (is-followers "  FOLLOWERS  ")
+                             (is-following "  FOLLOWING  "))))
         (insert
          "\n"
          (mastodon-profile--image-from-account account)
@@ -133,10 +334,42 @@ following the current profile."
                       account 'display_name)
                      'face 'mastodon-display-name-face)
          "\n"
-         (propertize acct
+         (propertize (concat "@" acct)
                      'face 'default)
+         (if (equal locked t)
+             (if (fontp (char-displayable-p #10r9993))
+                 " 🔒"
+               " [locked]")
+           "")
          "\n ------------\n"
-         (mastodon-tl--render-text note nil)
+         (mastodon-tl--render-text note account)
+         ;; account here to enable tab-stops in profile note
+         (if fields
+             (concat "\n"
+                     (mastodon-tl--set-face
+                      (mastodon-profile--fields-insert fields)
+                      'success)
+                     "\n")
+           "")
+         ;; insert counts
+         (mastodon-tl--set-face
+          (concat " ------------\n"
+                  " TOOTS: " toots-count " | "
+                  "FOLLOWERS: " followers-count " | "
+                  "FOLLOWING: " following-count "\n"
+                  " ------------\n\n")
+          'success)
+         ;; insert relationship (follows)
+         (if followsp
+             (mastodon-tl--set-face
+              (concat (if (equal follows-you 't)
+                          " | FOLLOWS YOU")
+                      (if (equal followed-by-you 't)
+                          " | FOLLOWED BY YOU")
+                      "\n\n")
+              'success)
+           "") ; if no followsp we still need str-or-char-p for insert
+         ;; insert endpoint
          (mastodon-tl--set-face
           (concat " ------------\n"
                   endpoint-name "\n"
@@ -144,37 +377,52 @@ following the current profile."
           '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)))
-    (mastodon-tl--goto-next-toot)))
+    ;;(mastodon-tl--goto-next-toot)
+    (goto-char (point-min))))
 
 (defun mastodon-profile--get-toot-author ()
-  "Opens authors profile of toot under point."
+  "Open profile of author of toot under point.
+
+If toot is a boost, opens the profile of the booster."
   (interactive)
   (mastodon-profile--make-author-buffer
-   (cdr (assoc 'account (mastodon-profile--toot-json)))))
+   (alist-get 'account (mastodon-profile--toot-json))))
 
 (defun mastodon-profile--image-from-account (status)
   "Generate an image from a STATUS."
-  (let ((url (cdr (assoc 'avatar_static 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--show-user (user-handle)
-  "Query user for user id from current status and show that user's profile."
+  "Query for USER-HANDLE from current status and show that user's profile."
   (interactive
    (list
     (let ((user-handles (mastodon-profile--extract-users-handles
                          (mastodon-profile--toot-json))))
-      (completing-read "User handle: "
+      (completing-read "View profile of user [choose or enter any handle]: "
                        user-handles
                        nil ; predicate
                        'confirm))))
   (let ((account (mastodon-profile--lookup-account-in-status
                   user-handle (mastodon-profile--toot-json))))
     (if account
-        (mastodon-profile--make-author-buffer account)
+        (progn
+          (message "Loading profile of user %s..." user-handle)
+          (mastodon-profile--make-author-buffer account))
       (message "Cannot find a user with handle %S" user-handle))))
 
+(defun mastodon-profile--my-profile ()
+  "Show the profile of the currently signed in user."
+  (interactive)
+  (message "Loading your profile...")
+  (mastodon-profile--show-user (mastodon-auth--get-account-name)))
+
 (defun mastodon-profile--account-field (account field)
   "Return FIELD from the ACCOUNT.
 
@@ -190,17 +438,17 @@ FIELD is used to identify regions under 'account"
                       (propertize
                        (mastodon-tl--byline-author `((account . ,toot)))
                        'byline  't
-                       'toot-id (cdr (assoc 'id toot))
+                       'toot-id (alist-get 'id toot)
                        'base-toot-id (mastodon-tl--toot-id toot)
                        'toot-json toot))
               (mastodon-media--inline-images start-pos (point))
               (insert "\n"
-                      (mastodon-tl--render-text (cdr (assoc 'note toot)) nil)
+                      (mastodon-tl--render-text (alist-get 'note toot) nil)
                       "\n")))
           tootv)))
 
 (defun mastodon-profile--search-account-by-handle (handle)
-  "Return an account based on a users HANDLE.
+  "Return an account based on a user's HANDLE.
 
 If the handle does not match a search return then retun NIL."
   (let* ((handle (if (string= "@" (substring handle 0 1))
@@ -208,7 +456,8 @@ If the handle does not match a search return then retun NIL."
                    handle))
          (matching-account
           (seq-remove
-           (lambda(x) (not (string= (cdr (assoc 'acct x)) handle)))
+           (lambda (x)
+             (not (string= (alist-get 'acct x) handle)))
            (mastodon-http--get-json
             (mastodon-http--api (format "accounts/search?q=%s" handle))))))
     (when (equal 1 (length matching-account))
@@ -224,35 +473,35 @@ If the handle does not match a search return then retun NIL."
 
 These include the author, author of reblogged entries and any user mentioned."
   (when status
-    (let ((this-account (cdr (assoc 'account status)))
-	  (mentions (cdr (assoc 'mentions status)))
-	  (reblog (cdr (assoc 'reblog status))))
+    (let ((this-account (alist-get 'account status))
+	      (mentions (alist-get 'mentions status))
+	      (reblog (alist-get 'reblog status)))
       (seq-filter
        'stringp
        (seq-uniq
         (seq-concatenate
          'list
-         (list (cdr (assoc 'acct this-account)))
+         (list (alist-get 'acct this-account))
          (mastodon-profile--extract-users-handles reblog)
          (mapcar (lambda (mention)
-                   (cdr (assoc 'acct mention)))
+                   (alist-get 'acct mention))
                  mentions)))))))
 
 (defun mastodon-profile--lookup-account-in-status (handle status)
   "Return account for HANDLE using hints in STATUS if possible."
-  (let* ((this-account (cdr (assoc 'account status)))
-         (reblog-account (cdr (assoc 'account (cdr (assoc 'reblog status)))))
+  (let* ((this-account (alist-get 'account status))
+         (reblog-account (alist-get 'account (alist-get 'reblog status)))
          (mention-id (seq-some
                       (lambda (mention)
                         (when (string= handle
-                                       (cdr (assoc 'acct mention)))
-                          (cdr (assoc 'id mention))))
-                      (cdr (assoc 'mentions status)))))
+                                       (alist-get 'acct mention))
+                          (alist-get 'id mention)))
+                      (alist-get 'mentions status))))
     (cond ((string= handle
-                    (cdr (assoc 'acct this-account)))
+                    (alist-get 'acct this-account))
            this-account)
           ((string= handle
-                    (cdr (assoc 'acct reblog-account)))
+                    (alist-get 'acct reblog-account))
            reblog-account)
           (mention-id
            (mastodon-profile--account-from-id mention-id))