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

1 files changed, 112 insertions, 29 deletions

diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index d74f003..7092352 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,106 @@ 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: ")
+          (prin1-to-string (car el))))
+
+(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 (equal (type-of (cdr el)) 'vector)
+               (not (seq-empty-p (cdr el)))
+               (equal (type-of (seq-elt (cdr el) 0)) 'cons))
+          (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 (equal (type-of (cdr el)) 'vector)
+               (not (seq-empty-p (cdr el)))
+               (< 1 (seq-length (cdr el)))
+               (equal (type-of (seq-elt (cdr el) 0)) 'string))
+          (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:
+         ((equal (type-of (cdr el)) 'cons)
+          (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)
+                  (mastodon-tl--render-text
+                   (prin1-to-string (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: "
+                    (alist-get key alist))
+            (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.