(require 'eieio)
(require 'find-func)
(require 'speedbar)
-(require 'help-mode)
;;; Code:
;;;###autoload
(declare-function help-fns-short-filename "help-fns" (filename))
;;;###autoload
-(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 (cl--find-class class) :abstract)
- "n abstract"
- "")
- " class")
- (let ((location (find-lisp-object-file-name class 'eieio-defclass)))
- (when location
- (insert (substitute-command-keys " in ‘"))
- (help-insert-xref-button
- (help-fns-short-filename location)
- 'eieio-class-def class location 'eieio-defclass)
- (insert (substitute-command-keys "’"))))
- (insert ".\n")
- ;; Parents
- (let ((pl (eieio-class-parents class))
- cur)
- (when pl
- (insert " Inherits from ")
- (while (setq cur (pop pl))
- (setq cur (eieio--class-name cur))
- (insert (substitute-command-keys "‘"))
- (help-insert-xref-button (symbol-name cur)
- 'help-function cur)
- (insert (substitute-command-keys (if pl "’, " "’"))))
- (insert ".\n")))
- ;; Children
- (let ((ch (eieio-class-children class))
- cur)
- (when ch
- (insert " Children ")
- (while (setq cur (pop ch))
- (insert (substitute-command-keys "‘"))
- (help-insert-xref-button (symbol-name cur)
- 'help-function cur)
- (insert (substitute-command-keys (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 (substitute-command-keys "‘"))
- (help-insert-xref-button (symbol-name generic) 'help-function generic)
- (insert (substitute-command-keys "’"))
- (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-print-slot (slot)
- (insert
- (concat
- (propertize "Slot: " 'face 'bold)
- (prin1-to-string (cl--slot-descriptor-name slot))
- (unless (eq (cl--slot-descriptor-type slot) t)
- (concat " type = "
- (prin1-to-string (cl--slot-descriptor-type slot))))
- (unless (eq (cl--slot-descriptor-initform slot) eieio-unbound)
- (concat " default = "
- (prin1-to-string (cl--slot-descriptor-initform slot))))
- (when (alist-get :printer (cl--slot-descriptor-props slot))
- (concat " printer = "
- (prin1-to-string
- (alist-get :printer (cl--slot-descriptor-props slot)))))
- (when (alist-get :documentation (cl--slot-descriptor-props slot))
- (concat "\n " (alist-get :documentation (cl--slot-descriptor-props slot))
- "\n")))
- "\n"))
-
-(defun eieio-help-class-slots (class)
- "Print help description for the slots in CLASS.
-Outputs to the current buffer."
- (let* ((cv (cl--find-class class))
- (slots (eieio--class-slots cv))
- (cslots (eieio--class-class-slots cv)))
- (insert (propertize "Instance Allocated Slots:\n\n"
- 'face 'bold))
- (dotimes (i (length slots))
- (eieio--help-print-slot (aref slots i)))
- (when (> (length cslots) 0)
- (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)))
- (dotimes (i (length cslots))
- (eieio--help-print-slot (aref cslots i)))))
+(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
"Return an alist of all currently active classes for completion purposes.
;;; METHOD COMPLETION / DOC
-(define-button-type 'eieio-class-def
- :supertype 'help-function-def
- 'help-echo (purecopy "mouse-2, RET: find class definition"))
-
-(defconst eieio--defclass-regexp "(defclass[ \t\r\n]+%s[ \t\r\n]+")
-(with-eval-after-load 'find-func
- (defvar find-function-regexp-alist)
- (add-to-list 'find-function-regexp-alist
- `(eieio-defclass . eieio--defclass-regexp)))
;;;###autoload
(defun eieio-help-constructor (ctr)
"Describe CTR if it is a class constructor."
(when (class-p ctr)
(erase-buffer)
- (let ((location (find-lisp-object-file-name ctr 'eieio-defclass))
+ (let ((location (find-lisp-object-file-name ctr 'define-type))
(def (symbol-function ctr)))
(goto-char (point-min))
(prin1 ctr)
(insert (substitute-command-keys " in ‘"))
(help-insert-xref-button
(help-fns-short-filename location)
- 'eieio-class-def ctr location 'eieio-defclass)
+ 'cl-type-definition ctr location 'define-type)
(insert (substitute-command-keys "’")))
(insert ".\nCreates an object of class " (symbol-name ctr) ".")
(goto-char (point-max))
(eieio-help-class ctr))
))))
-(defun eieio--specializers-apply-to-class-p (specializers class)
- "Return non-nil if a method with SPECIALIZERS applies to CLASS."
- (let ((applies nil))
- (dolist (specializer specializers)
- (if (memq (car-safe specializer) '(subclass eieio--static))
- (setq specializer (nth 1 specializer)))
- ;; Don't include the methods that are "too generic", such as those
- ;; applying to `eieio-default-superclass'.
- (and (not (memq specializer '(t eieio-default-superclass)))
- (class-p specializer)
- (child-of-class-p class specializer)
- (setq applies t)))
- applies))
-
-(defun eieio-all-generic-functions (&optional class)
- "Return a list of all generic functions.
-Optional CLASS argument returns only those functions that contain
-methods for CLASS."
- (let ((l nil))
- (mapatoms
- (lambda (symbol)
- (let ((generic (and (fboundp symbol) (cl--generic symbol))))
- (and generic
- (catch 'found
- (if (null class) (throw 'found t))
- (dolist (method (cl--generic-method-table generic))
- (if (eieio--specializers-apply-to-class-p
- (cl--generic-method-specializers method) class)
- (throw 'found t))))
- (push symbol l)))))
- l))
-
-(defun eieio-method-documentation (generic class)
- "Return info for all methods of GENERIC applicable to CLASS.
-The value returned is a list of elements of the form
-\(QUALIFIERS ARGS DOC)."
- (let ((generic (cl--generic generic))
- (docs ()))
- (when generic
- (dolist (method (cl--generic-method-table generic))
- (when (eieio--specializers-apply-to-class-p
- (cl--generic-method-specializers method) class)
- (push (cl--generic-method-info method) docs))))
- docs))
;;; METHOD STATS
;;
(defun eieio-display-method-list ()
"Display a list of all the methods and what features are used."
(interactive)
- (let* ((meth1 (eieio-all-generic-functions))
+ (let* ((meth1 (cl--generic-all-functions))
(meth (sort meth1 (lambda (a b)
(string< (symbol-name a)
(symbol-name b)))))