From 945bedc26c358dc20d34a4546ac6fc9f0641e2ee Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 13:57:01 +0100 Subject: check for compose buffer in schedule toot check for toot compose or scheduled view before scheduling a toot --- lisp/mastodon-toot.el | 64 +++++++++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 30 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b9e97b6..08b3467 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1232,36 +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) - (if (mastodon-tl--buffer-type-eq 'edit-toot) - (message "You can't schedule toots you're editing.") - (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-tl--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." -- cgit v1.2.3 From 70ad53998f0042c194fb28d09afc0398ac5aaad6 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 14:13:53 +0100 Subject: profile.el: autoload and docstring --- lisp/mastodon-profile.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 668a82f..29ed077 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -82,6 +82,7 @@ (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-tl--interactive-user-handles-get "mastodon-tl") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) @@ -764,7 +765,7 @@ If toot is a boost, opens the profile of the booster." (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." +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)))) @@ -958,7 +959,8 @@ Send an empty note to clear an existing one." "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." + "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))) -- cgit v1.2.3 From a7af764df9175b72f067db7dfeeb820e48ec9232 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 14:14:05 +0100 Subject: tl.el package description --- lisp/mastodon-tl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 38b7a6b..325af2d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1,4 +1,4 @@ -;;; mastodon-tl.el --- timeline 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 -- cgit v1.2.3 From e6d2c3ab8cc616799ccff979fa66e3d83c43f9f8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 14:12:59 +0100 Subject: factor out mastodon-views.el for minor views These are currently lists, follow suggestions, filters, scheduled toots, follow requests, and instance descriptions. fix remanant tl fun names in views stray views fun rename in notifs.el stray views funs in notifs stray views funs in toot.el views file commentary --- lisp/mastodon-notifications.el | 4 +- lisp/mastodon-profile.el | 51 +-- lisp/mastodon-tl.el | 749 ---------------------------------- lisp/mastodon-toot.el | 8 +- lisp/mastodon-views.el | 894 +++++++++++++++++++++++++++++++++++++++++ lisp/mastodon.el | 25 +- 6 files changed, 915 insertions(+), 816 deletions(-) create mode 100644 lisp/mastodon-views.el diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 279361b..27793eb 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -50,7 +50,7 @@ (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-views--view-follow-requests "mastodon-views") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") (autoload 'mastodon-notifications-get "mastodon") @@ -126,7 +126,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 29ed077..fffb331 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -73,7 +73,7 @@ (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-views--add-account-to-list "mastodon-views") (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") @@ -107,23 +107,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 @@ -233,36 +216,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) - (mastodon-tl--goto-first-item) - (with-current-buffer "*mastodon-follow-requests*" - (use-local-map mastodon-profile--view-follow-requests-keymap))) - -(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) @@ -270,7 +223,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 diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 325af2d..1dbe199 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -29,7 +29,6 @@ ;;; Commentary: ;; mastodon-tl.el provides timeline functions. -;; Also provides list, filters, follow suggestions, etc. view functions. ;;; Code: @@ -242,60 +241,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 "") '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 "") '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))) @@ -1770,700 +1715,6 @@ 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) - (with-current-buffer "*mastodon-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 #'mastodon-tl--insert-scheduled-toot 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) - (with-current-buffer "*mastodon-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) - (with-current-buffer "*mastodon-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))) - - -;;; 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* ((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 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 instance))))) - -(defun mastodon-tl--instance-response-fun (response brief instance) - "Display instance description RESPONSE in a new buffer. -BRIEF means to show fewer details." - (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-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 diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 08b3467..3dc6522 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -78,8 +78,8 @@ (autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl") -(autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") +(autoload 'mastodon-views--cancel-scheduled-toot "mastodon-views") (autoload 'org-read-date "org") (autoload 'iso8601-parse "iso8601") (autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") @@ -805,7 +805,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)))))))) @@ -1263,7 +1263,7 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (mastodon-http--triage response (lambda () ;; reschedule means we are in scheduled toots view: - (mastodon-tl--view-scheduled-toots) + (mastodon-views--view-scheduled-toots) (message (format "Toot rescheduled for %s." msg-str)))))))))) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el new file mode 100644 index 0000000..1e3dd4a --- /dev/null +++ b/lisp/mastodon-views.el @@ -0,0 +1,894 @@ +;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 Marty Hiatt +;; Author: Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; 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 + +(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 "") '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))) + (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 "") '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)) + +(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) + (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))) + (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-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* ((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 + + + +;;; 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 (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-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 e70beb5..406df59 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -69,7 +69,6 @@ (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") @@ -83,22 +82,24 @@ (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") (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-tl--list-followed-tags "mastodon-tl") +(autoload 'mastodon-views--view-lists "mastodon-views") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") +(autoload 'mastodon-views--view-filters "mastodon-views") +(autoload 'mastodon-views--get-follow-suggestions "mastodon-views") +(autoload 'mastodon-views--view-instance-description "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") (defvar mastodon-notifications--map) @@ -194,23 +195,23 @@ 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) -- cgit v1.2.3 From 7bd869fdb58b95ae5a3d009f7030f8854191581d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 15:16:34 +0100 Subject: fix check for filter on delete-filter --- lisp/mastodon-views.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 1e3dd4a..2a6238b 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -660,7 +660,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (phrase (get-text-property (point) 'phrase)) (url (mastodon-http--api (format "filters/%s" filter-id)))) - (if (equal nil filter-id) + (if (null phrase) (error "No filter at point?") (when (y-or-n-p (format "Delete this filter? "))) (let ((response (mastodon-http--delete url))) -- cgit v1.2.3 From 34f9c78566a8fdb21987843a335c789a1dcfb8c4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 15:24:26 +0100 Subject: add next prev item funs to lists/scheduled maps --- lisp/mastodon-views.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 2a6238b..10a6a8a 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -105,6 +105,8 @@ (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 "") '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) @@ -115,6 +117,8 @@ (defvar mastodon-views--scheduled-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) -- cgit v1.2.3 From 393f700bc45ae713af48b40fedc422da4d986f57 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 15:24:47 +0100 Subject: use scheduled map on viewing scheduleds --- lisp/mastodon-views.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 10a6a8a..ed68528 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -485,7 +485,9 @@ JSON is the data returned by the server." (interactive) (mastodon-tl--init-sync "scheduled-toots" "scheduled_statuses" - 'mastodon-views--insert-scheduled-toots)) + '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." -- cgit v1.2.3 From 4a06f0c5c0cc8b70e51d6a816d55dc53fe7edcf8 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 15:25:44 +0100 Subject: check for scheduled toot at point before action fix reschedule check fix cancel scheduled toot rejig --- lisp/mastodon-views.el | 67 ++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index ed68528..45317cf 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -531,7 +531,10 @@ If ID, just return that toot." (defun mastodon-views--reschedule-toot () "Reschedule the scheduled toot at point." (interactive) - (mastodon-toot--schedule-toot :reschedule)) + (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." @@ -546,41 +549,41 @@ If ID, just return that toot." 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-views--view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!")))))))) + (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* ((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 - + (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 -- cgit v1.2.3 From 9b2bacb956e64cc68f3778da27362f353eed9421 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 15:48:11 +0100 Subject: views: comment on keymap inheritace - all maps inherit --- lisp/mastodon-views.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 45317cf..544c362 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -68,6 +68,17 @@ ;;; 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))) @@ -116,7 +127,9 @@ "Keymap for when point is on list name.") (defvar mastodon-views--scheduled-map - (let ((map (make-sparse-keymap))) + (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) -- cgit v1.2.3 From dc1149ae594f44944d6807001dd2765ff1766d71 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 18:08:28 +0100 Subject: show filter name in y-or-n prompt --- lisp/mastodon-views.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 544c362..e38455b 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -684,7 +684,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (format "filters/%s" filter-id)))) (if (null phrase) (error "No filter at point?") - (when (y-or-n-p (format "Delete this filter? "))) + (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) -- cgit v1.2.3