aboutsummaryrefslogtreecommitdiff
path: root/lisp/mastodon-views.el
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus [a t] riseup [d o t] net>2023-03-18 18:22:48 +0100
committermarty hiatt <martianhiatus [a t] riseup [d o t] net>2023-03-18 18:22:48 +0100
commit7fd37350a8a565a71b326462ff5026f729310b67 (patch)
tree608df5c686447e846265ab91317d41892bc7cf00 /lisp/mastodon-views.el
parent9c449bd25d196a9545cbe22ba664a35a6df98224 (diff)
parentdc1149ae594f44944d6807001dd2765ff1766d71 (diff)
Merge branch 'views' into develop
Diffstat (limited to 'lisp/mastodon-views.el')
-rw-r--r--lisp/mastodon-views.el916
1 files changed, 916 insertions, 0 deletions
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el
new file mode 100644
index 0000000..e38455b
--- /dev/null
+++ b/lisp/mastodon-views.el
@@ -0,0 +1,916 @@
+;;; 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
+ (mapcar (lambda (x)
+ (alist-get 'title x))
+ 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)))
+ (mapcar (lambda (x)
+ (alist-get 'title x))
+ 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 (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-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 (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-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