Commit 32bb5a94 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Improve describe-symbol's layout of slots when describing types

* lisp/emacs-lisp/cl-extra.el (cl--print-table): New function.
(cl--describe-class-slots): Use it.
parent e0eb1af5
......@@ -865,6 +865,40 @@ including `cl-block' and `cl-eval-when'."
(defun cl--print-table (header rows)
;; FIXME: Isn't this functionality already implemented elsewhere?
(let ((cols (apply #'vector (mapcar #'string-width header)))
(col-space 2))
(dolist (row rows)
(dotimes (i (length cols))
(let* ((x (pop row))
(curwidth (aref cols i))
(newwidth (if x (string-width x) 0)))
(if (> newwidth curwidth)
(setf (aref cols i) newwidth)))))
(let ((formats '())
(tmp-head header)
(col 0))
(dotimes (i (length cols))
(let ((head (pop tmp-head)))
(push (concat (propertize " "
`(space :align-to ,(+ col col-space)))
(cl-incf col (+ col-space (aref cols i)))))
(let ((format (mapconcat #'identity (nreverse formats) "")))
(insert (apply #'format format
(mapcar (lambda (str) (propertize str 'face 'italic))
(insert (apply #'format format
(mapcar (lambda (str) (make-string (string-width str) ?))
(dolist (row rows)
(insert (apply #'format format row) "\n"))))))
(defun cl--describe-class-slots (class)
"Print help description for the slots in CLASS.
Outputs to the current buffer."
......@@ -877,7 +911,22 @@ Outputs to the current buffer."
(cl-struct-unknown-slot nil))))
(insert (propertize "Instance Allocated Slots:\n\n"
'face 'bold))
(mapc #'cl--describe-class-slot slots)
(let* ((has-doc nil)
(lambda (slot)
(list (cl-prin1-to-string (cl--slot-descriptor-name slot))
(cl-prin1-to-string (cl--slot-descriptor-type slot))
(cl-prin1-to-string (cl--slot-descriptor-initform slot))
(let ((doc (alist-get :documentation
(cl--slot-descriptor-props slot))))
(if (not doc) ""
(setq has-doc t)
(substitute-command-keys doc)))))
(cl--print-table `("Name" "Type" "Default" . ,(if has-doc '("Doc")))
(insert "\n")
(when (> (length cslots) 0)
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
(mapc #'cl--describe-class-slot cslots))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment