diff options
Diffstat (limited to 'lisp/mastodon-views.el')
| -rw-r--r-- | lisp/mastodon-views.el | 239 |
1 files changed, 92 insertions, 147 deletions
diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el index 4f102a6..9809365 100644 --- a/lisp/mastodon-views.el +++ b/lisp/mastodon-views.el @@ -168,26 +168,23 @@ provides the JSON data." (insert (mastodon-tl--set-face (concat "\n " mastodon-tl--horiz-bar "\n " (upcase view-name) - "\n " - mastodon-tl--horiz-bar "\n\n") + "\n " mastodon-tl--horiz-bar "\n\n") 'success) (if bindings-string - (mastodon-tl--set-face - (concat "[" bindings-string "]" - "\n\n") - 'font-lock-comment-face) + (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 + 'toot-id "0")) ; so point can move here when no item (funcall insert-fun data) (goto-char (point-min))) - ;; (when json + ;; (when data ;; FIXME: this seems to trigger a new request, but ideally would run. - ;; (mastodon-tl--goto-next-toot)))) + ;; (mastodon-tl--goto-next-toot)) ) @@ -196,8 +193,7 @@ provides the JSON data." (defun mastodon-views--view-lists () "Show the user's lists in a new buffer." (interactive) - (mastodon-tl--init-sync "lists" - "lists" + (mastodon-tl--init-sync "lists" "lists" 'mastodon-views--insert-lists) (with-current-buffer "*mastodon-lists*" (use-local-map mastodon-views--view-lists-keymap))) @@ -214,8 +210,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 - (mastodon-tl--map-alist 'title lists))) + (let ((lists-names (mastodon-tl--map-alist 'title lists))) (mapc (lambda (x) (mastodon-views--print-list-accounts x) (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n") @@ -237,16 +232,14 @@ a: add account to this list, r: remove account from this list" '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 "\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 @@ -293,8 +286,7 @@ If ID is provided, use that list." (let* ((list-names (unless id (mastodon-views--get-lists-names))) (name-old (if id (mastodon-tl--property 'list-name :no-move) - (completing-read "Edit list: " - list-names))) + (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 @@ -346,8 +338,8 @@ Prompt for name and replies policy." `(("title" . ,title) ("replies_policy" . ,replies-policy)) nil))) - (mastodon-views--list-action-triage response - (message "list %s created!" title)))) + (mastodon-views--list-action-triage + response "list %s created!" title))) (defun mastodon-views--delete-list-at-point () "Delete list at point." @@ -362,14 +354,13 @@ If ID is provided, delete that list." (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))) + (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)))))) + (mastodon-views--list-action-triage + response "list %s deleted!" name))))) (defun mastodon-views--get-users-followings () "Return the list of followers of the logged in account." @@ -402,11 +393,9 @@ If ACCOUNT-ID and HANDLE are provided use them rather than prompting." 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))))) + (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) (mastodon-views--list-action-triage - response - (message "%s added to list %s!" account list-name)))) + response "%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." @@ -441,16 +430,15 @@ If ID is provided, use that list." (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)))) + response "%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." +(defun mastodon-views--list-action-triage (response &rest args) + "Call `mastodon-http--triage' on RESPONSE and call message on ARGS." (mastodon-http--triage response (lambda () (when (mastodon-tl--buffer-type-eq 'lists) (mastodon-views--view-lists)) - message))) + (apply #'message args)))) (defun mastodon-views--accounts-in-list (list-id) "Return the JSON of the accounts in list with LIST-ID." @@ -505,20 +493,17 @@ JSON is the data returned by the server." (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))) + (let-alist toot (insert - (propertize (concat text + (propertize (concat .params.text " | " - (mastodon-toot--iso-to-human scheduled)) + (mastodon-toot--iso-to-human .scheduled_at)) '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) + 'id .id) "\n"))) (defun mastodon-views--get-scheduled-toots (&optional id) @@ -571,21 +556,16 @@ NO-CONFIRM means there is no ask or message, there is only do." (if (null id) (message "no scheduled toot at point?") (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)) - (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))))) + (scheduled (alist-get 'scheduled_at toot))) + (let-alist (alist-get 'params toot) + ;; (poll (alist-get 'poll 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 + .in_reply_to_id .visibility .spoiler_text .language scheduled id)))))) ;;; FILTERS @@ -593,8 +573,7 @@ NO-CONFIRM means there is no ask or message, there is only do." (defun mastodon-views--view-filters () "View the user's filters in a new buffer." (interactive) - (mastodon-tl--init-sync "filters" - "filters" + (mastodon-tl--init-sync "filters" "filters" 'mastodon-views--insert-filters) (with-current-buffer "*mastodon-filters*" (use-local-map mastodon-views--view-filters-keymap))) @@ -611,10 +590,7 @@ JSON is what is returned by by the server." (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)) + (mapc #'mastodon-views--insert-filter-string json)) (defun mastodon-views--insert-filter-string (filter) "Insert a single FILTER." @@ -627,9 +603,8 @@ JSON is the filters data." (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 + 'byline t) ;for goto-next-filter compat + "\n\n"))) (defun mastodon-views--create-filter () "Create a filter for a word. @@ -646,8 +621,7 @@ Prompt for a context, must be a list containting at least one of \"home\", (completing-read-multiple "Contexts to filter [TAB for options]: " '("home" "notifications" "public" "thread") - nil ; no predicate - t))) ; require-match, as context is mandatory + nil t))) (contexts-processed (if (equal nil contexts) (error "You must select at least one context for a filter") @@ -660,7 +634,6 @@ Prompt for a context, must be a list containting at least one of \"home\", (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)))))) @@ -669,15 +642,15 @@ Prompt for a context, must be a list containting at least one of \"home\", (interactive) (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)))) + (url (mastodon-http--api (format "filters/%s" filter-id)))) (if (null phrase) (error "No filter at point?") (when (y-or-n-p (format "Delete filter %s? " phrase))) (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response (lambda () - (mastodon-views--view-filters) - (message "Filter for \"%s\" deleted!" phrase))))))) + (mastodon-http--triage + response (lambda () + (mastodon-views--view-filters) + (message "Filter for \"%s\" deleted!" phrase))))))) ;;; FOLLOW SUGGESTIONS @@ -751,17 +724,13 @@ 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-http--api "instance") nil nil :vector))) (mastodon-views--instance-response-fun response brief instance)) (mastodon-tl--do-if-toot (let* ((toot (if (mastodon-tl--profile-buffer-p) ;; we may be on profile description itself: (or (mastodon-tl--property 'profile-json) - ;; or on profile account listings, which use toot-json: - ;; or just toots: + ;; or on profile account listings, or just toots: (mastodon-tl--property 'toot-json)) ;; normal timeline/account listing: (mastodon-tl--property 'toot-json))) @@ -769,28 +738,21 @@ INSTANCE is an instance domain name." (account (or (alist-get 'account reblog) (alist-get 'account toot) toot)) ; else `toot' is already an account listing. - ;; we can't use --profile-buffer-p as our test here because we may - ;; be looking at toots/boosts/users in a profile buffer. - ;; profile-json works as a defacto test for if point is on the - ;; profile details at the top of a profile buffer. - (url (if (and (mastodon-tl--profile-buffer-p) - ;; only call this in profile buffers: - (mastodon-tl--property 'profile-json)) + ;; we may be at toots/boosts/users in a profile buffer. + ;; profile-json is a defacto test for if point is on the profile + ;; details at the top of a profile buffer. + (profile-note-p (and (mastodon-tl--profile-buffer-p) + ;; only call this in profile buffers: + (mastodon-tl--property 'profile-json))) + (url (if profile-note-p (alist-get 'url toot) ; profile description (alist-get 'url account))) - (username (if (and (mastodon-tl--profile-buffer-p) - ;; only call this in profile buffers: - (mastodon-tl--property 'profile-json)) + (username (if profile-note-p (alist-get 'username toot) ;; profile (alist-get 'username account))) (instance (mastodon-views--get-instance-url url username instance)) (response (mastodon-http--get-json - (if user - (mastodon-http--api "instance") - (concat instance "/api/v1/instance")) - nil ; params - nil ; silent - :vector))) + (concat instance "/api/v1/instance") nil nil :vector))) (mastodon-views--instance-response-fun response brief instance))))) (defun mastodon-views--instance-response-fun (response brief instance) @@ -823,53 +785,44 @@ INSTANCE is the instance were are working with." (format (concat "%-" (number-to-string pad) "s: ") - (propertize - (prin1-to-string (car el)) - 'face '(:underline t)))) + (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)) + (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)) + ((and (vectorp (cdr el)) ; vector of alists (fields, instance rules): (not (seq-empty-p (cdr el))) (consp (seq-elt (cdr el) 0))) - (insert - (mastodon-views--format-key el pad) - "\n\n") + (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)) + ((and (vectorp (cdr el)) ; vector of strings (media types): (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)) + (insert (mastodon-views--format-key el pad) + "\n" + (seq-mapcat + (lambda (x) (concat x ", ")) + (cdr el) 'string) + "\n\n")) + ((consp (cdr el)) ; basic nesting: (when ind (indent-to ind)) - (insert - (mastodon-views--format-key el pad) - "\n\n") + (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) + (t ; basic handling of raw booleans: + (let ((val (cond ((equal (cdr el) :json-false) "no") ((equal (cdr el) 't) "yes") @@ -879,31 +832,23 @@ IND is the optional indentation level to print at." (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)) + ;; only send strings to --render-text (for hyperlinks): + (mastodon-tl--render-text + (if (stringp val) val (prin1-to-string val))) "\n")))))))) (defun mastodon-views--print-instance-rules-or-fields (alist) "Print ALIST of instance rules or contact account or emoji fields." - (let ((key (or (alist-get 'id alist) - (alist-get 'name alist) - (alist-get 'shortcode alist))) - (value (or (alist-get 'text alist) - (alist-get 'value alist) - (alist-get 'url alist)))) - (indent-to 4) - (insert - (format "%-5s: " - (propertize key - 'face '(:underline t))) - (mastodon-views--newline-if-long value) - (format "%s" (mastodon-tl--render-text - value)) - "\n"))) + (let-alist alist + (let ((key (or .id .name .shortcode)) + (value (or .text .value .url))) + (indent-to 4) + (insert (format "%-5s: " + (propertize key 'face '(:underline t))) + (mastodon-views--newline-if-long value) + (format "%s" (mastodon-tl--render-text + value)) + "\n")))) (defun mastodon-views--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." |