-(defun eieio-help-class (class)
- "Print help description for CLASS.
-If CLASS is actually an object, then also display current values of that object."
- ;; Header line
- (prin1 class)
- (insert " is a"
- (if (eieio--class-option (eieio--class-v class) :abstract)
- "n abstract"
- "")
- " class")
- (let ((location (find-lisp-object-file-name class 'eieio-defclass)))
- (when location
- (insert " in `")
- (help-insert-xref-button
- (help-fns-short-filename location)
- 'eieio-class-def class location 'eieio-defclass)
- (insert "'")))
- (insert ".\n")
- ;; Parents
- (let ((pl (eieio-class-parents class))
- cur)
- (when pl
- (insert " Inherits from ")
- (while (setq cur (pop pl))
- (setq cur (eieio--class-symbol cur))
- (insert "`")
- (help-insert-xref-button (symbol-name cur)
- 'help-function cur)
- (insert (if pl "', " "'")))
- (insert ".\n")))
- ;; Children
- (let ((ch (eieio-class-children class))
- cur)
- (when ch
- (insert " Children ")
- (while (setq cur (pop ch))
- (insert "`")
- (help-insert-xref-button (symbol-name cur)
- 'help-function cur)
- (insert (if ch "', " "'")))
- (insert ".\n")))
- ;; System documentation
- (let ((doc (documentation-property class 'variable-documentation)))
- (when doc
- (insert "\n" doc "\n\n")))
- ;; Describe all the slots in this class.
- (eieio-help-class-slots class)
- ;; Describe all the methods specific to this class.
- (let ((generics (eieio-all-generic-functions class)))
- (when generics
- (insert (propertize "Specialized Methods:\n\n" 'face 'bold))
- (dolist (generic generics)
- (insert "`")
- (help-insert-xref-button (symbol-name generic) 'help-function generic)
- (insert "'")
- (pcase-dolist (`(,qualifiers ,args ,doc)
- (eieio-method-documentation generic class))
- (insert (format " %s%S\n" qualifiers args)
- (or doc "")))
- (insert "\n\n")))))
-
-(defun eieio-help-class-slots (class)
- "Print help description for the slots in CLASS.
-Outputs to the current buffer."
- (let* ((cv (eieio--class-v class))
- (docs (eieio--class-public-doc cv))
- (names (eieio--class-public-a cv))
- (deflt (eieio--class-public-d cv))
- (types (eieio--class-public-type cv))
- (publp (eieio--class-public-printer cv))
- (i 0)
- (prot (eieio--class-protection cv))
- )
- (insert (propertize "Instance Allocated Slots:\n\n"
- 'face 'bold))
- (while names
- (insert
- (concat
- (when (car prot)
- (propertize "Private " 'face 'bold))
- (propertize "Slot: " 'face 'bold)
- (prin1-to-string (car names))
- (unless (eq (aref types i) t)
- (concat " type = "
- (prin1-to-string (aref types i))))
- (unless (eq (car deflt) eieio-unbound)
- (concat " default = "
- (prin1-to-string (car deflt))))
- (when (car publp)
- (concat " printer = "
- (prin1-to-string (car publp))))
- (when (car docs)
- (concat "\n " (car docs) "\n"))
- "\n"))
- (setq names (cdr names)
- docs (cdr docs)
- deflt (cdr deflt)
- publp (cdr publp)
- prot (cdr prot)
- i (1+ i)))
- (setq docs (eieio--class-class-allocation-doc cv)
- names (eieio--class-class-allocation-a cv)
- types (eieio--class-class-allocation-type cv)
- i 0
- prot (eieio--class-class-allocation-protection cv))
- (when names
- (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)))
- (while names
- (insert
- (concat
- (when (car prot)
- "Private ")
- "Slot: "
- (prin1-to-string (car names))
- (unless (eq (aref types i) t)
- (concat " type = "
- (prin1-to-string (aref types i))))
- (condition-case nil
- (let ((value (eieio-oref class (car names))))
- (concat " value = "
- (prin1-to-string value)))
- (error nil))
- (when (car docs)
- (concat "\n\n " (car docs) "\n"))
- "\n"))
- (setq names (cdr names)
- docs (cdr docs)
- prot (cdr prot)
- i (1+ i)))))