From 5ae092746f711942c10e9f811bb15f16551bbfba Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 14 Mar 2023 22:04:39 +0100 Subject: lsp corrections: lambdas, if to when, etc. --- lisp/mastodon-toot.el | 49 ++++++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 25 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b8930b0..bac152d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -520,12 +520,12 @@ Uses `lingva.el'." (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) (message "You can only pin your own toots.") - (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) - (mastodon-toot--action action - (lambda () - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot %s!" msg))))))) + (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (mastodon-toot--action action + (lambda () + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot %s!" msg))))))) (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." @@ -546,22 +546,22 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot))) (if (not (mastodon-toot--own-toot-p toot)) (message "You can only delete (and redraft) your own toots.") - (if (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda () - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - reply-id - toot-visibility - toot-cw))))))))) + (when (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda () + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + reply-id + toot-visibility + toot-cw))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -903,9 +903,8 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. Remove empty string (self) from result and joins the sequence with whitespace." (mapconcat (lambda (mention) mention) - (remove "" (mapcar (lambda (x) (mastodon-toot--process-local x)) - mentions)) - " ")) + (remove "" (mapcar #'mastodon-toot--process-local mentions)) + " ")) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". -- cgit v1.2.3 From c088137b1cbe5c4d0b9d5f732a2bd5b894531fe3 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 16 Mar 2023 20:03:28 +0100 Subject: remove unused -toot--set-visibility --- lisp/mastodon-toot.el | 10 ---------- 1 file changed, 10 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index bac152d..7c67c49 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -727,16 +727,6 @@ to `emojify-user-emojis', and the emoji data is updated." (point-min)))) (buffer-substring (cdr header-region) (point-max)))) -(defun mastodon-toot--set-visibility (visibility) - "Set the visiblity of the next toot to VISIBILITY." - (interactive - (list (completing-read "Visiblity: " '("public" - "unlisted" - "private" - "direct")))) - (setq mastodon-toot--visibility visibility) - (message "Visibility set to %s" visibility)) - (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append -- cgit v1.2.3 From a34056094d1ced2c492a58c4c27fe658133d1bfe Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 16 Mar 2023 20:03:48 +0100 Subject: disallow -toot--set-visibility / --schedule-toot in edit-toot --- lisp/mastodon-toot.el | 80 +++++++++++++++++++++++++++------------------------ 1 file changed, 42 insertions(+), 38 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7c67c49..b9e97b6 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1059,16 +1059,18 @@ text of the toot being replied to in the compose buffer." (defun mastodon-toot--change-visibility () "Change the current visibility to the next valid value." (interactive) - (setq mastodon-toot--visibility - (cond ((string= mastodon-toot--visibility "public") - "unlisted") - ((string= mastodon-toot--visibility "unlisted") - "private") - ((string= mastodon-toot--visibility "private") - "direct") - (t - "public"))) - (mastodon-toot--update-status-fields)) + (if (mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't change visibility when editing toots.") + (setq mastodon-toot--visibility + (cond ((string= mastodon-toot--visibility "public") + "unlisted") + ((string= mastodon-toot--visibility "unlisted") + "private") + ((string= mastodon-toot--visibility "private") + "direct") + (t + "public"))) + (mastodon-toot--update-status-fields))) (defun mastodon-toot--clear-all-attachments () "Remove all attachments from a toot draft." @@ -1230,34 +1232,36 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;; original idea by christian tietze, thanks! ;; https://codeberg.org/martianh/mastodon.el/issues/285 (interactive) - (let* ((id (when reschedule (get-text-property (point) 'id))) - (ts (when reschedule - (alist-get 'scheduled_at - (get-text-property (point) 'scheduled-json)))) - (time-value - (org-read-date t t nil "Schedule toot:" - ;; default to scheduled timestamp if already set: - (mastodon-toot--iso-to-org - ;; we are rescheduling without editing: - (or ts - ;; we are maybe editing the scheduled toot: - mastodon-toot--scheduled-for)))) - (iso8601-str (format-time-string "%FT%T%z" time-value)) - (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) - (if (not reschedule) - (progn - (setq-local mastodon-toot--scheduled-for iso8601-str) - (message (format "Toot scheduled for %s." msg-str))) - (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str)))) - (url (when reschedule (mastodon-http--api - (format "scheduled_statuses/%s" id)))) - (response (mastodon-http--put url args))) - (mastodon-http--triage response - (lambda () - ;; reschedule means we are in scheduled toots view: - (mastodon-tl--view-scheduled-toots) - (message - (format "Toot rescheduled for %s." msg-str)))))))) + (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))))))))) (defun mastodon-toot--iso-to-human (ts) "Format an ISO8601 timestamp TS to be more human-readable." -- cgit v1.2.3 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(-) (limited to 'lisp/mastodon-toot.el') 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 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 (limited to 'lisp/mastodon-toot.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 4a1670f278b755691bc37c64eeee35b9b02a3085 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 18:36:25 +0100 Subject: sort all autoloads sort autoloads in profile.el --- lisp/mastodon-auth.el | 11 ++++--- lisp/mastodon-client.el | 2 +- lisp/mastodon-http.el | 1 - lisp/mastodon-notifications.el | 41 +++++++++++++------------ lisp/mastodon-profile.el | 51 +++++++++++++++--------------- lisp/mastodon-search.el | 12 ++++---- lisp/mastodon-tl.el | 56 ++++++++++++++++----------------- lisp/mastodon-toot.el | 26 ++++++++-------- lisp/mastodon.el | 70 ++++++++++++++++++++---------------------- 9 files changed, 133 insertions(+), 137 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 788fa77..ec56a05 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -37,14 +37,15 @@ (eval-when-compile (require 'subr-x)) ; for if-let (autoload 'mastodon-client "mastodon-client") +(autoload 'mastodon-client--active-user "mastodon-client") +(autoload 'mastodon-client--form-user-from-vars "mastodon-client") +(autoload 'mastodon-client--make-user-active "mastodon-client") +(autoload 'mastodon-client--store-access-token "mastodon-client") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--append-query-string "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--append-query-string "mastodon-http") -(autoload 'mastodon-client--store-access-token "mastodon-client") -(autoload 'mastodon-client--active-user "mastodon-client") -(autoload 'mastodon-client--make-user-active "mastodon-client") -(autoload 'mastodon-client--form-user-from-vars "mastodon-client") + (defvar mastodon-instance-url) (defvar mastodon-client-scopes) (defvar mastodon-client-redirect-uri) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index f1dcd4f..5981a26 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -37,10 +37,10 @@ (defvar mastodon-instance-url) (defvar mastodon-active-user) + (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") - (defcustom mastodon-client--token-file (concat user-emacs-directory "mastodon.plstore") "File path where Mastodon access tokens are stored." :group 'mastodon diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 88bc9c6..d1f654e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -43,7 +43,6 @@ (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-toot--update-status-fields "mastodon-toot") - (defvar mastodon-http--api-version "v1") (defconst mastodon-http--timeout 15 diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 27793eb..bb9637c 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -32,28 +32,29 @@ ;;; Code: -(autoload 'mastodon-http--api "mastodon-http.el") -(autoload 'mastodon-http--post "mastodon-http.el") -(autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-media--inline-images "mastodon-media.el") -(autoload 'mastodon-tl--byline "mastodon-tl.el") -(autoload 'mastodon-tl--byline-author "mastodon-tl.el") -(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl.el") -(autoload 'mastodon-tl--content "mastodon-tl.el") -(autoload 'mastodon-tl--field "mastodon-tl.el") -(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") -(autoload 'mastodon-tl--has-spoiler "mastodon-tl.el") -(autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--init-sync "mastodon-tl.el") -(autoload 'mastodon-tl--insert-status "mastodon-tl.el") -(autoload 'mastodon-tl--property "mastodon-tl.el") -(autoload 'mastodon-tl--spoiler "mastodon-tl.el") -(autoload 'mastodon-tl--toot-id "mastodon-tl.el") -(autoload 'mastodon-http--get-params-async-json "mastodon-http.el") -(autoload 'mastodon-views--view-follow-requests "mastodon-views") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-params-async-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--byline "mastodon-tl") +(autoload 'mastodon-tl--byline-author "mastodon-tl") +(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--content "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl--has-spoiler "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--insert-status "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--spoiler "mastodon-tl") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") + (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index fffb331..e6f5853 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -41,48 +41,49 @@ (require 'ts) (require 'parse-time) +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-http--get-json-async "mastodon-http.el") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-http--patch-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http.el") (autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") -(autoload 'mastodon-http--get-json-async "mastodon-http.el") (autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el") (autoload 'mastodon-media--inline-images "mastodon-media.el") (autoload 'mastodon-mode "mastodon.el") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-tl--as-string "mastodon-tl.el") +(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") (autoload 'mastodon-tl--byline-author "mastodon-tl.el") +(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") +(autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--goto-next-item "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl.el") +(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--interactive-user-handles-get "mastodon-tl") +(autoload 'mastodon-tl--map-get-accts "mastodon-views") +(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") (autoload 'mastodon-tl--property "mastodon-tl.el") -(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") (autoload 'mastodon-tl--render-text "mastodon-tl.el") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--set-face "mastodon-tl.el") +(autoload 'mastodon-tl--symbol "mastodon-tl") (autoload 'mastodon-tl--timeline "mastodon-tl.el") -(autoload 'mastodon-tl--as-string "mastodon-tl.el") -(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--toot "mastodon-tl") -(autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--init-sync "mastodon-tl") -(autoload 'mastodon-http--patch "mastodon-http") -(autoload 'mastodon-http--patch-json "mastodon-http") -(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") -(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") -(autoload 'mastodon-tl--goto-next-item "mastodon-tl") -(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") -(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-toot "mastodon") -(autoload 'mastodon-search--insert-users-propertized "mastodon-search") -(autoload 'mastodon-tl--get-endpoint "mastodon-tl.el") +(autoload 'mastodon-toot--count-toot-chars "mastodon-toot") (autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") (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") -(autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") -(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") -(autoload 'mastodon-toot--count-toot-chars "mastodon-toot") -(autoload 'mastodon-tl--interactive-user-handles-get "mastodon-tl") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 0f2a6d4..3f76162 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -31,16 +31,16 @@ ;;; Code: (require 'json) +(autoload 'mastodon-auth--access-token "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-http--get-search-json "mastodon-http") (autoload 'mastodon-mode "mastodon") -(autoload 'mastodon-tl--set-face "mastodon-tl") -(autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--as-string "mastodon-tl") -(autoload 'mastodon-auth--access-token "mastodon-auth") -(autoload 'mastodon-http--get-search-json "mastodon-http") -(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--set-face "mastodon-tl") (defvar mastodon-toot--completion-style-for-mentions) (defvar mastodon-instance-url) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 1dbe199..61c612a 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -40,50 +40,48 @@ (require 'mastodon-iso) (require 'mpv nil :no-error) +(autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-auth--get-account-name "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") +(autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-http--get-response-async "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") (autoload 'mastodon-media--get-avatar-rendering "mastodon-media") (autoload 'mastodon-media--get-media-link-rendering "mastodon-media") (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-notifications-get "mastodon-notifications" + "Display NOTIFICATIONS in buffer." t) ; interactive +(autoload 'mastodon-profile--account-field "mastodon-profile") (autoload 'mastodon-profile--account-from-id "mastodon-profile") +(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--my-profile "mastodon-profile") (autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") -;; mousebot adds (autoload 'mastodon-profile--toot-json "mastodon-profile") -(autoload 'mastodon-profile--account-field "mastodon-profile") -(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") -(autoload 'mastodon-profile--my-profile "mastodon-profile") -(autoload 'mastodon-toot--delete-toot "mastodon-toot") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-http--get-json-async "mastodon-http") -(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") +(autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") -;; make notifications--get available via M-x and outside our keymap: -(autoload 'mastodon-notifications-get "mastodon-notifications" - "Display NOTIFICATIONS in buffer." t) ; interactive -(autoload 'mastodon-search--propertize-user "mastodon-search") -(autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-search--get-user-info "mastodon-search") -(autoload 'mastodon-http--delete "mastodon-http") -(autoload 'mastodon-profile--view-author-profile "mastodon-profile") -(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") -(autoload 'mastodon-http--get-response-async "mastodon-http") -(autoload 'mastodon-url-lookup "mastodon") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-http--put "mastodon-http") -(autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--build-params-string "mastodon-http") -(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") -(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") -(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-toot--compose-buffer "mastodon-toot") -(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") -(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--delete-toot "mastodon-toot") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (autoload 'mastodon-toot--iso-to-human "mastodon-toot") +(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-url-lookup "mastodon") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3dc6522..8d63fce 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -48,19 +48,28 @@ (defvar mastodon-tl--enable-proportional-fonts) (defvar mastodon-profile-account-settings) +(autoload 'iso8601-parse "iso8601") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--get-json-async "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--get-source-pref "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-preference "mastodon-profile") (autoload 'mastodon-search--search-accounts-query "mastodon-search") (autoload 'mastodon-search--search-tags-query "mastodon-search") (autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") @@ -68,23 +77,14 @@ (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") -(autoload 'mastodon-toot "mastodon") -(autoload 'mastodon-profile--get-source-pref "mastodon-profile") -(autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") +(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-toot "mastodon") (autoload 'mastodon-views--cancel-scheduled-toot "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") (autoload 'org-read-date "org") -(autoload 'iso8601-parse "iso8601") -(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 406df59..8c3cbd2 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -45,61 +45,57 @@ (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") (declare-function request "request") -(autoload 'special-mode "simple") + +(autoload 'mastodon-auth--get-account-name "mastodon-auth") +(autoload 'mastodon-auth--user-acct "mastodon-auth") +(autoload 'mastodon-discover "mastodon-discover") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--my-profile "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") +(autoload 'mastodon-profile--view-bookmarks "mastodon-profile") +(autoload 'mastodon-profile--view-favourites "mastodon-profile") +(autoload 'mastodon-search--search-query "mastodon-search") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-tl--block-user "mastodon-tl") +(autoload 'mastodon-tl--follow-user "mastodon-tl") +(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") (autoload 'mastodon-tl--get-federated-timeline "mastodon-tl") (autoload 'mastodon-tl--get-home-timeline "mastodon-tl") (autoload 'mastodon-tl--get-local-timeline "mastodon-tl") (autoload 'mastodon-tl--get-tag-timeline "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") (autoload 'mastodon-tl--goto-prev-toot "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--list-followed-tags "mastodon-tl") +(autoload 'mastodon-tl--mute-user "mastodon-tl") (autoload 'mastodon-tl--next-tab-item "mastodon-tl") +(autoload 'mastodon-tl--poll-vote "mastodon-http") (autoload 'mastodon-tl--previous-tab-item "mastodon-tl") (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") -(autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-profile--get-toot-author "mastodon-profile") -(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-discover "mastodon-discover") -(autoload 'mastodon-tl--block-user "mastodon-tl") (autoload 'mastodon-tl--unblock-user "mastodon-tl") -(autoload 'mastodon-tl--mute-user "mastodon-tl") -(autoload 'mastodon-tl--unmute-user "mastodon-tl") -(autoload 'mastodon-tl--follow-user "mastodon-tl") (autoload 'mastodon-tl--unfollow-user "mastodon-tl") -(autoload 'mastodon-profile--my-profile "mastodon-profile") -(autoload 'mastodon-profile--view-favourites "mastodon-profile") -(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") -(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") -(autoload 'mastodon-search--search-query "mastodon-search") -(autoload 'mastodon-auth--get-account-name "mastodon-auth") -;; (autoload 'mastodon-async--stream-federated "mastodon-async") -;; (autoload 'mastodon-async--stream-local "mastodon-async") -;; (autoload 'mastodon-async--stream-home "mastodon-async") -;; (autoload 'mastodon-async--stream-notifications "mastodon-async") -;; (autoload 'mastodon-async-mode "mastodon-async") -(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") -(autoload 'mastodon-auth--user-acct "mastodon-auth") -(autoload 'mastodon-tl--poll-vote "mastodon-http") -(autoload 'mastodon-profile--view-bookmarks "mastodon-profile") +(autoload 'mastodon-tl--unmute-user "mastodon-tl") +(autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) -(autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") -(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") -(autoload 'mastodon-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--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-filters "mastodon-views") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") (autoload 'mastodon-views--view-instance-description "mastodon-views") +(autoload 'mastodon-views--view-lists "mastodon-views") (autoload 'mastodon-views--view-scheduled-toots "mastodon-views") +(autoload 'special-mode "simple") (defvar mastodon-notifications--map) -- cgit v1.2.3 From 58bab7b01496f2d26dd3d766ff060152daef25e7 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 20:21:43 +0100 Subject: edit tag/handle regex to handle preceding opening bracket. FIX #406. --- lisp/mastodon-toot.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8d63fce..87b4afb 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -223,16 +223,16 @@ send.") (defvar mastodon-toot-handle-regex (concat - ;; preceding space or bol [boundary doesn't work with @] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with @] + "\\([(\n\t ]\\|^\\)" "\\(?2:@[1-9a-zA-Z._-]+" ; a handle "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) (defvar mastodon-toot-tag-regex (concat - ;; preceding space or bol [boundary doesn't work with #] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with #] + "\\([(\n\t ]\\|^\\)" "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary -- cgit v1.2.3 From 135443c63d26d0b77be5370e693aff8643d5078b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 21:32:26 +0100 Subject: factor out -tl--map-get-accts --- lisp/mastodon-tl.el | 11 ++++++++--- lisp/mastodon-toot.el | 6 +++--- 2 files changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 61c612a..6e80db3 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1504,6 +1504,13 @@ timeline." ;;; UTILITIES +;; consider having this return an id / acct alist +(defun mastodon-tl--map-get-accts (alist) + "Return a list of handles from ALIST." + (mapcar (lambda (x) + (alist-get 'acct x)) + alist)) + (defun mastodon-tl--symbol (name) "Return the unicode symbol (as a string) corresponding to NAME. If symbol is not displayable, an ASCII equivalent is returned. If @@ -1872,9 +1879,7 @@ Action must be either \"unblock\" or \"unmute\"." "mutes"))) (url (mastodon-http--api endpoint)) (json (mastodon-http--get-json url)) - (accts (mapcar (lambda (user) - (alist-get 'acct user)) - json))) + (accts (mastodon-tl--map-get-accts json))) (when accts (completing-read (format "Handle of user to %s: " action) accts diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 87b4afb..1d91f84 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -75,6 +75,7 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--map-get-accts "mastodon-views") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--render-text "mastodon-tl") @@ -450,7 +451,7 @@ With FAVOURITE, list favouriters, else list boosters." (if (eq (caar json) 'error) (error "%s (Status does not exist or is private)" (alist-get 'error json)) - (let ((handles (mapcar (lambda (x) (alist-get 'acct x)) json)) + (let ((handles (mastodon-tl--map-get-accts json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (error "Looks like this toot has no %s" type-string) @@ -920,8 +921,7 @@ Federated user: `username@host.co`." (alist-get 'mentions (alist-get 'reblog status)) (alist-get 'mentions status)))) ;; reverse does not work on vectors in 24.5 - (mapcar (lambda(x) (alist-get 'acct x)) - (reverse mentions)))) + (mastodon-tl--map-get-accts (reverse mentions)))) (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point using REGEX." -- cgit v1.2.3 From d6470dd725c0da74345e1ed8bf40822730e0c004 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 18 Mar 2023 21:57:42 +0100 Subject: map-get-accts > map-alist, handle no results for fam folls use tl--map-alist in views.el --- lisp/mastodon-profile.el | 16 ++++++++-------- lisp/mastodon-tl.el | 29 ++++++++++------------------- lisp/mastodon-toot.el | 6 +++--- lisp/mastodon-views.el | 8 ++------ 4 files changed, 23 insertions(+), 36 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 3661615..684b11f 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -70,7 +70,7 @@ (autoload 'mastodon-tl--init "mastodon-tl.el") (autoload 'mastodon-tl--init-sync "mastodon-tl") (autoload 'mastodon-tl--interactive-user-handles-get "mastodon-tl") -(autoload 'mastodon-tl--map-get-accts "mastodon-views") +(autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--profile-buffer-p "mastodon tl") (autoload 'mastodon-tl--property "mastodon-tl.el") (autoload 'mastodon-tl--render-text "mastodon-tl.el") @@ -827,9 +827,7 @@ These include the author, author of reblogged entries and any user mentioned." 'list (list (alist-get 'acct this-account)) (mastodon-profile--extract-users-handles reblog) - (mapcar (lambda (mention) - (alist-get 'acct mention)) - mentions))))))) + (mastodon-tl--map-alist 'acct mentions))))))) (defun mastodon-profile--lookup-account-in-status (handle status) "Return account for HANDLE using hints in STATUS if possible." @@ -989,10 +987,12 @@ the given account." (url (mastodon-http--api "accounts/familiar_followers")) (json (mastodon-http--get-json url params)) (accounts (alist-get 'accounts (car json))) ; first id result - (handles (mastodon-tl--map-get-accts accounts)) - (choice (completing-read "Show profile of user: " - handles))) - (mastodon-profile--show-user choice))) + (handles (mastodon-tl--map-alist 'acct accounts))) + (if (null handles) + (message "Looks like there are no familiar followers for this account") + (let ((choice (completing-read "Show profile of user: " + handles))) + (mastodon-profile--show-user choice))))) (provide 'mastodon-profile) ;;; mastodon-profile.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 6e80db3..95af2f1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -489,9 +489,7 @@ image media from the byline." (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." (let* ((attachments (mastodon-tl--field 'media_attachments toot))) - (mapcar (lambda (x) - (alist-get 'type x)) - attachments))) + (mastodon-tl--map-alist 'type attachments))) (defun mastodon-tl--get-attachments-for-byline (toot) "Return a list of attachment URLs and types for TOOT. @@ -1124,9 +1122,7 @@ this just means displaying toot client." (voters-count (mastodon-tl--field 'voters_count poll)) (vote-count (mastodon-tl--field 'votes_count poll)) (options (mastodon-tl--field 'options poll)) - (option-titles (mapcar (lambda (x) - (alist-get 'title x)) - options)) + (option-titles (mastodon-tl--map-alist 'title options)) (longest-option (car (sort option-titles (lambda (x y) (> (length x) @@ -1194,9 +1190,7 @@ this just means displaying toot client." (poll (or (alist-get 'poll reblog) (mastodon-tl--field 'poll toot))) (options (mastodon-tl--field 'options poll)) - (options-titles (mapcar (lambda (x) - (alist-get 'title x)) - options)) + (options-titles (mastodon-tl--map-alist 'title options)) (options-number-seq (number-sequence 1 (length options))) (options-numbers (mapcar #'number-to-string options-number-seq)) (options-alist (cl-mapcar 'cons options-numbers options-titles)) @@ -1504,11 +1498,11 @@ timeline." ;;; UTILITIES -;; consider having this return an id / acct alist -(defun mastodon-tl--map-get-accts (alist) - "Return a list of handles from ALIST." +(defun mastodon-tl--map-alist (key alist) + "Return a list of values extracted from ALIST with KEY. +Key is a symbol, as with `alist-get'." (mapcar (lambda (x) - (alist-get 'acct x)) + (alist-get key x)) alist)) (defun mastodon-tl--symbol (name) @@ -1973,9 +1967,8 @@ If TAG provided, follow it." If TAG is provided, unfollow it." (interactive) (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) - (tags (unless tag (mapcar (lambda (x) - (alist-get 'name x)) - followed-tags-json))) + (tags (unless tag + (mastodon-tl--map-alist 'name followed-tags-json))) (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) @@ -1988,9 +1981,7 @@ If TAG is provided, unfollow it." "List followed tags. View timeline of tag user choses." (interactive) (let* ((followed-tags-json (mastodon-tl--followed-tags)) - (tags (mapcar (lambda (x) - (alist-get 'name x)) - followed-tags-json)) + (tags (mastodon-tl--map-alist 'name followed-tags-json)) (tag (completing-read "Tag: " tags))) (mastodon-tl--get-tag-timeline tag))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1d91f84..df9a22c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -75,7 +75,7 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") -(autoload 'mastodon-tl--map-get-accts "mastodon-views") +(autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (autoload 'mastodon-tl--render-text "mastodon-tl") @@ -451,7 +451,7 @@ With FAVOURITE, list favouriters, else list boosters." (if (eq (caar json) 'error) (error "%s (Status does not exist or is private)" (alist-get 'error json)) - (let ((handles (mastodon-tl--map-get-accts json)) + (let ((handles (mastodon-tl--map-alist 'acct json)) (type-string (if favourite "Favouriters" "Boosters"))) (if (not handles) (error "Looks like this toot has no %s" type-string) @@ -921,7 +921,7 @@ Federated user: `username@host.co`." (alist-get 'mentions (alist-get 'reblog status)) (alist-get 'mentions status)))) ;; reverse does not work on vectors in 24.5 - (mastodon-tl--map-get-accts (reverse mentions)))) + (mastodon-tl--map-alist 'acct (reverse mentions)))) (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point using REGEX." diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index e38455b..f92a9aa 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -219,9 +219,7 @@ provides the JSON data." (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))) + (mastodon-tl--map-alist 'title lists))) (mapc (lambda (x) (mastodon-views--print-list-accounts x) (insert (propertize " ------------\n\n" @@ -266,9 +264,7 @@ a: add account to this list, r: remove account from this list" (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))) + (mastodon-tl--map-alist 'title lists))) (defun mastodon-views--get-list-by-name (name) "Return the list data for list with NAME." -- cgit v1.2.3 From 6b96ee401ff5eb2d3e459660d6f58abc59915068 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 20 Mar 2023 21:59:37 +0100 Subject: rename bookmark toggle --- lisp/mastodon-discover.el | 2 +- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 57c1aa0..b549ce1 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -53,7 +53,7 @@ ("b" "Boost" mastodon-toot--boost) ("f" "Favourite" mastodon-toot--favourite) ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot) - ("k" "Bookmark toot" mastodon-toot--bookmark-toot-toggle) + ("k" "Bookmark toot" mastodon-toot--toggle-bookmark) ("v" "Vote on poll" mastodon-tl--poll-vote) ("n" "Next" mastodon-tl--goto-next-toot) ("p" "Prev" mastodon-tl--goto-prev-toot) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index df9a22c..0a3b602 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -395,7 +395,7 @@ TYPE is a symbol, either 'favourite or 'boost." (mastodon-toot--toggle-boost-or-favourite 'favourite)) ;; TODO maybe refactor into boost/fave fun -(defun mastodon-toot--bookmark-toot-toggle () +(defun mastodon-toot--toggle-bookmark () "Bookmark or unbookmark toot at point." (interactive) (let* ( ;(toot (mastodon-tl--property 'toot-json)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index ae8a795..075aa6a 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -169,6 +169,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "b") #'mastodon-toot--toggle-boost) (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) + (define-key map (kbd "k") #'mastodon-toot--toggle-bookmark) (define-key map (kbd "r") #'mastodon-toot--reply) ;; this is now duplicated by 'g', cd remove/use for else: (define-key map (kbd "u") #'mastodon-tl--update) @@ -194,7 +195,6 @@ Use. e.g. \"%c\" for your locale's date and time format." (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-views--view-filters) (define-key map (kbd "G") #'mastodon-views--get-follow-suggestions) -- cgit v1.2.3 From d711903e751125875467982a8ba843a75f45eedc Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 21 Mar 2023 10:45:05 +0100 Subject: use tl--property 'prop :no-move. FIX #416 --- lisp/mastodon-profile.el | 6 +++--- lisp/mastodon-tl.el | 33 +++++++++++++++++---------------- lisp/mastodon-toot.el | 13 ++++++------- lisp/mastodon-views.el | 30 +++++++++++++++--------------- lisp/mastodon.el | 2 +- 5 files changed, 42 insertions(+), 42 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index e00a028..a252abc 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -714,7 +714,7 @@ IMG-TYPE is the JSON key from the account data." (interactive (list (if (and (not (mastodon-tl--profile-buffer-p)) - (not (get-text-property (point) 'toot-json))) + (not (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) @@ -725,7 +725,7 @@ IMG-TYPE is the JSON key from the account data." (if (not (or ;; own profile has no need for toot-json test: (equal user-handle (mastodon-auth--get-account-name)) - (get-text-property (point) 'toot-json))) + (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) @@ -839,7 +839,7 @@ These include the author, author of reblogged entries and any user mentioned." "Remove a user from your followers. Optionally provide the ID of the account to remove." (interactive) - (let* ((account (unless id (get-text-property (point) 'toot-json))) + (let* ((account (unless id (mastodon-tl--property 'toot-json :no-move))) (id (or id (alist-get 'id account))) (handle (if account (alist-get 'acct account) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d62b798..8588ebd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -67,6 +67,7 @@ (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--my-profile "mastodon-profile") +(autoload 'mastodon-profile--profile-json "mastodon-profile") (autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") (autoload 'mastodon-profile--toot-json "mastodon-profile") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") @@ -268,7 +269,7 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (if (null next-range) (message "Nothing else here.") (goto-char (car next-range)) - (message "%s" (get-text-property (point) 'help-echo))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) (defun mastodon-tl--previous-tab-item () "Move to the previous interesting item. @@ -288,7 +289,7 @@ text, i.e. hidden spoiler text." (if (null next-range) (message "Nothing else before this.") (goto-char (car next-range)) - (message "%s" (get-text-property (point) 'help-echo))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) (defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) "Search for toot with FIND-POS. @@ -395,12 +396,12 @@ Optionally load TAG timeline directly." Do so if type of status at poins is not follow_request/follow." (let ((type (alist-get 'type - (get-text-property (point) 'toot-json))) - (echo (get-text-property (point) 'help-echo))) + (mastodon-tl--property 'toot-json :no-move))) + (echo (mastodon-tl--property 'help-echo :no-move))) (when echo ; not for followers/following in profile (unless (or (string= type "follow_request") (string= type "follow")) ; no counts for these - (message "%s" (get-text-property (point) 'help-echo)))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move)))))) (defun mastodon-tl--byline-author (toot &optional avatar) "Propertize author of TOOT. @@ -1256,11 +1257,11 @@ in which case play first video or gif from current toot." ;; point in byline: url ;; point in toot: - (get-text-property (point) 'image-url))) + (mastodon-tl--property 'image-url :no-move))) (type (or ;; in byline: type ;; point in toot: - (mastodon-tl--property 'mastodon-media-type)))) + (mastodon-tl--property 'mastodon-media-type :no-move)))) (if url (if (or (equal type "gifv") (equal type "video")) @@ -1541,7 +1542,8 @@ Return value from boosted content if available." (defun mastodon-tl--property (prop &optional no-move backward) "Get property PROP for toot at point. -Move forward (down) the timeline unless BACKWARD is non-nil." +Move forward (down) the timeline unless NO-MOVE is non-nil. +BACKWARD means move backward (up) the timeline." (if no-move (get-text-property (point) prop) (or (get-text-property (point) prop) @@ -1856,14 +1858,13 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; fetch 'toot-json: (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following)) - (list (alist-get 'acct (get-text-property (point) 'toot-json)))) - ;; profile view, no toots, point on profile note, ie. 'profile-json: + (list (alist-get 'acct + (mastodon-tl--property 'toot-json :no-move)))) + ;; profile view, no toots ;; needed for e.g. gup.pe groups which show no toots publically: - ((and (mastodon-tl--profile-buffer-p) - (get-text-property (point) 'profile-json)) - (list (alist-get 'acct (get-text-property (point) 'profile-json)))) - ;; avoid tl--property here because it calls next-toot - ;; which breaks non-toot buffers like foll reqs etc.: + ((mastodon-tl--profile-buffer-p) + (list (alist-get 'acct + (mastodon-profile--profile-json)))) (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) @@ -1905,7 +1906,7 @@ LANGS is an array parameters alist of languages to filer user's posts by." ;; if profile view, use 'profile-json as status: (if (mastodon-tl--profile-buffer-p) (mastodon-profile--lookup-account-in-status - user-handle (get-text-property (point) 'profile-json)) + user-handle (mastodon-profile--profile-json)) ;; if muting/blocking, we select from handles in current status (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0a3b602..a487932 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -295,7 +295,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((inhibit-read-only t) (bol (car byline-region)) (eol (cdr byline-region)) - (at-byline-p (eq (get-text-property (point) 'byline) t))) + (at-byline-p (eq (mastodon-tl--property 'byline :no-move) t))) (save-excursion (when remove (goto-char bol) @@ -1008,10 +1008,9 @@ Customize `mastodon-toot-display-orig-in-reply-buffer' to display text of the toot being replied to in the compose buffer." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) - ;; NB: we cannot use mastodon-tl--property for 'base-toot - ;; because if it doesn't have one, it is fetched from next toot! - ;; we also cannot use --field because we need to get a different property first - (base-toot (get-text-property (point) 'base-toot)) ; for new notifs handling + ;; no-move arg for base toot, because if it doesn't have one, it is + ;; fetched from next toot! + (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) (account (mastodon-tl--field 'account toot)) (user (alist-get 'acct account)) @@ -1238,10 +1237,10 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." (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))) + (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) (ts (when reschedule (alist-get 'scheduled_at - (get-text-property (point) 'scheduled-json)))) + (mastodon-tl--property 'scheduled-json :no-move)))) (time-value (org-read-date t t nil "Schedule toot:" ;; default to scheduled timestamp if already set: diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 5cfbe41..762efa9 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -280,7 +280,7 @@ a: add account to this list, r: remove account from this list" (defun mastodon-views--edit-list-at-point () "Edit list at point." (interactive) - (let ((id (get-text-property (point) 'list-id))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--edit-list id))) (defun mastodon-views--edit-list (&optional id) @@ -289,7 +289,7 @@ 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) + (mastodon-tl--property 'list-name :no-move) (completing-read "Edit list: " list-names))) (id (or id (mastodon-views--get-list-id name-old))) @@ -313,7 +313,7 @@ If ID is provided, use that list." (defun mastodon-views--view-timeline-list-at-point () "View timeline of list at point." (interactive) - (let ((list-id (get-text-property (point) 'list-id))) + (let ((list-id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--view-list-timeline list-id))) (defun mastodon-views--view-list-timeline (&optional id) @@ -346,7 +346,7 @@ Prompt for name and replies policy." (defun mastodon-views--delete-list-at-point () "Delete list at point." (interactive) - (let ((id (get-text-property (point) 'list-id))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--delete-list id))) (defun mastodon-views--delete-list (&optional id) @@ -374,7 +374,7 @@ If ID is provided, delete that list." (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))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--add-account-to-list id))) (defun mastodon-views--add-account-to-list (&optional id account-id handle) @@ -386,7 +386,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (format "Add %s to list: " handle) "Add account to list: ")) (list-name (if id - (get-text-property (point) 'list-name) + (mastodon-tl--property 'list-name :no-move) (completing-read list-prompt (mastodon-views--get-lists-names) nil t))) (list-id (or id (mastodon-views--get-list-id list-name))) @@ -414,7 +414,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." (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))) + (let ((id (mastodon-tl--property 'list-id :no-move))) (mastodon-views--remove-account-from-list id))) (defun mastodon-views--remove-account-from-list (&optional id) @@ -422,7 +422,7 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." If ID is provided, use that list." (interactive) (let* ((list-name (if id - (get-text-property (point) 'list-name) + (mastodon-tl--property 'list-name :no-move) (completing-read "Remove account from list: " (mastodon-views--get-lists-names) nil t))) (list-id (or id (mastodon-views--get-list-id list-name))) @@ -527,7 +527,7 @@ If ID, just return that toot." (defun mastodon-views--reschedule-toot () "Reschedule the scheduled toot at point." (interactive) - (let ((id (get-text-property (point) 'id))) + (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) (message "no scheduled toot at point?") (mastodon-toot--schedule-toot :reschedule)))) @@ -535,7 +535,7 @@ If ID, just return that toot." (defun mastodon-views--copy-scheduled-toot-text () "Copy the text of the scheduled toot at point." (interactive) - (let* ((toot (get-text-property (point) 'toot)) + (let* ((toot (mastodon-tl--property 'toot :no-move)) (params (alist-get 'params toot)) (text (alist-get 'text params))) (kill-new text))) @@ -545,7 +545,7 @@ 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)))) + (let ((id (or id (mastodon-tl--property 'id :no-move)))) (if (null id) (message "no scheduled toot at point?") (when (or no-confirm @@ -561,10 +561,10 @@ NO-CONFIRM means there is no ask or message, there is only do." (defun mastodon-views--edit-scheduled-as-new () "Edit scheduled status as new toot." (interactive) - (let ((id (get-text-property (point) 'id))) + (let ((id (mastodon-tl--property 'id :no-move))) (if (null id) (message "no scheduled toot at point?") - (let* ((toot (get-text-property (point) 'scheduled-json)) + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) (scheduled (alist-get 'scheduled_at toot)) (params (alist-get 'params toot)) (text (alist-get 'text params)) @@ -661,8 +661,8 @@ Prompt for a context, must be a list containting at least one of \"home\", (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)) + (let* ((filter-id (mastodon-tl--property 'toot-id :no-move)) + (phrase (mastodon-tl--property 'phrase :no-move)) (url (mastodon-http--api (format "filters/%s" filter-id)))) (if (null phrase) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d54380d..8875419 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -309,7 +309,7 @@ not, just browse the URL in the normal fashion." (interactive) (let* ((query (or query-url (thing-at-point-url-at-point) - (get-text-property (point) 'shr-url) + (mastodon-tl--property 'shr-url :no-move) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) ;; this doesn't work as shr-browse-url doesn't take a url arg -- cgit v1.2.3 From fdeeb396c7c2c9a6618661e2ea5d24b999a0e42f Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 21 Mar 2023 14:50:55 +0100 Subject: manually(!) apply stephan monnier's patch, save the ts work thanks stephan! --- lisp/mastodon-async.el | 9 ++--- lisp/mastodon-http.el | 2 +- lisp/mastodon-media.el | 7 ++-- lisp/mastodon-profile.el | 8 ++--- lisp/mastodon-search.el | 4 +-- lisp/mastodon-tl.el | 78 ++++++++++++++++++++---------------------- lisp/mastodon-toot.el | 42 +++++++++-------------- lisp/mastodon-views.el | 82 ++++++++++++++++++++++----------------------- lisp/mastodon.el | 3 -- test/mastodon-auth-tests.el | 4 ++- 10 files changed, 111 insertions(+), 128 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 364c5db..9de69db 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -1,4 +1,4 @@ -;;; mastodon-async.el --- async streaming functions for mastodon.el -*- lexical-binding: t -*- +;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017 Alex J. Griffith ;; Author: Alex J. Griffith @@ -30,6 +30,7 @@ ;;; Code: +(require 'mastodon-tl) (require 'json) (require 'url-http) @@ -227,9 +228,9 @@ ENDPOINT is the endpoint for the stream and timeline." (mastodon-mode) (mastodon-tl--set-buffer-spec buffer-name endpoint - ,(if (equal name "notifications") - 'mastodon-notifications--timeline - 'mastodon-tl--timeline)) + (if (equal name "notifications") + 'mastodon-notifications--timeline + 'mastodon-tl--timeline)) (setq-local mastodon-tl--enable-relative-timestamps nil) (setq-local mastodon-tl--display-media-p t) (current-buffer)))) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d1f654e..3632a11 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -317,7 +317,7 @@ PARAMS is an alist of any extra parameters to send with the request." (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-json) cbargs))))) -(defun mastodon-http--post-async (url params headers &optional callback &rest cbargs) +(defun mastodon-http--post-async (url params _headers &optional callback &rest cbargs) "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 3fb10b0..63860bd 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -50,17 +50,14 @@ (defcustom mastodon-media--avatar-height 20 "Height of the user avatar images (if shown)." - :group 'mastodon-media :type 'integer) (defcustom mastodon-media--preview-max-height 250 "Max height of any media attachment preview to be shown in timelines." - :group 'mastodon-media :type 'integer) (defcustom mastodon-media--enable-image-caching nil "Whether images should be cached." - :group 'mastodon-media :type 'boolean) (defvar mastodon-media--generic-avatar-data @@ -139,7 +136,7 @@ CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") - "The PNG data for a generic 200x200 'broken image' view.") + "The PNG data for a generic 200x200 \"broken image\" view.") (defun mastodon-media--process-image-response (status-plist marker image-options region-length url) @@ -185,7 +182,7 @@ with the image." (defun mastodon-media--load-image-from-url (url media-type start region-length) "Take a URL and MEDIA-TYPE and load the image asynchronously. -MEDIA-TYPE is a symbol and either 'avatar or 'media-link. +MEDIA-TYPE is a symbol and either `avatar' or `media-link.' START is the position where we start loading the image. REGION-LENGTH is the range from start to propertize." (let ((image-options (when (or (image-type-available-p 'imagemagick) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index a252abc..6c58e52 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -258,7 +258,7 @@ NO-REBLOGS means do not display boosts in statuses." 'display nil) "/500 characters") 'read-only t - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'note-header t) "\n") (make-local-variable 'after-change-functions) @@ -317,7 +317,7 @@ Ask for confirmation if length > 500 characters." (defun mastodon-profile--update-preference (pref val &optional source) "Update account PREF erence to setting VAL. Both args are strings. -SOURCE means that the preference is in the 'source' part of the account JSON." +SOURCE means that the preference is in the `source' part of the account JSON." (let* ((url (mastodon-http--api "accounts/update_credentials")) (pref-formatted (if source (concat "source[" pref "]") pref)) (response (mastodon-http--patch url `((,pref-formatted . ,val))))) @@ -744,7 +744,7 @@ IMG-TYPE is the JSON key from the account data." (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. -FIELD is used to identify regions under 'account" +FIELD is used to identify regions under `account'." (cdr (assoc field account))) (defun mastodon-profile--add-author-bylines (tootv) @@ -806,7 +806,7 @@ These include the author, author of reblogged entries and any user mentioned." (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter - 'stringp + #'stringp (seq-uniq (seq-concatenate 'list diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 80a26ff..b5900c7 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -121,7 +121,7 @@ QUERY is the string to search." tags)) ;; (status-list (mapcar #'mastodon-search--get-status-info ;; statuses)) - (status-ids-list (mapcar 'mastodon-search--get-id-from-status + (status-ids-list (mapcar #'mastodon-search--get-id-from-status statuses)) (toots-list-json (mapcar #'mastodon-search--fetch-full-status-from-id status-ids-list))) @@ -153,7 +153,7 @@ QUERY is the string to search." " STATUSES\n" " ------------\n") 'success)) - (mapc 'mastodon-tl--toot toots-list-json) + (mapc #'mastodon-tl--toot toots-list-json) (goto-char (point-min)))))) (defun mastodon-search--insert-users-propertized (json &optional note) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index a9e2353..49ddd94 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -64,6 +64,7 @@ (autoload 'mastodon-profile--account-from-id "mastodon-profile") (autoload 'mastodon-profile--extract-users-handles "mastodon-profile") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") (autoload 'mastodon-profile--my-profile "mastodon-profile") @@ -107,13 +108,11 @@ "Whether to show relative (to the current time) timestamps. This will require periodic updates of a timeline buffer to keep the timestamps current as time progresses." - :group 'mastodon-tl :type '(boolean :tag "Enable relative timestamps and background updater task")) (defcustom mastodon-tl--enable-proportional-fonts nil "Nonnil to enable using proportional fonts when rendering HTML. By default fixed width fonts are used." - :group 'mastodon-tl :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) @@ -121,18 +120,15 @@ width fonts when rendering HTML text")) "Display an image's caption rather than URL. Only has an effect when `mastodon-tl--display-media-p' is set to nil." - :group 'mastodon-tl :type 'boolean) (defcustom mastodon-tl--show-avatars nil "Whether to enable display of user avatars in timelines." - :group 'mastodon-tl :type '(boolean :tag "Whether to display user avatars in timelines")) (defcustom mastodon-tl--show-stats t "Whether to show toot stats (faves, boosts, replies counts)." - :type 'bool - :group 'mastodon-tl) + :type 'bool) (defcustom mastodon-tl--symbols '((reply . ("💬" . "R")) @@ -148,8 +144,7 @@ nil." "A set of symbols (and fallback strings) to be used in timeline. If a symbol does not look right (tofu), it means your font settings do not support it." - :type '(alist :key-type symbol :value-type string) - :group 'mastodon-tl) + :type '(alist :key-type symbol :value-type string)) (defcustom mastodon-tl-position-after-update nil "Defines where `point' should be located after a timeline update. @@ -170,7 +165,6 @@ Must be an integer between 20 and 40 inclusive." "Whether to hide replies from the timelines. Note that you can hide replies on a one-off basis by loading a timeline with a simple prefix argument, `C-u'." - :group 'mastodon-tl :type '(boolean :tag "Whether to hide replies from the timelines.")) @@ -203,44 +197,46 @@ If nil `(point-min)' is used instead.") (define-key map [return] 'mastodon-tl--do-link-action-at-point) (define-key map [mouse-2] 'mastodon-tl--do-link-action) (define-key map [follow-link] 'mouse-face) - (keymap-canonicalize map)) + map) "The keymap for link-like things in buffer (except for shr.el generate links). This will make the region of text act like like a link with mouse highlighting, mouse click action tabbing to next/previous link etc.") (defvar mastodon-tl--shr-map-replacement - (let ((map (copy-keymap shr-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map shr-map) ;; Replace the move to next/previous link bindings with our ;; version that knows about more types of links. - (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item) - (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) + (define-key map [remap shr-next-link] #'mastodon-tl--next-tab-item) + (define-key map [remap shr-previous-link] #'mastodon-tl--previous-tab-item) ;; keep new my-profile binding; shr 'O' doesn't work here anyway - (define-key map (kbd "O") 'mastodon-profile--my-profile) - (define-key map [remap shr-browse-url] 'mastodon-url-lookup) - (keymap-canonicalize map)) + (define-key map (kbd "O") #'mastodon-profile--my-profile) + (define-key map [remap shr-browse-url] #'mastodon-url-lookup) + map) "The keymap to be set for shr.el generated links that are not images. 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--shr-image-map-replacement - (let ((map (copy-keymap (if (boundp 'shr-image-map) - shr-image-map - shr-map)))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (if (boundp 'shr-image-map) + shr-image-map + shr-map)) ;; Replace the move to next/previous link bindings with our ;; version that knows about more types of links. - (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item) - (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) + (define-key map [remap shr-next-link] #'mastodon-tl--next-tab-item) + (define-key map [remap shr-previous-link] #'mastodon-tl--previous-tab-item) ;; browse-url loads the preview only, we want browse-image ;; on RET to browse full sized image URL - (define-key map [remap shr-browse-url] 'shr-browse-image) + (define-key map [remap shr-browse-url] #'shr-browse-image) ;; remove shr's u binding, as it the maybe-probe-and-copy-url ;; is already bound to w also - (define-key map (kbd "u") 'mastodon-tl--update) + (define-key map (kbd "u") #'mastodon-tl--update) ;; keep new my-profile binding; shr 'O' doesn't work here anyway - (define-key map (kbd "O") 'mastodon-profile--my-profile) - (define-key map (kbd "") 'mastodon-tl--mpv-play-video-at-point) - (keymap-canonicalize map)) + (define-key map (kbd "O") #'mastodon-profile--my-profile) + (define-key map (kbd "") #'mastodon-tl--mpv-play-video-at-point) + map) "The keymap to be set for shr.el generated image links. We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") @@ -248,9 +244,9 @@ types of mastodon links and not just shr.el-generated ones.") (defvar mastodon-tl--byline-link-keymap (when (require 'mpv nil :no-error) (let ((map (make-sparse-keymap))) - (define-key map (kbd "") 'mastodon-tl--mpv-play-video-from-byline) - (define-key map (kbd "") 'mastodon-profile--get-toot-author) - (keymap-canonicalize map))) + (define-key map (kbd "") #'mastodon-tl--mpv-play-video-from-byline) + (define-key map (kbd "RET") #'mastodon-profile--get-toot-author) + map)) "The keymap to be set for the author byline. It is active where point is placed by `mastodon-tl--goto-next-toot.'") @@ -397,7 +393,7 @@ Optionally load TAG timeline directly." ;;; BYLINES, etc. (defun mastodon-tl--message-help-echo () - "Call message on 'help-echo property at point. + "Call message on `help-echo' property at point. Do so if type of status at poins is not follow_request/follow." (let ((type (alist-get 'type @@ -626,7 +622,7 @@ this just means displaying toot client." (propertize (format-time-string mastodon-toot-timestamp-format edited-parsed) - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'timestamp edited-parsed 'display (if mastodon-tl--enable-relative-timestamps (mastodon-tl--relative-time-description edited-parsed) @@ -870,7 +866,7 @@ LINK-TYPE is the type of link to produce." (defun mastodon-tl--do-link-action-at-point (position) "Do the action of the link at POSITION. -Used for hitting on a given link." +Used for hitting RET on a given link." (interactive "d") (let ((link-type (get-text-property position 'mastodon-tab-stop))) (cond ((eq link-type 'content-warning) @@ -1149,18 +1145,18 @@ To disable showing the stats, customize 'favourited-p favourited 'favourites-field t 'favourites-count favourites-count - 'face 'font-lock-comment-face) - (propertize " | " 'face 'font-lock-comment-face) + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) (propertize boosts 'boosted-p boosted 'boosts-field t 'boosts-count boosts-count - 'face 'font-lock-comment-face) - (propertize " | " 'face 'font-lock-comment-face) + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) (propertize replies 'replies-field t 'replies-count replies-count - 'face 'font-lock-comment-face))) + 'face font-lock-comment-face))) (status (concat (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) status))) @@ -1249,7 +1245,7 @@ To disable showing the stats, customize (options-titles (mastodon-tl--map-alist 'title options)) (options-number-seq (number-sequence 1 (length options))) (options-numbers (mapcar #'number-to-string options-number-seq)) - (options-alist (cl-mapcar 'cons options-numbers options-titles)) + (options-alist (cl-mapcar #'cons options-numbers options-titles)) ;; we display both option number and the option title ;; but also store both as cons cell as cdr, as we need it below (candidates (mapcar (lambda (cell) @@ -1335,7 +1331,7 @@ in which case play first video or gif from current toot." (not (mastodon-tl--field 'rebloged toot)))) (defun mastodon-tl--toot (toot &optional detailed-p) - "Formats TOOT and inserts it into the buffer. + "Format TOOT and insert it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client." (mastodon-tl--insert-status @@ -1353,7 +1349,7 @@ this just means displaying toot client." (defun mastodon-tl--timeline (toots) "Display each toot in TOOTS. This function removes replies if user required." - (mapc 'mastodon-tl--toot + (mapc #'mastodon-tl--toot ;; hack to *not* filter replies on profiles: (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) toots @@ -2051,7 +2047,7 @@ the current view." (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) (args (if params (push (car args) params) args)) (url (mastodon-http--api endpoint))) - (apply 'mastodon-http--get-json-async url args callback cbargs))) + (apply #'mastodon-http--get-json-async url args callback cbargs))) ;; TODO ;; Look into the JSON returned here by Local diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a487932..c6f87d3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -33,11 +33,11 @@ ;;; Code: (eval-when-compile (require 'subr-x)) -(when (require 'emojify nil :noerror) - (declare-function emojify-insert-emoji "emojify") - (declare-function emojify-set-emoji-data "emojify") - (defvar emojify-emojis-dir) - (defvar emojify-user-emojis)) +(require 'emojify nil :noerror) +(declare-function emojify-insert-emoji "emojify") +(declare-function emojify-set-emoji-data "emojify") +(defvar emojify-emojis-dir) +(defvar emojify-user-emojis) (require 'cl-lib) (require 'persist) @@ -99,18 +99,15 @@ (defcustom mastodon-toot--default-media-directory "~/" "The default directory when prompting for a media file to upload." - :group 'mastodon-toot :type 'string) (defcustom mastodon-toot--attachment-height 80 "Height of the attached images preview in the toot draft buffer." - :group 'mastodon-toot :type 'integer) (defcustom mastodon-toot--enable-completion t "Whether to enable completion of mentions and hashtags. Used for completion in toot compose buffer." - :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot--use-company-for-completion nil @@ -120,12 +117,10 @@ buffer, and mastodon completion backends are added to `company-capf'. You need to install company yourself to use this." - :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot--completion-style-for-mentions "all" "The company completion style to use for mentions." - :group 'mastodon-toot :type '(choice (const :tag "off" nil) (const :tag "following only" "following") @@ -133,27 +128,23 @@ You need to install company yourself to use this." (defcustom mastodon-toot-display-orig-in-reply-buffer nil "Display a copy of the toot replied to in the compose buffer." - :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot-orig-in-reply-length 160 "Length to crop toot replied to in the compose buffer to." - :group 'mastodon-toot :type 'integer) (defcustom mastodon-toot--default-reply-visibility "public" "Default visibility settings when replying. If the original toot visibility is different we use the more restricted one." - :group 'mastodon-toot :type '(choice - (const :tag "public" "public") - (const :tag "unlisted" "unlisted") - (const :tag "followers only" "private") - (const :tag "direct" "direct"))) + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) (defcustom mastodon-toot--enable-custom-instance-emoji nil "Whether to enable your instance's custom emoji by default." - :group 'mastodon-toot :type 'boolean) (defvar-local mastodon-toot--content-warning nil @@ -288,7 +279,7 @@ NO-TOOT means we are not calling from a toot buffer." (mastodon-toot--update-status-fields))))) (defun mastodon-toot--action-success (marker byline-region remove) - "Insert/remove the text MARKER with 'success face in byline. + "Insert/remove the text MARKER with `success' face in byline. BYLINE-REGION is a cons of start and end pos of the byline to be modified. Remove MARKER if REMOVE is non-nil, otherwise add it." @@ -330,7 +321,7 @@ boosting, or bookmarking toots." (defun mastodon-toot--toggle-boost-or-favourite (type) "Toggle boost or favourite of toot at `point'. -TYPE is a symbol, either 'favourite or 'boost." +TYPE is a symbol, either `favourite' or `boost.'" (interactive) (let* ((boost-p (equal type 'boost)) (has-id (mastodon-tl--property 'base-toot-id)) @@ -861,7 +852,7 @@ instance to edit a toot." (insert (propertize (if (= count 1) (format "%s [original]:\n" count) (format "%s:\n" count)) - 'face 'font-lock-comment-face) + 'face font-lock-comment-face) (mastodon-toot--insert-toot-iter x) "\n") (cl-incf count)) @@ -1342,7 +1333,7 @@ LONGEST is the length of the longest binding." (mastodon-toot--format-kbinds kbinds)))) (concat " Compose a new toot here. The following keybindings are available:" - (mapconcat 'identity + (mapconcat #'identity (mastodon-toot--formatted-kbinds-pairs (mastodon-toot--format-kbinds kbinds) longest-kbind) @@ -1383,7 +1374,7 @@ REPLY-TEXT is the text of the toot being replied to." (propertize "None " 'toot-attachments t) "\n") - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'read-only "Edit your message below." 'toot-post-header t) (if reply-text @@ -1395,7 +1386,7 @@ REPLY-TEXT is the text of the toot being replied to." (propertize (concat divider "\n") 'rear-nonsticky t - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'read-only "Edit your message below." 'toot-post-header t)))) @@ -1629,7 +1620,7 @@ EDIT means we are editing an existing toot, not composing a new one." ;; company (when (and mastodon-toot--use-company-for-completion (require 'company nil :no-error)) - (declare-function 'company-mode-on "company") + (declare-function company-mode-on "company") (set (make-local-variable 'company-backends) (add-to-list 'company-backends 'company-capf)) (company-mode-on))) @@ -1657,7 +1648,6 @@ EDIT means we are editing an existing toot, not composing a new one." (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." - :group 'mastodon-toot :keymap mastodon-toot-mode-map :global nil) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 762efa9..d113d44 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -69,7 +69,7 @@ ;;; KEYMAPS -;; copy `mastodon-mode-map' if possible, as then all timeline functions are +;; we copy `mastodon-mode-map', 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. @@ -81,65 +81,65 @@ ;; `mastodon-mode', it gets overridden in some but not all cases. (defvar mastodon-views-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) - (keymap-canonicalize map)) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-mode-map) + (define-key map (kbd "n") #'mastodon-tl--goto-next-item) + (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) + map) "Base keymap for minor mastodon views.") (defvar mastodon-views--view-filters-keymap - (let ((map - (copy-keymap mastodon-views-map))) - (define-key map (kbd "d") 'mastodon-views--delete-filter) - (define-key map (kbd "c") 'mastodon-views--create-filter) - (define-key map (kbd "TAB") 'mastodon-tl--goto-next-item) - (define-key map (kbd "g") 'mastodon-views--view-filters) - (keymap-canonicalize map)) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (define-key map (kbd "d") #'mastodon-views--delete-filter) + (define-key map (kbd "c") #'mastodon-views--create-filter) + (define-key map (kbd "TAB") #'mastodon-tl--goto-next-item) + (define-key map (kbd "g") #'mastodon-views--view-filters) + map) "Keymap for viewing filters.") (defvar mastodon-views--follow-suggestions-map - (let ((map - (copy-keymap mastodon-views-map))) - (define-key map (kbd "g") 'mastodon-views--view-follow-suggestions) - (keymap-canonicalize map)) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (define-key map (kbd "g") #'mastodon-views--view-follow-suggestions) + map) "Keymap for viewing follow suggestions.") (defvar mastodon-views--view-lists-keymap - (let ((map - (copy-keymap mastodon-views-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 "g") 'mastodon-views--view-lists) - (keymap-canonicalize map)) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-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 "g") #'mastodon-views--view-lists) + 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)) + (define-key map (kbd "RET") #'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) + map) "Keymap for when point is on list name.") (defvar mastodon-views--scheduled-map - (let ((map ;(make-sparse-keymap))) - (copy-keymap mastodon-views-map))) - (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)) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (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 "RET") #'mastodon-views--edit-scheduled-as-new) + 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-views-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-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 diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 8875419..5a46735 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -116,7 +116,6 @@ be \"example_user\". After setting these variables you should restart Emacs for these changes to take effect." - :group 'mastodon :type 'string) (defcustom mastodon-active-user nil @@ -131,7 +130,6 @@ should be \"https://social.instance.org\". After setting these variables you should restart Emacs for these changes to take effect." - :group 'mastodon :type 'string) (defcustom mastodon-toot-timestamp-format "%F %T" @@ -139,7 +137,6 @@ changes to take effect." For valid formatting options see `format-time-string`. The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS. Use. e.g. \"%c\" for your locale's date and time format." - :group 'mastodon :type 'string) (defvar mastodon-mode-map diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 2d9d6df..f2fe009 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -1,6 +1,8 @@ ;;; mastodon-auth-test.el --- Tests for mastodon-auth.el -*- lexical-binding: nil -*- (require 'el-mock) +(require 'mastodon) +(require 'mastodon-auth) (ert-deftest mastodon-auth--handle-token-response--good () "Should extract the access token from a good response." @@ -29,7 +31,7 @@ `(error ,(format "Mastodon-auth--access-token: invalid_grant: %s" error-message)) (condition-case error (mastodon-auth--handle-token-response - `(:error "invalid_grant" :error_description ,error-message)) + `(:error "Invalid_grant" :error_description ,error-message)) (t error)))))) (ert-deftest mastodon-auth--get-token () -- cgit v1.2.3 From fc37e87072e268ee7c330b133ad796a7fd1887c5 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 22 Mar 2023 16:40:45 +0100 Subject: have a crack at updating byline stats on fave/boost --- lisp/mastodon-toot.el | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c6f87d3..0fc7a1e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -374,6 +374,45 @@ TYPE is a symbol, either `favourite' or `boost.'" byline-region remove)) (message (format "%s #%s" (if boost-p msg action) id)))))) (message (format "Nothing to %s here?!?" action-string))))) + (mastodon-toot--update-stats-on-action type remove) + (mastodon-toot--action-success + (if boost-p + (mastodon-tl--symbol 'boost) + (mastodon-tl--symbol 'favourite)) + byline-region remove)) + (message (format "%s #%s" (if boost-p msg action) id)))))) + (message (format "Nothing to %s here?!?" action-string)))))) + +(defun mastodon-toot--inc-or-dec (count subtract) + "If SUBTRACT, decrement COUNT, else increment." + (if subtract + (1- count) + (1+ count))) + +(defun mastodon-toot--update-stats-on-action (action &optional subtract) + "Increment the toot stats display upon ACTION. +ACTION is a symbol, either `favourite' or `boost'. +SUBTRACT means we are un-favouriting or unboosting, so we decrement." + (let* ((count-prop (if (eq action 'favourite) + 'favourites-count + 'boosts-count)) + (count-prop-range (mastodon-tl--find-property-range count-prop (point))) + (count (get-text-property (car count-prop-range) count-prop)) + (inhibit-read-only 1)) + ;; TODO another way to implement this would be to async fetch counts again + ;; and re-display from count-properties + (add-text-properties + (car count-prop-range) + (cdr count-prop-range) + (list 'display ; update the display prop: + (concat + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) + " ") + ;; update the count prop + ;; we rely on this for any subsequent actions: + count-prop + (mastodon-toot--inc-or-dec count subtract))))) (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." -- cgit v1.2.3 From e1740a7386a4cef95fb06133a28144aa8160f21c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Wed, 22 Mar 2023 16:42:48 +0100 Subject: do-if-toot-strict, to prevent faves/boosts on user listings --- lisp/mastodon-tl.el | 9 +- lisp/mastodon-toot.el | 264 +++++++++++++++++++++++++------------------------- 2 files changed, 139 insertions(+), 134 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index db1e40e..bf0bc7e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1771,10 +1771,17 @@ ID is that of the post the context is currently displayed for." "Execute BODY if we have a toot or user at point." (declare (debug t)) `(if (and (not (mastodon-tl--profile-buffer-p)) - (not (mastodon-tl--property 'toot-json))) + (not (mastodon-tl--property 'toot-json))) ; includes user listings (message "Looks like there's no toot or user at point?") ,@body)) +(defmacro mastodon-tl--do-if-toot-strict (&rest body) + "Execute BODY if we have a toot, and only a toot, at point." + (declare (debug t)) + `(if (not (mastodon-tl--property 'toot-id :no-move)) + (message "Looks like there's no toot at point?") + ,@body)) + (defun mastodon-tl--follow-user (user-handle &optional notify langs) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0fc7a1e..8183c27 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -71,6 +71,7 @@ (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--do-if-toot-strict "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") @@ -323,57 +324,51 @@ boosting, or bookmarking toots." "Toggle boost or favourite of toot at `point'. TYPE is a symbol, either `favourite' or `boost.'" (interactive) - (let* ((boost-p (equal type 'boost)) - (has-id (mastodon-tl--property 'base-toot-id)) - (byline-region (when has-id - (mastodon-tl--find-property-range 'byline (point)))) - (id (when byline-region - (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) - (boosted (when byline-region - (get-text-property (car byline-region) 'boosted-p))) - (faved (when byline-region - (get-text-property (car byline-region) 'favourited-p))) - (action (if boost-p - (if boosted "unreblog" "reblog") - (if faved "unfavourite" "favourite"))) - (msg (if boosted "unboosted" "boosted")) - (action-string (if boost-p "boost" "favourite")) - (remove (if boost-p (when boosted t) (when faved t))) - (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) - (visibility (mastodon-tl--field 'visibility - (mastodon-tl--property 'toot-json)))) - (if byline-region - (cond ;; actually there's nothing wrong with faving/boosting own toots! - ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) - ;;(error "You can't %s your own toots" action-string)) - ;; & nothing wrong with faving/boosting own toots from notifs: - ;; this boosts/faves the base toot, not the notif status - ((and (equal "reblog" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (error "You can't %s boosts" action-string)) - ((and (equal "favourite" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (error "You can't %s favourites" action-string)) - ((and (equal "private" visibility) - (equal type 'boost)) - (error "You can't boost private toots")) - (t - (mastodon-toot--action - action - (lambda () - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--action-success - (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove)) - (message (format "%s #%s" (if boost-p msg action) id)))))) - (message (format "Nothing to %s here?!?" action-string))))) + (mastodon-tl--do-if-toot-strict + (let* ((boost-p (equal type 'boost)) + (has-id (mastodon-tl--property 'base-toot-id)) + (byline-region (when has-id + (mastodon-tl--find-property-range 'byline (point)))) + (id (when byline-region + (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) + (boosted (when byline-region + (get-text-property (car byline-region) 'boosted-p))) + (faved (when byline-region + (get-text-property (car byline-region) 'favourited-p))) + (action (if boost-p + (if boosted "unreblog" "reblog") + (if faved "unfavourite" "favourite"))) + (msg (if boosted "unboosted" "boosted")) + (action-string (if boost-p "boost" "favourite")) + (remove (if boost-p (when boosted t) (when faved t))) + (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) + (visibility (mastodon-tl--field 'visibility + (mastodon-tl--property 'toot-json)))) + (if byline-region + (cond ;; actually there's nothing wrong with faving/boosting own toots! + ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) + ;;(error "You can't %s your own toots" action-string)) + ;; & nothing wrong with faving/boosting own toots from notifs: + ;; this boosts/faves the base toot, not the notif status + ((and (equal "reblog" toot-type) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (error "You can't %s boosts" action-string)) + ((and (equal "favourite" toot-type) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (error "You can't %s favourites" action-string)) + ((and (equal "private" visibility) + (equal type 'boost)) + (error "You can't boost private toots")) + (t + (mastodon-toot--action + action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) (mastodon-toot--update-stats-on-action type remove) (mastodon-toot--action-success (if boost-p @@ -428,36 +423,37 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (defun mastodon-toot--toggle-bookmark () "Bookmark or unbookmark toot at point." (interactive) - (let* ( ;(toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--property 'base-toot-id)) - ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (bookmarked-p (mastodon-tl--property 'bookmarked-p)) - (prompt (if bookmarked-p - (format "Toot already bookmarked. Remove? ") - (format "Bookmark this toot? "))) - (byline-region - (when id - (mastodon-tl--find-property-range 'byline (point)))) - (action (if bookmarked-p "unbookmark" "bookmark")) - (bookmark-str (mastodon-tl--symbol 'bookmark)) - (message (if bookmarked-p - "Bookmark removed!" - "Toot bookmarked!")) - (remove (when bookmarked-p t))) - (if byline-region - (when (y-or-n-p prompt) - (mastodon-toot--action - action - (lambda () - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success - bookmark-str - byline-region remove) - (message (format "%s #%s" message id))))) - (message (format "Nothing to %s here?!?" action))))) + (mastodon-tl--do-if-toot-strict + (let* ( ;(toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--property 'base-toot-id)) + ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (bookmarked-p (mastodon-tl--property 'bookmarked-p)) + (prompt (if bookmarked-p + (format "Toot already bookmarked. Remove? ") + (format "Bookmark this toot? "))) + (byline-region + (when id + (mastodon-tl--find-property-range 'byline (point)))) + (action (if bookmarked-p "unbookmark" "bookmark")) + (bookmark-str (mastodon-tl--symbol 'bookmark)) + (message (if bookmarked-p + "Bookmark removed!" + "Toot bookmarked!")) + (remove (when bookmarked-p t))) + (if byline-region + (when (y-or-n-p prompt) + (mastodon-toot--action + action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p)))) + (mastodon-toot--action-success + bookmark-str + byline-region remove) + (message (format "%s #%s" message id))))) + (message (format "Nothing to %s here?!?" action)))))) (defun mastodon-toot--list-toot-boosters () "List the boosters of toot at point." @@ -472,26 +468,27 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." - (let* ((base-toot (mastodon-tl--property 'base-toot-id)) - (endpoint (if favourite "favourited_by" "reblogged_by")) - (url (mastodon-http--api - (format "statuses/%s/%s" base-toot endpoint))) - (params '(("limit" . "80"))) - (json (mastodon-http--get-json url params))) - (if (eq (caar json) 'error) - (error "%s (Status does not exist or is private)" - (alist-get 'error json)) - (let ((handles (mastodon-tl--map-alist 'acct json)) - (type-string (if favourite "Favouriters" "Boosters"))) - (if (not handles) - (error "Looks like this toot has no %s" type-string) - (let ((choice - (completing-read - (format "%s (enter to view profile): " type-string) - handles - nil - t))) - (mastodon-profile--show-user choice))))))) + (mastodon-tl--do-if-toot-strict + (let* ((base-toot (mastodon-tl--property 'base-toot-id)) + (endpoint (if favourite "favourited_by" "reblogged_by")) + (url (mastodon-http--api + (format "statuses/%s/%s" base-toot endpoint))) + (params '(("limit" . "80"))) + (json (mastodon-http--get-json url params))) + (if (eq (caar json) 'error) + (error "%s (Status does not exist or is private)" + (alist-get 'error json)) + (let ((handles (mastodon-tl--map-alist 'acct json)) + (type-string (if favourite "Favouriters" "Boosters"))) + (if (not handles) + (error "Looks like this toot has no %s" type-string) + (let ((choice + (completing-read + (format "%s (enter to view profile): " type-string) + handles + nil + t))) + (mastodon-profile--show-user choice)))))))) (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point. @@ -1037,38 +1034,39 @@ If TAGS, we search for tags, else we search for handles." Customize `mastodon-toot-display-orig-in-reply-buffer' to display text of the toot being replied to in the compose buffer." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - ;; no-move arg for base toot, because if it doesn't have one, it is - ;; fetched from next toot! - (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling - (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) - (account (mastodon-tl--field 'account toot)) - (user (alist-get 'acct account)) - (mentions (mastodon-toot--mentions (or base-toot toot))) - (boosted (mastodon-tl--field 'reblog (or base-toot toot))) - (booster (when boosted - (alist-get 'acct - (alist-get 'account toot))))) - (mastodon-toot (when user - (if booster - (if (and (not (equal user booster)) - (not (member booster mentions))) - ;; different booster, user and mentions: - (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) - ;; booster is either user or in mentions: - (if (not (member user mentions)) - ;; user not already in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user already in mentions: - (mastodon-toot--mentions-to-string (copy-sequence mentions)))) - ;; ELSE no booster: - (if (not (member user mentions)) - ;; user not in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user in mentions already: - (mastodon-toot--mentions-to-string (copy-sequence mentions))))) - id - (or base-toot toot)))) + (mastodon-tl--do-if-toot-strict + (let* ((toot (mastodon-tl--property 'toot-json)) + ;; no-move arg for base toot, because if it doesn't have one, it is + ;; fetched from next toot! + (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling + (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) + (account (mastodon-tl--field 'account toot)) + (user (alist-get 'acct account)) + (mentions (mastodon-toot--mentions (or base-toot toot))) + (boosted (mastodon-tl--field 'reblog (or base-toot toot))) + (booster (when boosted + (alist-get 'acct + (alist-get 'account toot))))) + (mastodon-toot (when user + (if booster + (if (and (not (equal user booster)) + (not (member booster mentions))) + ;; different booster, user and mentions: + (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) + ;; booster is either user or in mentions: + (if (not (member user mentions)) + ;; user not already in mentions: + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + ;; user already in mentions: + (mastodon-toot--mentions-to-string (copy-sequence mentions)))) + ;; ELSE no booster: + (if (not (member user mentions)) + ;; user not in mentions: + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + ;; user in mentions already: + (mastodon-toot--mentions-to-string (copy-sequence mentions))))) + id + (or base-toot toot))))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." -- cgit v1.2.3 From 37bf61d3674063c7c6f726adccb142fecbf7fe75 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 23 Mar 2023 09:37:42 +0100 Subject: separate faves/boosts-count prop in toot-stats this is so we can safely update the count display prop without touching the emoji --- lisp/mastodon-tl.el | 12 ++++++++---- lisp/mastodon-toot.el | 6 ++---- 2 files changed, 10 insertions(+), 8 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index bf0bc7e..289eda1 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1131,23 +1131,27 @@ To disable showing the stats, customize (when-let ((toot (mastodon-tl--toot-for-stats toot))) (let* ((favourites-count (alist-get 'favourites_count toot)) (favourited (equal 't (alist-get 'favourited toot))) + (faves-prop (propertize (format "%s" favourites-count) + 'favourites-count favourites-count)) (boosts-count (alist-get 'reblogs_count toot)) (boosted (equal 't (alist-get 'reblogged toot))) + (boosts-prop (propertize (format "%s" boosts-count) + 'boosts-count boosts-count)) (replies-count (alist-get 'replies_count toot)) - (favourites (format "%s %s" favourites-count (mastodon-tl--symbol 'favourite))) - (boosts (format "%s %s" boosts-count (mastodon-tl--symbol 'boost))) + (favourites (format "%s %s" faves-prop ;favourites-count + (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-prop ;boosts-count + (mastodon-tl--symbol 'boost))) (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) (status (concat (propertize favourites 'favourited-p favourited 'favourites-field t - 'favourites-count favourites-count 'face font-lock-comment-face) (propertize " | " 'face font-lock-comment-face) (propertize boosts 'boosted-p boosted 'boosts-field t - 'boosts-count boosts-count 'face font-lock-comment-face) (propertize " | " 'face font-lock-comment-face) (propertize replies diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8183c27..82a9482 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -400,10 +400,8 @@ SUBTRACT means we are un-favouriting or unboosting, so we decrement." (car count-prop-range) (cdr count-prop-range) (list 'display ; update the display prop: - (concat - (number-to-string - (mastodon-toot--inc-or-dec count subtract)) - " ") + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) ;; update the count prop ;; we rely on this for any subsequent actions: count-prop -- cgit v1.2.3