diff options
Diffstat (limited to 'lisp/emacs-lisp/eieio-opt.el')
| -rw-r--r-- | lisp/emacs-lisp/eieio-opt.el | 156 |
1 files changed, 4 insertions, 152 deletions
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index f7dbdf5014b..9ecc59434e1 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -31,7 +31,6 @@ (require 'eieio) (require 'find-func) (require 'speedbar) -(require 'help-mode) ;;; Code: ;;;###autoload @@ -78,101 +77,7 @@ Argument CH-PREFIX is another character prefix to display." (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. @@ -217,22 +122,13 @@ are not abstract." ;;; 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) @@ -248,7 +144,7 @@ are not abstract." (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)) @@ -259,50 +155,6 @@ are not abstract." (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 ;; @@ -310,7 +162,7 @@ The value returned is a list of elements of the form (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))))) |