diff options
Diffstat (limited to 'lisp/mastodon-tl.el')
| -rw-r--r-- | lisp/mastodon-tl.el | 149 |
1 files changed, 120 insertions, 29 deletions
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. |