From b298016324f22bc9c0fddf877c8ec27259b09538 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Fri, 2 Sep 2022 08:33:04 +0200 Subject: work on printing instance details more work on printing instance details readme - instance description more more work on printing instance details more more more work on printing instance details --- README.org | 18 ++++--- lisp/mastodon-tl.el | 149 ++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 130 insertions(+), 37 deletions(-) diff --git a/README.org b/README.org index 815e99f..a2b047a 100644 --- a/README.org +++ b/README.org @@ -99,7 +99,7 @@ restart Emacs and follow the steps again. =M-x mastodon= -Opens a =*mastodon-home*= buffer in the major mode and displays toots. You +Opens a =*mastodon-home*= buffer in the major mode and displays toots. If your credentials are not yet saved, you will be prompted for email and password. The app registration process will take place if your =mastodon-token-file= does not contain =:client_id= and =:client_secret=. @@ -204,6 +204,15 @@ You can download and use your instance's custom emoji | =C-c C-e= | add emoji (if =emojify= installed) | |---------+----------------------------------| +*** Other commands and account settings: + +- =mastodon-tl-view-instance-description=: View information about the instance that the author of the toot at point is on. + +- =mastodon-profile-update-display-name=: Update the display name for your account. +- =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. +- =mastodon-profile-account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. +- =mastodon-profile-account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. + *** Customization See =M-x customize-group RET mastodon= to view all customize options. @@ -220,13 +229,6 @@ See =M-x customize-group RET mastodon= to view all customize options. - Completion for mentions and tags - Enable custom emoji -*** Account settings: - -- =mastodon-profile-update-display-name=: Update the display name for your account. -- =mastodon-profile-set-default-toot-visibility=: Set the default visibility for your toots. -- =mastodon-profile-account-locked-toggle=: Toggle the locked status of your account. Locked accounts have to manually approve follow requests. -- =mastodon-profile-account-discoverable-toggle=: Toggle the discoverable status of your account. Non-discoverable accounts are not listed in the profile directory. - *** Live-updating timelines: =mastodon-async-mode= (code taken from https://github.com/alexjgriffith/mastodon-future.el.) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d74f003..b59be8b 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -34,7 +34,7 @@ (require 'shr) (require 'thingatpt) ; for word-at-point (require 'time-date) -(require 'cl-lib) ; for cl-mapcar +(require 'cl-lib) (require 'mpv nil :no-error) @@ -1363,8 +1363,26 @@ RESPONSE is the JSON returned by the server." (message "Looks like there's no toot or user at point?") ,@body)) -(defun mastodon-tl-view-instance-description () - "View the details of the instance the current post's author is on." +(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) + "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." (interactive) (mastodon-tl--do-if-toot (let* ((toot (mastodon-tl--property 'toot-json)) @@ -1378,41 +1396,114 @@ RESPONSE is the JSON returned by the server." (string-remove-prefix (concat username "@") acct))) (response (mastodon-http--get-json - (concat instance - "/api/v1/instance")))) + (if user + (mastodon-http--api "instance") + (concat instance + "/api/v1/instance"))))) (when response - (let ((buf (get-buffer-create "*mastodon-preferences*"))) + (let ((buf (get-buffer-create "*mastodon-instance*"))) (with-current-buffer buf - ;; (setq masto-test-inst-json response) (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) (goto-char (point-min))))))))) -(defun mastodon-tl--print-json-keys (response) - "Print the JSON keys and values in RESPONSE." - (while response - (let ((el (pop response))) - (if (equal (type-of (cdr el)) 'cons) - (progn - (setq-local left-margin 4) - (insert - (mastodon-tl--render-text - (format "%-20s: " - (prin1-to-string (car el))) - nil) - "\n") - (indent-to-left-margin) - (mastodon-tl--print-json-keys (cdr el))) - (insert - (mastodon-tl--render-text - (format "%-20s: %s" - (prin1-to-string (car el)) - (prin1-to-string (cdr el))) - nil) - "\n"))))) +(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 + (when ind (indent-to ind)) + (insert (mastodon-tl--format-key el pad) + " " + (mastodon-tl--newline-if-long el) + ;; only send strings straight to --render-text + ;; this makes hyperlinks work: + (if (not (stringp (cdr el))) + (mastodon-tl--render-text + (prin1-to-string (cdr el))) + (mastodon-tl--render-text (cdr el))) + "\n"))))))) + +(defun mastodon-tl--print-instance-rules-or-fields (alist) + "Print ALIST of instance rules or contact account fields." + (let ((key (if (alist-get 'id alist) 'id 'name)) + (value (if (alist-get 'id alist) 'text 'value))) + (indent-to 4) + (insert + (format "%-5s: " + (propertize (alist-get key alist) + 'face '(:underline t))) + (mastodon-tl--newline-if-long (assoc 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." + (if (and (sequencep (cdr el)) + (< 50 (length (cdr el)))) + "\n" + "")) (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. -- cgit v1.2.3