* lisp/emacs-lisp/eieio*.el: Fix up warnings and improve compatibility

Fixes: debbugs:19645

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
(cl--generic-setf-rewrite): Setup the setf expander right away.
(cl-defmethod): Make sure the setf expander is setup before we expand
the body.
(cl-defmethod): Silence byte-compiler warnings.
(cl-generic-define-method): Shuffle code to change return value.
(cl--generic-method-info): New function, extracted from
cl--generic-describe.
(cl--generic-describe): Use it.

* lisp/emacs-lisp/eieio-speedbar.el:
* lisp/emacs-lisp/eieio-datadebug.el:
* lisp/emacs-lisp/eieio-custom.el:
* lisp/emacs-lisp/eieio-base.el: Use cl-defmethod.

* lisp/emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
errors when there's a `before' but no `primary'.
(next-method-p): Return nil rather than signal an error.
(eieio-defgeneric): Remove bogus (fboundp 'method).

* lisp/emacs-lisp/eieio-opt.el: Adapt to cl-generic.
(eieio--specializers-apply-to-class-p):	New function.
(eieio-all-generic-functions): Use it.
(eieio-method-documentation): Use it as well as cl--generic-method-info.
Change format of return value.
(eieio-help-class): Adapt accordingly.

* lisp/emacs-lisp/eieio.el: Use cl-defmethod.
(defclass): Generate cl-defmethod calls; use setf methods for :accessor.
(eieio-object-name-string): Declare as obsolete.

* test/automated/cl-generic-tests.el (setf cl--generic-2): Make sure
the setf can be used already in the body of the method.

9 files changed, 260 insertions, 202 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 65c068425f9..d13bacfd965 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,36 @@
+2015-01-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/eieio.el: Use cl-defmethod.
+	(defclass): Generate cl-defmethod calls; use setf methods for :accessor.
+	(eieio-object-name-string): Declare as obsolete.
+
+	* emacs-lisp/eieio-opt.el: Adapt to cl-generic.
+	(eieio--specializers-apply-to-class-p):	New function.
+	(eieio-all-generic-functions): Use it.
+	(eieio-method-documentation): Use it as well as cl--generic-method-info.
+	Change format of return value.
+	(eieio-help-class): Adapt accordingly.
+
+	* emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
+	errors when there's a `before' but no `primary' (bug#19645).
+	(next-method-p): Return nil rather than signal an error.
+	(eieio-defgeneric): Remove bogus (fboundp 'method).
+
+	* emacs-lisp/eieio-speedbar.el:
+	* emacs-lisp/eieio-datadebug.el:
+	* emacs-lisp/eieio-custom.el:
+	* emacs-lisp/eieio-base.el: Use cl-defmethod.
+
+	* emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
+	(cl--generic-setf-rewrite): Setup the setf expander right away.
+	(cl-defmethod): Make sure the setf expander is setup before we expand
+	the body.
+	(cl-defmethod): Silence byte-compiler warnings.
+	(cl-generic-define-method): Shuffle code to change return value.
+	(cl--generic-method-info): New function, extracted from
+	cl--generic-describe.
+	(cl--generic-describe): Use it.
+
 2015-01-21  Dmitry Gutov  <dgutov@yandex.ru>
 
 	* progmodes/xref.el (xref--xref-buffer-mode-map): Define before
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 3bbddfc45a1..8dee9a38ab0 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -98,19 +98,20 @@ They should be sorted from most specific to least specific.")
                (:constructor cl--generic-make
                 (name &optional dispatches method-table))
                (:predicate nil))
-  (name nil :read-only t)               ;Pointer back to the symbol.
+  (name nil :type symbol :read-only t)  ;Pointer back to the symbol.
   ;; `dispatches' holds a list of (ARGNUM . TAGCODES) where ARGNUM is the index
   ;; of the corresponding argument and TAGCODES is a list of (PRIORITY . EXP)
   ;; where the EXPs are expressions (to be `or'd together) to compute the tag
   ;; on which to dispatch and PRIORITY is the priority of each expression to
   ;; decide in which order to sort them.
   ;; The most important dispatch is last in the list (and the least is first).
-  dispatches
+  (dispatches nil :type (list-of (cons natnum (list-of tagcode))))
   ;; `method-table' is a list of
   ;; ((SPECIALIZERS . QUALIFIER) USES-CNM . FUNCTION), where
   ;; USES-CNM is a boolean indicating if FUNCTION calls `cl-call-next-method'
   ;; (and hence expects an extra argument holding the next-method).
-  method-table)
+  (method-table nil :type (list-of (cons (cons (list-of type) keyword)
+                                         (cons boolean function)))))
 
 (defmacro cl--generic (name)
   `(get ,name 'cl--generic))
@@ -134,15 +135,16 @@ They should be sorted from most specific to least specific.")
     generic))
 
 (defun cl--generic-setf-rewrite (name)
-  (let ((setter (intern (format "cl-generic-setter--%s" name))))
-    (cons setter
-          `(eval-and-compile
-             (unless (eq ',setter (get ',name 'cl-generic-setter))
-               ;; (when (get ',name 'gv-expander)
-               ;;   (error "gv-expander conflicts with (setf %S)" ',name))
-               (setf (get ',name 'cl-generic-setter) ',setter)
-               (gv-define-setter ,name (val &rest args)
-                 (cons ',setter (cons val args))))))))
+  (let* ((setter (intern (format "cl-generic-setter--%s" name)))
+         (exp `(unless (eq ',setter (get ',name 'cl-generic-setter))
+                 ;; (when (get ',name 'gv-expander)
+                 ;;   (error "gv-expander conflicts with (setf %S)" ',name))
+                 (setf (get ',name 'cl-generic-setter) ',setter)
+                 (gv-define-setter ,name (val &rest args)
+                   (cons ',setter (cons val args))))))
+    ;; Make sure `setf' can be used right away, e.g. in the body of the method.
+    (eval exp t)
+    (cons setter exp)))
 
 ;;;###autoload
 (defmacro cl-defgeneric (name args &rest options-and-methods)
@@ -151,8 +153,9 @@ DOC-STRING is the base documentation for this class.  A generic
 function has no body, as its purpose is to decide which method body
 is appropriate to use.  Specific methods are defined with `cl-defmethod'.
 With this implementation the ARGS are currently ignored.
-OPTIONS-AND-METHODS is currently only used to specify the docstring,
-via (:documentation DOCSTRING)."
+OPTIONS-AND-METHODS currently understands:
+- (:documentation DOCSTRING)
+- (declare DECLARATIONS)"
   (declare (indent 2) (doc-string 3))
   (let* ((docprop (assq :documentation options-and-methods))
          (doc (cond ((stringp (car-safe options-and-methods))
@@ -161,13 +164,26 @@ via (:documentation DOCSTRING)."
                      (prog1
                          (cadr docprop)
                        (setq options-and-methods
-                             (delq docprop options-and-methods)))))))
+                             (delq docprop options-and-methods))))))
+         (declarations (assq 'declare options-and-methods)))
+    (when declarations
+      (setq options-and-methods
+            (delq declarations options-and-methods)))
     `(progn
        ,(when (eq 'setf (car-safe name))
           (pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite
                                            (cadr name))))
             (setq name setter)
             code))
+       ,@(mapcar (lambda (declaration)
+                   (let ((f (cdr (assq (car declaration)
+                                       defun-declarations-alist))))
+                     (cond
+                      (f (apply (car f) name args (cdr declaration)))
+                      (t (message "Warning: Unknown defun property `%S' in %S"
+                                  (car declaration) name)
+                         nil))))
+                 (cdr declarations))
        (defalias ',name
          (cl-generic-define ',name ',args ',options-and-methods)
          ,(help-add-fundoc-usage doc args)))))
@@ -292,18 +308,19 @@ which case this method will be invoked when the argument is `eql' to VAL.
              list                       ; arguments
              [ &optional stringp ]      ; documentation string
              def-body)))                ; part to be debugged
-  (let ((qualifiers nil))
+  (let ((qualifiers nil)
+        (setfizer (if (eq 'setf (car-safe name))
+                      ;; Call it before we call cl--generic-lambda.
+                      (cl--generic-setf-rewrite (cadr name)))))
     (while (keywordp args)
       (push args qualifiers)
       (setq args (pop body)))
     (pcase-let* ((with-cnm (not (memq (car qualifiers) '(:before :after))))
                  (`(,uses-cnm . ,fun) (cl--generic-lambda args body with-cnm)))
       `(progn
-         ,(when (eq 'setf (car-safe name))
-            (pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite
-                                             (cadr name))))
-              (setq name setter)
-              code))
+         ,(when setfizer
+            (setq name (car setfizer))
+            (cdr setfizer))
          ,(and (get name 'byte-obsolete-info)
                (or (not (fboundp 'byte-compile-warning-enabled-p))
                    (byte-compile-warning-enabled-p 'obsolete))
@@ -311,6 +328,11 @@ which case this method will be invoked when the argument is `eql' to VAL.
                  (macroexp--warn-and-return
                   (macroexp--obsolete-warning name obsolete "generic function")
                   nil)))
+         ;; You could argue that `defmethod' modifies rather than defines the
+         ;; function, so warnings like "not known to be defined" are fair game.
+         ;; But in practice, it's common to use `cl-defmethod'
+         ;; without a previous `cl-defgeneric'.
+         (declare-function ,name "")
          (cl-generic-define-method ',name ',qualifiers ',args
                                    ,uses-cnm ,fun)))))
 
@@ -344,14 +366,14 @@ which case this method will be invoked when the argument is `eql' to VAL.
     (if me (setcdr me (cons uses-cnm function))
       (setf (cl--generic-method-table generic)
             (cons `(,key ,uses-cnm . ,function) mt)))
-    ;; For aliases, cl--generic-name gives us the actual name.
+    (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
+                current-load-list :test #'equal)
     (let ((gfun (cl--generic-make-function generic))
           ;; Prevent `defalias' from recording this as the definition site of
           ;; the generic function.
           current-load-list)
-      (defalias (cl--generic-name generic) gfun))
-    (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
-                current-load-list :test #'equal)))
+      ;; For aliases, cl--generic-name gives us the actual name.
+      (defalias (cl--generic-name generic) gfun))))
 
 (defmacro cl--generic-with-memoization (place &rest code)
   (declare (indent 1) (debug t))
@@ -448,8 +470,12 @@ for all those different tags in the method-cache.")
                       ;; We don't currently have "method objects" like CLOS
                       ;; does so we can't really do it the CLOS way.
                       ;; The closest would be to pass the lambda corresponding
-                      ;; to the method, but the caller wouldn't be able to do
-                      ;; much with it anyway.  So we pass nil for now.
+                      ;; to the method, or maybe the ((SPECIALIZERS
+                      ;; . QUALIFIER) USE-CNM . FUNCTION) entry from the method
+                      ;; table, but the caller wouldn't be able to do much with
+                      ;; it anyway.  So we pass nil for now.
+                      ;; FIXME: signal `no-primary-method' if there's
+                      ;; no primary.
                       (apply #'cl-no-next-method generic-name nil args)))
                ;; We use `cdr' to drop the `uses-cnm' annotations.
                (before
@@ -566,6 +592,24 @@ Can only be used from within the lexical body of a primary or around method."
   (add-to-list 'find-function-regexp-alist
                `(cl-defmethod . ,#'cl--generic-search-method)))
 
+(defun cl--generic-method-info (method)
+  (pcase-let ((`((,specializers . ,qualifier) ,uses-cnm . ,function) method))
+    (let* ((args (help-function-arglist function 'names))
+           (docstring (documentation function))
+           (doconly (if docstring
+                        (let ((split (help-split-fundoc docstring nil)))
+                          (if split (cdr split) docstring))))
+           (combined-args ()))
+      (if uses-cnm (setq args (cdr args)))
+      (dolist (specializer specializers)
+        (let ((arg (if (eq '&rest (car args))
+                       (intern (format "arg%d" (length combined-args)))
+                     (pop args))))
+          (push (if (eq specializer t) arg (list arg specializer))
+                combined-args)))
+      (setq combined-args (append (nreverse combined-args) args))
+      (list qualifier combined-args doconly))))
+
 (add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
 (defun cl--generic-describe (function)
   (let ((generic (if (symbolp function) (cl--generic function))))
@@ -575,25 +619,11 @@ Can only be used from within the lexical body of a primary or around method."
         (insert "\n\nThis is a generic function.\n\n")
         (insert (propertize "Implementations:\n\n" 'face 'bold))
         ;; Loop over fanciful generics
-        (pcase-dolist (`((,specializers . ,qualifier) ,uses-cnm . ,method)
-                       (cl--generic-method-table generic))
-          (let* ((args (help-function-arglist method 'names))
-                 (docstring (documentation method))
-                 (doconly (if docstring
-                              (let ((split (help-split-fundoc docstring nil)))
-                                (if split (cdr split) docstring))))
-                 (combined-args ()))
-            (if uses-cnm (setq args (cdr args)))
-            (dolist (specializer specializers)
-              (let ((arg (if (eq '&rest (car args))
-                             (intern (format "arg%d" (length combined-args)))
-                           (pop args))))
-                (push (if (eq specializer t) arg (list arg specializer))
-                      combined-args)))
-            (setq combined-args (append (nreverse combined-args) args))
+        (dolist (method (cl--generic-method-table generic))
+          (let* ((info (cl--generic-method-info method)))
             ;; FIXME: Add hyperlinks for the types as well.
-            (insert (format "%S %S" qualifier combined-args))
-            (let* ((met-name (cons function specializers))
+            (insert (format "%S %S" (nth 0 info) (nth 1 info)))
+            (let* ((met-name (cons function (caar method)))
                    (file (find-lisp-object-file-name met-name 'cl-defmethod)))
               (when file
                 (insert " in `")
@@ -601,7 +631,7 @@ Can only be used from within the lexical body of a primary or around method."
                                          'help-function-def met-name file
                                          'cl-defmethod)
                 (insert "'.\n")))
-            (insert "\n" (or doconly "Undocumented") "\n\n")))))))
+            (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
 
 ;;; Support for (eql <val>) specializers.
 
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 9931fbd114e..feb06711cb3 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -52,7 +52,7 @@ a parent instance.  When a slot in the child is referenced, and has
 not been set, use values from the parent."
   :abstract t)
 
-(defmethod slot-unbound ((object eieio-instance-inheritor)
+(cl-defmethod slot-unbound ((object eieio-instance-inheritor)
                          _class slot-name _fn)
   "If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal.
 SLOT-NAME is the offending slot.  FN is the function signaling the error."
@@ -61,16 +61,16 @@ SLOT-NAME is the offending slot.  FN is the function signaling the error."
       ;; method if the parent instance's slot is unbound.
       (eieio-oref (oref object parent-instance) slot-name)
     ;; Throw the regular signal.
-    (call-next-method)))
+    (cl-call-next-method)))
 
-(defmethod clone ((obj eieio-instance-inheritor) &rest _params)
+(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params)
   "Clone OBJ, initializing `:parent' to OBJ.
 All slots are unbound, except those initialized with PARAMS."
-  (let ((nobj (call-next-method)))
+  (let ((nobj (cl-call-next-method)))
     (oset nobj parent-instance obj)
     nobj))
 
-(defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor)
+(cl-defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor)
 						slot)
   "Return non-nil if the instance inheritor OBJECT's SLOT is bound.
 See `slot-boundp' for details on binding slots.
@@ -103,7 +103,7 @@ Inheritors from this class must overload `tracking-symbol' which is
 a variable symbol used to store a list of all instances."
   :abstract t)
 
