diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-extra.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-extra.el | 68 |
1 files changed, 34 insertions, 34 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 9281cd9821e..437dea2d6a9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -711,11 +711,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class. (require 'help-mode) -;; 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)))) - (defconst cl--typedef-regexp (concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct" "cl-deftype" "deftype")) @@ -725,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (add-to-list 'find-function-regexp-alist '(define-type . cl--typedef-regexp))) -(define-button-type 'cl-help-type - :supertype 'help-function-def - 'help-function #'cl-describe-type - 'help-echo (purecopy "mouse-2, RET: describe this type")) - (define-button-type 'cl-type-definition :supertype 'help-function-def 'help-echo (purecopy "mouse-2, RET: find type definition")) @@ -744,7 +734,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 +756,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)) @@ -773,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (insert (symbol-name type) (substitute-command-keys " is a type (of kind `")) (help-insert-xref-button (symbol-name metatype) - 'cl-help-type metatype) + 'help-type metatype) (insert (substitute-command-keys "')")) (when location (insert (substitute-command-keys " in `")) @@ -792,21 +791,19 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (setq cur (cl--class-name cur)) (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) - 'cl-help-type cur) + 'help-type cur) (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 ") (while (setq cur (pop ch)) (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) - 'cl-help-type cur) + 'help-type cur) (insert (substitute-command-keys (if ch "', " "'")))) (insert ".\n"))) @@ -903,22 +900,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)) |