mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
cl-preloaded.el (built-in-class): New type
Add classes describing the built-in types. * lisp/emacs-lisp/cl-preloaded.el (built-in-class): New type. (cl--define-built-in-type): New aux macro. (all built-in types): "Define" them with it. (cl--builtin-type-p): New aux function. (cl--struct-name-p): Use it. (cl--direct-supertypes-of-type, cl--typeof-types, cl--all-builtin-types): Move the definitions to after the built-in classes are defined, and rewrite to make use of those classes. * lisp/emacs-lisp/cl-extra.el (cl-describe-type): Accept two (unused) optional args, for use with `describe-symbol-backends`. (describe-symbol-backends): Simplify accordingly and add ourselves at the end. (cl--class-children): New function. (cl--describe-class): Use it. Also don't show a silly empty list of slots for the built-in types.
This commit is contained in:
parent
9830421e96
commit
4fdcbd09af
3 changed files with 200 additions and 102 deletions
|
|
@ -714,7 +714,9 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
;; FIXME: We could go crazy and add another entry so describe-symbol can be
|
||||
;; used with the slot names of CL structs (and/or EIEIO objects).
|
||||
(add-to-list 'describe-symbol-backends
|
||||
`(nil ,#'cl-find-class ,(lambda (s _b _f) (cl-describe-type s))))
|
||||
`(nil ,#'cl-find-class ,#'cl-describe-type)
|
||||
;; Document the `cons` function before the `cons` type.
|
||||
t)
|
||||
|
||||
(defconst cl--typedef-regexp
|
||||
(concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct"
|
||||
|
|
@ -744,7 +746,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
|
|||
(cl--find-class type))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-describe-type (type)
|
||||
(defun cl-describe-type (type &optional _buf _frame)
|
||||
"Display the documentation for type TYPE (a symbol)."
|
||||
(interactive
|
||||
(let ((str (completing-read "Describe type: " obarray #'cl-find-class t)))
|
||||
|
|
@ -766,6 +768,15 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
|
|||
;; Return the text we displayed.
|
||||
(buffer-string)))))
|
||||
|
||||
(defun cl--class-children (class)
|
||||
(let ((children '()))
|
||||
(mapatoms
|
||||
(lambda (sym)
|
||||
(let ((sym-class (cl--find-class sym)))
|
||||
(and sym-class (memq class (cl--class-parents sym-class))
|
||||
(push sym children)))))
|
||||
children))
|
||||
|
||||
(defun cl--describe-class (type &optional class)
|
||||
(unless class (setq class (cl--find-class type)))
|
||||
(let ((location (find-lisp-object-file-name type 'define-type))
|
||||
|
|
@ -796,10 +807,8 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
|
|||
(insert (substitute-command-keys (if pl "', " "'"))))
|
||||
(insert ".\n")))
|
||||
|
||||
;; Children, if available. ¡For EIEIO!
|
||||
(let ((ch (condition-case nil
|
||||
(cl-struct-slot-value metatype 'children class)
|
||||
(cl-struct-unknown-slot nil)))
|
||||
;; Children.
|
||||
(let ((ch (cl--class-children class))
|
||||
cur)
|
||||
(when ch
|
||||
(insert " Children ")
|
||||
|
|
@ -903,22 +912,25 @@ Outputs to the current buffer."
|
|||
(cslots (condition-case nil
|
||||
(cl-struct-slot-value metatype 'class-slots class)
|
||||
(cl-struct-unknown-slot nil))))
|
||||
(insert (propertize "Instance Allocated Slots:\n\n"
|
||||
'face 'bold))
|
||||
(let* ((has-doc nil)
|
||||
(slots-strings
|
||||
(mapcar
|
||||
(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)))))
|
||||
slots)))
|
||||
(cl--print-table `("Name" "Type" "Default") slots-strings has-doc))
|
||||
(if (and (null slots) (eq metatype 'built-in-class))
|
||||
(insert "This is a built-in type.\n")
|
||||
|
||||
(insert (propertize "Instance Allocated Slots:\n\n"
|
||||
'face 'bold))
|
||||
(let* ((has-doc nil)
|
||||
(slots-strings
|
||||
(mapcar
|
||||
(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)))))
|
||||
slots)))
|
||||
(cl--print-table `("Name" "Type" "Default") slots-strings has-doc)))
|
||||
(insert "\n")
|
||||
(when (> (length cslots) 0)
|
||||
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue