Add online-help support to describe types

* lisp/help-fns.el (describe-symbol-backends): Move to help-mode.el.
(describe-symbol): Improve the selection of default.

* lisp/help-mode.el: Require cl-lib.
(describe-symbol-backends): Move from help-fns.el.
(help-make-xrefs): Use it.

* lisp/emacs-lisp/cl-extra.el (describe-symbol-backends): Add entry
for types.
(cl--typedef-regexp): New const.
(find-function-regexp-alist): Add entry for types.
(cl-help-type, cl-type-definition): New buttons.
(cl-find-class): New function.
(cl-describe-type): New command.
(cl--describe-class, cl--describe-class-slot)
(cl--describe-class-slots): New functions, moved from eieio-opt.el.

* lisp/emacs-lisp/cl-generic.el (cl--generic-method-documentation)
(cl--generic-all-functions, cl--generic-specializers-apply-to-type-p):
New functions.  Moved from eieio-opt.el.
(cl--generic-class-parents): New function, extracted from
cl--generic-struct-specializers.
(cl--generic-struct-specializers): Use it.

* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Use pcase-dolist.
Improve constructor's docstrings.
(cl-struct-unknown-slot): New error.
(cl-struct-slot-offset): Use it.

* lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Record the type
definition in current-load-list.

* lisp/emacs-lisp/eieio-core.el (eieio--known-slot-names): New var.
(eieio--add-new-slot): Set it.
(eieio-defclass-internal): Use new name for current-load-list.
(eieio-oref): Add compiler-macro to warn about unknown slots.
* lisp/emacs-lisp/eieio.el (defclass): Update eieio--known-slot-names
as compile-time as well.  Improve constructor docstrings.

* lisp/emacs-lisp/eieio-opt.el (eieio-help-class)
(eieio--help-print-slot, eieio-help-class-slots): Move to cl-extra.el.
(eieio-class-def): Remove button.
(eieio-help-constructor): Use new name for load-history element.
(eieio--specializers-apply-to-class-p, eieio-all-generic-functions)
(eieio-method-documentation): Move to cl-generic.el.
(eieio-display-method-list): Use new names.

* lisp/emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
Add "define-linline".
(lisp-fdefs): Remove "defsubst".
(el-fdefs): Add "defsubst", "cl-defsubst", and "define-linline".

* lisp/emacs-lisp/macroexp.el (macroexp--warned): New var.
(macroexp--warn-and-return): Use it to avoid inf-loops.
Add `compile-only' argument.

lisp/emacs-lisp/cl-extra.el

@@ -688,6 +688,169 @@ including `cl-block' and `cl-eval-when'."
     (prog1 (cl-prettyprint form)
       (message ""))))
 
