From 0be20d16711b8cfd1f83e3fdcf262be36586c30e Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Fri, 5 Feb 2021 20:37:15 +0100
Subject: [PATCH] ambrevar/emacs: Add emspect.

---
 .../common-lisp/source/ambrevar/emacs.lisp    | 81 +++++++++++++++++++
 1 file changed, 81 insertions(+)

diff --git a/.local/share/common-lisp/source/ambrevar/emacs.lisp b/.local/share/common-lisp/source/ambrevar/emacs.lisp
index a67a126d..24d7dc63 100644
--- a/.local/share/common-lisp/source/ambrevar/emacs.lisp
+++ b/.local/share/common-lisp/source/ambrevar/emacs.lisp
@@ -9,6 +9,78 @@
   (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
   (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
 
+;; TODO: Rename `emacs-readable-value'?
+(defmethod emacs-value ((s symbol))
+  s)
+
+(defmethod emacs-value ((s string))
+  s)
+
+(defmethod emacs-value ((object t))
+  (write-to-string object))
+
+(defmethod emacs-value ((c complex))
+  (write-to-string c))
+
+(defmethod emacs-value ((n number))
+  n)
+
+(defmethod emacs-value ((l list))
+  (mapcar #'emacs-value l))
+
+;; (defmethod emacs-value ((l vector))
+;;   (mapcar #'emacs-value l))
+
+(defmethod emacs-value ((l list))
+  (mapcar #'emacs-value l))
+;; TODO: How do we pass timestamps to Emacs?  Floating points work, but how do
+;; we make the distinction between a timestamp and a random float?
+;; (defmethod emacs-value ((l local-time:timestamp))
+;;   "Return the the floating point number of seconds since Epoch.
+;; Can be passed to Emacs' `float-time'."
+;;   (format nil "~f"
+;;           (+ (local-time:timestamp-to-unix l)
+;;              (/ (local-time:timestamp-microsecond l) 1000000d0))))
+
+;; TODO: Should `header' return strings?
+(defmethod header ((object standard-object))
+  (mapcar (alex:compose #'str:capitalize #'symbol-name) (mopu:slot-names object)))
+
+;; TODO: Support structures.
+(defmethod header ((table hash-table))
+  (alex:hash-table-keys table))
+
+(defmethod header ((seq sequence))
+  (cond
+    ((trivial-types:property-list-p seq)
+     (sera:plist-keys seq))
+    ;; TODO: Fix predicate for alists.
+    ((trivial-types:association-list-p seq)
+     (mapcar #'first seq))
+    (t
+     (alex:iota (length seq)))))
+
+(defmethod ->list ((object standard-object))
+  (mapcar (lambda (slot-name)
+            ;; list or cons?
+            ;; (list slot-name)
+            (emacs-value (slot-value object slot-name)))
+          ;; TODO: Slot order?
+          (mopu:slot-names object)))
+
+(defmethod ->list ((table hash-table))
+  (alex:hash-table-values table))
+
+(defmethod ->list ((seq sequence))
+  (cond
+    ((trivial-types:property-list-p seq)
+     (sera:plist-values seq))
+    ;; TODO: Fix predicate for alists.
+    ((trivial-types:association-list-p seq)
+     (mapcar #'rest seq))
+    (t
+     (coerce seq 'list))))
+
 ;; TODO: Add helper to print list of objects / structs / plist / alist to an Emacs tabulated-mode buffer.
 
 (export-always 'with-emacs-eval)
@@ -70,6 +142,15 @@ See `princ-emacs-buffer'."
     `(with-current-buffer (get-buffer-create ,buffer-or-name)
        (insert ,(princ-to-string thing)))))
 
+(export-always 'emspect)
+(defun emspect (&rest things)
+  "Inspect THINGS with Emacs.
+Require the `clinspect' library."
+  ;; TODO: Allow customizing column sorters, width, formatters.
+  (emacs-eval
+   `(clinspect ',(header (first things))
+               ',(mapcar #'->list things))))
+
 (defun emacs-unescape (string)
   "Since Emacsclient returns escaped strings, return the string in a form
 understood by Common Lisp."