-(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
+(cl-defmethod initialize-instance :after ((this eieio-instance-tracker)
 				       &rest _slots)
   "Make sure THIS is in our master list of this class.
 Optional argument SLOTS are the initialization arguments."
@@ -112,7 +112,7 @@ Optional argument SLOTS are the initialization arguments."
     (if (not (memq this (symbol-value sym)))
 	(set sym (append (symbol-value sym) (list this))))))
 
-(defmethod delete-instance ((this eieio-instance-tracker))
+(cl-defmethod delete-instance ((this eieio-instance-tracker))
   "Remove THIS from the master list of this class."
   (set (oref this tracking-symbol)
        (delq this (symbol-value (oref this tracking-symbol)))))
@@ -140,7 +140,7 @@ Multiple calls to `make-instance' will return this object."))
 A singleton is a class which will only ever have one instance."
   :abstract t)
 
-(defmethod eieio-constructor :STATIC ((class eieio-singleton) &rest _slots)
+(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest _slots)
   "Constructor for singleton CLASS.
 NAME and SLOTS initialize the new object.
 This constructor guarantees that no matter how many you request,
@@ -149,7 +149,7 @@ only one object ever exists."
   ;; with class allocated slots or default values.
   (let ((old (oref-default class singleton)))
     (if (eq old eieio-unbound)
-	(oset-default class singleton (call-next-method))
+	(oset-default class singleton (cl-call-next-method))
       old)))
 
 
@@ -198,7 +198,7 @@ object.  For this reason, only slots which do not have an `:initarg'
 specified will not be saved."
   :abstract t)
 
