diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-async.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-auth.el | 11 | ||||
| -rw-r--r-- | lisp/mastodon-client.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 1 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 43 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 383 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 12 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 1445 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 192 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 906 | ||||
| -rw-r--r-- | lisp/mastodon.el | 102 |
11 files changed, 1669 insertions, 1430 deletions
diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index a352ffc..364c5db 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -1,4 +1,4 @@ -;;; mastodon-async.el --- Client for Mastodon -*- lexical-binding: t -*- +;;; mastodon-async.el --- async streaming functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017 Alex J. Griffith ;; Author: Alex J. Griffith <griffitaj@gmail.com> diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 788fa77..ec56a05 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -37,14 +37,15 @@ (eval-when-compile (require 'subr-x)) ; for if-let (autoload 'mastodon-client "mastodon-client") +(autoload 'mastodon-client--active-user "mastodon-client") +(autoload 'mastodon-client--form-user-from-vars "mastodon-client") +(autoload 'mastodon-client--make-user-active "mastodon-client") +(autoload 'mastodon-client--store-access-token "mastodon-client") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--append-query-string "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--append-query-string "mastodon-http") -(autoload 'mastodon-client--store-access-token "mastodon-client") -(autoload 'mastodon-client--active-user "mastodon-client") -(autoload 'mastodon-client--make-user-active "mastodon-client") -(autoload 'mastodon-client--form-user-from-vars "mastodon-client") + (defvar mastodon-instance-url) (defvar mastodon-client-scopes) (defvar mastodon-client-redirect-uri) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index f1dcd4f..5981a26 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -37,10 +37,10 @@ (defvar mastodon-instance-url) (defvar mastodon-active-user) + (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") - (defcustom mastodon-client--token-file (concat user-emacs-directory "mastodon.plstore") "File path where Mastodon access tokens are stored." :group 'mastodon diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 88bc9c6..d1f654e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -43,7 +43,6 @@ (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-toot--update-status-fields "mastodon-toot") - (defvar mastodon-http--api-version "v1") (defconst mastodon-http--timeout 15 diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 279361b..bb9637c 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -32,28 +32,29 @@ ;;; Code: -(autoload 'mastodon-http--api "mastodon-http.el") -(autoload 'mastodon-http--post "mastodon-http.el") -(autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-media--inline-images "mastodon-media.el") -(autoload 'mastodon-tl--byline "mastodon-tl.el") -(autoload 'mastodon-tl--byline-author "mastodon-tl.el") -(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl.el") -(autoload 'mastodon-tl--content "mastodon-tl.el") -(autoload 'mastodon-tl--field "mastodon-tl.el") -(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") -(autoload 'mastodon-tl--has-spoiler "mastodon-tl.el") -(autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--init-sync "mastodon-tl.el") -(autoload 'mastodon-tl--insert-status "mastodon-tl.el") -(autoload 'mastodon-tl--property "mastodon-tl.el") -(autoload 'mastodon-tl--spoiler "mastodon-tl.el") -(autoload 'mastodon-tl--toot-id "mastodon-tl.el") -(autoload 'mastodon-http--get-params-async-json "mastodon-http.el") -(autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-params-async-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--byline "mastodon-tl") +(autoload 'mastodon-tl--byline-author "mastodon-tl") +(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--content "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl--has-spoiler "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--insert-status "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--spoiler "mastodon-tl") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") + (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -126,7 +127,7 @@ follow-requests view." (mastodon-http--triage response (lambda () (if f-reqs-view-p - (mastodon-profile--view-follow-requests) + (mastodon-views--view-follow-requests) (mastodon-notifications-get)) (message "Follow request of %s (@%s) %s!" name handle (if reject diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 8d8d0c7..380c82f 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -41,47 +41,49 @@ (require 'ts) (require 'parse-time) +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-http--get-json-async "mastodon-http.el") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-http--patch-json "mastodon-http") (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-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-tl--as-string "mastodon-tl.el") +(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") (autoload 'mastodon-tl--byline-author "mastodon-tl.el") +(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") +(autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--goto-next-item "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl.el") +(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--interactive-user-handles-get "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") +(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") (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-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--set-face "mastodon-tl.el") +(autoload 'mastodon-tl--symbol "mastodon-tl") (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-tl--init-sync "mastodon-tl") -(autoload 'mastodon-http--patch "mastodon-http") -(autoload 'mastodon-http--patch-json "mastodon-http") -(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") -(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") -(autoload 'mastodon-tl--goto-next-item "mastodon-tl") -(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") -(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-toot "mastodon") -(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") -(autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") -(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") (autoload 'mastodon-toot--count-toot-chars "mastodon-toot") +(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") +(autoload 'mastodon-views--add-account-to-list "mastodon-views") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) @@ -106,23 +108,6 @@ map) "Keymap for `mastodon-profile-mode'.") -(defvar mastodon-profile--view-follow-requests-keymap - (let ((map ;(make-sparse-keymap))) - (copy-keymap mastodon-mode-map))) - ;; make reject binding match the binding in notifs view - ;; 'r' is then reserved for replying, even tho it is not avail - ;; in foll-reqs view - (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) - (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) - (define-key map (kbd "n") #'mastodon-tl--goto-next-item) - (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) - (define-key map (kbd "g") #'mastodon-profile--view-follow-requests) - ;; (define-key map (kbd "t") #'mastodon-toot) - ;; (define-key map (kbd "q") #'kill-current-buffer) - ;; (define-key map (kbd "Q") #'kill-buffer-and-window) - map) - "Keymap for viewing follow requests.") - (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 @@ -232,35 +217,6 @@ NO-REBLOGS means do not display boosts in statuses." 'mastodon-tl--timeline :headers)) -(defun mastodon-profile--view-follow-requests () - "Open a new buffer displaying the user's follow requests." - (interactive) - (mastodon-tl--init-sync "follow-requests" - "follow_requests" - 'mastodon-profile--insert-follow-requests) - (use-local-map mastodon-profile--view-follow-requests-keymap) - (mastodon-tl--goto-first-item)) - -(defun mastodon-profile--insert-follow-requests (json) - "Insert the user's current follow requests. -JSON is the data returned by the server." - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " FOLLOW REQUESTS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[a/r - accept/reject request at point\n n/p - go to next/prev request]\n\n" - 'font-lock-comment-face)) - (if (seq-empty-p json) - (insert (propertize - "Looks like you have no follow requests for now." - 'face font-lock-comment-face - 'byline t - 'toot-id "0")) - (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) @@ -268,7 +224,7 @@ JSON is the data returned by the server." (let* ((profile mastodon-profile--account) (id (alist-get 'id profile)) (handle (alist-get 'acct profile))) - (mastodon-tl--add-account-to-list nil id handle)))) + (mastodon-views--add-account-to-list nil id handle)))) ;;; ACCOUNT PREFERENCES @@ -584,10 +540,7 @@ FIELDS means provide a fields vector fetched by other means." (let ((fields (or fields (mastodon-profile--account-field account 'fields)))) (when fields - (mapcar (lambda (el) - (cons (alist-get 'name el) - (alist-get 'value el))) - fields)))) + (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) (defun mastodon-profile--fields-insert (fields) "Format and insert field pairs (a.k.a profile metadata) in FIELDS." @@ -650,97 +603,104 @@ HEADERS means also fetch link headers for pagination." (mastodon-profile--account-field account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) + (requested-you (when (not (seq-empty-p relationships)) + (alist-get 'requested_by relationships))) (followed-by-you (when (not (seq-empty-p relationships)) (alist-get 'following relationships))) (follows-you (when (not (seq-empty-p relationships)) (alist-get 'followed_by relationships))) - (followsp (or (equal follows-you 't) (equal followed-by-you 't))) + (followsp (or (equal follows-you 't) (equal followed-by-you 't) + (equal requested-you 't))) (fields (mastodon-profile--fields-get 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--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 " 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 ------------\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: + (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 " TOOTS ") + (is-followers " FOLLOWERS ") + (is-following " FOLLOWING ")))) + (insert (propertize - (mastodon-profile--format-joined-date-string joined) - 'face 'success) - "\n\n") - 'profile-json account) - ;; 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) + (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 ------------\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 " ------------\n" + " TOOTS: " toots-count " | " + "FOLLOWERS: " followers-count " | " + "FOLLOWING: " following-count "\n" + " ------------\n\n") + 'success) + ;; insert relationship (follows) + (if followsp + (mastodon-tl--set-face + (concat (when (equal follows-you 't) " | FOLLOWS YOU") - (if (equal followed-by-you 't) + (when (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" - " ------------\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)))) + (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 " ------------\n" + endpoint-name "\n" + " ------------\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." @@ -754,10 +714,10 @@ If toot is a boost, opens the profile of the booster." (mastodon-profile--make-author-buffer (alist-get 'account (mastodon-profile--toot-json)))) -(defun mastodon-profile--image-from-account (account img_type) +(defun mastodon-profile--image-from-account (account img-type) "Return a avatar image from ACCOUNT. -IMG_TYPE is the JSON key from the account data." - (let ((img (alist-get img_type account))) +IMG-TYPE is the JSON key from the account data." + (let ((img (alist-get img-type account))) (unless (equal img "/avatars/original/missing.png") (mastodon-media--get-media-link-rendering img)))) @@ -864,9 +824,7 @@ These include the author, author of reblogged entries and any user mentioned." 'list (list (alist-get 'acct this-account)) (mastodon-profile--extract-users-handles reblog) - (mapcar (lambda (mention) - (alist-get 'acct mention)) - mentions))))))) + (mastodon-tl--map-alist 'acct mentions))))))) (defun mastodon-profile--lookup-account-in-status (handle status) "Return account for HANDLE using hints in STATUS if possible." @@ -930,15 +888,104 @@ Currently limited to 100 handles. If not found, try (url (mastodon-http--api endpoint)) (response (mastodon-http--get-json url `(("limit" . "100")))) - (handles (mapcar (lambda (x) - (cons - (alist-get 'acct x) - (alist-get 'id x))) - response)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response)) (choice (completing-read "Remove from followers: " handles)) (id (alist-get choice handles nil nil 'equal))) (mastodon-profile--remove-user-from-followers id))) +(defun mastodon-profile--add-private-note-to-account () + "Add a private note to an account. +Can be called from a profile page or normal timeline. +Send an empty note to clear an existing one." + (interactive) + (mastodon-profile--add-or-view-private-note + 'mastodon-profile--post-private-note-to-account + "add a note to")) + +(defun mastodon-profile--post-private-note-to-account (id handle note-old) + "POST a private note onto an account ID with user HANDLE on the server. +NOTE-OLD is the text of any existing note." + (let* ((note (read-string (format "Add private note to account %s: " handle) + note-old)) + (params `(("comment" . ,note))) + (url (mastodon-http--api (format "accounts/%s/note" id))) + (response (mastodon-http--post url params))) + (mastodon-http--triage response + (lambda () + (message "Private note on %s added!" handle))))) + +(defun mastodon-profile--view-account-private-note () + "Display the private note about a user." + (interactive) + (mastodon-profile--add-or-view-private-note + 'mastodon-profile--display-private-note + "view private note of" + :view)) + +(defun mastodon-profile--display-private-note (note) + "Display private NOTE in a temporary buffer." + (with-output-to-temp-buffer "*mastodon-profile-private-note*" + (let ((inhibit-read-only t)) + (princ note)))) + +(defun mastodon-profile--grab-profile-json () + "Return the profile-json property if we are in a profile buffer." + (when (mastodon-tl--profile-buffer-p) + (save-excursion + (goto-char (point-min)) + (or (mastodon-tl--property 'profile-json) + (error "No profile data found"))))) + +(defun mastodon-profile--add-or-view-private-note (action-fun &optional message view) + "Add or view a private note for an account. +ACTION-FUN does the adding or viewing, MESSAGE is a prompt for +`mastodon-tl--interactive-user-handles-get', VIEW is a flag." + (let* ((profile-json (mastodon-profile--grab-profile-json)) + (handle (if (mastodon-tl--profile-buffer-p) + (alist-get 'acct profile-json) + (mastodon-tl--interactive-user-handles-get message))) + (account (if (mastodon-tl--profile-buffer-p) + profile-json + (mastodon-profile--search-account-by-handle handle))) + (id (alist-get 'id account)) + (relationships (mastodon-profile--relationships-get id)) + (note (alist-get 'note relationships))) + (if view + (if (string-empty-p note) + (message "No private note for %s" handle) + (funcall action-fun note)) + (funcall action-fun id handle note)))) + +(defun mastodon-profile--show-familiar-followers () + "Show a list of familiar followers. +Familiar followers are accounts that you follow, and that follow +the given account." + (interactive) + (let* ((profile-json (mastodon-profile--grab-profile-json)) + (handle + (if (mastodon-tl--profile-buffer-p) + (alist-get 'acct profile-json) + (mastodon-tl--interactive-user-handles-get "show familiar followers of"))) + (account (if (mastodon-tl--profile-buffer-p) + profile-json + (mastodon-profile--search-account-by-handle handle))) + (id (alist-get 'id account))) + (mastodon-profile--get-familiar-followers id))) + +(defun mastodon-profile--get-familiar-followers (id) + "Return JSON data of familiar followers for account ID." + ;; the server can handle multiple IDs, but for now we just handle one. + (let* ((params `(("id" . ,id))) + (url (mastodon-http--api "accounts/familiar_followers")) + (json (mastodon-http--get-json url params)) + (accounts (alist-get 'accounts (car json))) ; first id result + (handles (mastodon-tl--map-alist 'acct accounts))) + (if (null handles) + (message "Looks like there are no familiar followers for this account") + (let ((choice (completing-read "Show profile of user: " + handles))) + (mastodon-profile--show-user choice))))) + (provide 'mastodon-profile) ;;; mastodon-profile.el ends here diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 0f2a6d4..3f76162 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -31,16 +31,16 @@ ;;; Code: (require 'json) +(autoload 'mastodon-auth--access-token "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-http--get-search-json "mastodon-http") (autoload 'mastodon-mode "mastodon") -(autoload 'mastodon-tl--set-face "mastodon-tl") -(autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--as-string "mastodon-tl") -(autoload 'mastodon-auth--access-token "mastodon-auth") -(autoload 'mastodon-http--get-search-json "mastodon-http") -(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--set-face "mastodon-tl") (defvar mastodon-toot--completion-style-for-mentions) (defvar mastodon-instance-url) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8197315..dc538a9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1,4 +1,4 @@ -;;; mastodon-tl.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*- +;;; mastodon-tl.el --- Timeline functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen ;; Copyright (C) 2020-2022 Marty Hiatt @@ -38,53 +38,50 @@ (require 'time-date) (require 'cl-lib) (require 'mastodon-iso) - (require 'mpv nil :no-error) +(autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-auth--get-account-name "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") +(autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-http--get-response-async "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") (autoload 'mastodon-media--get-avatar-rendering "mastodon-media") (autoload 'mastodon-media--get-media-link-rendering "mastodon-media") (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-notifications-get "mastodon-notifications" + "Display NOTIFICATIONS in buffer." t) ; interactive +(autoload 'mastodon-profile--account-field "mastodon-profile") (autoload 'mastodon-profile--account-from-id "mastodon-profile") +(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--my-profile "mastodon-profile") (autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") -;; mousebot adds (autoload 'mastodon-profile--toot-json "mastodon-profile") -(autoload 'mastodon-profile--account-field "mastodon-profile") -(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") -(autoload 'mastodon-profile--my-profile "mastodon-profile") -(autoload 'mastodon-toot--delete-toot "mastodon-toot") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-http--get-json-async "mastodon-http") -(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") +(autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") -;; make notifications--get available via M-x and outside our keymap: -(autoload 'mastodon-notifications-get "mastodon-notifications" - "Display NOTIFICATIONS in buffer." t) ; interactive -(autoload 'mastodon-search--propertize-user "mastodon-search") -(autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-search--get-user-info "mastodon-search") -(autoload 'mastodon-http--delete "mastodon-http") -(autoload 'mastodon-profile--view-author-profile "mastodon-profile") -(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") -(autoload 'mastodon-http--get-response-async "mastodon-http") -(autoload 'mastodon-url-lookup "mastodon") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-http--put "mastodon-http") -(autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--build-params-string "mastodon-http") -(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") -(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") -(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-toot--compose-buffer "mastodon-toot") -(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") -(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--delete-toot "mastodon-toot") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (autoload 'mastodon-toot--iso-to-human "mastodon-toot") +(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-url-lookup "mastodon") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) @@ -97,6 +94,9 @@ (defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this (defvar mastodon-mode-map) + +;;; CUSTOMIZES + (defgroup mastodon-tl nil "Timelines in Mastodon." :prefix "mastodon-tl-" @@ -123,9 +123,6 @@ nil." :group 'mastodon-tl :type 'boolean) -(defvar-local mastodon-tl--buffer-spec nil - "A unique identifier and functions for each Mastodon buffer.") - (defcustom mastodon-tl--show-avatars nil "Whether to enable display of user avatars in timelines." :group 'mastodon-tl @@ -170,6 +167,12 @@ timeline with a simple prefix argument, `C-u'." :group 'mastodon-tl :type '(boolean :tag "Whether to hide replies from the timelines.")) + +;;; VARIABLES + +(defvar-local mastodon-tl--buffer-spec nil + "A unique identifier and functions for each Mastodon buffer.") + (defvar-local mastodon-tl--update-point nil "When updating a mastodon buffer this is where new toots will be inserted. If nil `(point-min)' is used instead.") @@ -186,7 +189,8 @@ If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--timestamp-update-timer nil "The timer that, when set will scan the buffer to update the timestamps.") -;; KEYMAPS + +;;; KEYMAPS (defvar mastodon-tl--link-keymap (let ((map (make-sparse-keymap))) @@ -235,60 +239,6 @@ types of mastodon links and not just shr.el-generated ones.") We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") -(defvar mastodon-tl--view-filters-keymap - (let ((map - (copy-keymap mastodon-mode-map))) - (define-key map (kbd "d") 'mastodon-tl--delete-filter) - (define-key map (kbd "c") 'mastodon-tl--create-filter) - (define-key map (kbd "n") 'mastodon-tl--goto-next-item) - (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) - (define-key map (kbd "TAB") 'mastodon-tl--goto-next-item) - (define-key map (kbd "g") 'mastodon-tl--view-filters) - (keymap-canonicalize map)) - "Keymap for viewing filters.") - -(defvar mastodon-tl--follow-suggestions-map - (let ((map - (copy-keymap mastodon-mode-map))) - (define-key map (kbd "n") 'mastodon-tl--goto-next-item) - (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) - (define-key map (kbd "g") 'mastodon-tl--get-follow-suggestions) - (keymap-canonicalize map)) - "Keymap for viewing follow suggestions.") - -(defvar mastodon-tl--view-lists-keymap - (let ((map ;(make-sparse-keymap))) - (copy-keymap mastodon-mode-map))) - (define-key map (kbd "D") 'mastodon-tl--delete-list) - (define-key map (kbd "C") 'mastodon-tl--create-list) - (define-key map (kbd "A") 'mastodon-tl--add-account-to-list) - (define-key map (kbd "R") 'mastodon-tl--remove-account-from-list) - (define-key map (kbd "E") 'mastodon-tl--edit-list) - (define-key map (kbd "n") 'mastodon-tl--goto-next-item) - (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) - (define-key map (kbd "g") 'mastodon-tl--view-lists) - (keymap-canonicalize map)) - "Keymap for viewing lists.") - -(defvar mastodon-tl--list-name-keymap - (let ((map (make-sparse-keymap))) - (define-key map (kbd "<return>") 'mastodon-tl--view-timeline-list-at-point) - (define-key map (kbd "d") 'mastodon-tl--delete-list-at-point) - (define-key map (kbd "a") 'mastodon-tl--add-account-to-list-at-point) - (define-key map (kbd "r") 'mastodon-tl--remove-account-from-list-at-point) - (define-key map (kbd "e") 'mastodon-tl--edit-list-at-point) - (keymap-canonicalize map)) - "Keymap for when point is on list name.") - -(defvar mastodon-tl--scheduled-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "r") 'mastodon-tl--reschedule-toot) - (define-key map (kbd "c") 'mastodon-tl--cancel-scheduled-toot) - (define-key map (kbd "e") 'mastodon-tl--edit-scheduled-as-new) - (define-key map (kbd "<return>") 'mastodon-tl--edit-scheduled-as-new) - (keymap-canonicalize map)) - "Keymap for when point is on a scheduled toot.") - (defvar mastodon-tl--byline-link-keymap (when (require 'mpv nil :no-error) (let ((map (make-sparse-keymap))) @@ -298,17 +248,8 @@ types of mastodon links and not just shr.el-generated ones.") "The keymap to be set for the author byline. It is active where point is placed by `mastodon-tl--goto-next-toot.'") -(defun mastodon-tl--symbol (name) - "Return the unicode symbol (as a string) corresponding to NAME. -If symbol is not displayable, an ASCII equivalent is returned. If -NAME is not part of the symbol table, '?' is returned." - (if-let* ((symbol (alist-get name mastodon-tl--symbols))) - (if (char-displayable-p (string-to-char (car symbol))) - (car symbol) - (cdr symbol)) - "?")) - -;; NAV + +;;; NAV (defun mastodon-tl--next-tab-item () "Move to the next interesting item. @@ -320,7 +261,6 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (search-pos (point))) (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos nil)) - (get-text-property (car next-range) 'invisible) (setq search-pos (1+ (cdr next-range)))) ;; do nothing, all the action in in the while condition @@ -350,11 +290,9 @@ text, i.e. hidden spoiler text." (goto-char (car next-range)) (message "%s" (get-text-property (point) 'help-echo))))) - (defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) "Search for toot with FIND-POS. If search returns nil, execute REFRESH function. - Optionally start from POS." (let* ((npos (funcall find-pos (or pos (point)) @@ -401,7 +339,8 @@ Used on initializing a timeline or thread." (mastodon-tl--goto-toot-pos 'previous-single-property-change 'previous-line)) -;; TIMELINES + +;;; TIMELINES (defun mastodon-tl--get-federated-timeline () "Opens federated timeline." @@ -448,6 +387,9 @@ Optionally load TAG timeline directly." 'mastodon-tl--timeline nil `(("limit" . ,mastodon-tl--timeline-posts-count)))) + +;;; BYLINES, etc. + (defun mastodon-tl--message-help-echo () "Call message on 'help-echo property at point. Do so if type of status at poins is not follow_request/follow." @@ -460,12 +402,6 @@ Do so if type of status at poins is not follow_request/follow." (string= type "follow")) ; no counts for these (message "%s" (get-text-property (point) 'help-echo)))))) -(defun mastodon-tl--remove-html (toot) - "Remove unrendered tags from TOOT." - (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) - (t2 (replace-regexp-in-string "<\/?span>" "" t1))) - (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) - (defun mastodon-tl--byline-author (toot &optional avatar) "Propertize author of TOOT. With arg AVATAR, include the account's avatar image." @@ -507,12 +443,12 @@ With arg AVATAR, include the account's avatar image." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--format-faves-count (toot) @@ -553,9 +489,7 @@ image media from the byline." (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." (let* ((attachments (mastodon-tl--field 'media_attachments toot))) - (mapcar (lambda (x) - (alist-get 'type x)) - attachments))) + (mastodon-tl--map-alist 'type attachments))) (defun mastodon-tl--get-attachments-for-byline (toot) "Return a list of attachment URLs and types for TOOT. @@ -581,74 +515,20 @@ The result is added as an attachments property to author-byline." " " (mastodon-tl--byline-author reblog))))) -(defun mastodon-tl--field (field toot) - "Return FIELD from TOOT. -Return value from boosted content if available." - (or (alist-get field (alist-get 'reblog toot)) - (alist-get field toot))) - -(defun mastodon-tl--relative-time-details (timestamp &optional current-time) - "Return cons of (descriptive string . next change) for the TIMESTAMP. -Use the optional CURRENT-TIME as the current time (only used for -reliable testing). - -The descriptive string is a human readable version relative to -the current time while the next change timestamp give the first -time that this description will change in the future. - -TIMESTAMP is assumed to be in the past." - (let* ((now (or current-time (current-time))) - (time-difference (time-subtract now timestamp)) - (seconds-difference (float-time time-difference)) - (regular-response - (lambda (seconds-difference multiplier unit-name) - (let ((n (floor (+ 0.5 (/ seconds-difference multiplier))))) - (cons (format "%d %ss ago" n unit-name) - (* (+ 0.5 n) multiplier))))) - (relative-result - (cond - ((< seconds-difference 60) - (cons "just now" - 60)) - ((< seconds-difference (* 1.5 60)) - (cons "1 minute ago" - 90)) ;; at 90 secs - ((< seconds-difference (* 60 59.5)) - (funcall regular-response seconds-difference 60 "minute")) - ((< seconds-difference (* 1.5 60 60)) - (cons "1 hour ago" - (* 60 90))) ;; at 90 minutes - ((< seconds-difference (* 60 60 23.5)) - (funcall regular-response seconds-difference (* 60 60) "hour")) - ((< seconds-difference (* 1.5 60 60 24)) - (cons "1 day ago" - (* 1.5 60 60 24))) ;; at a day and a half - ((< seconds-difference (* 60 60 24 6.5)) - (funcall regular-response seconds-difference (* 60 60 24) "day")) - ((< seconds-difference (* 1.5 60 60 24 7)) - (cons "1 week ago" - (* 1.5 60 60 24 7))) ;; a week and a half - ((< seconds-difference (* 60 60 24 7 52)) - (if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7)))) - (cons "52 weeks ago" - (* 60 60 24 7 52)) - (funcall regular-response seconds-difference (* 60 60 24 7) "week"))) - ((< seconds-difference (* 1.5 60 60 24 365)) - (cons "1 year ago" - (* 60 60 24 365 1.5))) ;; a year and a half - (t - (funcall regular-response seconds-difference (* 60 60 24 365.25) "year"))))) - (cons (car relative-result) - (time-add timestamp (seconds-to-time (cdr relative-result)))))) - -(defun mastodon-tl--relative-time-description (timestamp &optional current-time) - "Return a string with a human readable TIMESTAMP relative to the current time. -Use the optional CURRENT-TIME as the current time (only used for -reliable testing). - -E.g. this could return something like \"1 min ago\", \"yesterday\", etc. -TIME-STAMP is assumed to be in the past." - (car (mastodon-tl--relative-time-details timestamp current-time))) +(defun mastodon-tl--format-faved-or-boosted-byline (letter) + "Format the byline marker for a boosted or favourited status. +LETTER is a string, F for favourited, B for boosted, or K for bookmarked." + (let ((help-string (cond ((equal letter "F") + "favourited") + ((equal letter "B") + "boosted") + ((equal letter (or "🔖" "K")) + "bookmarked")))) + (format "(%s) " + (propertize letter 'face 'mastodon-boost-fave-face + ;; emojify breaks this for 🔖: + 'help-echo (format "You have %s this status." + help-string))))) (defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p) "Generate byline for TOOT. @@ -657,7 +537,6 @@ the byline that takes one variable. ACTION-BYLINE is a function for adding an action, such as boosting, favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'. - DETAILED-P means display more detailed info. For now this just means displaying toot client." (let* ((created-time @@ -734,10 +613,10 @@ this just means displaying toot client." 'face 'mastodon-display-name-face 'follow-link t 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url + 'mastodon-tab-stop 'shr-url + 'shr-url app-url 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) + 'keymap mastodon-tl--shr-map-replacement))))) (if edited-time (concat " " @@ -761,36 +640,71 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) -(defun mastodon-tl--format-edit-timestamp (timestamp) - "Convert edit TIMESTAMP into a descriptive string." - (let ((parsed (ts-human-duration - (ts-diff (ts-now) (ts-parse timestamp))))) - (cond ((> (plist-get parsed :days) 0) - (format "%s days ago" (plist-get parsed :days) (plist-get parsed :hours))) - ((> (plist-get parsed :hours) 0) - (format "%s hours ago" (plist-get parsed :hours) (plist-get parsed :minutes))) - ((> (plist-get parsed :minutes) 0) - (format "%s minutes ago" (plist-get parsed :minutes))) - (t ;; we failed to guess: - (format "%s days, %s hours, %s minutes ago" - (plist-get parsed :days) - (plist-get parsed :hours) - (plist-get parsed :minutes)))))) + +;;; TIMESTAMPS -(defun mastodon-tl--format-faved-or-boosted-byline (letter) - "Format the byline marker for a boosted or favourited status. -LETTER is a string, F for favourited, B for boosted, or K for bookmarked." - (let ((help-string (cond ((equal letter "F") - "favourited") - ((equal letter "B") - "boosted") - ((equal letter (or "🔖" "K")) - "bookmarked")))) - (format "(%s) " - (propertize letter 'face 'mastodon-boost-fave-face - ;; emojify breaks this for 🔖: - 'help-echo (format "You have %s this status." - help-string))))) +(defun mastodon-tl--relative-time-details (timestamp &optional current-time) + "Return cons of (descriptive string . next change) for the TIMESTAMP. +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). +The descriptive string is a human readable version relative to +the current time while the next change timestamp give the first +time that this description will change in the future. +TIMESTAMP is assumed to be in the past." + (let* ((now (or current-time (current-time))) + (time-difference (time-subtract now timestamp)) + (seconds-difference (float-time time-difference)) + (regular-response + (lambda (seconds-difference multiplier unit-name) + (let ((n (floor (+ 0.5 (/ seconds-difference multiplier))))) + (cons (format "%d %ss ago" n unit-name) + (* (+ 0.5 n) multiplier))))) + (relative-result + (cond + ((< seconds-difference 60) + (cons "just now" + 60)) + ((< seconds-difference (* 1.5 60)) + (cons "1 minute ago" + 90)) ;; at 90 secs + ((< seconds-difference (* 60 59.5)) + (funcall regular-response seconds-difference 60 "minute")) + ((< seconds-difference (* 1.5 60 60)) + (cons "1 hour ago" + (* 60 90))) ;; at 90 minutes + ((< seconds-difference (* 60 60 23.5)) + (funcall regular-response seconds-difference (* 60 60) "hour")) + ((< seconds-difference (* 1.5 60 60 24)) + (cons "1 day ago" + (* 1.5 60 60 24))) ;; at a day and a half + ((< seconds-difference (* 60 60 24 6.5)) + (funcall regular-response seconds-difference (* 60 60 24) "day")) + ((< seconds-difference (* 1.5 60 60 24 7)) + (cons "1 week ago" + (* 1.5 60 60 24 7))) ;; a week and a half + ((< seconds-difference (* 60 60 24 7 52)) + (if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7)))) + (cons "52 weeks ago" + (* 60 60 24 7 52)) + (funcall regular-response seconds-difference (* 60 60 24 7) "week"))) + ((< seconds-difference (* 1.5 60 60 24 365)) + (cons "1 year ago" + (* 60 60 24 365 1.5))) ;; a year and a half + (t + (funcall regular-response seconds-difference (* 60 60 24 365.25) "year"))))) + (cons (car relative-result) + (time-add timestamp (seconds-to-time (cdr relative-result)))))) + +(defun mastodon-tl--relative-time-description (timestamp &optional current-time) + "Return a string with a human readable TIMESTAMP relative to the current time. +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). +E.g. this could return something like \"1 min ago\", \"yesterday\", etc. +TIME-STAMP is assumed to be in the past." + (car (mastodon-tl--relative-time-details timestamp current-time))) + + +;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES (defun mastodon-tl--render-text (string &optional toot) "Return a propertized text rendering the given HTML string STRING. @@ -933,40 +847,8 @@ the toot)." ;; If nothing matches we assume it is not a hashtag link: (t nil))) -(defun mastodon-tl--set-face (string face) - "Return the propertized STRING with the face property set to FACE." - (propertize string 'face face)) - -(defun mastodon-tl--toggle-spoiler-text (position) - "Toggle the visibility of the spoiler text at/after POSITION." - (let ((inhibit-read-only t) - (spoiler-text-region (mastodon-tl--find-property-range - 'mastodon-content-warning-body position nil))) - (if (not spoiler-text-region) - (message "No spoiler text here") - (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) - (list 'invisible - (not (get-text-property (car spoiler-text-region) - 'invisible))))))) - -(defun mastodon-tl--toggle-spoiler-text-in-toot () - "Toggle the visibility of the spoiler text in the current toot." - (interactive) - (let* ((toot-range (or (mastodon-tl--find-property-range - 'toot-json (point)) - (mastodon-tl--find-property-range - 'toot-json (point) t))) - (spoiler-range (when toot-range - (mastodon-tl--find-property-range - 'mastodon-content-warning-body - (car toot-range))))) - (cond ((null toot-range) - (message "No toot here")) - ((or (null spoiler-range) - (> (car spoiler-range) (cdr toot-range))) - (message "No content warning text here")) - (t - (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) + +;;; HYPERLINKS (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. @@ -1024,6 +906,9 @@ Used for a mouse-click EVENT on a link." (interactive "e") (mastodon-tl--do-link-action-at-point (posn-point (event-end event)))) + +;;; CONTENT WARNINGS + (defun mastodon-tl--has-spoiler (toot) "Check if the given TOOT has a spoiler text. Spoiler text should initially be shown only while the main @@ -1031,6 +916,37 @@ content should be hidden." (let ((spoiler (mastodon-tl--field 'spoiler_text toot))) (and spoiler (> (length spoiler) 0)))) +(defun mastodon-tl--toggle-spoiler-text (position) + "Toggle the visibility of the spoiler text at/after POSITION." + (let ((inhibit-read-only t) + (spoiler-text-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil))) + (if (not spoiler-text-region) + (message "No spoiler text here") + (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) + (list 'invisible + (not (get-text-property (car spoiler-text-region) + 'invisible))))))) + +(defun mastodon-tl--toggle-spoiler-text-in-toot () + "Toggle the visibility of the spoiler text in the current toot." + (interactive) + (let* ((toot-range (or (mastodon-tl--find-property-range + 'toot-json (point)) + (mastodon-tl--find-property-range + 'toot-json (point) t))) + (spoiler-range (when toot-range + (mastodon-tl--find-property-range + 'mastodon-content-warning-body + (car toot-range))))) + (cond ((null toot-range) + (message "No toot here")) + ((or (null spoiler-range) + (> (car spoiler-range) (cdr toot-range))) + (message "No content warning text here")) + (t + (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) + (defun mastodon-tl--clean-tabs-and-nl (string) "Remove tabs and newlines from STRING." (replace-regexp-in-string @@ -1071,6 +987,9 @@ message is a link which unhides/hides the main body." t) 'mastodon-content-warning-body t)))) + +;;; MEDIA + (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) @@ -1136,6 +1055,9 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." help-echo (concat help-echo "\nC-RET: play " type " with mpv")))) + +;;; INSERT TOOTS + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." @@ -1157,17 +1079,14 @@ BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author portion of the byline that takes one variable. By default it is `mastodon-tl--byline-author'. - ACTION-BYLINE is also an optional function for adding an action, such as boosting favouriting and following to the byline. It also takes a single function. By default it is `mastodon-tl--byline-boosted'. - ID is that of the status if it is a notification, which is attached as a `toot-id' property if provided. If the status is a favourite or boost notification, BASE-TOOT is the JSON of the toot responded to. - DETAILED-P means display more detailed info. For now this just means displaying toot client." (let ((start-pos (point))) @@ -1191,6 +1110,9 @@ this just means displaying toot client." (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) + +;; POLLS + (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let* ((poll (mastodon-tl--field 'poll toot)) @@ -1200,9 +1122,7 @@ this just means displaying toot client." (voters-count (mastodon-tl--field 'voters_count poll)) (vote-count (mastodon-tl--field 'votes_count poll)) (options (mastodon-tl--field 'options poll)) - (option-titles (mapcar (lambda (x) - (alist-get 'title x)) - options)) + (option-titles (mastodon-tl--map-alist 'title options)) (longest-option (car (sort option-titles (lambda (x y) (> (length x) @@ -1270,13 +1190,9 @@ this just means displaying toot client." (poll (or (alist-get 'poll reblog) (mastodon-tl--field 'poll toot))) (options (mastodon-tl--field 'options poll)) - (options-titles (mapcar (lambda (x) - (alist-get 'title x)) - options)) + (options-titles (mastodon-tl--map-alist 'title options)) (options-number-seq (number-sequence 1 (length options))) - (options-numbers (mapcar (lambda(x) - (number-to-string x)) - options-number-seq)) + (options-numbers (mapcar #'number-to-string options-number-seq)) (options-alist (cl-mapcar 'cons options-numbers options-titles)) ;; we display both option number and the option title ;; but also store both as cons cell as cdr, as we need it below @@ -1308,6 +1224,9 @@ this just means displaying toot client." (message "You voted for option %s: %s!" (car option) (cdr option))))))) + +;; VIDEOS / MPV + (defun mastodon-tl--find-first-video-in-attachments () "Return the first media attachment that is a moving image." (let ((attachments (mastodon-tl--property 'attachments)) @@ -1351,6 +1270,9 @@ in which case play first video or gif from current toot." (message "no moving image here?")) (message "no moving image here?")))) + +;; INSERT TOOTS + (defun mastodon-tl--is-reply (toot) "Check if the TOOT is a reply to another one (and not boosted)." (and (null (mastodon-tl--field 'in_reply_to_id toot)) @@ -1383,10 +1305,13 @@ This function removes replies if user required." (mastodon-tl--get-buffer-property 'hide-replies nil :no-error) ;; loading a tl with a prefix arg: (mastodon-tl--hide-replies-p current-prefix-arg)) - (cl-remove-if-not #'mastodon-tl--is-reply toots) - toots))) + (cl-remove-if-not #'mastodon-tl--is-reply toots) + toots))) (goto-char (point-min))) + +;;; BUFFER SPEC + (defun mastodon-tl--get-update-function (&optional buffer) "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." @@ -1443,6 +1368,9 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." update-params ,update-params hide-replies ,hide-replies))) + +;;; BUFFERS + (defun mastodon-tl--get-buffer-type () "Return a symbol descriptive of current mastodon buffer type. Should work in all mastodon buffers. @@ -1567,32 +1495,49 @@ timeline." ;; Timeline called with C-u prefix (equal '(4) prefix)))) -(defun mastodon-tl--more-json (endpoint id) - "Return JSON for timeline ENDPOINT before ID." - (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url args))) + +;;; UTILITIES -(defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs) - "Return JSON for timeline ENDPOINT before ID. -Then run CALLBACK with arguments CBARGS. -PARAMS is used to send any parameters needed to correctly update -the current view." - (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push (car args) params) args)) - (url (mastodon-http--api endpoint))) - (apply 'mastodon-http--get-json-async url args callback cbargs))) +(defun mastodon-tl--map-alist (key alist) + "Return a list of values extracted from ALIST with KEY. +Key is a symbol, as with `alist-get'." + (mapcar (lambda (x) + (alist-get key x)) + alist)) -;; TODO -;; Look into the JSON returned here by Local -(defun mastodon-tl--updated-json (endpoint id &optional params) - "Return JSON for timeline ENDPOINT since ID. -PARAMS is used to send any parameters needed to correctly update -the current view." - (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push (car args) params) args)) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url args))) +(defun mastodon-tl--map-alist-vals-to-alist (key1 key2 alist) + "From ALIST, return an alist consisting of (val1 . val2) elements. +Values are accessed by `alist-get', using KEY1 and KEY2." + (mapcar (lambda (x) + (cons (alist-get key1 x) + (alist-get key2 x))) + alist)) + +(defun mastodon-tl--symbol (name) + "Return the unicode symbol (as a string) corresponding to NAME. +If symbol is not displayable, an ASCII equivalent is returned. If +NAME is not part of the symbol table, '?' is returned." + (if-let* ((symbol (alist-get name mastodon-tl--symbols))) + (if (char-displayable-p (string-to-char (car symbol))) + (car symbol) + (cdr symbol)) + "?")) + +(defun mastodon-tl--set-face (string face) + "Return the propertized STRING with the face property set to FACE." + (propertize string 'face face)) + +(defun mastodon-tl--field (field toot) + "Return FIELD from TOOT. +Return value from boosted content if available." + (or (alist-get field (alist-get 'reblog toot)) + (alist-get field toot))) + +(defun mastodon-tl--remove-html (toot) + "Remove unrendered tags from TOOT." + (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) + (t2 (replace-regexp-in-string "<\/?span>" "" t1))) + (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) (defun mastodon-tl--property (prop &optional backward) "Get property PROP for toot at point. @@ -1635,6 +1580,7 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) + ;;; THREADS (defun mastodon-tl--single-toot (id) @@ -1646,14 +1592,15 @@ 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-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (mastodon-tl--set-buffer-spec buffer - (format "statuses/%s" id) - nil) + (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) - (mastodon-tl--toot toot :detailed-p)))))) + (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))))))) (defun mastodon-tl--view-whole-thread () "From a thread view, view entire thread. @@ -1698,13 +1645,13 @@ view all branches of a thread." 0) ;; if we have a thread: (progn - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (mastodon-tl--set-buffer-spec buffer - endpoint - #'mastodon-tl--thread) + (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) + (switch-to-buffer buffer) + (mastodon-mode) + (mastodon-tl--set-buffer-spec buffer + endpoint + #'mastodon-tl--thread) (mastodon-tl--timeline (alist-get 'ancestors context)) (goto-char (point-max)) (move-marker marker (point)) @@ -1717,7 +1664,6 @@ view all branches of a thread." ;; else just print the lone toot: (mastodon-tl--single-toot id))))))) - (defun mastodon-tl--mute-thread () "Mute the thread displayed in the current buffer. Note that you can only (un)mute threads you have posted in." @@ -1776,499 +1722,8 @@ ID is that of the post the context is currently displayed for." (or (member (mastodon-auth--get-account-id) a-ids) (member (mastodon-auth--get-account-id) d-ids)))) -;;; LISTS - -(defun mastodon-tl--get-users-lists () - "Get the list of the user's lists from the server." - (let ((url (mastodon-http--api "lists"))) - (mastodon-http--get-json url))) - -(defun mastodon-tl--get-lists-names () - "Return a list of the user's lists' names." - (let ((lists (mastodon-tl--get-users-lists))) - (mapcar (lambda (x) - (alist-get 'title x)) - lists))) - -(defun mastodon-tl--get-list-by-name (name) - "Return the list data for list with NAME." - (let* ((lists (mastodon-tl--get-users-lists))) - (cl-loop for list in lists - if (string= (alist-get 'title list) name) - return list))) - -(defun mastodon-tl--get-list-id (name) - "Return id for list with NAME." - (let ((list (mastodon-tl--get-list-by-name name))) - (alist-get 'id list))) - -(defun mastodon-tl--get-list-name (id) - "Return name of list with ID." - (let* ((url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--get-json url))) - (alist-get 'title response))) - -(defun mastodon-tl--edit-list-at-point () - "Edit list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--edit-list id))) - -(defun mastodon-tl--edit-list (&optional id) - "Prompt for a list and edit the name and replies policy. -If ID is provided, use that list." - (interactive) - (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (name-old (if id - (get-text-property (point) 'list-name) - (completing-read "Edit list: " - list-names))) - (id (or id (mastodon-tl--get-list-id name-old))) - (name-choice (read-string "List name: " name-old)) - (replies-policy (completing-read "Replies policy: " ; give this a proper name - '("followed" "list" "none") - nil t nil nil "list")) - (url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--put url - `(("title" . ,name-choice) - ("replies_policy" . ,replies-policy))))) - (mastodon-http--triage response - (lambda () - (with-current-buffer response - (let* ((json (mastodon-http--process-json)) - (name-new (alist-get 'title json))) - (message "list %s edited to %s!" name-old name-new))) - (when (mastodon-tl--buffer-type-eq 'lists) - (mastodon-tl--view-lists)))))) - -(defun mastodon-tl--view-timeline-list-at-point () - "View timeline of list at point." - (interactive) - (let ((list-id (get-text-property (point) 'list-id))) - (mastodon-tl--view-list-timeline list-id))) - -(defun mastodon-tl--view-list-timeline (&optional id) - "Prompt for a list and view its timeline. -If ID is provided, use that list." - (interactive) - (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (list-name (unless id (completing-read "View list: " list-names))) - (id (or id (mastodon-tl--get-list-id list-name))) - (endpoint (format "timelines/list/%s" id)) - (name (mastodon-tl--get-list-name id)) - (buffer-name (format "list-%s" name))) - (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline))) - -(defun mastodon-tl--create-list () - "Create a new list. -Prompt for name and replies policy." - (interactive) - (let* ((title (read-string "New list name: ")) - (replies-policy (completing-read "Replies policy: " ; give this a proper name - '("followed" "list" "none") - nil t nil nil "list")) ; default - (response (mastodon-http--post (mastodon-http--api "lists") - `(("title" . ,title) - ("replies_policy" . ,replies-policy)) - nil))) - (mastodon-tl--list-action-triage response - (message "list %s created!" title)))) - -(defun mastodon-tl--delete-list-at-point () - "Delete list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--delete-list id))) - -(defun mastodon-tl--delete-list (&optional id) - "Prompt for a list and delete it. -If ID is provided, delete that list." - (interactive) - (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (name (if id - (mastodon-tl--get-list-name id) - (completing-read "Delete list: " - list-names))) - (id (or id (mastodon-tl--get-list-id name))) - (url (mastodon-http--api (format "lists/%s" id)))) - (when (y-or-n-p (format "Delete list %s?" name)) - (let ((response (mastodon-http--delete url))) - (mastodon-tl--list-action-triage response - (message "list %s deleted!" name)))))) - -(defun mastodon-tl--view-lists () - "Show the user's lists in a new buffer." - (interactive) - (mastodon-tl--init-sync "lists" - "lists" - 'mastodon-tl--insert-lists) - (use-local-map mastodon-tl--view-lists-keymap)) - -(defun mastodon-tl--insert-lists (_json) - "Insert the user's lists from JSON." - ;; TODO: for now we don't use the JSON, we get it ourself again - (let* ((lists-names (mastodon-tl--get-lists-names))) - (erase-buffer) - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " YOUR LISTS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[C - create a list\n D - delete a list\ -\n A/R - add/remove account from a list\ -\n E - edit a list\n n/p - go to next/prev item]\n\n" - 'font-lock-comment-face)) - (mapc (lambda (x) - (mastodon-tl--print-list-accounts x) - (insert (propertize " ------------\n\n" - 'face 'success))) - lists-names) - (goto-char (point-min)))) -;; (mastodon-tl--goto-next-item))) ; causes another request! - -(defun mastodon-tl--print-list-accounts (list-name) - "Insert the accounts in list named LIST-NAME." - (let* ((id (mastodon-tl--get-list-id list-name)) - (accounts (mastodon-tl--accounts-in-list id))) - (insert - (propertize list-name - 'byline t ; so we nav here - 'toot-id "0" ; so we nav here - 'help-echo "RET: view list timeline, d: delete this list, \ -a: add account to this list, r: remove account from this list" - 'list t - 'face 'link - 'keymap mastodon-tl--list-name-keymap - 'list-name list-name - 'list-id id) - (propertize - "\n\n" - 'list t - 'keymap mastodon-tl--list-name-keymap - 'list-name list-name - 'list-id id) - (propertize - (mapconcat #'mastodon-search--propertize-user accounts - " ") - ;; (mastodon-search--insert-users-propertized accounts) - 'list t - 'keymap mastodon-tl--list-name-keymap - 'list-name list-name - 'list-id id)))) - -(defun mastodon-tl--get-users-followings () - "Return the list of followers of the logged in account." - (let* ((id (mastodon-auth--get-account-id)) - (url (mastodon-http--api (format "accounts/%s/following" id)))) - (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts - -(defun mastodon-tl--add-account-to-list-at-point () - "Prompt for account and add to list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--add-account-to-list id))) - -(defun mastodon-tl--add-account-to-list (&optional id account-id handle) - "Prompt for a list and for an account, add account to list. -If ID is provided, use that list. -If ACCOUNT-ID and HANDLE are provided use them rather than prompting." - (interactive) - (let* ((list-prompt (if handle - (format "Add %s to list: " handle) - "Add account to list: ")) - (list-name (if id - (get-text-property (point) 'list-name) - (completing-read list-prompt - (mastodon-tl--get-lists-names) nil t))) - (list-id (or id (mastodon-tl--get-list-id list-name))) - (followings (mastodon-tl--get-users-followings)) - (handles (mapcar (lambda (x) - (cons (alist-get 'acct x) - (alist-get 'id x))) - followings)) - (account (or handle (completing-read "Account to add: " - handles nil t))) - (account-id (or account-id (alist-get account handles nil nil 'equal))) - (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (response (mastodon-http--post url - `(("account_ids[]" . ,account-id))))) - (mastodon-tl--list-action-triage - response - (message "%s added to list %s!" account list-name)))) - -(defun mastodon-tl--add-toot-account-at-point-to-list () - "Prompt for a list, and add the account of the toot at point to it." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (account (mastodon-tl--field 'account toot)) - (account-id (mastodon-tl--field 'id account)) - (handle (mastodon-tl--field 'acct account))) - (mastodon-tl--add-account-to-list nil account-id handle))) - -(defun mastodon-tl--remove-account-from-list-at-point () - "Prompt for account and remove from list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--remove-account-from-list id))) - -(defun mastodon-tl--remove-account-from-list (&optional id) - "Prompt for a list, select an account and remove from list. -If ID is provided, use that list." - (interactive) - (let* ((list-name (if id - (get-text-property (point) 'list-name) - (completing-read "Remove account from list: " - (mastodon-tl--get-lists-names) nil t))) - (list-id (or id (mastodon-tl--get-list-id list-name))) - (accounts (mastodon-tl--accounts-in-list list-id)) - (handles (mapcar (lambda (x) - (cons (alist-get 'acct x) - (alist-get 'id x))) - accounts)) - (account (completing-read "Account to remove: " - handles nil t)) - (account-id (alist-get account handles nil nil 'equal)) - (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) - (response (mastodon-http--delete url args))) - (mastodon-tl--list-action-triage - response - (message "%s removed from list %s!" account list-name)))) - -(defun mastodon-tl--list-action-triage (response message) - "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." - (mastodon-http--triage response - (lambda () - (when (mastodon-tl--buffer-type-eq 'lists) - (mastodon-tl--view-lists)) - message))) - -(defun mastodon-tl--accounts-in-list (list-id) - "Return the JSON of the accounts in list with LIST-ID." - (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) - (mastodon-http--get-json url))) - -;;; SCHEDULED TOOTS - -(defun mastodon-tl--get-scheduled-toots (&optional id) - "Get the user's currently scheduled toots. -If ID, just return that toot." - (let* ((endpoint (if id - (format "scheduled_statuses/%s" id) - "scheduled_statuses")) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) - -(defun mastodon-tl--reschedule-toot () - "Reschedule the scheduled toot at point." - (interactive) - (mastodon-toot--schedule-toot :reschedule)) - -(defun mastodon-tl--view-scheduled-toots () - "Show the user's scheduled toots in a new buffer." - (interactive) - (mastodon-tl--init-sync "scheduled-toots" - "scheduled_statuses" - 'mastodon-tl--insert-scheduled-toots)) - -(defun mastodon-tl--insert-scheduled-toots (json) - "Insert the user's scheduled toots, from JSON." - (let ((scheduleds (mastodon-tl--get-scheduled-toots))) - (erase-buffer) - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " YOUR SCHEDULED TOOTS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[n/p - prev/next\n r - reschedule\n e/RET - edit toot\n c - cancel]\n\n" - 'font-lock-comment-face)) - (mapc (lambda (x) - (mastodon-tl--insert-scheduled-toot x)) - scheduleds) - (goto-char (point-min)) - (when json - (mastodon-tl--goto-next-toot)))) - -(defun mastodon-tl--insert-scheduled-toot (toot) - "Insert scheduled TOOT into the buffer." - (let* ((id (alist-get 'id toot)) - (scheduled (alist-get 'scheduled_at toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params))) - (insert - (propertize (concat text - " | " - (mastodon-toot--iso-to-human scheduled)) - 'byline t ; so we nav here - 'toot-id "0" ; so we nav here - 'face 'font-lock-comment-face - 'keymap mastodon-tl--scheduled-map - 'scheduled-json toot - 'id id) - "\n"))) - -(defun mastodon-tl--copy-scheduled-toot-text () - "Copy the text of the scheduled toot at point." - (interactive) - (let* ((toot (get-text-property (point) 'toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params))) - (kill-new text))) - -(defun mastodon-tl--cancel-scheduled-toot (&optional id no-confirm) - "Cancel the scheduled toot at point. -ID is that of the scheduled toot to cancel. -NO-CONFIRM means there is no ask or message, there is only do." - (interactive) - (let* ((id (or id (get-text-property (point) 'id))) - (url (mastodon-http--api (format "scheduled_statuses/%s" id)))) - (when (or no-confirm - (y-or-n-p "Cancel scheduled toot?")) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (mastodon-tl--view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!")))))))) - -(defun mastodon-tl--edit-scheduled-as-new () - "Edit scheduled status as new toot." - (interactive) - (let* ((toot (get-text-property (point) 'scheduled-json)) - (id (alist-get 'id toot)) - (scheduled (alist-get 'scheduled_at toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params)) - (visibility (alist-get 'visibility params)) - (cw (alist-get 'spoiler_text params)) - (lang (alist-get 'language params)) - ;; (poll (alist-get 'poll params)) - (reply-id (alist-get 'in_reply_to_id params))) - ;; (media (alist-get 'media_attachments toot))) - (mastodon-toot--compose-buffer) - (goto-char (point-max)) - (insert text) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties reply-id visibility cw - lang scheduled id))) - -;;; FILTERS - -(defun mastodon-tl--create-filter () - "Create a filter for a word. -Prompt for a context, must be a list containting at least one of \"home\", -\"notifications\", \"public\", \"thread\"." - (interactive) - (let* ((url (mastodon-http--api "filters")) - (word (read-string - (format "Word(s) to filter (%s): " (or (current-word) "")) - nil nil (or (current-word) ""))) - (contexts - (if (string-empty-p word) - (error "You must select at least one word for a filter") - (completing-read-multiple - "Contexts to filter [TAB for options]: " - '("home" "notifications" "public" "thread") - nil ; no predicate - t))) ; require-match, as context is mandatory - (contexts-processed - (if (equal nil contexts) - (error "You must select at least one context for a filter") - (mapcar (lambda (x) - (cons "context[]" x)) - contexts))) - (response (mastodon-http--post url (push - `("phrase" . ,word) - contexts-processed)))) - (mastodon-http--triage response - (lambda () - (message "Filter created for %s!" word) - ;; reload if we are in filters view: - (when (mastodon-tl--buffer-type-eq 'filters) - (mastodon-tl--view-filters)))))) - -(defun mastodon-tl--view-filters () - "View the user's filters in a new buffer." - (interactive) - (mastodon-tl--init-sync "filters" - "filters" - 'mastodon-tl--insert-filters) - (use-local-map mastodon-tl--view-filters-keymap)) - -(defun mastodon-tl--insert-filters (json) - "Insert the user's current filters. -JSON is what is returned by by the server." - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " CURRENT FILTERS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[c - create filter\n d - delete filter at point\n n/p - go to next/prev filter]\n\n" - 'font-lock-comment-face)) - (if (seq-empty-p json) - (insert (propertize - "Looks like you have no filters for now." - 'face font-lock-comment-face - 'byline t - 'toot-id "0")) ; so point can move here when no filters - (mapc (lambda (x) - (mastodon-tl--insert-filter-string x) - (insert "\n\n")) - json))) - -(defun mastodon-tl--insert-filter-string (filter) - "Insert a single FILTER." - (let* ((phrase (alist-get 'phrase filter)) - (contexts (alist-get 'context filter)) - (id (alist-get 'id filter)) - (filter-string (concat "- \"" phrase "\" filtered in: " - (mapconcat #'identity contexts ", ")))) - (insert - (propertize filter-string - 'toot-id id ;for goto-next-filter compat - 'phrase phrase - ;;'help-echo "n/p to go to next/prev filter, c to create new filter, d to delete filter at point." - ;;'keymap mastodon-tl--view-filters-keymap - 'byline t)))) ;for goto-next-filter compat - -(defun mastodon-tl--delete-filter () - "Delete filter at point." - (interactive) - (let* ((filter-id (get-text-property (point) 'toot-id)) - (phrase (get-text-property (point) 'phrase)) - (url (mastodon-http--api - (format "filters/%s" filter-id)))) - (if (equal nil filter-id) - (error "No filter at point?") - (when (y-or-n-p (format "Delete this filter? "))) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response (lambda () - (mastodon-tl--view-filters) - (message "Filter for \"%s\" deleted!" phrase))))))) - -;;; FOLLOW SUGGESTIONS - -(defun mastodon-tl--get-follow-suggestions () - "Display a buffer of suggested accounts to follow." - (interactive) - (mastodon-tl--init-sync "follow-suggestions" - "suggestions" - 'mastodon-tl--insert-follow-suggestions) - (use-local-map mastodon-tl--follow-suggestions-map)) - -(defun mastodon-tl--insert-follow-suggestions (response) - "Insert follow suggestions into buffer. -RESPONSE is the JSON returned by the server." - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " SUGGESTED ACCOUNTS\n" - " ------------\n\n") - 'success)) - (mastodon-search--insert-users-propertized response :note) - (goto-char (point-min))) + +;;; FOLLOW/BLOCK/MUTE, ETC (defmacro mastodon-tl--do-if-toot (&rest body) "Execute BODY if we have a toot or user at point." @@ -2278,201 +1733,6 @@ RESPONSE is the JSON returned by the server." (message "Looks like there's no toot or user at point?") ,@body)) -;;; INSTANCES - -(defun mastodon-tl--view-own-instance (&optional brief) - "View details of your own instance. -BRIEF means show fewer details." - (interactive) - (mastodon-tl--view-instance-description :user brief)) - -(defun mastodon-tl--view-own-instance-brief () - "View brief details of your own instance." - (interactive) - (mastodon-tl--view-instance-description :user :brief)) - -(defun mastodon-tl--view-instance-description-brief () - "View brief details of the instance the current post's author is on." - (interactive) - (mastodon-tl--view-instance-description nil :brief)) - -(defun mastodon-tl--view-instance-description (&optional user brief instance) - "View the details of the instance the current post's author is on. -USER means to show the instance details for the logged in user. -BRIEF means to show fewer details. -INSTANCE is an instance domain name." - (interactive) - (if user - (let ((response (mastodon-http--get-json - (mastodon-http--api "instance") - nil ; params - nil ; silent - :vector))) - (mastodon-tl--instance-response-fun response brief)) - (mastodon-tl--do-if-toot - (let* ((profile-p (get-text-property (point) 'profile-json)) - (toot (if profile-p - (mastodon-tl--property 'profile-json) ; profile may have 0 toots - (mastodon-tl--property 'toot-json))) - (reblog (alist-get 'reblog toot)) - (account (or (alist-get 'account reblog) - (alist-get 'account toot))) - (url (if profile-p - (alist-get 'url toot) ; profile - (alist-get 'url account))) - (username (if profile-p - (alist-get 'username toot) ;; profile - (alist-get 'username account))) - (instance (if instance - (concat "https://" instance) - ;; pleroma URL is https://instance.com/users/username - (if (string-suffix-p "users/" (url-basepath url)) - (string-remove-suffix "/users/" - (url-basepath url)) - ;; mastodon: - (string-remove-suffix (concat "/@" username) - url)))) - (response (mastodon-http--get-json - (if user - (mastodon-http--api "instance") - (concat instance "/api/v1/instance")) - nil ; params - nil ; silent - :vector))) - (mastodon-tl--instance-response-fun response brief))))) - -(defun mastodon-tl--instance-response-fun (response brief) - "Display instance description RESPONSE in a new buffer. -BRIEF means to show fewer details." - (when response - (let ((buf (get-buffer-create "*mastodon-instance*"))) - (with-current-buffer buf - (switch-to-buffer-other-window buf) - (let ((inhibit-read-only t)) - (erase-buffer) - (special-mode) - (when brief - (setq response - (list (assoc 'uri response) - (assoc 'title response) - (assoc 'short_description response) - (assoc 'email response) - (cons 'contact_account - (list - (assoc 'username - (assoc 'contact_account response)))) - (assoc 'rules response) - (assoc 'stats response)))) - (mastodon-tl--print-json-keys response) - (mastodon-mode) - (mastodon-tl--set-buffer-spec (buffer-name buf) - "instance" - nil) - (goto-char (point-min))))))) - -(defun mastodon-tl--format-key (el pad) - "Format a key of element EL, a cons, with PAD padding." - (format (concat "%-" - (number-to-string pad) - "s: ") - (propertize - (prin1-to-string (car el)) - 'face '(:underline t)))) - -(defun mastodon-tl--print-json-keys (response &optional ind) - "Print the JSON keys and values in RESPONSE. -IND is the optional indentation level to print at." - (let* ((cars (mapcar - (lambda (x) (symbol-name (car x))) - response)) - (pad (1+ (cl-reduce #'max (mapcar #'length cars))))) - (while response - (let ((el (pop response))) - (cond - ;; vector of alists (fields, instance rules): - ((and (vectorp (cdr el)) - (not (seq-empty-p (cdr el))) - (consp (seq-elt (cdr el) 0))) - (insert - (mastodon-tl--format-key el pad) - "\n\n") - (seq-do #'mastodon-tl--print-instance-rules-or-fields (cdr el)) - (insert "\n")) - ;; vector of strings (media types): - ((and (vectorp (cdr el)) - (not (seq-empty-p (cdr el))) - (< 1 (seq-length (cdr el))) - (stringp (seq-elt (cdr el) 0))) - (when ind (indent-to ind)) - (insert - (mastodon-tl--format-key el pad) - "\n" - (seq-mapcat - (lambda (x) (concat x ", ")) - (cdr el) 'string) - "\n\n")) - ;; basic nesting: - ((consp (cdr el)) - (when ind (indent-to ind)) - (insert - (mastodon-tl--format-key el pad) - "\n\n") - (mastodon-tl--print-json-keys - (cdr el) (if ind (+ ind 4) 4))) - (t - ;; basic handling of raw booleans: - (let ((val (cond ((equal (cdr el) ':json-false) - "no") - ((equal (cdr el) 't) - "yes") - (t - (cdr el))))) - (when ind (indent-to ind)) - (insert (mastodon-tl--format-key el pad) - " " - (mastodon-tl--newline-if-long (cdr el)) - ;; only send strings straight to --render-text - ;; this makes hyperlinks work: - (if (not (stringp val)) - (mastodon-tl--render-text - (prin1-to-string val)) - (mastodon-tl--render-text val)) - "\n")))))))) - -(defun mastodon-tl--print-instance-rules-or-fields (alist) - "Print ALIST of instance rules or contact account or emoji fields." - (let ((key (cond ((alist-get 'id alist) - 'id) - ((alist-get 'name alist) - 'name) - ((alist-get 'shortcode alist) - 'shortcode))) - (value (cond ((alist-get 'id alist) - 'text) - ((alist-get 'value alist) - 'value) - ((alist-get 'url alist) - 'url)))) - (indent-to 4) - (insert - (format "%-5s: " - (propertize (alist-get key alist) - 'face '(:underline t))) - (mastodon-tl--newline-if-long (alist-get value alist)) - (format "%s" (mastodon-tl--render-text - (alist-get value alist))) - "\n"))) - -(defun mastodon-tl--newline-if-long (el) - "Return a newline string if the cdr of EL is over 50 characters long." - (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) - (if (and (sequencep rend) - (< 50 (length rend))) - "\n" - ""))) - -;;; FOLLOW/BLOCK/MUTE, ETC - (defun mastodon-tl--follow-user (user-handle &optional notify langs) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. @@ -2621,9 +1881,7 @@ Action must be either \"unblock\" or \"unmute\"." "mutes"))) (url (mastodon-http--api endpoint)) (json (mastodon-http--get-json url)) - (accts (mapcar (lambda (user) - (alist-get 'acct user)) - json))) + (accts (mastodon-tl--map-get-accts json))) (when accts (completing-read (format "Handle of user to %s: " action) accts @@ -2688,6 +1946,7 @@ ARGS is an alist of any parameters to send with the request." ((eq notify nil) (message "User %s (@%s) %sed!" name user-handle action))))))) + ;; FOLLOW TAGS (defun mastodon-tl--get-tag-json (tag) @@ -2716,9 +1975,8 @@ If TAG provided, follow it." If TAG is provided, unfollow it." (interactive) (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) - (tags (unless tag (mapcar (lambda (x) - (alist-get 'name x)) - followed-tags-json))) + (tags (unless tag + (mastodon-tl--map-alist 'name followed-tags-json))) (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) @@ -2731,12 +1989,40 @@ If TAG is provided, unfollow it." "List followed tags. View timeline of tag user choses." (interactive) (let* ((followed-tags-json (mastodon-tl--followed-tags)) - (tags (mapcar (lambda (x) - (alist-get 'name x)) - followed-tags-json)) + (tags (mastodon-tl--map-alist 'name followed-tags-json)) (tag (completing-read "Tag: " tags))) (mastodon-tl--get-tag-timeline tag))) + +;;; UPDATING, etc. + +(defun mastodon-tl--more-json (endpoint id) + "Return JSON for timeline ENDPOINT before ID." + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) + +(defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs) + "Return JSON for timeline ENDPOINT before ID. +Then run CALLBACK with arguments CBARGS. +PARAMS is used to send any parameters needed to correctly update +the current view." + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (args (if params (push (car args) params) args)) + (url (mastodon-http--api endpoint))) + (apply 'mastodon-http--get-json-async url args callback cbargs))) + +;; TODO +;; Look into the JSON returned here by Local +(defun mastodon-tl--updated-json (endpoint id &optional params) + "Return JSON for timeline ENDPOINT since ID. +PARAMS is used to send any parameters needed to correctly update +the current view." + (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) + (args (if params (push (car args) params) args)) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) + ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () "Reload the current timeline or profile page. @@ -2774,6 +2060,12 @@ when showing followers or accounts followed." (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following))) +(defun mastodon-tl--get-link-header-from-response (headers) + "Get http Link header from list of http HEADERS." + ;; pleroma uses "link", so case-insensitive match required: + (when-let ((link-headers (alist-get "Link" headers nil nil 'cl-equalp))) + (split-string link-headers ", "))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) @@ -2828,7 +2120,6 @@ HEADERS is the http headers returned in the response, if any." "Return `nil` if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. - SEARCH-BACKWARDS determines whether we pick point before (non-nil) or after (nil)" (if (get-text-property start-point property) @@ -2863,9 +2154,7 @@ before (non-nil) or after (nil)" "Find (start . end) property range after/before START-POINT. Does so while PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). - Return nil if no such range exists. - If SEARCH-BACKWARDS is non-nil it find a region before START-POINT otherwise after START-POINT." (if (get-text-property start-point property) @@ -2888,15 +2177,13 @@ START-POINT otherwise after START-POINT." This calculates the next time the text for TIMESTAMP will change and may adjust existing or future timer runs should that time before current plans to run the update function. - The adjustment is only made if it is significantly (a few seconds) before the currently scheduled time. This helps reduce the number of occasions where we schedule an update only to schedule the next one on completion to be within a few seconds. - -If relative timestamps are -disabled (`mastodon-tl--enable-relative-timestamps` is nil) this -is a no-op." +If relative timestamps are disabled (i.e. if +`mastodon-tl--enable-relative-timestamps' is nil), this is a +no-op." (when mastodon-tl--enable-relative-timestamps (let ((this-update (cdr (mastodon-tl--relative-time-details timestamp)))) (when (time-less-p this-update @@ -3010,11 +2297,8 @@ This location is defined by a non-nil value of (goto-char mastodon-tl--after-update-marker)))) (message "nothing to update"))))) -(defun mastodon-tl--get-link-header-from-response (headers) - "Get http Link header from list of http HEADERS." - ;; pleroma uses "link", so case-insensitive match required: - (when-let ((link-headers (alist-get "Link" headers nil nil 'cl-equalp))) - (split-string link-headers ", "))) + +;;; LOADING TIMELINES (defun mastodon-tl--init (buffer-name endpoint update-function &optional headers params hide-replies) @@ -3043,46 +2327,46 @@ RESPONSE is the data returned from the server by JSON and http headers, without it just the JSON." (let ((json (if headers (car response) response))) (if (not json) ; praying this is right here, else try "\n[]" - (message "Looks like nothing returned from endpoint: %s" endpoint) + (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-output-to-temp-buffer 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) - (with-current-buffer buffer - (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-current-buffer (get-buffer-create buffer) + (let ((inhibit-read-only t)) + (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)))))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function &optional note-type) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. @@ -3098,34 +2382,35 @@ 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-output-to-temp-buffer 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) - (with-current-buffer buffer - (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) - (mastodon-tl--goto-first-item))) - buffer)) + (with-current-buffer (get-buffer-create buffer) + (let ((inhibit-read-only t)) + (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))) (provide 'mastodon-tl) ;;; mastodon-tl.el ends here diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 2625695..df9a22c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -48,43 +48,44 @@ (defvar mastodon-tl--enable-proportional-fonts) (defvar mastodon-profile-account-settings) +(autoload 'iso8601-parse "iso8601") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--get-json-async "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--get-source-pref "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-preference "mastodon-profile") (autoload 'mastodon-search--search-accounts-query "mastodon-search") (autoload 'mastodon-search--search-tags-query "mastodon-search") (autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") -(autoload 'mastodon-toot "mastodon") -(autoload 'mastodon-profile--get-source-pref "mastodon-profile") -(autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl") -(autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot") +(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-toot "mastodon") +(autoload 'mastodon-views--cancel-scheduled-toot "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") (autoload 'org-read-date "org") -(autoload 'iso8601-parse "iso8601") -(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -223,16 +224,16 @@ send.") (defvar mastodon-toot-handle-regex (concat - ;; preceding space or bol [boundary doesn't work with @] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with @] + "\\([(\n\t ]\\|^\\)" "\\(?2:@[1-9a-zA-Z._-]+" ; a handle "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) (defvar mastodon-toot-tag-regex (concat - ;; preceding space or bol [boundary doesn't work with #] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with #] + "\\([(\n\t ]\\|^\\)" "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary @@ -450,7 +451,7 @@ With FAVOURITE, list favouriters, else list boosters." (if (eq (caar json) 'error) (error "%s (Status does not exist or is private)" (alist-get 'error json)) - (let ((handles (mapcar (lambda (x) (alist-get 'acct x)) json)) + (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (error "Looks like this toot has no %s" type-string) @@ -520,12 +521,12 @@ Uses `lingva.el'." (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) (message "You can only pin your own toots.") - (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) - (mastodon-toot--action action - (lambda () - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot %s!" msg))))))) + (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (mastodon-toot--action action + (lambda () + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot %s!" msg))))))) (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." @@ -546,22 +547,22 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot))) (if (not (mastodon-toot--own-toot-p toot)) (message "You can only delete (and redraft) your own toots.") - (if (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda () - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - reply-id - toot-visibility - toot-cw))))))))) + (when (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda () + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + reply-id + toot-visibility + toot-cw))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -727,16 +728,6 @@ to `emojify-user-emojis', and the emoji data is updated." (point-min)))) (buffer-substring (cdr header-region) (point-max)))) -(defun mastodon-toot--set-visibility (visibility) - "Set the visiblity of the next toot to VISIBILITY." - (interactive - (list (completing-read "Visiblity: " '("public" - "unlisted" - "private" - "direct")))) - (setq mastodon-toot--visibility visibility) - (message "Visibility set to %s" visibility)) - (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append @@ -815,7 +806,7 @@ instance to edit a toot." (message "Toot toot!")) ;; cancel scheduled toot if we were editing it: (when scheduled-id - (mastodon-tl--cancel-scheduled-toot + (mastodon-views--cancel-scheduled-toot scheduled-id :no-confirm)) (mastodon-toot--restore-previous-window-config prev-window-config)))))))) @@ -903,9 +894,8 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. Remove empty string (self) from result and joins the sequence with whitespace." (mapconcat (lambda (mention) mention) - (remove "" (mapcar (lambda (x) (mastodon-toot--process-local x)) - mentions)) - " ")) + (remove "" (mapcar #'mastodon-toot--process-local mentions)) + " ")) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -931,8 +921,7 @@ Federated user: `username@host.co`." (alist-get 'mentions (alist-get 'reblog status)) (alist-get 'mentions status)))) ;; reverse does not work on vectors in 24.5 - (mapcar (lambda(x) (alist-get 'acct x)) - (reverse mentions)))) + (mastodon-tl--map-alist 'acct (reverse mentions)))) (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point using REGEX." @@ -1070,16 +1059,18 @@ text of the toot being replied to in the compose buffer." (defun mastodon-toot--change-visibility () "Change the current visibility to the next valid value." (interactive) - (setq mastodon-toot--visibility - (cond ((string= mastodon-toot--visibility "public") - "unlisted") - ((string= mastodon-toot--visibility "unlisted") - "private") - ((string= mastodon-toot--visibility "private") - "direct") - (t - "public"))) - (mastodon-toot--update-status-fields)) + (if (mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't change visibility when editing toots.") + (setq mastodon-toot--visibility + (cond ((string= mastodon-toot--visibility "public") + "unlisted") + ((string= mastodon-toot--visibility "unlisted") + "private") + ((string= mastodon-toot--visibility "private") + "direct") + (t + "public"))) + (mastodon-toot--update-status-fields))) (defun mastodon-toot--clear-all-attachments () "Remove all attachments from a toot draft." @@ -1241,34 +1232,40 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;; original idea by christian tietze, thanks! ;; https://codeberg.org/martianh/mastodon.el/issues/285 (interactive) - (let* ((id (when reschedule (get-text-property (point) 'id))) - (ts (when reschedule - (alist-get 'scheduled_at - (get-text-property (point) 'scheduled-json)))) - (time-value - (org-read-date t t nil "Schedule toot:" - ;; default to scheduled timestamp if already set: - (mastodon-toot--iso-to-org - ;; we are rescheduling without editing: - (or ts - ;; we are maybe editing the scheduled toot: - mastodon-toot--scheduled-for)))) - (iso8601-str (format-time-string "%FT%T%z" time-value)) - (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) - (if (not reschedule) - (progn - (setq-local mastodon-toot--scheduled-for iso8601-str) - (message (format "Toot scheduled for %s." msg-str))) - (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str)))) - (url (when reschedule (mastodon-http--api - (format "scheduled_statuses/%s" id)))) - (response (mastodon-http--put url args))) - (mastodon-http--triage response - (lambda () - ;; reschedule means we are in scheduled toots view: - (mastodon-tl--view-scheduled-toots) - (message - (format "Toot rescheduled for %s." msg-str)))))))) + (cond ((mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't schedule toots you're editing.")) + ((not (or (mastodon-tl--buffer-type-eq 'new-toot) + (mastodon-tl--buffer-type-eq 'scheduled-statuses))) + (message "You can only schedule toots from the compose toot buffer or the scheduled toots view.")) + (t + (let* ((id (when reschedule (get-text-property (point) 'id))) + (ts (when reschedule + (alist-get 'scheduled_at + (get-text-property (point) 'scheduled-json)))) + (time-value + (org-read-date t t nil "Schedule toot:" + ;; default to scheduled timestamp if already set: + (mastodon-toot--iso-to-org + ;; we are rescheduling without editing: + (or ts + ;; we are maybe editing the scheduled toot: + mastodon-toot--scheduled-for)))) + (iso8601-str (format-time-string "%FT%T%z" time-value)) + (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) + (if (not reschedule) + (progn + (setq-local mastodon-toot--scheduled-for iso8601-str) + (message (format "Toot scheduled for %s." msg-str))) + (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str)))) + (url (when reschedule (mastodon-http--api + (format "scheduled_statuses/%s" id)))) + (response (mastodon-http--put url args))) + (mastodon-http--triage response + (lambda () + ;; reschedule means we are in scheduled toots view: + (mastodon-views--view-scheduled-toots) + (message + (format "Toot rescheduled for %s." msg-str)))))))))) (defun mastodon-toot--iso-to-human (ts) "Format an ISO8601 timestamp TS to be more human-readable." @@ -1654,6 +1651,11 @@ EDIT means we are editing an existing toot, not composing a new one." ;;;###autoload (add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe) +;; disable auto-fill-mode: +(add-hook 'mastodon-toot-mode-hook + (lambda () + (auto-fill-mode -1))) + (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." :group 'mastodon-toot diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el new file mode 100644 index 0000000..9274f45 --- /dev/null +++ b/lisp/mastodon-views.el @@ -0,0 +1,906 @@ +;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 Marty Hiatt +;; Author: Marty Hiatt <martianhiatus@riseup.net> +;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1")) +;; Homepage: https://codeberg.org/martianh/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-views.el provides minor views functions. + +;; These are currently lists, follow suggestions, filters, scheduled toots, +;; follow requests, and instance descriptions. + +;; It doesn't include favourites, bookmarks, preferences, trending tags, followed tags, toot edits, + +;;; Code: + +(require 'cl-lib) +(require 'mastodon-http) + +(defvar mastodon-profile--account) +(defvar mastodon-mode-map) + +(autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-tl--init "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") +(autoload 'mastodon-tl--set-face "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-tl--profile-buffer-p "mastodon-tl") +(autoload 'mastodon-tl--goto-next-item "mastodon-tl") +(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") +(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--do-if-toot "mastodon-tl") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--render-text "mastodon-tl") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-toot--iso-to-human "mastodon-toot") +(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--compose-buffer "mastodon-toot") +(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") +(autoload 'mastodon-search--propertize-user "mastodon-search") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") + + +;;; KEYMAPS + +;; copy `mastodon-mode-map' if possible, as then all timeline functions are +;; available. this is helpful because if a minor view is the only buffer left +;; open, calling `mastodon' will switch to it, but then we will be unable to +;; switch to timlines without closing the minor view. + +;; copying the mode map however means we need to avoid/unbind/override any +;; functions that might cause interfere with the minor view. + +;; this is not redundant, as while the buffer -init function calls +;; `mastodon-mode', it gets overridden in some but not all cases. + +(defvar mastodon-views--view-filters-keymap + (let ((map + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "d") 'mastodon-views--delete-filter) + (define-key map (kbd "c") 'mastodon-views--create-filter) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "TAB") 'mastodon-tl--goto-next-item) + (define-key map (kbd "g") 'mastodon-views--view-filters) + (keymap-canonicalize map)) + "Keymap for viewing filters.") + +(defvar mastodon-views--follow-suggestions-map + (let ((map + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "g") 'mastodon-views--get-follow-suggestions) + (keymap-canonicalize map)) + "Keymap for viewing follow suggestions.") + +(defvar mastodon-views--view-lists-keymap + (let ((map ;(make-sparse-keymap))) + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "D") 'mastodon-views--delete-list) + (define-key map (kbd "C") 'mastodon-views--create-list) + (define-key map (kbd "A") 'mastodon-views--add-account-to-list) + (define-key map (kbd "R") 'mastodon-views--remove-account-from-list) + (define-key map (kbd "E") 'mastodon-views--edit-list) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "g") 'mastodon-views--view-lists) + (keymap-canonicalize map)) + "Keymap for viewing lists.") + +(defvar mastodon-views--list-name-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "<return>") 'mastodon-views--view-timeline-list-at-point) + (define-key map (kbd "d") 'mastodon-views--delete-list-at-point) + (define-key map (kbd "a") 'mastodon-views--add-account-to-list-at-point) + (define-key map (kbd "r") 'mastodon-views--remove-account-from-list-at-point) + (define-key map (kbd "e") 'mastodon-views--edit-list-at-point) + (keymap-canonicalize map)) + "Keymap for when point is on list name.") + +(defvar mastodon-views--scheduled-map + (let ((map ;(make-sparse-keymap))) + (copy-keymap mastodon-mode-map))) + ;; (let ((map (make-sparse-keymap))) + (define-key map (kbd "n") 'mastodon-tl--goto-next-item) + (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) + (define-key map (kbd "r") 'mastodon-views--reschedule-toot) + (define-key map (kbd "c") 'mastodon-views--cancel-scheduled-toot) + (define-key map (kbd "e") 'mastodon-views--edit-scheduled-as-new) + (define-key map (kbd "<return>") 'mastodon-views--edit-scheduled-as-new) + (keymap-canonicalize map)) + "Keymap for when point is on a scheduled toot.") + +(defvar mastodon-views--view-follow-requests-keymap + (let ((map ;(make-sparse-keymap))) + (copy-keymap mastodon-mode-map))) + ;; make reject binding match the binding in notifs view + ;; 'r' is then reserved for replying, even tho it is not avail + ;; in foll-reqs view + (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) + (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) + (define-key map (kbd "n") #'mastodon-tl--goto-next-item) + (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) + (define-key map (kbd "g") #'mastodon-views--view-follow-requests) + ;; (define-key map (kbd "t") #'mastodon-toot) + ;; (define-key map (kbd "q") #'kill-current-buffer) + ;; (define-key map (kbd "Q") #'kill-buffer-and-window) + map) + "Keymap for viewing follow requests.") + + +;;; GENERAL FUNCTION + +(defun mastodon-views--minor-view (view-name bindings-string insert-fun data) + "Load a minor view named VIEW-NAME. +BINDINGS-STRING is a string explaining the view's local bindings. +INSERT-FUN is the function to call to insert the view's elements. +DATA is the argument to insert-fun, usually JSON returned in a +request. +This function is used as the update-function to +`mastodon-tl--init-sync', which initializes a buffer for us and +provides the JSON data." + (erase-buffer) + (insert (mastodon-tl--set-face + (concat "\n ------------\n " + (upcase view-name) + "\n" + " ------------\n\n") + 'success) + (if bindings-string + (mastodon-tl--set-face + (concat "[" bindings-string "]" + "\n\n") + 'font-lock-comment-face) + "")) + (if (seq-empty-p data) + (insert (propertize + (format "Looks like you have no %s for now." view-name) + 'face font-lock-comment-face + 'byline t + 'toot-id "0")) ; so point can move here when no filters + (funcall insert-fun data) + (goto-char (point-min))) + ;; (when json + ;; FIXME: this seems to trigger a new request, but ideally would run. + ;; (mastodon-tl--goto-next-toot)))) + ) + + +;;; LISTS + +(defun mastodon-views--view-lists () + "Show the user's lists in a new buffer." + (interactive) + (mastodon-tl--init-sync "lists" + "lists" + 'mastodon-views--insert-lists) + (with-current-buffer "*mastodon-lists*" + (use-local-map mastodon-views--view-lists-keymap))) + +(defun mastodon-views--insert-lists (json) + "Insert the user's lists from JSON." + (mastodon-views--minor-view + "your lists" + "C - create a list\n D - delete a list\ + \n A/R - add/remove account from a list\ + \n E - edit a list\n n/p - go to next/prev item" + #'mastodon-views--print-list-set + json)) + +(defun mastodon-views--print-list-set (lists) + "Print each account plus a separator for each list in LISTS." + (let ((lists-names + (mastodon-tl--map-alist 'title lists))) + (mapc (lambda (x) + (mastodon-views--print-list-accounts x) + (insert (propertize " ------------\n\n" + 'face 'success))) + lists-names))) + +(defun mastodon-views--print-list-accounts (list-name) + "Insert the accounts in list named LIST-NAME." + (let* ((id (mastodon-views--get-list-id list-name)) + (accounts (mastodon-views--accounts-in-list id))) + (insert + (propertize list-name + 'byline t ; so we nav here + 'toot-id "0" ; so we nav here + 'help-echo "RET: view list timeline, d: delete this list, \ +a: add account to this list, r: remove account from this list" + 'list t + 'face 'link + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + "\n\n" + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + (mapconcat #'mastodon-search--propertize-user accounts + " ") + ;; (mastodon-search--insert-users-propertized accounts) + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id)))) + +(defun mastodon-views--get-users-lists () + "Get the list of the user's lists from the server." + (let ((url (mastodon-http--api "lists"))) + (mastodon-http--get-json url))) + +(defun mastodon-views--get-lists-names () + "Return a list of the user's lists' names." + (let ((lists (mastodon-views--get-users-lists))) + (mastodon-tl--map-alist 'title lists))) + +(defun mastodon-views--get-list-by-name (name) + "Return the list data for list with NAME." + (let* ((lists (mastodon-views--get-users-lists))) + (cl-loop for list in lists + if (string= (alist-get 'title list) name) + return list))) + +(defun mastodon-views--get-list-id (name) + "Return id for list with NAME." + (let ((list (mastodon-views--get-list-by-name name))) + (alist-get 'id list))) + +(defun mastodon-views--get-list-name (id) + "Return name of list with ID." + (let* ((url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--get-json url))) + (alist-get 'title response))) + +(defun mastodon-views--edit-list-at-point () + "Edit list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-views--edit-list id))) + +(defun mastodon-views--edit-list (&optional id) + "Prompt for a list and edit the name and replies policy. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (name-old (if id + (get-text-property (point) 'list-name) + (completing-read "Edit list: " + list-names))) + (id (or id (mastodon-views--get-list-id name-old))) + (name-choice (read-string "List name: " name-old)) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--put url + `(("title" . ,name-choice) + ("replies_policy" . ,replies-policy))))) + (mastodon-http--triage response + (lambda () + (with-current-buffer response + (let* ((json (mastodon-http--process-json)) + (name-new (alist-get 'title json))) + (message "list %s edited to %s!" name-old name-new))) + (when (mastodon-tl--buffer-type-eq 'lists) + (mastodon-views--view-lists)))))) + +(defun mastodon-views--view-timeline-list-at-point () + "View timeline of list at point." + (interactive) + (let ((list-id (get-text-property (point) 'list-id))) + (mastodon-views--view-list-timeline list-id))) + +(defun mastodon-views--view-list-timeline (&optional id) + "Prompt for a list and view its timeline. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (list-name (unless id (completing-read "View list: " list-names))) + (id (or id (mastodon-views--get-list-id list-name))) + (endpoint (format "timelines/list/%s" id)) + (name (mastodon-views--get-list-name id)) + (buffer-name (format "list-%s" name))) + (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline))) + +(defun mastodon-views--create-list () + "Create a new list. +Prompt for name and replies policy." + (interactive) + (let* ((title (read-string "New list name: ")) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) ; default + (response (mastodon-http--post (mastodon-http--api "lists") + `(("title" . ,title) + ("replies_policy" . ,replies-policy)) + nil))) + (mastodon-views--list-action-triage response + (message "list %s created!" title)))) + +(defun mastodon-views--delete-list-at-point () + "Delete list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-views--delete-list id))) + +(defun mastodon-views--delete-list (&optional id) + "Prompt for a list and delete it. +If ID is provided, delete that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (name (if id + (mastodon-views--get-list-name id) + (completing-read "Delete list: " + list-names))) + (id (or id (mastodon-views--get-list-id name))) + (url (mastodon-http--api (format "lists/%s" id)))) + (when (y-or-n-p (format "Delete list %s?" name)) + (let ((response (mastodon-http--delete url))) + (mastodon-views--list-action-triage response + (message "list %s deleted!" name)))))) + +(defun mastodon-views--get-users-followings () + "Return the list of followers of the logged in account." + (let* ((id (mastodon-auth--get-account-id)) + (url (mastodon-http--api (format "accounts/%s/following" id)))) + (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts + +(defun mastodon-views--add-account-to-list-at-point () + "Prompt for account and add to list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-views--add-account-to-list id))) + +(defun mastodon-views--add-account-to-list (&optional id account-id handle) + "Prompt for a list and for an account, add account to list. +If ID is provided, use that list. +If ACCOUNT-ID and HANDLE are provided use them rather than prompting." + (interactive) + (let* ((list-prompt (if handle + (format "Add %s to list: " handle) + "Add account to list: ")) + (list-name (if id + (get-text-property (point) 'list-name) + (completing-read list-prompt + (mastodon-views--get-lists-names) nil t))) + (list-id (or id (mastodon-views--get-list-id list-name))) + (followings (mastodon-views--get-users-followings)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id followings)) + (account (or handle (completing-read "Account to add: " + handles nil t))) + (account-id (or account-id (alist-get account handles nil nil 'equal))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--post url + `(("account_ids[]" . ,account-id))))) + (mastodon-views--list-action-triage + response + (message "%s added to list %s!" account list-name)))) + +(defun mastodon-views--add-toot-account-at-point-to-list () + "Prompt for a list, and add the account of the toot at point to it." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (account (mastodon-tl--field 'account toot)) + (account-id (mastodon-tl--field 'id account)) + (handle (mastodon-tl--field 'acct account))) + (mastodon-views--add-account-to-list nil account-id handle))) + +(defun mastodon-views--remove-account-from-list-at-point () + "Prompt for account and remove from list at point." + (interactive) + (let ((id (get-text-property (point) 'list-id))) + (mastodon-views--remove-account-from-list id))) + +(defun mastodon-views--remove-account-from-list (&optional id) + "Prompt for a list, select an account and remove from list. +If ID is provided, use that list." + (interactive) + (let* ((list-name (if id + (get-text-property (point) 'list-name) + (completing-read "Remove account from list: " + (mastodon-views--get-lists-names) nil t))) + (list-id (or id (mastodon-views--get-list-id list-name))) + (accounts (mastodon-views--accounts-in-list list-id)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts)) + (account (completing-read "Account to remove: " + handles nil t)) + (account-id (alist-get account handles nil nil 'equal)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) + (response (mastodon-http--delete url args))) + (mastodon-views--list-action-triage + response + (message "%s removed from list %s!" account list-name)))) + +(defun mastodon-views--list-action-triage (response message) + "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." + (mastodon-http--triage response + (lambda () + (when (mastodon-tl--buffer-type-eq 'lists) + (mastodon-views--view-lists)) + message))) + +(defun mastodon-views--accounts-in-list (list-id) + "Return the JSON of the accounts in list with LIST-ID." + (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) + (mastodon-http--get-json url))) + + +;;; FOLLOW REQUESTS + +(defun mastodon-views--insert-follow-requests (json) + "Insert the user's current follow requests. +JSON is the data returned by the server." + (mastodon-views--minor-view + "follow requests" + "a/r - accept/reject request at point\n n/p - go to next/prev request" + #'mastodon-views--insert-users-propertized-note + json)) + +(defun mastodon-views--view-follow-requests () + "Open a new buffer displaying the user's follow requests." + (interactive) + (mastodon-tl--init-sync "follow-requests" + "follow_requests" + 'mastodon-views--insert-follow-requests) + (mastodon-tl--goto-first-item) + (with-current-buffer "*mastodon-follow-requests*" + (use-local-map mastodon-views--view-follow-requests-keymap))) + + +;;; SCHEDULED TOOTS + +(defun mastodon-views--view-scheduled-toots () + "Show the user's scheduled toots in a new buffer." + (interactive) + (mastodon-tl--init-sync "scheduled-toots" + "scheduled_statuses" + 'mastodon-views--insert-scheduled-toots) + (with-current-buffer "*mastodon-scheduled-toots*" + (use-local-map mastodon-views--scheduled-map))) + +(defun mastodon-views--insert-scheduled-toots (json) + "Insert the user's scheduled toots, from JSON." + (mastodon-views--minor-view + "your scheduled toots" + "n/p - prev/next\n r - reschedule\n e/RET - edit toot\n c - cancel" + #'mastodon-views--insert-scheduled-toots-list + json)) + +(defun mastodon-views--insert-scheduled-toots-list (scheduleds) + "Insert scheduled toots in SCHEDULEDS." + (mapc #'mastodon-views--insert-scheduled-toot scheduleds)) + +(defun mastodon-views--insert-scheduled-toot (toot) + "Insert scheduled TOOT into the buffer." + (let* ((id (alist-get 'id toot)) + (scheduled (alist-get 'scheduled_at toot)) + (params (alist-get 'params toot)) + (text (alist-get 'text params))) + (insert + (propertize (concat text + " | " + (mastodon-toot--iso-to-human scheduled)) + 'byline t ; so we nav here + 'toot-id "0" ; so we nav here + 'face 'font-lock-comment-face + 'keymap mastodon-views--scheduled-map + 'scheduled-json toot + 'id id) + "\n"))) + +(defun mastodon-views--get-scheduled-toots (&optional id) + "Get the user's currently scheduled toots. +If ID, just return that toot." + (let* ((endpoint (if id + (format "scheduled_statuses/%s" id) + "scheduled_statuses")) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url))) + +(defun mastodon-views--reschedule-toot () + "Reschedule the scheduled toot at point." + (interactive) + (let ((id (get-text-property (point) 'id))) + (if (null id) + (message "no scheduled toot at point?") + (mastodon-toot--schedule-toot :reschedule)))) + +(defun mastodon-views--copy-scheduled-toot-text () + "Copy the text of the scheduled toot at point." + (interactive) + (let* ((toot (get-text-property (point) 'toot)) + (params (alist-get 'params toot)) + (text (alist-get 'text params))) + (kill-new text))) + +(defun mastodon-views--cancel-scheduled-toot (&optional id no-confirm) + "Cancel the scheduled toot at point. +ID is that of the scheduled toot to cancel. +NO-CONFIRM means there is no ask or message, there is only do." + (interactive) + (let ((id (or id (get-text-property (point) 'id)))) + (if (null id) + (message "no scheduled toot at point?") + (when (or no-confirm + (y-or-n-p "Cancel scheduled toot?")) + (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda () + (mastodon-views--view-scheduled-toots) + (unless no-confirm + (message "Toot cancelled!"))))))))) + +(defun mastodon-views--edit-scheduled-as-new () + "Edit scheduled status as new toot." + (interactive) + (let ((id (get-text-property (point) 'id))) + (if (null id) + (message "no scheduled toot at point?") + (let* ((toot (get-text-property (point) 'scheduled-json)) + (scheduled (alist-get 'scheduled_at toot)) + (params (alist-get 'params toot)) + (text (alist-get 'text params)) + (visibility (alist-get 'visibility params)) + (cw (alist-get 'spoiler_text params)) + (lang (alist-get 'language params)) + ;; (poll (alist-get 'poll params)) + (reply-id (alist-get 'in_reply_to_id params))) + ;; (media (alist-get 'media_attachments toot))) + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert text) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties reply-id visibility cw + lang scheduled id))))) + + +;;; FILTERS + +(defun mastodon-views--view-filters () + "View the user's filters in a new buffer." + (interactive) + (mastodon-tl--init-sync "filters" + "filters" + 'mastodon-views--insert-filters) + (with-current-buffer "*mastodon-filters*" + (use-local-map mastodon-views--view-filters-keymap))) + +(defun mastodon-views--insert-filters (json) + "Insert the user's current filters. +JSON is what is returned by by the server." + (mastodon-views--minor-view + "current filters" + "c - create filter\n d - delete filter at point\n n/p - go to next/prev filter" + #'mastodon-views--insert-filter-string-set + json)) + +(defun mastodon-views--insert-filter-string-set (json) + "Insert a filter string plus a blank line. +JSON is the filters data." + (mapc (lambda (x) + (mastodon-views--insert-filter-string x) + (insert "\n\n")) + json)) + +(defun mastodon-views--insert-filter-string (filter) + "Insert a single FILTER." + (let* ((phrase (alist-get 'phrase filter)) + (contexts (alist-get 'context filter)) + (id (alist-get 'id filter)) + (filter-string (concat "- \"" phrase "\" filtered in: " + (mapconcat #'identity contexts ", ")))) + (insert + (propertize filter-string + 'toot-id id ;for goto-next-filter compat + 'phrase phrase + ;;'help-echo "n/p to go to next/prev filter, c to create new filter, d to delete filter at point." + ;;'keymap mastodon-views--view-filters-keymap + 'byline t)))) ;for goto-next-filter compat + +(defun mastodon-views--create-filter () + "Create a filter for a word. +Prompt for a context, must be a list containting at least one of \"home\", +\"notifications\", \"public\", \"thread\"." + (interactive) + (let* ((url (mastodon-http--api "filters")) + (word (read-string + (format "Word(s) to filter (%s): " (or (current-word) "")) + nil nil (or (current-word) ""))) + (contexts + (if (string-empty-p word) + (error "You must select at least one word for a filter") + (completing-read-multiple + "Contexts to filter [TAB for options]: " + '("home" "notifications" "public" "thread") + nil ; no predicate + t))) ; require-match, as context is mandatory + (contexts-processed + (if (equal nil contexts) + (error "You must select at least one context for a filter") + (mapcar (lambda (x) + (cons "context[]" x)) + contexts))) + (response (mastodon-http--post url (push + `("phrase" . ,word) + contexts-processed)))) + (mastodon-http--triage response + (lambda () + (message "Filter created for %s!" word) + ;; reload if we are in filters view: + (when (mastodon-tl--buffer-type-eq 'filters) + (mastodon-views--view-filters)))))) + +(defun mastodon-views--delete-filter () + "Delete filter at point." + (interactive) + (let* ((filter-id (get-text-property (point) 'toot-id)) + (phrase (get-text-property (point) 'phrase)) + (url (mastodon-http--api + (format "filters/%s" filter-id)))) + (if (null phrase) + (error "No filter at point?") + (when (y-or-n-p (format "Delete filter %s? " phrase))) + (let ((response (mastodon-http--delete url))) + (mastodon-http--triage response (lambda () + (mastodon-views--view-filters) + (message "Filter for \"%s\" deleted!" phrase))))))) + + +;;; FOLLOW SUGGESTIONS + +(defun mastodon-views--get-follow-suggestions () + "Display a buffer of suggested accounts to follow." + (interactive) + (mastodon-tl--init-sync "follow-suggestions" + "suggestions" + 'mastodon-views--insert-follow-suggestions) + (with-current-buffer "*mastodon-follow-suggestions*" + (use-local-map mastodon-views--follow-suggestions-map))) + +(defun mastodon-views--insert-follow-suggestions (json) + "Insert follow suggestions into buffer. +JSON is the data returned by the server." + (mastodon-views--minor-view + "suggested accounts" + nil + #'mastodon-views--insert-users-propertized-note + json)) + +(defun mastodon-views--insert-users-propertized-note (json) + "Insert users list into the buffer, including profile note. +JSON is the users list data." + (mastodon-search--insert-users-propertized json :note)) + + +;;; INSTANCES + +(defun mastodon-views--view-own-instance (&optional brief) + "View details of your own instance. +BRIEF means show fewer details." + (interactive) + (mastodon-views--view-instance-description :user brief)) + +(defun mastodon-views--view-own-instance-brief () + "View brief details of your own instance." + (interactive) + (mastodon-views--view-instance-description :user :brief)) + +(defun mastodon-views--view-instance-description-brief () + "View brief details of the instance the current post's author is on." + (interactive) + (mastodon-views--view-instance-description nil :brief)) + +(defun mastodon-views--view-instance-description (&optional user brief instance) + "View the details of the instance the current post's author is on. +USER means to show the instance details for the logged in user. +BRIEF means to show fewer details. +INSTANCE is an instance domain name." + (interactive) + (if user + (let ((response (mastodon-http--get-json + (mastodon-http--api "instance") + nil ; params + nil ; silent + :vector))) + (mastodon-views--instance-response-fun response brief instance)) + (mastodon-tl--do-if-toot + (let* ((toot (if (mastodon-tl--profile-buffer-p) + (mastodon-tl--property 'profile-json) ; profile may have 0 toots + (mastodon-tl--property 'toot-json))) + (reblog (alist-get 'reblog toot)) + (account (or (alist-get 'account reblog) + (alist-get 'account toot))) + (url (if (mastodon-tl--profile-buffer-p) + (alist-get 'url toot) ; profile + (alist-get 'url account))) + (username (if (mastodon-tl--profile-buffer-p) + (alist-get 'username toot) ;; profile + (alist-get 'username account))) + (instance (if instance + (concat "https://" instance) + ;; pleroma URL is https://instance.com/users/username + (if (string-suffix-p "users/" (url-basepath url)) + (string-remove-suffix "/users/" + (url-basepath url)) + ;; mastodon: + (string-remove-suffix (concat "/@" username) + url)))) + (response (mastodon-http--get-json + (if user + (mastodon-http--api "instance") + (concat instance "/api/v1/instance")) + nil ; params + nil ; silent + :vector))) + (mastodon-views--instance-response-fun response brief instance))))) + +(defun mastodon-views--instance-response-fun (response brief instance) + "Display instance description RESPONSE in a new buffer. +BRIEF means to show fewer details. +INSTANCE is the instance were are working with." + (when response + (let* ((domain (url-file-nondirectory instance)) + (buf (get-buffer-create + (format "*mastodon-instance-%s*" domain)))) + (with-current-buffer buf + (switch-to-buffer-other-window buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (special-mode) + (when brief + (setq response + (list (assoc 'uri response) + (assoc 'title response) + (assoc 'short_description response) + (assoc 'email response) + (cons 'contact_account + (list + (assoc 'username + (assoc 'contact_account response)))) + (assoc 'rules response) + (assoc 'stats response)))) + (mastodon-views--print-json-keys response) + (mastodon-mode) + (mastodon-tl--set-buffer-spec (buffer-name buf) + "instance" + nil) + (goto-char (point-min))))))) + +(defun mastodon-views--format-key (el pad) + "Format a key of element EL, a cons, with PAD padding." + (format (concat "%-" + (number-to-string pad) + "s: ") + (propertize + (prin1-to-string (car el)) + 'face '(:underline t)))) + +(defun mastodon-views--print-json-keys (response &optional ind) + "Print the JSON keys and values in RESPONSE. +IND is the optional indentation level to print at." + (let* ((cars (mapcar + (lambda (x) (symbol-name (car x))) + response)) + (pad (1+ (cl-reduce #'max (mapcar #'length cars))))) + (while response + (let ((el (pop response))) + (cond + ;; vector of alists (fields, instance rules): + ((and (vectorp (cdr el)) + (not (seq-empty-p (cdr el))) + (consp (seq-elt (cdr el) 0))) + (insert + (mastodon-views--format-key el pad) + "\n\n") + (seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el)) + (insert "\n")) + ;; vector of strings (media types): + ((and (vectorp (cdr el)) + (not (seq-empty-p (cdr el))) + (< 1 (seq-length (cdr el))) + (stringp (seq-elt (cdr el) 0))) + (when ind (indent-to ind)) + (insert + (mastodon-views--format-key el pad) + "\n" + (seq-mapcat + (lambda (x) (concat x ", ")) + (cdr el) 'string) + "\n\n")) + ;; basic nesting: + ((consp (cdr el)) + (when ind (indent-to ind)) + (insert + (mastodon-views--format-key el pad) + "\n\n") + (mastodon-views--print-json-keys + (cdr el) (if ind (+ ind 4) 4))) + (t + ;; basic handling of raw booleans: + (let ((val (cond ((equal (cdr el) ':json-false) + "no") + ((equal (cdr el) 't) + "yes") + (t + (cdr el))))) + (when ind (indent-to ind)) + (insert (mastodon-views--format-key el pad) + " " + (mastodon-views--newline-if-long (cdr el)) + ;; only send strings straight to --render-text + ;; this makes hyperlinks work: + (if (not (stringp val)) + (mastodon-tl--render-text + (prin1-to-string val)) + (mastodon-tl--render-text val)) + "\n")))))))) + +(defun mastodon-views--print-instance-rules-or-fields (alist) + "Print ALIST of instance rules or contact account or emoji fields." + (let ((key (cond ((alist-get 'id alist) + 'id) + ((alist-get 'name alist) + 'name) + ((alist-get 'shortcode alist) + 'shortcode))) + (value (cond ((alist-get 'id alist) + 'text) + ((alist-get 'value alist) + 'value) + ((alist-get 'url alist) + 'url)))) + (indent-to 4) + (insert + (format "%-5s: " + (propertize (alist-get key alist) + 'face '(:underline t))) + (mastodon-views--newline-if-long (alist-get value alist)) + (format "%s" (mastodon-tl--render-text + (alist-get value alist))) + "\n"))) + +(defun mastodon-views--newline-if-long (el) + "Return a newline string if the cdr of EL is over 50 characters long." + (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) + (if (and (sequencep rend) + (< 50 (length rend))) + "\n" + ""))) + +(provide 'mastodon-views) +;;; mastodon-views.el ends here diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a49d0cc..ae8a795 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -45,60 +45,57 @@ (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") (declare-function request "request") -(autoload 'special-mode "simple") + +(autoload 'mastodon-auth--get-account-name "mastodon-auth") +(autoload 'mastodon-auth--user-acct "mastodon-auth") +(autoload 'mastodon-discover "mastodon-discover") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--my-profile "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") +(autoload 'mastodon-profile--view-bookmarks "mastodon-profile") +(autoload 'mastodon-profile--view-favourites "mastodon-profile") +(autoload 'mastodon-search--search-query "mastodon-search") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-tl--block-user "mastodon-tl") +(autoload 'mastodon-tl--follow-user "mastodon-tl") +(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") (autoload 'mastodon-tl--get-federated-timeline "mastodon-tl") (autoload 'mastodon-tl--get-home-timeline "mastodon-tl") (autoload 'mastodon-tl--get-local-timeline "mastodon-tl") (autoload 'mastodon-tl--get-tag-timeline "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") (autoload 'mastodon-tl--goto-prev-toot "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--list-followed-tags "mastodon-tl") +(autoload 'mastodon-tl--mute-user "mastodon-tl") (autoload 'mastodon-tl--next-tab-item "mastodon-tl") +(autoload 'mastodon-tl--poll-vote "mastodon-http") (autoload 'mastodon-tl--previous-tab-item "mastodon-tl") (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") -(autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-profile--get-toot-author "mastodon-profile") -(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-discover "mastodon-discover") -(autoload 'mastodon-tl--block-user "mastodon-tl") (autoload 'mastodon-tl--unblock-user "mastodon-tl") -(autoload 'mastodon-tl--mute-user "mastodon-tl") -(autoload 'mastodon-tl--unmute-user "mastodon-tl") -(autoload 'mastodon-tl--follow-user "mastodon-tl") (autoload 'mastodon-tl--unfollow-user "mastodon-tl") -(autoload 'mastodon-profile--my-profile "mastodon-profile") -(autoload 'mastodon-profile--view-favourites "mastodon-profile") -(autoload 'mastodon-profile--view-follow-requests "mastodon-profile") -(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") -(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") -(autoload 'mastodon-search--search-query "mastodon-search") -(autoload 'mastodon-auth--get-account-name "mastodon-auth") -;; (autoload 'mastodon-async--stream-federated "mastodon-async") -;; (autoload 'mastodon-async--stream-local "mastodon-async") -;; (autoload 'mastodon-async--stream-home "mastodon-async") -;; (autoload 'mastodon-async--stream-notifications "mastodon-async") -;; (autoload 'mastodon-async-mode "mastodon-async") -(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") -(autoload 'mastodon-auth--user-acct "mastodon-auth") -(autoload 'mastodon-tl--poll-vote "mastodon-http") -(autoload 'mastodon-profile--view-bookmarks "mastodon-profile") -(autoload 'mastoton-tl--view-filters "mastodon-tl") -(autoload 'mastodon-tl--view-filters "mastodon-tl") -(autoload 'mastodon-tl--get-follow-suggestions "mastodon-tl") +(autoload 'mastodon-tl--unmute-user "mastodon-tl") +(autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) -(autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") -(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") -(autoload 'mastodon-tl--view-lists "mastodon-tl") -(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (autoload 'mastodon-toot--view-toot-history "mastodon-tl") -(autoload 'mastodon-tl--init-sync "mastodon-tl") -(autoload 'mastodon-notifications--timeline "mastodon-notifications") -(autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-tl--view-instance-description "mastodon-tl") -(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") +(autoload 'mastodon-views--get-follow-suggestions "mastodon-views") +(autoload 'mastodon-views--view-filters "mastodon-views") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") +(autoload 'mastodon-views--view-instance-description "mastodon-views") +(autoload 'mastodon-views--view-lists "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") +(autoload 'special-mode "simple") (defvar mastodon-notifications--map) @@ -194,23 +191,24 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "C") #'mastodon-toot--copy-toot-url) (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) (define-key map (kbd "V") #'mastodon-profile--view-favourites) - (define-key map (kbd "R") #'mastodon-profile--view-follow-requests) + (define-key map (kbd "R") #'mastodon-views--view-follow-requests) (define-key map (kbd "U") #'mastodon-profile--update-user-profile-note) (define-key map (kbd "v") #'mastodon-tl--poll-vote) (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle) (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) - (define-key map (kbd "I") #'mastodon-tl--view-filters) - (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) - (define-key map (kbd "X") #'mastodon-tl--view-lists) + (define-key map (kbd "I") #'mastodon-views--view-filters) + (define-key map (kbd "G") #'mastodon-views--get-follow-suggestions) + (define-key map (kbd "X") #'mastodon-views--view-lists) (define-key map (kbd "@") #'mastodon-notifications--get-mentions) (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point) (define-key map (kbd "E") #'mastodon-toot--view-toot-edits) (define-key map (kbd "l") #'recenter-top-bottom) (when (require 'lingva nil :no-error) (define-key map (kbd "a") #'mastodon-toot--translate-toot-text)) - (define-key map (kbd "s") #'mastodon-tl--view-scheduled-toots) + (define-key map (kbd "s") #'mastodon-views--view-scheduled-toots) (define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers) - (define-key map (kbd ";") #'mastodon-tl--view-instance-description) + (define-key map (kbd ";") #'mastodon-views--view-instance-description) + (define-key map (kbd ":") #'mastodon-tl--list-followed-tags) (define-key map (kbd ",") #'mastodon-toot--list-toot-favouriters) (define-key map (kbd ".") #'mastodon-toot--list-toot-boosters) map) @@ -282,8 +280,9 @@ If REPLY-JSON is the json of the toot being replied to." Optionally only print notifications of type TYPE, a string. BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." (interactive) - (let ((buffer (or (concat "*mastodon-" buffer-name "*") - "*mastodon-notifications*"))) + (let ((buffer (if buffer-name + (concat "*mastodon-" buffer-name "*") + "*mastodon-notifications*"))) (if (get-buffer buffer) (progn (switch-to-buffer buffer) (mastodon-tl--update)) @@ -293,7 +292,8 @@ BUFFER-NAME is added to \"*mastodon-\" to create the buffer name." "notifications" 'mastodon-notifications--timeline type) - (use-local-map mastodon-notifications--map)))) + (with-current-buffer buffer + (use-local-map mastodon-notifications--map))))) ;; URL lookup: should be available even if `mastodon.el' not loaded: @@ -344,7 +344,7 @@ not, just browse the URL in the normal fashion." (save-match-data (or (string-match "^/@[^/]+$" query) (string-match "^/@[^/]+/[[:digit:]]+$" query) - (string-match "^/users/[[:alnum:]]+$" query) + (string-match "^/user[s]?/[[:alnum:]]+$" query) (string-match "^/notice/[[:alnum:]]+$" query) (string-match "^/objects/[-a-f0-9]+$" query) (string-match "^/notes/[a-z0-9]+$" query) @@ -372,9 +372,7 @@ Calls `mastodon-tl--get-buffer-type', which see." "Switch to a live mastodon buffer." (interactive) (let* ((bufs (mastodon-live-buffers)) - (buf-names (mapcar (lambda (buf) - (buffer-name buf)) - bufs)) + (buf-names (mapcar #'buffer-name bufs)) (choice (completing-read "Switch to mastodon buffer: " buf-names))) (switch-to-buffer choice))) |