+;;; Integration into the online help system.
+
+(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"))
+          "[ \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
+               `(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"))
+
+(declare-function help-fns-short-filename "help-fns" (filename))
+
+;;;###autoload
+(defun cl-find-class (type) (cl--find-class type))
+
+;;;###autoload
+(defun cl-describe-type (type)
+  "Display the documentation for type TYPE (a symbol)."
+  (interactive
+   (let ((str (completing-read "Describe type: " obarray #'cl-find-class t)))
+     (if (<= (length str) 0)
+         (user-error "Abort!")
+       (list (intern str)))))
+  (help-setup-xref (list #'cl-describe-type type)
+                   (called-interactively-p 'interactive))
+  (save-excursion
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+        (let ((class (cl-find-class type)))
+          (if class
+              (cl--describe-class type class)
+            ;; FIXME: Describe other types (the built-in ones, or those from
+            ;; cl-deftype).
+            (user-error "Unknown type %S" type))))
+      (with-current-buffer standard-output
+        ;; Return the text we displayed.
+        (buffer-string)))))
+
+(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))
+        ;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
+        (metatype (cl--class-name (symbol-value (aref class 0)))))
+    (insert (symbol-name type)
+            (substitute-command-keys " is a type (of kind ‘"))
+    (help-insert-xref-button (symbol-name metatype)
+                             'cl-help-type metatype)
+    (insert (substitute-command-keys "’)"))
+    (when location
+      (insert (substitute-command-keys " in ‘"))
+      (help-insert-xref-button
+       (help-fns-short-filename location)
+       'cl-type-definition type location 'define-type)
+      (insert (substitute-command-keys "’")))
+    (insert ".\n")
+
+    ;; Parents.
+    (let ((pl (cl--class-parents class))
+          cur)
+      (when pl
+        (insert " Inherits from ")
+        (while (setq cur (pop pl))
+          (setq cur (cl--class-name cur))
+          (insert (substitute-command-keys "‘"))
+          (help-insert-xref-button (symbol-name cur)
+                                   'cl-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)))
+          cur)
+      (when ch
+        (insert " Children ")
+        (while (setq cur (pop ch))
+          (insert (substitute-command-keys "‘"))
+          (help-insert-xref-button (symbol-name cur)
+                                   'cl-help-type cur)
+          (insert (substitute-command-keys (if ch "’, " "’"))))
+        (insert ".\n")))
+
+    ;; Type's documentation.
+    (let ((doc (cl--class-docstring class)))
+      (when doc
+        (insert "\n" doc "\n\n")))
+
+    ;; Describe all the slots in this class.
+    (cl--describe-class-slots class)
+
+    ;; Describe all the methods specific to this class.
+    (let ((generics (cl--generic-all-functions type)))
+      (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)
+                         (cl--generic-method-documentation generic type))
+            (insert (format " %s%S\n" qualifiers args)
+                    (or doc "")))
+          (insert "\n\n"))))))
+
+(defun cl--describe-class-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))))
+    ;; FIXME: The default init form is treated differently for structs and for
+    ;; eieio objects: for structs, the default is nil, for eieio-objects
+    ;; it's a special "unbound" value.
+    (unless nil ;; (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 cl--describe-class-slots (class)
+  "Print help description for the slots in CLASS.
+Outputs to the current buffer."
+  (let* ((slots (cl--class-slots class))
+         ;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
+         (metatype (cl--class-name (symbol-value (aref class 0))))
+         ;; ¡For EIEIO!
+         (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))
+    (mapc #'cl--describe-class-slot slots)
+    (when (> (length cslots) 0)
+      (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
+      (mapc #'cl--describe-class-slot cslots))))
 
 
 (run-hooks 'cl-extra-load-hook)

lisp/emacs-lisp/cl-generic.el

@@ -95,6 +95,7 @@
 ;; usually be simplified, or even completely skipped.
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-macs))  ;For cl--find-class.
 (eval-when-compile (require 'pcase))
 
 (cl-defstruct (cl--generic-generalizer
@@ -883,6 +884,55 @@ Can only be used from within the lexical body of a primary or around method."
                 (insert (substitute-command-keys "’.\n"))))
             (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
 
+(defun cl--generic-specializers-apply-to-type-p (specializers type)
+  "Return non-nil if a method with SPECIALIZERS applies to TYPE."
+  (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)))
+           (or (equal type specializer)
+               (when (symbolp specializer)
+                 (let ((sclass (cl--find-class specializer))
+                       (tclass (cl--find-class type)))
+                   (when (and sclass tclass)
+                     (member specializer (cl--generic-class-parents tclass))))))
+           (setq applies t)))
+    applies))
+
+(defun cl--generic-all-functions (&optional type)
+  "Return a list of all generic functions.
+Optional TYPE argument returns only those functions that contain
+methods for TYPE."
+  (let ((l nil))
+    (mapatoms
+     (lambda (symbol)
+       (let ((generic (and (fboundp symbol) (cl--generic symbol))))
+         (and generic
+	      (catch 'found
+		(if (null type) (throw 'found t))
+		(dolist (method (cl--generic-method-table generic))
+		  (if (cl--generic-specializers-apply-to-type-p
+		       (cl--generic-method-specializers method) type)
+		      (throw 'found t))))
+	      (push symbol l)))))
+    l))
+
+(defun cl--generic-method-documentation (function type)
+  "Return info for all methods of FUNCTION (a symbol) applicable to TYPE.
+The value returned is a list of elements of the form
+\(QUALIFIERS ARGS DOC)."
+  (let ((generic (cl--generic function))
+        (docs ()))
+    (when generic
+      (dolist (method (cl--generic-method-table generic))
+        (when (cl--generic-specializers-apply-to-type-p
+               (cl--generic-method-specializers method) type)
+          (push (cl--generic-method-info method) docs))))
+    docs))
+
 ;;; Support for (head <val>) specializers.
 
 ;; For both the `eql' and the `head' specializers, the dispatch
@@ -958,19 +1008,22 @@ Can only be used from within the lexical body of a primary or around method."
           (if (eq (symbol-function tag) :quick-object-witness-check)
               tag))))
 
