* 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.

1 files changed, 47 insertions, 66 deletions

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
 ;;