* lisp/emacs-lisp/eieio*.el: Move the function defs to defclass.

* lisp/emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
that creates functions, and most of the sanity checks.
Mark as obsolete the <class>-child-p function.
* lisp/emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
(eieio--class, eieio--object): Use cl-defstruct.
(eieio--object-num-slots): Define manually.
(eieio-defclass-autoload): Use eieio--class-make.
(eieio-defclass-internal): Rename from eieio-defclass.  Move all the
`(lambda...) definitions and most of the sanity checks to `defclass'.
Mark as obsolete the <class>-list-p function, the <class> variable and
the <initarg> variables.  Use pcase-dolist.
(eieio-defclass): New compatibility function.
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-class-speedbar): Don't use eieio-default-superclass var.

5 files changed, 301 insertions, 272 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 14a91768680..0f20be86b9b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1,6 +1,6 @@
 GNU Emacs NEWS -- history of user-visible changes.
 
-Copyright (C) 2014 Free Software Foundation, Inc.
+Copyright (C) 2014, 2015 Free Software Foundation, Inc.
 See the end of the file for license conditions.
 
 Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
@@ -187,6 +187,11 @@ Unicode standards.
 
 
 * Changes in Specialized Modes and Packages in Emacs 25.1
+
+** EIEIO
+*** The <class>-list-p and <class>-child-p functions are declared obsolete.
+*** The <class> variables are declared obsolete.
+*** The <initarg> variables are declared obsolete.
 ** ido
 *** New command `ido-bury-buffer-at-head' bound to C-S-b
 Bury the buffer at the head of `ido-matches', analogous to how C-k
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 66b3b8eb061..6d7bfae31ce 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,9 +1,27 @@
 2015-01-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
+        that creates functions, and most of the sanity checks.
+        Mark as obsolete the <class>-child-p function.
+        * emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
+        (eieio--class, eieio--object): Use cl-defstruct.
+        (eieio--object-num-slots): Define manually.
+        (eieio-defclass-autoload): Use eieio--class-make.
+        (eieio-defclass-internal): Rename from eieio-defclass.  Move all the
+        `(lambda...) definitions and most of the sanity checks to `defclass'.
+        Mark as obsolete the <class>-list-p function, the <class> variable and
+        the <initarg> variables.  Use pcase-dolist.
+        (eieio-defclass): New compatibility function.
+        * emacs-lisp/eieio-opt.el (eieio-build-class-alist)
+        (eieio-class-speedbar): Don't use eieio-default-superclass var.
+
+2015-01-08  Stefan Monnier  <monnier@iro.umontreal.ca>
+
         * emacs-lisp/eieio-generic.el: New file.
         * emacs-lisp/eieio-core.el: Move all generic function code to
         eieio-generic.el.
         (eieio--defmethod): Declare.