-(defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
+(cl-defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
 					      &optional name)
   "Prepare to save THIS.  Use in an `interactive' statement.
 Query user for file name with PROMPT if THIS does not yet specify
@@ -417,17 +417,17 @@ If no class is referenced there, then return nil."
 	 ;; No match, not a class.
 	 nil)))
 
-(defmethod object-write ((this eieio-persistent) &optional comment)
+(cl-defmethod object-write ((this eieio-persistent) &optional comment)
   "Write persistent object THIS out to the current stream.
 Optional argument COMMENT is a header line comment."
-  (call-next-method this (or comment (oref this file-header-line))))
+  (cl-call-next-method this (or comment (oref this file-header-line))))
 
-(defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
+(cl-defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
   "For object THIS, make absolute file name FILE relative."
   (file-relative-name (expand-file-name file)
 		      (file-name-directory (oref this file))))
 
-(defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
+(cl-defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
   "Save persistent object THIS to disk.
 Optional argument FILE overrides the file name specified in the object
 instance."
@@ -474,21 +474,21 @@ instance."
   "Object with a name."
   :abstract t)
 
-(defmethod eieio-object-name-string ((obj eieio-named))
+(cl-defmethod eieio-object-name-string ((obj eieio-named))
   "Return a string which is OBJ's name."
   (or (slot-value obj 'object-name)
       (symbol-name (eieio-object-class obj))))
 
-(defmethod eieio-object-set-name-string ((obj eieio-named) name)
+(cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
   "Set the string which is OBJ's NAME."
   (eieio--check-type stringp name)
   (eieio-oset obj 'object-name name))
 
-(defmethod clone ((obj eieio-named) &rest params)
+(cl-defmethod clone ((obj eieio-named) &rest params)
   "Clone OBJ, initializing `:parent' to OBJ.
 All slots are unbound, except those initialized with PARAMS."
   (let* ((newname (and (stringp (car params)) (pop params)))
-         (nobj (apply #'call-next-method obj params))
+         (nobj (apply #'cl-call-next-method obj params))
          (nm (slot-value obj 'object-name)))
     (eieio-oset obj 'object-name
                 (or newname
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 34c06c01763..c2dabf7f446 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -190,13 +190,27 @@ Summary:
                                 (if split (cdr split) docstring))))
                 (new-docstring (help-add-fundoc-usage doc-only
                                                       (cons 'cl-cnm args))))
-           ;; FIXME: ¡Add the new-docstring to those closures!
+           ;; FIXME: ¡Add new-docstring to those closures!
            (lambda (cnm &rest args)
              (cl-letf (((symbol-function 'call-next-method) cnm)
                        ((symbol-function 'next-method-p)
                         (lambda () (cl--generic-isnot-nnm-p cnm))))
                (apply code args))))
-       code))))
+       code))
+    ;; The old EIEIO code did not signal an error when there are methods
+    ;; applicable but only of the before/after kind.  So if we add a :before
+    ;; or :after, make sure there's a matching dummy primary.
+    (when (and (memq kind '(:before :after))
+               (not (assoc (cons (mapcar (lambda (arg)
+                                           (if (consp arg) (nth 1 arg) t))
+                                         specializers)
+                                 :primary)
+                           (cl--generic-method-table (cl--generic method)))))
+      (cl-generic-define-method method () specializers t
+                                (lambda (cnm &rest args)
+                                  (if (cl--generic-isnot-nnm-p cnm)
+                                      (apply cnm args)))))
+    method))
 
 ;; Compatibility with code which tries to catch `no-method-definition' errors.
 (push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions))
@@ -212,7 +226,12 @@ Summary:
   (apply #'cl-no-applicable-method method object args))
 
 (define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
-(define-obsolete-function-alias 'next-method-p 'cl-next-method-p "25.1")
+(defun next-method-p ()
+  (declare (obsolete cl-next-method-p "25.1"))
+  ;; EIEIO's `next-method-p' just returned nil when called in an
+  ;; invalid context.
+  (message "next-method-p called outside of a primary or around method")
+  nil)
 
 ;;;###autoload
 (defun eieio-defmethod (method args)
@@ -225,11 +244,9 @@ Summary:
 (defun eieio-defgeneric (method doc-string)
   "Obsolete work part of an old version of the `defgeneric' macro."
   (declare (obsolete cl-defgeneric "24.1"))
-  ;; Don't do this over and over.
-  (unless (fboundp 'method)
-    (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
-    ;; Return the method
-    'method))
+  (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
+  ;; Return the method
+  'method)
 
 ;;;###autoload
 (defun eieio-defclass (cname superclasses slots options)
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 8ab74ae3352..0e0b31e4e7e 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -322,7 +322,7 @@ Optional argument IGNORE is an extraneous parameter."
     ;; This is the same object we had before.
     obj))
 
-(defmethod eieio-done-customizing ((_obj eieio-default-superclass))
+(cl-defmethod eieio-done-customizing ((_obj eieio-default-superclass))
   "When applying change to a widget, call this method.
 This method is called by the default widget-edit commands.
 User made commands should also call this method when applying changes.
@@ -345,7 +345,7 @@ Optional argument GROUP is the sub-group of slots to display."
   "Major mode for customizing EIEIO objects.
 \\{eieio-custom-mode-map}")
 
-(defmethod eieio-customize-object ((obj eieio-default-superclass)
+(cl-defmethod eieio-customize-object ((obj eieio-default-superclass)
 				   &optional group)
   "Customize OBJ in a specialized custom buffer.
 To override call the `eieio-custom-widget-insert' to just insert the
@@ -386,7 +386,7 @@ These groups are specified with the `:group' slot flag."
     (make-local-variable 'eieio-cog)
     (setq eieio-cog g)))
 
-(defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
+(cl-defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
   "Insert an Apply and Reset button into the object editor.
 Argument OBJ is the object being customized."
   (widget-create 'push-button
@@ -417,7 +417,7 @@ Argument OBJ is the object being customized."
 			   (bury-buffer))
 		 "Cancel"))
 
-(defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
+(cl-defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
 				       &rest flags)
   "Insert the widget used for editing object OBJ in the current buffer.
 Arguments FLAGS are widget compatible flags.
@@ -446,7 +446,7 @@ Must return the created widget."
 ;; These functions provide the ability to create dynamic menus to
 ;; customize specific sections of an object.  They do not hook directly
 ;; into a filter, but can be used to create easymenu vectors.
-(defmethod eieio-customize-object-group ((obj eieio-default-superclass))
+(cl-defmethod eieio-customize-object-group ((obj eieio-default-superclass))
   "Create a list of vectors for customizing sections of OBJ."
   (mapcar (lambda (group)
 	    (vector (concat "Group " (symbol-name group))
@@ -457,7 +457,7 @@ Must return the created widget."
 (defvar eieio-read-custom-group-history nil
   "History for the custom group reader.")
 
-(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
+(cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass))
   "Do a completing read on the name of a customization group in OBJ.
 Return the symbol for the group, or nil"
   (let ((g (eieio--class-option (eieio--object-class-object obj)
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index ab8d41e4ac4..6534bd0fecf 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -79,7 +79,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 ;;
 ;; Each object should have an opportunity to show stuff about itself.
 
-(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
+(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
 					  prefix)
   "Insert the slots of OBJ into the current DDEBUG buffer."
   (let ((inhibit-read-only t))
@@ -124,7 +124,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 ;;
 ;; A generic function to run DDEBUG on an object and popup a new buffer.
 ;;
-(defmethod data-debug-show ((obj eieio-default-superclass))
+(cl-defmethod data-debug-show ((obj eieio-default-superclass))
   "Run ddebug against any EIEIO object OBJ."
   (data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
   (data-debug-insert-object-slots obj "]"))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 13ad120a9b5..a131b02ee16 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -122,29 +122,18 @@ If CLASS is actually an object, then also display current values of that object.
   ;; Describe all the slots in this class.
   (eieio-help-class-slots class)
   ;; Describe all the methods specific to this class.
-  (let ((methods (eieio-all-generic-functions class))
-	(type [":STATIC" ":BEFORE" ":PRIMARY" ":AFTER"])
-	counter doc)
-    (when methods
+  (let ((generics (eieio-all-generic-functions class)))
+    (when generics
       (insert (propertize "Specialized Methods:\n\n" 'face 'bold))
-      (while methods
-	(setq doc (eieio-method-documentation (car methods) class))
-	(insert "`")
-	(help-insert-xref-button (symbol-name (car methods))
-				 'help-function (car methods))
-	(insert "'")
-	(if (not doc)
-	    (insert "  Undocumented")
-	  (setq counter 0)
-	  (dolist (cur doc)
-	    (when cur
-	      (insert " " (aref type counter) " "
-		      (prin1-to-string (car cur) (current-buffer))
-		      "\n"
-		      (or (cdr cur) "")))
-	    (setq counter (1+ counter))))
-	(insert "\n\n")
-	(setq methods (cdr methods))))))
+      (dolist (generic generics)
+        (insert "`")
+        (help-insert-xref-button (symbol-name generic) 'help-function generic)
+        (insert "'")
+	(pcase-dolist (`(,qualifier ,args ,doc)
+                       (eieio-method-documentation generic class))
+          (insert (format " %S %S\n" qualifier args)
+                  (or doc "")))
+	(insert "\n\n")))))
 
 (defun eieio-help-class-slots (class)
   "Print help description for the slots in CLASS.
@@ -311,6 +300,20 @@ 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 (eq 'subclass (car-safe specializer))
+          (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
@@ -318,53 +321,31 @@ methods for CLASS."
   (let ((l nil))
     (mapatoms
      (lambda (symbol)
-       (let ((tree (get symbol 'eieio-method-hashtable)))
-         (when tree
-           ;; A symbol might be interned for that class in one of
-           ;; these three slots in the method-obarray.
-           (if (or (not class)
-                   (car (gethash class (aref tree 0)))
-                   (car (gethash class (aref tree 1)))
-                   (car (gethash class (aref tree 2))))
-               (setq l (cons symbol l)))))))
+       (let ((generic (and (fboundp symbol) (cl--generic symbol))))
+         (and generic
+	      (catch 'found
+		(if (null class) (throw 'found t))
+		(pcase-dolist (`((,specializers . ,_qualifier) . ,_)
+			       (cl--generic-method-table generic))
+		  (if (eieio--specializers-apply-to-class-p
+		       specializers class)
+		      (throw 'found t))))
+	      (push symbol l)))))
     l))
 
 (defun eieio-method-documentation (generic class)
-  "Return a list of the specific documentation of GENERIC for CLASS.
-If there is not an explicit method for CLASS in GENERIC, or if that
-function has no documentation, then return nil."
-  (let ((tree (get generic 'eieio-method-hashtable)))
-    (when tree
-      ;; A symbol might be interned for that class in one of
-      ;; these three slots in the method-hashtable.
-      ;; FIXME: Where do these 0/1/2 come from?  Isn't 0 for :static,
-      ;; 1 for before, and 2 for primary (and 3 for after)?
-      (let ((before  (car (gethash class (aref tree 0))))
-	    (primary (car (gethash class (aref tree 1))))
-	    (after   (car (gethash class (aref tree 2)))))
-        (if (not (or before primary after))
-            nil
-          (list (if before
-                    (cons (help-function-arglist before)
-                          (documentation before))
-                  nil)
-                (if primary
-                    (cons (help-function-arglist primary)
-                          (documentation primary))
-                  nil)
-                (if after
-                    (cons (help-function-arglist after)
-                          (documentation after))
-                  nil)))))))
-
-(defvar eieio-read-generic nil
-  "History of the `eieio-read-generic' prompt.")
-
-(defun eieio-read-generic (prompt &optional historyvar)
-  "Read a generic function from the minibuffer with PROMPT.
-Optional argument HISTORYVAR is the variable to use as history."
-  (intern (completing-read prompt obarray #'generic-p
-			   t nil (or historyvar 'eieio-read-generic))))
+  "Return info for all methods of GENERIC applicable to CLASS.
+The value returned is a list of elements of the form
+\(QUALIFIER ARGS DOC)."
+  (let ((generic (cl--generic generic))
+        (docs ()))
+    (when generic
+      (dolist (method (cl--generic-method-table generic))
+        (pcase-let ((`((,specializers . ,_qualifier) . ,_) method))
+          (when (eieio--specializers-apply-to-class-p
+                 specializers class)
+            (push (cl--generic-method-info method) docs)))))
+    docs))
 
 ;;; METHOD STATS
 ;;
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index b236f0f03e1..a1eabcf9700 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -196,19 +196,19 @@ that path."
 ;; when no other methods are found, allowing multiple inheritance to work
 ;; reliably with eieio-speedbar.
 
-(defmethod eieio-speedbar-description (object)
+(cl-defmethod eieio-speedbar-description (object)
   "Return a string describing OBJECT."
   (eieio-object-name-string object))
 
-(defmethod eieio-speedbar-derive-line-path (_object)
+(cl-defmethod eieio-speedbar-derive-line-path (_object)
   "Return the path which OBJECT has something to do with."
   nil)
 
-(defmethod eieio-speedbar-object-buttonname (object)
+(cl-defmethod eieio-speedbar-object-buttonname (object)
   "Return a string to use as a speedbar button for OBJECT."
   (eieio-object-name-string object))
 
-(defmethod eieio-speedbar-make-tag-line (object depth)
+(cl-defmethod eieio-speedbar-make-tag-line (object depth)
   "Insert a tag line into speedbar at point for OBJECT.
 By default, all objects appear as simple TAGS with no need to inherit from
 the special `eieio-speedbar' classes.  Child classes should redefine this
@@ -221,7 +221,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
 			  'speedbar-tag-face
 			  depth))
 
-(defmethod eieio-speedbar-handle-click (object)
+(cl-defmethod eieio-speedbar-handle-click (object)
   "Handle a click action on OBJECT in speedbar.
 Any object can be represented as a tag in SPEEDBAR without special
 attributes.  These default objects will be pulled up in a custom
@@ -285,7 +285,7 @@ Add one of the child classes to this class to the parent list of a class."
 
 ;;; Methods to eieio-speedbar-* which do not need to be overridden
 ;;
-(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
+(cl-defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
 					 depth)
   "Insert a tag line into speedbar at point for OBJECT.
 All objects a child of symbol `eieio-speedbar' can be created from
@@ -321,12 +321,12 @@ Argument DEPTH is the depth at which the tag line is inserted."
       (if exp
 	  (eieio-speedbar-expand object (1+ depth))))))
 
-(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
+(cl-defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
   "Base method for creating tag lines for non-object children."
   (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
 	 (eieio-object-name object)))
 
-(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
+(cl-defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
   "Expand OBJECT at indentation DEPTH.
 Inserts a list of new tag lines representing expanded elements within
 OBJECT."
@@ -362,7 +362,7 @@ TOKEN is the object.  INDENT is the current indentation level."
 	(t (error "Ooops... not sure what to do")))
   (speedbar-center-buffer-smartly))
 
-(defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
+(cl-defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
   "Return a description for a child of OBJ which is not an object."
   (error "You must implement `eieio-speedbar-child-description' for %s"
 	 (eieio-object-name obj)))
@@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at."
 
 ;;; Methods to the eieio-speedbar-* classes which need to be overridden.
 ;;
-(defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
+(cl-defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
   "Return a list of children to be displayed in speedbar.
 If the return value is a list of OBJECTs, then those objects are
 queried for details.  If the return list is made of strings,
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index b64eba1de1f..7672d7f0b6e 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -179,36 +179,31 @@ and reference them using the function `class-option'."
 	;; of the specified name, and also performs a `defsetf' if applicable
 	;; so that users can `setf' the space returned by this function.
 	(when acces
-          ;; FIXME: The defmethod below only defines a part of the generic
-          ;; function (good), but the define-setter below affects the whole
-          ;; generic function (bad)!
-          (push `(gv-define-setter ,acces (store object)
-                   ;; Apparently, eieio-oset-default doesn't work like
-                   ;;  oref-default and only accept class arguments!
-                   (list ',(if nil ;; (eq alloc :class)
-                               'eieio-oset-default
-                             'eieio-oset)
-                         object '',sname store))
+          (push `(cl-defmethod (setf ,acces) (value (this ,name))
+                   (eieio-oset this ',sname value))
                 accessors)
-          (push `(defmethod ,acces ,(if (eq alloc :class) :static :primary)
-                   ((this ,name))
+          (push `(cl-defmethod ,acces ((this ,name))
                    ,(format
                      "Retrieve the slot `%S' from an object of class `%S'."
                      sname name)
-                   (if (slot-boundp this ',sname)
-                       ;; Use oref-default for :class allocated slots, since
-                       ;; these also accept the use of a class argument instead
-                       ;; of an object argument.
-                       (,(if (eq alloc :class) 'eieio-oref-default 'eieio-oref)
-                        this ',sname)
-                     ;; Else - Some error?  nil?
-                     nil))
-                accessors))
+                   ;; FIXME: Why is this different from the :reader case?
+                   (if (slot-boundp this ',sname) (eieio-oref this ',sname)))
+                accessors)
+          (when (and eieio-backward-compatibility (eq alloc :class))
+            ;; FIXME: How could I declare this *method* as obsolete.
+            (push `(cl-defmethod ,acces ((this (subclass ,name)))
+                     ,(format
+                       "Retrieve the class slot `%S' from a class `%S'.
+This method is obsolete."
+                       sname name)
+                     (if (slot-boundp this ',sname)
+                         (eieio-oref-default this ',sname)))
+                  accessors)))
 
 	;; If a writer is defined, then create a generic method of that
 	;; name whose purpose is to set the value of the slot.
 	(if writer
-            (push `(defmethod ,writer ((this ,name) value)
+            (push `(cl-defmethod ,writer ((this ,name) value)
                      ,(format "Set the slot `%S' of an object of class `%S'."
                               sname name)
                      (setf (slot-value this ',sname) value))
@@ -216,7 +211,7 @@ and reference them using the function `class-option'."
 	;; If a reader is defined, then create a generic method
 	;; of that name whose purpose is to access this slot value.
 	(if reader
-            (push `(defmethod ,reader ((this ,name))
+            (push `(cl-defmethod ,reader ((this ,name))
                      ,(format "Access the slot `%S' from object of class `%S'."
                               sname name)
                      (slot-value this ',sname))
@@ -372,6 +367,10 @@ variable name of the same name as the slot."
 (define-obsolete-function-alias
   'object-class-fast #'eieio--object-class-name "24.4")
 
+(cl-defgeneric eieio-object-name-string (obj)
+  "Return a string which is OBJ's name."
+  (declare (obsolete eieio-named "25.1")))
+
 (defun eieio-object-name (obj &optional extra)
   "Return a Lisp like symbol string for object OBJ.
 If EXTRA, include that in the string returned to represent the symbol."
@@ -386,15 +385,13 @@ If EXTRA, include that in the string returned to represent the symbol."
 ;; below "for free".  Since this field is very rarely used, we got rid of it
 ;; and instead we keep it in a weak hash-tables, for those very rare objects
 ;; that use it.
-(defmethod eieio-object-name-string (obj)
-  "Return a string which is OBJ's name."
-  (declare (obsolete eieio-named "25.1"))
+(cl-defmethod eieio-object-name-string (obj)
   (or (gethash obj eieio--object-names)
       (symbol-name (eieio-object-class obj))))
 (define-obsolete-function-alias
   'object-name-string #'eieio-object-name-string "24.4")
 
-(defmethod eieio-object-set-name-string (obj name)
+(cl-defmethod eieio-object-set-name-string (obj name)
   "Set the string which is OBJ's NAME."
   (declare (obsolete eieio-named "25.1"))
   (eieio--check-type stringp name)
@@ -648,13 +645,13 @@ This class is not stored in the `parent' slot of a class vector."
 
 (defalias 'standard-class 'eieio-default-superclass)
 
-(defgeneric eieio-constructor (class &rest slots)
+(cl-defgeneric eieio-constructor (class &rest slots)
   "Default constructor for CLASS `eieio-default-superclass'.")
 
 (define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
 
-(defmethod eieio-constructor :static
-  ((class eieio-default-superclass) &rest slots)
+(cl-defmethod eieio-constructor
+  ((class (subclass eieio-default-superclass)) &rest slots)
   "Default constructor for CLASS `eieio-default-superclass'.
 SLOTS are the initialization slots used by `shared-initialize'.
 This static method is called when an object is constructed.
@@ -674,11 +671,11 @@ calls `shared-initialize' on that object."
     ;; Return the created object.
     new-object))
 
-(defgeneric shared-initialize (obj slots)
+(cl-defgeneric shared-initialize (obj slots)
   "Set slots of OBJ with SLOTS which is a list of name/value pairs.
 Called from the constructor routine.")
 
-(defmethod shared-initialize ((obj eieio-default-superclass) slots)
+(cl-defmethod shared-initialize ((obj eieio-default-superclass) slots)
   "Set slots of OBJ with SLOTS which is a list of name/value pairs.
 Called from the constructor routine."
   (while slots
@@ -689,10 +686,10 @@ Called from the constructor routine."
         (eieio-oset obj rn (car (cdr slots)))))
     (setq slots (cdr (cdr slots)))))
 
-(defgeneric initialize-instance (this &optional slots)
+(cl-defgeneric initialize-instance (this &optional slots)
   "Construct the new object THIS based on SLOTS.")
 
-(defmethod initialize-instance ((this eieio-default-superclass)
+(cl-defmethod initialize-instance ((this eieio-default-superclass)
 				&optional slots)
   "Construct the new object THIS based on SLOTS.
 SLOTS is a tagged list where odd numbered elements are tags, and
@@ -724,10 +721,10 @@ dynamically set from SLOTS."
   ;; Shared initialize will parse our slots for us.
   (shared-initialize this slots))
 
-(defgeneric slot-missing (object slot-name operation &optional new-value)
+(cl-defgeneric slot-missing (object slot-name operation &optional new-value)
   "Method invoked when an attempt to access a slot in OBJECT fails.")
 
-(defmethod slot-missing ((object eieio-default-superclass) slot-name
+(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name
 			 _operation &optional _new-value)
   "Method invoked when an attempt to access a slot in OBJECT fails.
 SLOT-NAME is the name of the failed slot, OPERATION is the type of access
@@ -739,10 +736,10 @@ directly reference slots in EIEIO objects."
   (signal 'invalid-slot-name (list (eieio-object-name object)
 				   slot-name)))
 
-(defgeneric slot-unbound (object class slot-name fn)
+(cl-defgeneric slot-unbound (object class slot-name fn)
   "Slot unbound is invoked during an attempt to reference an unbound slot.")
 
-(defmethod slot-unbound ((object eieio-default-superclass)
+(cl-defmethod slot-unbound ((object eieio-default-superclass)
 			 class slot-name fn)
   "Slot unbound is invoked during an attempt to reference an unbound slot.
 OBJECT is the instance of the object being reference.  CLASS is the
@@ -757,14 +754,14 @@ EIEIO can only dispatch on the first argument, so the first two are swapped."
   (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object)
 			      slot-name fn)))
 
-(defgeneric clone (obj &rest params)
+(cl-defgeneric clone (obj &rest params)
   "Make a copy of OBJ, and then supply PARAMS.
 PARAMS is a parameter list of the same form used by `initialize-instance'.
 
 When overloading `clone', be sure to call `call-next-method'
 first and modify the returned object.")
 
-(defmethod clone ((obj eieio-default-superclass) &rest params)
+(cl-defmethod clone ((obj eieio-default-superclass) &rest params)
   "Make a copy of OBJ, and then apply PARAMS."
   (let ((nobj (copy-sequence obj)))
     (if (stringp (car params))
@@ -773,24 +770,24 @@ first and modify the returned object.")
     (if params (shared-initialize nobj params))
     nobj))
 
-(defgeneric destructor (this &rest params)
+(cl-defgeneric destructor (this &rest params)
   "Destructor for cleaning up any dynamic links to our object.")
 
-(defmethod destructor ((_this eieio-default-superclass) &rest _params)
+(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params)
   "Destructor for cleaning up any dynamic links to our object.
 Argument THIS is the object being destroyed.  PARAMS are additional
 ignored parameters."
   ;; No cleanup... yet.
   )
 
-(defgeneric object-print (this &rest strings)
+(cl-defgeneric object-print (this &rest strings)
   "Pretty printer for object THIS.  Call function `object-name' with STRINGS.
 
 It is sometimes useful to put a summary of the object into the
 default #<notation> string when using EIEIO browsing tools.
 Implement this method to customize the summary.")
 
-(defmethod object-print ((this eieio-default-superclass) &rest strings)
+(cl-defmethod object-print ((this eieio-default-superclass) &rest strings)
   "Pretty printer for object THIS.  Call function `object-name' with STRINGS.
 The default method for printing object THIS is to use the
 function `object-name'.
@@ -807,11 +804,11 @@ to prepend a space."
 (defvar eieio-print-depth 0
   "When printing, keep track of the current indentation depth.")
 
-(defgeneric object-write (this &optional comment)
+(cl-defgeneric object-write (this &optional comment)
   "Write out object THIS to the current stream.
 Optional COMMENT will add comments to the beginning of the output.")
 
-(defmethod object-write ((this eieio-default-superclass) &optional comment)
+(cl-defmethod object-write ((this eieio-default-superclass) &optional comment)
   "Write object THIS out to the current stream.
 This writes out the vector version of this object.  Complex and recursive
 object are discouraged from being written.