+(defun cl--generic-class-parents (class)
+  (let ((parents ())
+        (classes (list class)))
+    ;; BFS precedence.  FIXME: Use a topological sort.
+    (while (let ((class (pop classes)))
+             (cl-pushnew (cl--class-name class) parents)
+             (setq classes
+                   (append classes
+                           (cl--class-parents class)))))
+    (nreverse parents)))
+
 (defun cl--generic-struct-specializers (tag)
   (and (symbolp tag) (boundp tag)
        (let ((class (symbol-value tag)))
          (when (cl-typep class 'cl-structure-class)
-           (let ((types ())
+           (cl--generic-class-parents class)))))
-                 (classes (list class)))
-             ;; BFS precedence.
-             (while (let ((class (pop classes)))
-                      (push (cl--class-name class) types)
-                      (setq classes
-                            (append classes
-                                    (cl--class-parents class)))))
-             (nreverse types))))))
 
 (defconst cl--generic-struct-generalizer
   (cl-generic-make-generalizer

lisp/emacs-lisp/cl-macs.el

@@ -2722,20 +2722,16 @@ non-nil value, that slot cannot be set via `setf'.
          (push `(defalias ',copier #'copy-sequence) forms))
     (if constructor
 	(push (list constructor
-		       (cons '&key (delq nil (copy-sequence slots))))
+                    (cons '&key (delq nil (copy-sequence slots))))
-		 constrs))
+              constrs))
-    (while constrs
+    (pcase-dolist (`(,cname ,args ,doc) constrs)
-      (let* ((name (caar constrs))
+      (let* ((anames (cl--arglist-args args))
-             (rest (cdr (pop constrs)))
-             (args (car rest))
-             (doc  (cadr rest))
-	     (anames (cl--arglist-args args))
 	     (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
 			    slots defaults)))
-	(push `(cl-defsubst ,name
+	(push `(cl-defsubst ,cname
                    (&cl-defs (nil ,@descs) ,@args)
-                 ,@(if (stringp doc) (list doc)
+                 ,(if (stringp doc) (list doc)
-                     (if (stringp docstring) (list docstring)))
+                    (format "Constructor for objects of type `%s'." name))
                  ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
                        '((declare (side-effect-free t))))
                  (,(or type #'vector) ,@make))
@@ -2859,6 +2855,8 @@ slots skipped by :initial-offset may appear in the list."
               descs)))
     (nreverse descs)))
 
+(define-error 'cl-struct-unknown-slot "struct %S has no slot %S")
+
 (defun cl-struct-slot-offset (struct-type slot-name)
   "Return the offset of slot SLOT-NAME in STRUCT-TYPE.
 The returned zero-based slot index is relative to the start of
@@ -2868,7 +2866,7 @@ does not contain SLOT-NAME."
   (declare (side-effect-free t) (pure t))
   (or (gethash slot-name
                (cl--class-index-table (cl--struct-get-class struct-type)))
-      (error "struct %s has no slot %s" struct-type slot-name)))
+      (signal 'cl-struct-unknown-slot (list struct-type slot-name))))
 
 (defvar byte-compile-function-environment)
 (defvar byte-compile-macro-environment)

lisp/emacs-lisp/cl-preloaded.el

@@ -147,6 +147,7 @@
               ok)
             (error "Included struct %S has changed since compilation of %S"
                    parent name))))
+    (add-to-list 'current-load-list `(define-type . ,name))
     (cl--struct-register-child parent-class tag)
     (unless (eq named t)
       (eval `(defconst ,tag ',class) t)

lisp/emacs-lisp/eieio-core.el

@@ -261,6 +261,8 @@ It creates an autoload function for CNAME's constructor."
     (and (eieio-object-p obj)
          (object-of-class-p obj class))))
 
+(defvar eieio--known-slot-names nil)
+
 (defun eieio-defclass-internal (cname superclasses slots options)
   "Define CNAME as a new subclass of SUPERCLASSES.
 SLOTS are the slots residing in that class definition, and OPTIONS
@@ -473,7 +475,7 @@ See `defclass' for more information."
         (put cname 'variable-documentation docstring)))
 
     ;; Save the file location where this class is defined.
-    (add-to-list 'current-load-list `(eieio-defclass . ,cname))
+    (add-to-list 'current-load-list `(define-type . ,cname))
 
     ;; We have a list of custom groups.  Store them into the options.
     (let ((g (eieio--class-option-assoc options :custom-groups)))
@@ -603,47 +605,48 @@ if default value is nil."
                               :key #'cl--slot-descriptor-name)))
          (cold (car (cl-member a (eieio--class-class-slots newc)
                                :key #'cl--slot-descriptor-name))))
-  (condition-case nil
+    (cl-pushnew a eieio--known-slot-names)
-      (if (sequencep d) (setq d (copy-sequence d)))
+    (condition-case nil
-    ;; This copy can fail on a cons cell with a non-cons in the cdr.  Let's
+        (if (sequencep d) (setq d (copy-sequence d)))
-    ;; skip it if it doesn't work.
+      ;; This copy can fail on a cons cell with a non-cons in the cdr.  Let's
-    (error nil))
+      ;; skip it if it doesn't work.
-  ;; (if (sequencep type) (setq type (copy-sequence type)))
+      (error nil))
-  ;; (if (sequencep cust) (setq cust (copy-sequence cust)))
+    ;; (if (sequencep type) (setq type (copy-sequence type)))
-  ;; (if (sequencep custg) (setq custg (copy-sequence custg)))
+    ;; (if (sequencep cust) (setq cust (copy-sequence cust)))
+    ;; (if (sequencep custg) (setq custg (copy-sequence custg)))
 
-  ;; To prevent override information w/out specification of storage,
+    ;; To prevent override information w/out specification of storage,
-  ;; we need to do this little hack.
+    ;; we need to do this little hack.
-  (if cold (setq alloc :class))
+    (if cold (setq alloc :class))
 
-  (if (memq alloc '(nil :instance))
+    (if (memq alloc '(nil :instance))
-      ;; In this case, we modify the INSTANCE version of a given slot.
+        ;; In this case, we modify the INSTANCE version of a given slot.
-      (progn
-        ;; Only add this element if it is so-far unique
-        (if (not old)
-            (progn
-              (eieio--perform-slot-validation-for-default slot skipnil)
-              (push slot (eieio--class-slots newc))
-              )
-          ;; When defaultoverride is true, we are usually adding new local
-          ;; attributes which must override the default value of any slot
-          ;; passed in by one of the parent classes.
-          (when defaultoverride
-            (eieio--slot-override old slot skipnil)))
-        (when init
-          (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc)
-                      :test #'equal)))
-
-    ;; CLASS ALLOCATED SLOTS
-    (if (not cold)
         (progn
-          (eieio--perform-slot-validation-for-default slot skipnil)
+          ;; Only add this element if it is so-far unique
-          ;; Here we have found a :class version of a slot.  This
+          (if (not old)
-          ;; requires a very different approach.
+              (progn
-          (push slot (eieio--class-class-slots newc)))
+                (eieio--perform-slot-validation-for-default slot skipnil)
-      (when defaultoverride
+                (push slot (eieio--class-slots newc))
-        ;; There is a match, and we must override the old value.
+                )
-        (eieio--slot-override cold slot skipnil))))))
+            ;; When defaultoverride is true, we are usually adding new local
+            ;; attributes which must override the default value of any slot
+            ;; passed in by one of the parent classes.
+            (when defaultoverride
+              (eieio--slot-override old slot skipnil)))
+          (when init
+            (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc)
+                        :test #'equal)))
+
+      ;; CLASS ALLOCATED SLOTS
+      (if (not cold)
+          (progn
+            (eieio--perform-slot-validation-for-default slot skipnil)
+            ;; Here we have found a :class version of a slot.  This
+            ;; requires a very different approach.
+            (push slot (eieio--class-class-slots newc)))
+        (when defaultoverride
+          ;; There is a match, and we must override the old value.
+          (eieio--slot-override cold slot skipnil))))))
 
 (defun eieio-copy-parents-into-subclass (newc)
   "Copy into NEWC the slots of PARENTS.
@@ -720,9 +723,18 @@ Argument FN is the function calling this verifier."
 
 
 ;;; Get/Set slots in an object.
-;;
+
 (defun eieio-oref (obj slot)
   "Return the value in OBJ at SLOT in the object vector."
+  (declare (compiler-macro
+            (lambda (exp)
+              (ignore obj)
+              (pcase slot
+                ((and (or `',name (and name (pred keywordp)))
+                      (guard (not (memq name eieio--known-slot-names))))
+                 (macroexp--warn-and-return
+                  (format "Unknown slot `%S'" name) exp 'compile-only))
+                (_ exp)))))
   (cl-check-type slot symbol)
   (cl-check-type obj (or eieio-object class))
   (let* ((class (cond ((symbolp obj)

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)
+(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
-  "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)))))
 
 (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)))))

lisp/emacs-lisp/eieio.el

@@ -142,6 +142,10 @@ and reference them using the function `class-option'."
 	     (alloc   (plist-get soptions :allocation))
 	     (label   (plist-get soptions :label)))
 
+        ;; Update eieio--known-slot-names already in case we compile code which
+        ;; uses this before the class is loaded.
+        (cl-pushnew sname eieio--known-slot-names)
+
 	(if eieio-error-unsupported-class-tags
 	    (let ((tmp soptions))
 	      (while tmp
@@ -254,13 +258,12 @@ This method is obsolete."
               (if (not (stringp abs))
                   (setq abs (format "Class %s is abstract" name)))
               `(defun ,name (&rest _)
-                 ,(format "You cannot create a new object of type %S." name)
+                 ,(format "You cannot create a new object of type `%S'." name)
                  (error ,abs)))
 
           ;; Non-abstract classes need a constructor.
           `(defun ,name (&rest slots)
-             ,(format "Create a new object with name NAME of class type %S."
+             ,(format "Create a new object of class type `%S'." name)
-                      name)
              (declare (compiler-macro
                        (lambda (whole)
                          (if (not (stringp (car slots)))
@@ -941,6 +944,8 @@ of `eq'."
   (error "EIEIO: `change-class' is unimplemented"))
 
 ;; Hook ourselves into help system for describing classes and methods.
+;; FIXME: This is not actually needed any more since we can click on the
+;; hyperlink from the constructor's docstring to see the type definition.
 (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
 
 ;;; Interfacing with edebug
@@ -978,7 +983,7 @@ Optional argument GROUP is the sub-group of slots to display.
 
 ;;;***
 
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "b7995d9076e4dd4b9358b2aa66835619")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "cb1aba7670b6a4b9c6f968c0ad6dc130")
 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\
@@ -988,11 +993,7 @@ variable `eieio-default-superclass'.
 
 \(fn &optional ROOT-CLASS)" t nil)
 
-(autoload 'eieio-help-class "eieio-opt" "\
+(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
-Print help description for CLASS.
-If CLASS is actually an object, then also display current values of that object.
-
-\(fn CLASS)" nil nil)
 
 (autoload 'eieio-help-constructor "eieio-opt" "\
 Describe CTR if it is a class constructor.

lisp/emacs-lisp/lisp-mode.el

@@ -95,7 +95,7 @@
 			     (regexp-opt
 			      '("defun" "defmacro"
                                 ;; Elisp.
-                                "defun*" "defsubst"
+                                "defun*" "defsubst" "define-inline"
 				"define-advice" "defadvice" "define-skeleton"
 				"define-compilation-mode" "define-minor-mode"
 				"define-global-minor-mode"
@@ -230,7 +230,7 @@
 	  (throw 'found t))))))
 
 (let-when-compile
-    ((lisp-fdefs '("defmacro" "defsubst" "defun"))
+    ((lisp-fdefs '("defmacro" "defun"))
      (lisp-vdefs '("defvar"))
      (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
                 "prog2" "lambda" "unwind-protect" "condition-case"
@@ -240,7 +240,8 @@
      ;; Elisp constructs.  Now they are update dynamically
      ;; from obarray but they are also used for setting up
      ;; the keywords for Common Lisp.
-     (el-fdefs '("define-advice" "defadvice" "defalias"
+     (el-fdefs '("defsubst" "cl-defsubst" "define-inline"
+                 "define-advice" "defadvice" "defalias"
                  "define-derived-mode" "define-minor-mode"
                  "define-generic-mode" "define-global-minor-mode"
                  "define-globalized-minor-mode" "define-skeleton"

lisp/emacs-lisp/macroexp.el

@@ -119,20 +119,28 @@ and also to avoid outputting the warning during normal execution."
   (member '(declare-function . byte-compile-macroexpand-declare-function)
           macroexpand-all-environment))
 
+(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
 
-(defun macroexp--warn-and-return (msg form)
+(defun macroexp--warn-and-return (msg form &optional compile-only)
   (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
     (cond
      ((null msg) form)
      ((macroexp--compiling-p)
-      `(progn
+      (if (gethash form macroexp--warned)
-         (macroexp--funcall-if-compiled ',when-compiled)
+          ;; Already wrapped this exp with a warning: avoid inf-looping
-         ,form))
+          ;; where we keep adding the same warning onto `form' because
+          ;; macroexpand-all gets right back to macroexpanding `form'.
+          form
+        (puthash form form macroexp--warned)
+        `(progn
+           (macroexp--funcall-if-compiled ',when-compiled)
+           ,form)))
      (t
-      (message "%s%s" (if (stringp load-file-name)
+      (unless compile-only
-                          (concat (file-relative-name load-file-name) ": ")
+        (message "%s%s" (if (stringp load-file-name)
-                        "")
+                            (concat (file-relative-name load-file-name) ": ")
-               msg)
+                          "")
+                 msg))
       form))))
 
 (defun macroexp--obsolete-warning (fun obsolescence-data type)
@@ -208,30 +216,30 @@ Assumes the caller has bound `macroexpand-all-environment'."
        (macroexp--cons
         'condition-case
         (macroexp--cons err
-                    (macroexp--cons (macroexp--expand-all body)
+                        (macroexp--cons (macroexp--expand-all body)
-                                (macroexp--all-clauses handlers 1)
+                                        (macroexp--all-clauses handlers 1)
-                                (cddr form))
+                                        (cddr form))
-                    (cdr form))
+                        (cdr form))
         form))
       (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
       (`(function ,(and f `(lambda . ,_)))
        (macroexp--cons 'function
-                   (macroexp--cons (macroexp--all-forms f 2)
+                       (macroexp--cons (macroexp--all-forms f 2)
-                               nil
+                                       nil
-                               (cdr form))
+                                       (cdr form))
-                   form))
+                       form))
       (`(,(or `function `quote) . ,_) form)
       (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
        (macroexp--cons fun
-                   (macroexp--cons (macroexp--all-clauses bindings 1)
+                       (macroexp--cons (macroexp--all-clauses bindings 1)
-                               (macroexp--all-forms body)
+                                       (macroexp--all-forms body)
-                               (cdr form))
+                                       (cdr form))
-                   form))
+                       form))
       (`(,(and fun `(lambda . ,_)) . ,args)
        ;; Embedded lambda in function position.
        (macroexp--cons (macroexp--all-forms fun 2)
-                   (macroexp--all-forms args)
+                       (macroexp--all-forms args)
-                   form))
+                       form))
       ;; The following few cases are for normal function calls that
       ;; are known to funcall one of their arguments.  The byte
       ;; compiler has traditionally handled these functions specially

lisp/help-fns.el

@@ -33,6 +33,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'help-mode)
 
 (defvar help-fns-describe-function-functions nil
   "List of functions to run in help buffer in `describe-function'.
@@ -970,15 +971,6 @@ file-local variable.\n")
 	      (buffer-string))))))))
 
 
-(defvar describe-symbol-backends
-  `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
-    ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
-    (nil
-     ,(lambda (symbol)
-        (or (and (boundp symbol) (not (keywordp symbol)))
-            (get symbol 'variable-documentation)))
-     ,#'describe-variable)))
-
 (defvar help-xref-stack-item)
 
 ;;;###autoload
@@ -986,23 +978,22 @@ file-local variable.\n")
   "Display the full documentation of SYMBOL.
 Will show the info of SYMBOL as a function, variable, and/or face."
   (interactive
-   ;; FIXME: also let the user enter a face name.
+   (let* ((v-or-f (symbol-at-point))
-   (let* ((v-or-f (variable-at-point))
+          (found (cl-some (lambda (x) (funcall (nth 1 x) v-or-f))
-          (found (symbolp v-or-f))
+                          describe-symbol-backends))
           (v-or-f (if found v-or-f (function-called-at-point)))
           (found (or found v-or-f))
           (enable-recursive-minibuffers t)
-          val)
+          (val (completing-read (if found
-     (setq val (completing-read (if found
 				    (format
-                                        "Describe symbol (default %s): " v-or-f)
+                                     "Describe symbol (default %s): " v-or-f)
 				  "Describe symbol: ")
 				obarray
 				(lambda (vv)
                                   (cl-some (lambda (x) (funcall (nth 1 x) vv))
                                            describe-symbol-backends))
 				t nil nil
-				(if found (symbol-name v-or-f))))
+				(if found (symbol-name v-or-f)))))
      (list (if (equal val "")
 	       v-or-f (intern val)))))
   (if (not (symbolp symbol))

lisp/help-mode.el

@@ -30,6 +30,7 @@
 ;;; Code:
 
 (require 'button)
+(require 'cl-lib)
 (eval-when-compile (require 'easymenu))
 
 (defvar help-mode-map
@@ -216,7 +217,8 @@ The format is (FUNCTION ARGS...).")
 			 (goto-char (point-min))
 			 (if (re-search-forward
 			      (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s"
-				      (regexp-quote (symbol-name fun))) nil t)
+				      (regexp-quote (symbol-name fun)))
+                              nil t)
 			     (forward-line 0)
 			   (message "Unable to find location in file")))
 		     (message "Unable to find file")))
@@ -385,6 +387,15 @@ it does not already exist."
        (error "Current buffer is not in Help mode"))
      (current-buffer))))
 
+(defvar describe-symbol-backends
+  `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
+    ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
+    (nil
+     ,(lambda (symbol)
+        (or (and (boundp symbol) (not (keywordp symbol)))
+            (get symbol 'variable-documentation)))
+     ,#'describe-variable)))
+
 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -487,28 +498,9 @@ that."
                             ;;       (pop-to-buffer (car location))
                             ;; 	(goto-char (cdr location))))
                             (help-xref-button 8 'help-function-def sym))
-                           ((and
+                           ((cl-some (lambda (x) (funcall (nth 1 x) sym))
-                             (facep sym)
+                                     describe-symbol-backends)
-                             (save-match-data (looking-at "[ \t\n]+face\\W")))
+                            (help-xref-button 8 'help-symbol sym)))))))
-                            (help-xref-button 8 'help-face sym))
-                           ((and (or (boundp sym)
-                                     (get sym 'variable-documentation))
-                                 (fboundp sym))
-                            ;; We can't intuit whether to use the
-                            ;; variable or function doc -- supply both.
-                            (help-xref-button 8 'help-symbol sym))
-                           ((and
-                             (or (boundp sym)
-                                 (get sym 'variable-documentation))
-                             (or
-                              (documentation-property
-                               sym 'variable-documentation)
-                              (documentation-property
-                               (indirect-variable sym)
-                               'variable-documentation)))
-                            (help-xref-button 8 'help-variable sym))
-                           ((fboundp sym)
-                            (help-xref-button 8 'help-function sym)))))))
                 ;; An obvious case of a key substitution:
                 (save-excursion
                   (while (re-search-forward