+
         * emacs-lisp/eieio.el: Require eieio-generic.  Move all generic
         function code to eieio-generic.el.
         * emacs-lisp/eieio-opt.el (eieio-help-generic): Move to
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index fba4d8f50c7..dc2c873eb42 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'pcase)
 
 (put 'eieio--defalias 'byte-hunk-handler
      #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
@@ -117,66 +118,70 @@ Currently under control of this var:
   `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack)))
      ,@forms))
 
-;;;
-;; Field Accessors
-;;
-(defmacro eieio--define-field-accessors (prefix fields)
-  (declare (indent 1))
-  (let ((index 0)
-        (defs '()))
-    (dolist (field fields)
-      (let ((doc (if (listp field)
-                     (prog1 (cadr field) (setq field (car field))))))
-        (push `(defmacro ,(intern (format "eieio--%s-%s" prefix field)) (x)
-                 ,@(if doc (list (format (if (string-match "\n" doc)
-                                             "Return %s" "Return %s of a %s.")
-                                         doc prefix)))
-                 (list 'aref x ,index))
-              defs)
-        (setq index (1+ index))))
-    `(eval-and-compile
-       ,@(nreverse defs)
-       (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index))))
-
-(eieio--define-field-accessors class
-  (-unused-0 ;;Constant slot, set to `defclass'.
-   (symbol "symbol (self-referencing)")
-   parent children
-   (symbol-hashtable "hashtable permitting fast access to variable position indexes")
-   ;; @todo
-   ;; the word "public" here is leftovers from the very first version.
-   ;; Get rid of it!
-   (public-a "class attribute index")
-   (public-d "class attribute defaults index")
-   (public-doc "class documentation strings for attributes")
-   (public-type "class type for a slot")
-   (public-custom "class custom type for a slot")
-   (public-custom-label "class custom group for a slot")
-   (public-custom-group "class custom group for a slot")
-   (public-printer "printer for a slot")
-   (protection "protection for a slot")
-   (initarg-tuples "initarg tuples list")
-   (class-allocation-a "class allocated attributes")
-   (class-allocation-doc "class allocated documentation")
-   (class-allocation-type "class allocated value type")
-   (class-allocation-custom "class allocated custom descriptor")
-   (class-allocation-custom-label "class allocated custom descriptor")
-   (class-allocation-custom-group "class allocated custom group")
-   (class-allocation-printer "class allocated printer for a slot")
-   (class-allocation-protection "class allocated protection list")
-   (class-allocation-values "class allocated value vector")
-   (default-object-cache "what a newly created object would look like.
-This will speed up instantiation time as only a `copy-sequence' will
-be needed, instead of looping over all the values and setting them
-from the default.")
-   (options "storage location of tagged class options.
-Stored outright without modifications or stripping.")))
-
-(eieio--define-field-accessors object
+(progn
+  ;; Arrange for field access not to bother checking if the access is indeed
+  ;; made to an eieio--class object.
+  (cl-declaim (optimize (safety 0)))
+(cl-defstruct (eieio--class
+               (:constructor nil)
+               (:constructor eieio--class-make (symbol &aux (tag 'defclass)))
+               (:type vector)
+               (:copier nil))
+  ;; We use an untagged cl-struct, with our own hand-made tag as first field
+  ;; (containing the symbol `defclass').  It would be better to use a normal
+  ;; cl-struct with its normal tag (e.g. so that cl-defstruct can define the
+  ;; predicate for us), but that breaks compatibility with .elc files compiled
+  ;; against older versions of EIEIO.
+  tag
+  symbol ;; symbol (self-referencing)
+  parent children
+  symbol-hashtable ;; hashtable permitting fast access to variable position indexes
+  ;; @todo
+  ;; the word "public" here is leftovers from the very first version.
+  ;; Get rid of it!
+  public-a                        ;; class attribute index
+  public-d                        ;; class attribute defaults index
+  public-doc                      ;; class documentation strings for attributes
+  public-type                     ;; class type for a slot
+  public-custom                   ;; class custom type for a slot
+  public-custom-label             ;; class custom group for a slot
+  public-custom-group             ;; class custom group for a slot
+  public-printer                  ;; printer for a slot
+  protection                      ;; protection for a slot
+  initarg-tuples                  ;; initarg tuples list
+  class-allocation-a              ;; class allocated attributes
+  class-allocation-doc            ;; class allocated documentation
+  class-allocation-type           ;; class allocated value type
+  class-allocation-custom         ;; class allocated custom descriptor
+  class-allocation-custom-label   ;; class allocated custom descriptor
+  class-allocation-custom-group   ;; class allocated custom group
+  class-allocation-printer        ;; class allocated printer for a slot
+  class-allocation-protection     ;; class allocated protection list
+  class-allocation-values         ;; class allocated value vector
+  default-object-cache ;; what a newly created object would look like.
+                       ; This will speed up instantiation time as
+                       ; only a `copy-sequence' will be needed, instead of
+                       ; looping over all the values and setting them from
+                       ; the default.
+  options ;; storage location of tagged class option
+          ; Stored outright without modifications or stripping
+  )
+  ;; Set it back to the default value.
+  (cl-declaim (optimize (safety 1))))
+
+
+(cl-defstruct (eieio--object
+               (:type vector)           ;We manage our own tagging system.
+               (:constructor nil)
+               (:copier nil))
   ;; `class-tag' holds a symbol, which is not the class name, but is instead
   ;; properly prefixed as an internal EIEIO thingy and which holds the class
   ;; object/struct in its `symbol-value' slot.
-  ((class-tag "tag containing the class struct")))
+  class-tag)
+
+(eval-and-compile
+  (defconst eieio--object-num-slots
+    (length (get 'eieio--object 'cl-struct-slots))))
 
 (defsubst eieio--object-class-object (obj)
   (symbol-value (eieio--object-class-tag obj)))
@@ -297,15 +302,11 @@ It creates an autoload function for CNAME's constructor."
   ;; Assume we've already debugged inputs.
 
   (let* ((oldc (when (class-p cname) (eieio--class-v cname)))
-         (newc (make-vector eieio--class-num-slots nil))
+         (newc (eieio--class-make cname))
          )
     (if oldc
         nil ;; Do nothing if we already have this class.
 
-      ;; Create the class in NEWC, but don't fill anything else in.
-      (aset newc 0 'defclass)
-      (setf (eieio--class-symbol newc) cname)
-
       (let ((clear-parent nil))
         ;; No parents?
         (when (not superclasses)
@@ -333,7 +334,8 @@ It creates an autoload function for CNAME's constructor."
 
         ;; turn this into a usable self-pointing symbol
         (when eieio-backward-compatibility
-          (set cname cname))
+          (set cname cname)
+          (make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
 
         ;; Store the new class vector definition into the symbol.  We need to
         ;; do this first so that we can call defmethod for the accessor.
@@ -364,11 +366,10 @@ It creates an autoload function for CNAME's constructor."
 
 (declare-function eieio--defmethod "eieio-generic" (method kind argclass code))
 
-(defun eieio-defclass (cname superclasses slots options-and-doc)
-  ;; FIXME: Most of this should be moved to the `defclass' macro.
+(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 or
-documentation OPTIONS-AND-DOC is the toplevel documentation for this class.
+SLOTS are the slots residing in that class definition, and OPTIONS
+holds the class options.
 See `defclass' for more information."
   ;; Run our eieio-hook each time, and clear it when we are done.
   ;; This way people can add hooks safely if they want to modify eieio
@@ -376,18 +377,12 @@ See `defclass' for more information."
   (run-hooks 'eieio-hook)
   (setq eieio-hook nil)
 
-  (eieio--check-type listp superclasses)
-
   (let* ((pname superclasses)
-         (newc (make-vector eieio--class-num-slots nil))
+         (newc (eieio--class-make cname))
          (oldc (when (class-p cname) (eieio--class-v cname)))
          (groups nil) ;; list of groups id'd from slots
-         (options nil)
          (clearparent nil))
 
-    (aset newc 0 'defclass)
-    (setf (eieio--class-symbol newc) cname)
-
     ;; If this class already existed, and we are updating its structure,
     ;; make sure we keep the old child list.  This can cause bugs, but
     ;; if no new slots are created, it also saves time, and prevents
@@ -403,19 +398,6 @@ See `defclass' for more information."
           (setf (eieio--class-children newc) children)
           (remhash cname eieio-defclass-autoload-map))))
 
-    (cond ((and (stringp (car options-and-doc))
-                (/= 1 (% (length options-and-doc) 2)))
-           (error "Too many arguments to `defclass'"))
-          ((and (symbolp (car options-and-doc))
-                (/= 0 (% (length options-and-doc) 2)))
-           (error "Too many arguments to `defclass'"))
-          )
-
-    (setq options
-          (if (stringp (car options-and-doc))
-              (cons :documentation options-and-doc)
-            options-and-doc))
-
     (if pname
         (progn
           (dolist (p pname)
@@ -447,52 +429,13 @@ See `defclass' for more information."
 
     ;; turn this into a usable self-pointing symbol;  FIXME: Why?
     (when eieio-backward-compatibility
-      (set cname cname))
-
-    ;; These two tests must be created right away so we can have self-
-    ;; referencing classes.  ei, a class whose slot can contain only
-    ;; pointers to itself.
-
-    ;; Create the test function
-    (let ((csym (intern (concat (symbol-name cname) "-p"))))
-      (fset csym
-            `(lambda (obj)
-               ,(format "Test OBJ to see if it an object of type %s" cname)
-               (and (eieio-object-p obj)
-                    (same-class-p obj ',cname)))))
-
-    ;; Make sure the method invocation order  is a valid value.
-    (let ((io (eieio--class-option-assoc options :method-invocation-order)))
-      (when (and io (not (member io '(:depth-first :breadth-first :c3))))
-        (error "Method invocation order %s is not allowed" io)
-        ))
-
-    ;; Create a handy child test too
-    (let ((csym (if eieio-backward-compatibility
-                    (intern (concat (symbol-name cname) "-child-p"))
-                  (make-symbol (concat (symbol-name cname) "-child-p")))))
-      (fset csym
-            `(lambda (obj)
-               ,(format
-                 "Test OBJ to see if it an object is a child of type %s"
-                 cname)
-               (and (eieio-object-p obj)
-                    (object-of-class-p obj ',cname))))
-
-      ;; When using typep, (typep OBJ 'myclass) returns t for objects which
-      ;; are subclasses of myclass.  For our predicates, however, it is
-      ;; important for EIEIO to be backwards compatible, where
-      ;; myobject-p, and myobject-child-p are different.
-      ;; "cl" uses this technique to specify symbols with specific typep
-      ;; test, so we can let typep have the CLOS documented behavior
-      ;; while keeping our above predicate clean.
-
-      (put cname 'cl-deftype-satisfies csym))
+      (set cname cname)
+      (make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
 
     ;; Create a handy list of the class test too
     (when eieio-backward-compatibility
       (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
-        (fset csym
+        (defalias csym
               `(lambda (obj)
                  ,(format
                    "Test OBJ to see if it a list of objects which are a child of type %s"
@@ -505,7 +448,10 @@ See `defclass' for more information."
                        (setq ans (and (eieio-object-p (car obj))
                                       (object-of-class-p (car obj) ,cname)))
                        (setq obj (cdr obj)))
-                     ans))))))
+                     ans))))
+        (make-obsolete csym (format "use (cl-typep ... '(list-of %s)) instead"
+                                    cname)
+                       "25.1")))
 
     ;; Before adding new slots, let's add all the methods and classes
     ;; in from the parent class.
@@ -519,19 +465,13 @@ See `defclass' for more information."
 
     ;; Query each slot in the declaration list and mangle into the
     ;; class structure I have defined.
-    (while slots
-      (let* ((slot1  (car slots))
-             (name    (car slot1))
-             (slot   (cdr slot1))
-             (acces   (plist-get slot :accessor))
-             (init    (or (plist-get slot :initform)
+    (pcase-dolist (`(,name . ,slot) slots)
+      (let* ((init    (or (plist-get slot :initform)
                           (if (member :initform slot) nil
                             eieio-unbound)))
              (initarg (plist-get slot :initarg))
              (docstr  (plist-get slot :documentation))
              (prot    (plist-get slot :protection))
-             (reader  (plist-get slot :reader))
-             (writer  (plist-get slot :writer))
              (alloc   (plist-get slot :allocation))
              (type    (plist-get slot :type))
              (custom  (plist-get slot :custom))
@@ -542,51 +482,24 @@ See `defclass' for more information."
              (skip-nil (eieio--class-option-assoc options :allow-nil-initform))
              )
 
-        (if eieio-error-unsupported-class-tags
-            (let ((tmp slot))
-              (while tmp
-                (if (not (member (car tmp) '(:accessor
-                                             :initform
-                                             :initarg
-                                             :documentation
-                                             :protection
-                                             :reader
-                                             :writer
-                                             :allocation
-                                             :type
-                                             :custom
-                                             :label
-                                             :group
-                                             :printer
-                                             :allow-nil-initform
-                                             :custom-groups)))
-                    (signal 'invalid-slot-type (list (car tmp))))
-                (setq tmp (cdr (cdr tmp))))))
-
         ;; Clean up the meaning of protection.
-        (cond ((or (eq prot 'public) (eq prot :public)) (setq prot nil))
-              ((or (eq prot 'protected) (eq prot :protected)) (setq prot 'protected))
-              ((or (eq prot 'private) (eq prot :private)) (setq prot 'private))
-              ((eq prot nil) nil)
-              (t (signal 'invalid-slot-type (list :protection prot))))
-
-        ;; Make sure the :allocation parameter has a valid value.
-        (if (not (or (not alloc) (eq alloc :class) (eq alloc :instance)))
-            (signal 'invalid-slot-type (list :allocation alloc)))
+        (setq prot
+              (pcase prot
+                ((or 'nil 'public ':public) nil)
+                ((or 'protected ':protected) 'protected)
+                ((or 'private ':private) 'private)
+                (_ (signal 'invalid-slot-type (list :protection prot)))))
 
         ;; The default type specifier is supposed to be t, meaning anything.
         (if (not type) (setq type t))
 
-        ;; Label is nil, or a string
-        (if (not (or (null label) (stringp label)))
-            (signal 'invalid-slot-type (list :label label)))
-
-        ;; Is there an initarg, but allocation of class?
-        (if (and initarg (eq alloc :class))
-            (message "Class allocated slots do not need :initarg"))
-
         ;; intern the symbol so we can use it blankly
-        (if initarg (set initarg initarg))
+        (if eieio-backward-compatibility
+            (and initarg (not (keywordp initarg))
+                 (progn
+                   (set initarg initarg)
+                   (make-obsolete-variable
+                    initarg (format "use '%s instead" initarg) "25.1"))))
 
         ;; The customgroup should be a list of symbols
         (cond ((null customg)
@@ -604,63 +517,9 @@ See `defclass' for more information."
                              prot initarg alloc 'defaultoverride skip-nil)
 
         ;; We need to id the group, and store them in a group list attribute.
-        (mapc (lambda (cg) (cl-pushnew cg groups :test 'equal)) customg)
-
-        ;; Anyone can have an accessor function.  This creates a function
-        ;; of the specified name, and also performs a `defsetf' if applicable
-        ;; so that users can `setf' the space returned by this function.
-        (if acces
-            (progn
-              (eieio--defmethod
-               acces (if (eq alloc :class) :static :primary) cname
-               `(lambda (this)
-                  ,(format
-                       "Retrieves the slot `%s' from an object of class `%s'"
-                       name cname)
-                  (if (slot-boundp this ',name)
-                      ;; 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 ',name)
-                    ;; Else - Some error?  nil?
-                    nil)))
-
-              ;; FIXME: We should move more of eieio-defclass into the
-              ;; defclass macro so we don't have to use `eval' and require
-              ;; `gv' at run-time.
-              ;; FIXME: The defmethod above only defines a part of the generic
-              ;; function, but the define-setter below affects the whole
-              ;; generic function!
-              (eval `(gv-define-setter ,acces (eieio--store eieio--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)
-                             eieio--object '',name
-                             eieio--store)))))
-
-        ;; 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
-            (eieio--defmethod
-             writer nil cname
-             `(lambda (this value)
-                ,(format "Set the slot `%s' of an object of class `%s'"
-                              name cname)
-                (setf (slot-value this ',name) value))))
-        ;; If a reader is defined, then create a generic method
-        ;; of that name whose purpose is to access this slot value.
-        (if reader
-            (eieio--defmethod
-             reader nil cname
-             `(lambda (this)
-                ,(format "Access the slot `%s' from object of class `%s'"
-                              name cname)
-                (slot-value this ',name))))
-        )
-      (setq slots (cdr slots)))
+        (dolist (cg customg)
+          (cl-pushnew cg groups :test 'equal))
+        ))
 
     ;; Now that everything has been loaded up, all our lists are backwards!
     ;; Fix that up now.
@@ -700,30 +559,6 @@ See `defclass' for more information."
               prots (cdr prots)))
       (setf (eieio--class-symbol-hashtable newc) oa))
 
-    ;; Create the constructor function
-    (if (eieio--class-option-assoc options :abstract)
-        ;; Abstract classes cannot be instantiated.  Say so.
-        (let ((abs (eieio--class-option-assoc options :abstract)))
-          (if (not (stringp abs))
-              (setq abs (format "Class %s is abstract" cname)))
-          (fset cname
-                `(lambda (&rest stuff)
-                   ,(format "You cannot create a new object of type %s" cname)
-                   (error ,abs))))
-
-      ;; Non-abstract classes need a constructor.
-      (fset cname
-            `(lambda (&rest slots)
-               ,(format "Create a new object with name NAME of class type %s" cname)
-               (if (and slots
-                        (let ((x (car slots)))
-                          (or (stringp x) (null x))))
-                   (funcall (if eieio-backward-compatibility #'ignore #'message)
-                            "Obsolete name %S passed to %S constructor"
-                            (pop slots) ',cname))
-               (apply #'eieio-constructor ',cname slots)))
-      )
-
     ;; Set up a specialized doc string.
     ;; Use stored value since it is calculated in a non-trivial way
     (put cname 'variable-documentation
@@ -1468,6 +1303,13 @@ method invocation orders of the involved classes."
 (define-error 'unbound-slot "Unbound slot")
 (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")
 
+;;; Backward compatibility functions
+;; To support .elc files compiled for older versions of EIEIO.
+
+(defun eieio-defclass (cname superclasses slots options)
+  (eval `(defclass ,cname ,superclasses ,slots ,options)))
+
+
 (provide 'eieio-core)
 
 ;;; eieio-core.el ends here
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 60bbd503adf..13ad120a9b5 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -230,7 +230,7 @@ Optional argument CLASS is the class to start with.
 If INSTANTIABLE-ONLY is non nil, only allow names of classes which
 are not abstract, otherwise allow all classes.
 Optional argument BUILDLIST is more list to attach and is used internally."
-  (let* ((cc (or class eieio-default-superclass))
+  (let* ((cc (or class 'eieio-default-superclass))
          (sublst (eieio--class-children (eieio--class-v cc))))
     (unless (assoc (symbol-name cc) buildlist)
       (when (or (not instantiable-only) (not (class-abstract-p cc)))
@@ -561,7 +561,7 @@ current expansion depth."
   (when (eq (point-min) (point-max))
     ;; This function is only called once, to start the whole deal.
     ;; Create and expand the default object.
-    (eieio-class-button eieio-default-superclass 0)
+    (eieio-class-button 'eieio-default-superclass 0)
     (forward-line -1)
     (speedbar-expand-line)))
 
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index bf51986b133..205f13108b8 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -58,13 +58,11 @@
 
 ;;; Defining a new class
 ;;
-(defmacro defclass (name superclass slots &rest options-and-doc)
+(defmacro defclass (name superclasses slots &rest options-and-doc)
   "Define NAME as a new class derived from SUPERCLASS with SLOTS.
 OPTIONS-AND-DOC is used as the class' options and base documentation.
-SUPERCLASS is a list of superclasses to inherit from, with SLOTS
-being the slots residing in that class definition.  NOTE: Currently
-only one slot may exist in SUPERCLASS as multiple inheritance is not
-yet supported.  Supported tags are:
+SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
+being the slots residing in that class definition.  Supported tags are:
 
   :initform   - Initializing form.
   :initarg    - Tag used during initialization.
@@ -115,12 +113,178 @@ Options in CLOS not supported in EIEIO:
 Due to the way class options are set up, you can add any tags you wish,
 and reference them using the function `class-option'."
   (declare (doc-string 4))
-  ;; This is eval-and-compile only to silence spurious compiler warnings
-  ;; about functions and variables not known to be defined.
-  ;; When eieio-defclass code is merged here and this becomes
-  ;; transparent to the compiler, the eval-and-compile can be removed.
-  `(eval-and-compile
-     (eieio-defclass ',name ',superclass ',slots ',options-and-doc)))
+  (eieio--check-type listp superclasses)
+
+  (cond ((and (stringp (car options-and-doc))
+              (/= 1 (% (length options-and-doc) 2)))
+         (error "Too many arguments to `defclass'"))
+        ((and (symbolp (car options-and-doc))
+              (/= 0 (% (length options-and-doc) 2)))
+         (error "Too many arguments to `defclass'")))
+
+  (if (stringp (car options-and-doc))
+      (setq options-and-doc
+            (cons :documentation options-and-doc)))
+
+  ;; Make sure the method invocation order is a valid value.
+  (let ((io (eieio--class-option-assoc options-and-doc
+                                       :method-invocation-order)))
+    (when (and io (not (member io '(:depth-first :breadth-first :c3))))
+      (error "Method invocation order %s is not allowed" io)))
+
+  (let ((testsym1 (intern (concat (symbol-name name) "-p")))
+        (testsym2 (intern (format "eieio--childp--%s" name)))
+        (accessors ()))
+
+    ;; Collect the accessors we need to define.
+    (pcase-dolist (`(,sname . ,soptions) slots)
+      (let* ((acces   (plist-get soptions :accessor))
+             (initarg (plist-get soptions :initarg))
+             (reader  (plist-get soptions :reader))
+             (writer  (plist-get soptions :writer))
+             (alloc   (plist-get soptions :allocation))
+             (label   (plist-get soptions :label)))
+
+        (if eieio-error-unsupported-class-tags
+            (let ((tmp soptions))
+              (while tmp
+                (if (not (member (car tmp) '(:accessor
+                                             :initform
+                                             :initarg
+                                             :documentation
+                                             :protection
+                                             :reader
+                                             :writer
+                                             :allocation
+                                             :type
+                                             :custom
+                                             :label
+                                             :group
+                                             :printer
+                                             :allow-nil-initform
+                                             :custom-groups)))
+                    (signal 'invalid-slot-type (list (car tmp))))
+                (setq tmp (cdr (cdr tmp))))))
+
+        ;; Make sure the :allocation parameter has a valid value.
+        (if (not (memq alloc '(nil :class :instance)))
+            (signal 'invalid-slot-type (list :allocation alloc)))
+
+        ;; Label is nil, or a string
+        (if (not (or (null label) (stringp label)))
+            (signal 'invalid-slot-type (list :label label)))
+
+        ;; Is there an initarg, but allocation of class?
+        (if (and initarg (eq alloc :class))
+            (message "Class allocated slots do not need :initarg"))
+
+        ;; Anyone can have an accessor function.  This creates a function
+        ;; 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))
+                accessors)
+          (push `(defmethod ,acces ,(if (eq alloc :class) :static :primary)
+                   ((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))
+
+        ;; 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)
+                     ,(format "Set the slot `%S' of an object of class `%S'."
+                              sname name)
+                     (setf (slot-value this ',sname) value))
+                  accessors))
+        ;; 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))
+                     ,(format "Access the slot `%S' from object of class `%S'."
+                              sname name)
+                     (slot-value this ',sname))
+                  accessors))
+        ))
+
+    `(progn
+       ;; This test must be created right away so we can have self-
+       ;; referencing classes.  ei, a class whose slot can contain only
+       ;; pointers to itself.
+
+       ;; Create the test function.
+       (defun ,testsym1 (obj)
+         ,(format "Test OBJ to see if it an object of type %S." name)
+         (and (eieio-object-p obj)
+              (same-class-p obj ',name)))
+
+       (defun ,testsym2 (obj)
+         ,(format
+           "Test OBJ to see if it an object is a child of type %S."
+           name)
+         (and (eieio-object-p obj)
+              (object-of-class-p obj ',name)))
+
+       ,@(when eieio-backward-compatibility
+           (let ((f (intern (format "%s-child-p" name))))
+             `((defalias ',f ',testsym2)
+               (make-obsolete
+                ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1"))))
+
+       ;; When using typep, (typep OBJ 'myclass) returns t for objects which
+       ;; are subclasses of myclass.  For our predicates, however, it is
+       ;; important for EIEIO to be backwards compatible, where
+       ;; myobject-p, and myobject-child-p are different.
+       ;; "cl" uses this technique to specify symbols with specific typep
+       ;; test, so we can let typep have the CLOS documented behavior
+       ;; while keeping our above predicate clean.
+
+       (put ',name 'cl-deftype-satisfies #',testsym2)
+
+       (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
+
+       ,@accessors
+
+       ;; Create the constructor function
+       ,(if (eieio--class-option-assoc options-and-doc :abstract)
+            ;; Abstract classes cannot be instantiated.  Say so.
+            (let ((abs (eieio--class-option-assoc options-and-doc :abstract)))
+              (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)
+                 (error ,abs)))
+
+          ;; Non-abstract classes need a constructor.
+          `(defun ,name (&rest slots)
+             ,(format "Create a new object with name NAME of class type %S."
+                      name)
+             (if (and slots
+                      (let ((x (car slots)))
+                        (or (stringp x) (null x))))
+                 (funcall (if eieio-backward-compatibility #'ignore #'message)
+                          "Obsolete name %S passed to %S constructor"
+                          (pop slots) ',name))
+             (apply #'eieio-constructor ',name slots))))))
 
 
 ;;; CLOS style implementation of object creators.