Merge branch 'develop' into HEAD

1 files changed, 113 insertions, 57 deletions

diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index 63c062b..658b1d4 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -36,6 +36,7 @@
 (require 'seq)
 (require 'cl-lib)
 (require 'persist)
+(require 'ts)
 
 (autoload 'mastodon-http--api "mastodon-http.el")
 (autoload 'mastodon-http--get-json "mastodon-http.el")
@@ -69,6 +70,11 @@
 (autoload 'mastodon-search--insert-users-propertized "mastodon-search")
 (autoload 'mastodon-tl--get-endpoint "mastodon-tl.el")
 (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot")
+(autoload 'mastodon-tl--add-account-to-list "mastodon-tl")
+(autoload 'mastodon-http--get-response "mastodon-http")
+(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl")
+(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
+
 (defvar mastodon-instance-url)
 (defvar mastodon-tl--buffer-spec)
 (defvar mastodon-tl--update-point)
@@ -87,7 +93,7 @@
     ;; maybe we can retire both of these awful bindings
     ;; (define-key map (kbd "s") #'mastodon-profile--open-followers)
     ;; (define-key map (kbd "g") #'mastodon-profile--open-following)
-    (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle)
+    (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle)
     map)
   "Keymap for `mastodon-profile-mode'.")
 
@@ -110,7 +116,6 @@
 
 (define-minor-mode mastodon-profile-mode
   "Toggle mastodon profile minor mode.
-
 This minor mode is used for mastodon profile pages and adds a couple of
 extra keybindings."
   :init-value nil
@@ -150,13 +155,14 @@ contains")
   ;; or handle --property failing
   (mastodon-tl--property 'toot-json))
 
-(defun mastodon-profile--make-author-buffer (account)
-  "Take an ACCOUNT json and insert a user account into a new buffer."
+(defun mastodon-profile--make-author-buffer (account &optional no-reblogs)
+  "Take an ACCOUNT json and insert a user account into a new buffer.
+NO-REBLOGS means do not display boosts in statuses."
   (mastodon-profile--make-profile-buffer-for
-   account "statuses" #'mastodon-tl--timeline))
+   account "statuses" #'mastodon-tl--timeline no-reblogs))
 
 ;; TODO: we shd just load all views' data then switch coz this is slow af:
-(defun mastodon-profile-account-view-cycle ()
+(defun mastodon-profile--account-view-cycle ()
   "Cycle through profile view: toots, followers, and following."
   (interactive)
   (let ((endpoint (plist-get mastodon-tl--buffer-spec 'endpoint)))
@@ -164,9 +170,17 @@ contains")
            (mastodon-profile--open-followers))
           ((string-suffix-p "followers" endpoint)
            (mastodon-profile--open-following))
+          ((string-suffix-p "following" endpoint)
+           (mastodon-profile--open-statuses-no-reblogs))
           (t
-           (mastodon-profile--make-profile-buffer-for
-            mastodon-profile--account "statuses" #'mastodon-tl--timeline)))))
+           (mastodon-profile--make-author-buffer mastodon-profile--account)))))
+
+(defun mastodon-profile--open-statuses-no-reblogs ()
+  "Open a profile buffer showing statuses without reblogs."
+  (interactive)
+  (if mastodon-profile--account
+      (mastodon-profile--make-author-buffer mastodon-profile--account :no-reblogs)
+    (error "Not in a mastodon profile")))
 
 (defun mastodon-profile--open-following ()
   "Open a profile buffer showing the accounts that current profile follows."
@@ -175,7 +189,9 @@ contains")
       (mastodon-profile--make-profile-buffer-for
        mastodon-profile--account
        "following"
-       #'mastodon-profile--add-author-bylines)
+       #'mastodon-profile--add-author-bylines
+       nil
+       :headers)
     (error "Not in a mastodon profile")))
 
 (defun mastodon-profile--open-followers ()
@@ -185,7 +201,9 @@ contains")
       (mastodon-profile--make-profile-buffer-for
        mastodon-profile--account
        "followers"
-       #'mastodon-profile--add-author-bylines)
+       #'mastodon-profile--add-author-bylines
+       nil
+       :headers)
     (error "Not in a mastodon profile")))
 
 (defun mastodon-profile--view-favourites ()
@@ -203,7 +221,8 @@ contains")
   (message "Loading your bookmarked toots...")
   (mastodon-tl--init "bookmarks"
                      "bookmarks"
-                     'mastodon-tl--timeline))
+                     'mastodon-tl--timeline
+                     :headers))
 
 (defun mastodon-profile--view-follow-requests ()
   "Open a new buffer displaying the user's follow requests."
@@ -234,6 +253,15 @@ JSON is the data returned by the server."
     (mastodon-search--insert-users-propertized json :note)))
 ;; (mastodon-profile--add-author-bylines json)))
 
+(defun mastodon-profile--add-account-to-list ()
+  "Add account of current profile buffer to a list."
+  (interactive)
+  (when mastodon-profile--account
+    (let* ((profile mastodon-profile--account)
+           (id (alist-get 'id profile))
+           (handle (alist-get 'acct profile)))
+      (mastodon-tl--add-account-to-list nil id handle))))
+
 ;;; ACCOUNT PREFERENCES
 
 (defun mastodon-profile--get-json-value (val)
@@ -295,25 +323,25 @@ SOURCE means that the preference is in the 'source' part of the account JSON."
          (response (mastodon-http--patch url `((,pref-formatted . ,val)))))
     (mastodon-http--triage response
                            (lambda ()
-                             (mastodon-profile-fetch-server-account-settings)
+                             (mastodon-profile--fetch-server-account-settings)
                              (message "Account setting %s updated to %s!" pref val)))))
 
 (defun mastodon-profile--get-pref (pref)
   "Return PREF from `mastodon-profile-account-settings'."
   (plist-get mastodon-profile-account-settings pref))
 
-(defun mastodon-profile-update-preference-plist (pref val)
+(defun mastodon-profile--update-preference-plist (pref val)
   "Set local account preference plist preference PREF to VAL.
 This is done after changing the setting on the server."
   (setq mastodon-profile-account-settings
         (plist-put mastodon-profile-account-settings pref val)))
 
-(defun mastodon-profile-fetch-server-account-settings-maybe ()
+(defun mastodon-profile--fetch-server-account-settings-maybe ()
   "Fetch account settings from the server.
 Only do so if `mastodon-profile-account-settings' is nil."
-  (mastodon-profile-fetch-server-account-settings :no-force))
+  (mastodon-profile--fetch-server-account-settings :no-force))
 
-(defun mastodon-profile-fetch-server-account-settings (&optional no-force)
+(defun mastodon-profile--fetch-server-account-settings (&optional no-force)
   "Fetch basic account settings from the server.
 Store the values in `mastodon-profile-account-settings'.
 Run in `mastodon-mode-hook'.
@@ -324,42 +352,42 @@ If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
     (let ((keys '(locked discoverable display_name bot))
           (source-keys '(privacy sensitive language)))
       (mapc (lambda (k)
-              (mastodon-profile-update-preference-plist
+              (mastodon-profile--update-preference-plist
                k
                (mastodon-profile--get-json-value k)))
             keys)
       (mapc (lambda (sk)
-              (mastodon-profile-update-preference-plist
+              (mastodon-profile--update-preference-plist
                sk
                (mastodon-profile--get-source-value sk)))
             source-keys)
       ;; hack for max toot chars:
       (mastodon-toot--get-max-toot-chars :no-toot)
-      (mastodon-profile-update-preference-plist 'max_toot_chars
-                                                mastodon-toot--max-toot-chars)
+      (mastodon-profile--update-preference-plist 'max_toot_chars
+                                                 mastodon-toot--max-toot-chars)
       ;; TODO: remove now redundant vars, replace with fetchers from the plist
       (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy)
             mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive))
       mastodon-profile-account-settings)))
 
-(defun mastodon-profile-account-locked-toggle ()
+(defun mastodon-profile--account-locked-toggle ()
   "Toggle the locked status of your account.
 Locked means follow requests have to be approved."
   (interactive)
   (mastodon-profile--toggle-account-key 'locked))
 
-(defun mastodon-profile-account-discoverable-toggle ()
+(defun mastodon-profile--account-discoverable-toggle ()
   "Toggle the discoverable status of your account.
 Discoverable means the account is listed in the server directory."
   (interactive)
   (mastodon-profile--toggle-account-key 'discoverable))
 
-(defun mastodon-profile-account-bot-toggle ()
+(defun mastodon-profile--account-bot-toggle ()
   "Toggle the bot status of your account."
   (interactive)
   (mastodon-profile--toggle-account-key 'bot))
 
-(defun mastodon-profile-account-sensitive-toggle ()
+(defun mastodon-profile--account-sensitive-toggle ()
   "Toggle the sensitive status of your account.
 When enabled, statuses are marked as sensitive by default."
   (interactive)
@@ -387,7 +415,7 @@ Current settings are fetched from the server."
                        val)))
     (mastodon-profile--update-preference (symbol-name key) new-val)))
 
-(defun mastodon-profile-update-display-name ()
+(defun mastodon-profile--update-display-name ()
   "Update display name for your account."
   (interactive)
   (mastodon-profile--edit-string-value 'display_name))
@@ -396,8 +424,8 @@ Current settings are fetched from the server."
   "Construct a parameter query string from metadata alist FIELDS.
 Returns an alist."
   (let ((keys (cl-loop for count from 1 to 5
-                      collect (cons (format "fields_attributes[%s][name]" count)
-                                    (format "fields_attributes[%s][value]" count)))))
+                       collect (cons (format "fields_attributes[%s][name]" count)
+                                     (format "fields_attributes[%s][value]" count)))))
     (cl-loop for a-pair in keys
              for b-pair in fields
              append (list (cons (car a-pair)
@@ -405,7 +433,7 @@ Returns an alist."
                           (cons (cdr a-pair)
                                 (cdr b-pair))))))
 
-(defun mastodon-profile-update-meta-fields ()
+(defun mastodon-profile--update-meta-fields ()
   "Prompt for new metadata fields information and PATCH the server."
   (interactive)
   (let* ((url (mastodon-http--api "accounts/update_credentials"))
@@ -414,7 +442,7 @@ Returns an alist."
          (response (mastodon-http--patch url params)))
     (mastodon-http--triage response
                            (lambda ()
-                             (mastodon-profile-fetch-server-account-settings)
+                             (mastodon-profile--fetch-server-account-settings)
                              (message "Account setting %s updated to %s!"
                                       "metadata fields" fields-updated)))))
 
@@ -458,7 +486,7 @@ This endpoint only holds a few preferences. For others, see
              (mastodon-http--get-json
               (mastodon-http--api "preferences"))))
 
-(defun mastodon-profile-view-preferences ()
+(defun mastodon-profile--view-preferences ()
   "View user preferences in another window."
   (interactive)
   (let* ((url (mastodon-http--api "preferences"))
@@ -483,11 +511,10 @@ This endpoint only holds a few preferences. For others, see
 (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))))
+         (args `(("id[]" . ,their-id)))
+         (url (mastodon-http--api "accounts/relationships")))
     ;; FIXME: not sure why we need to do this for relationships only!
-    (car (mastodon-http--get-json url))))
+    (car (mastodon-http--get-json url args))))
 
 (defun mastodon-profile--fields-get (&optional account fields)
   "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT.
@@ -518,8 +545,9 @@ FIELDS means provide a fields vector fetched by other means."
 (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)))
+         (args `(("pinned" . "true")))
+         (url (mastodon-http--api (format "accounts/%s/statuses" id))))
+    (mastodon-http--get-json url args)))
 
 (defun mastodon-profile--insert-statuses-pinned (pinned-statuses)
   "Insert each of the PINNED-STATUSES for a given account."
@@ -529,14 +557,27 @@ FIELDS means provide a fields vector fetched by other means."
           (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."
+(defun mastodon-profile--make-profile-buffer-for (account endpoint-type
+                                                          update-function
+                                                          &optional no-reblogs headers)
+  "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
+NO-REBLOGS means do not display boosts in statuses.
+HEADERS means also fetch link headers for pagination."
   (let* ((id (mastodon-profile--account-field account 'id))
+         (args (when no-reblogs '(("exclude_reblogs" . "t"))))
          (url (mastodon-http--api (format "accounts/%s/%s" id endpoint-type)))
          (acct (mastodon-profile--account-field account 'acct))
          (buffer (concat "*mastodon-" acct "-" endpoint-type  "*"))
+         (response (if headers
+                       (mastodon-http--get-response url args)
+                     (mastodon-http--get-json url args)))
+         (json (if headers (car response) response))
+         (endpoint (format "accounts/%s/%s" id endpoint-type))
+         (link-header (when headers
+                        (mastodon-tl--get-link-header-from-response
+                         (cdr response))))
+
          (note (mastodon-profile--account-field account 'note))
-         (json (mastodon-http--get-json url))
          (locked (mastodon-profile--account-field account 'locked))
          (followers-count (mastodon-tl--as-string
                            (mastodon-profile--account-field
@@ -554,16 +595,17 @@ FIELDS means provide a fields vector fetched by other means."
                         (alist-get 'followed_by relationships)))
          (followsp (or (equal follows-you 't) (equal followed-by-you 't)))
          (fields (mastodon-profile--fields-get account))
-         (pinned (mastodon-profile--get-statuses-pinned account)))
+         (pinned (mastodon-profile--get-statuses-pinned account))
+         (joined (mastodon-profile--account-field account 'created_at)))
     (with-output-to-temp-buffer buffer
       (switch-to-buffer buffer)
       (mastodon-mode)
       (mastodon-profile-mode)
-      (setq mastodon-profile--account account
-            mastodon-tl--buffer-spec
-            `(buffer-name ,buffer
-                          endpoint ,(format "accounts/%s/%s" id endpoint-type)
-                          update-function ,update-function))
+      (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"))
@@ -591,15 +633,22 @@ FIELDS means provide a fields vector fetched by other means."
                  " [locked]")
              "")
            "\n ------------\n"
-           (mastodon-tl--render-text note account)
+           ;; 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")
-             ""))
+                        '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
@@ -634,9 +683,16 @@ FIELDS means provide a fields vector fetched by other means."
         (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."
+  (let ((joined-ts (ts-parse joined)))
+    (format "Joined %s" (concat (ts-month-name joined-ts)
+                                " "
+                                (number-to-string
+                                 (ts-year joined-ts))))))
+
 (defun mastodon-profile--get-toot-author ()
   "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
@@ -692,7 +748,6 @@ IMG_TYPE is the JSON key from the account data."
 
 (defun mastodon-profile--account-field (account field)
   "Return FIELD from the ACCOUNT.
-
 FIELD is used to identify regions under 'account"
   (cdr (assoc field account)))
 
@@ -707,7 +762,8 @@ Used to view a user's followers and those they're following."
               (let ((start-pos (point)))
                 (insert "\n"
                         (propertize
-                         (mastodon-tl--byline-author `((account . ,toot)))
+                         (mastodon-tl--byline-author `((account . ,toot))
+                                                     :avatar)
                          'byline  't
                          'toot-id (alist-get 'id toot)
                          'base-toot-id (mastodon-tl--toot-id toot)
@@ -722,17 +778,18 @@ Used to view a user's followers and those they're following."
 
 (defun mastodon-profile--search-account-by-handle (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))
                      (substring handle 1 (length handle))
                    handle))
+         (args `(("q" . ,handle)))
          (matching-account
           (seq-remove
            (lambda (x)
              (not (string= (alist-get 'acct x) handle)))
            (mastodon-http--get-json
-            (mastodon-http--api (format "accounts/search?q=%s" handle))))))
+            (mastodon-http--api "accounts/search")
+            args))))
     (when (equal 1 (length matching-account))
       (elt matching-account 0))))
 
@@ -743,15 +800,14 @@ If the handle does not match a search return then retun NIL."
 
 (defun mastodon-profile--extract-users-handles (status)
   "Return all user handles found in STATUS.
-
 These include the author, author of reblogged entries and any user mentioned."
   (when status
     (let ((this-account
            (or (alist-get 'account status) ; status is a toot
                status)) ; status is a user listing
-	      (mentions (or (alist-get 'mentions (alist-get 'status status))
+	  (mentions (or (alist-get 'mentions (alist-get 'status status))
                         (alist-get 'mentions status)))
-	      (reblog (or (alist-get 'reblog (alist-get 'status status))
+	  (reblog (or (alist-get 'reblog (alist-get 'status status))
                       (alist-get 'reblog status))))
       (seq-filter
        'stringp