* lisp/emacs-lisp/eieio*.el: Align a bit better with CLOS

* lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste
error (semanticdb-project-database => sym).  Avoid eieio--class-public-a
when possible.

* lisp/emacs-lisp/eieio-base.el (make-instance): Add a method here rather
than on eieio-constructor.

* lisp/emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
(eieio-class-name): Make it do what the docstring claims.
(eieio-defclass-internal): Simplify since `prots' isn't used any more.
(eieio--slot-name-index): Simplify accordingly.
(eieio-barf-if-slot-unbound): Pass the class object rather than its
name to `slot-unbound'.

* lisp/emacs-lisp/eieio.el (defclass): Use make-instance rather than
eieio-constructor.
(set-slot-value): Mark as obsolete.
(eieio-object-class-name): Improve call to eieio-class-name.
(eieio-slot-descriptor-name, eieio-class-slots): New functions.
(object-slots): Use it.  Declare obsolete.
(eieio-constructor): Merge it with `make-instance'.
(initialize-instance): Use `dolist'.
(eieio-override-prin1, eieio-edebug-prin1-to-string):
Use eieio--class-print-name.

* test/automated/eieio-test-methodinvoke.el (make-instance): Add methods
here rather than on eieio-constructor.

6 files changed, 94 insertions, 69 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bb8c97badf7..e4383437c6d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,28 @@
 2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * emacs-lisp/eieio.el (defclass): Use make-instance rather than
+        eieio-constructor.
+        (set-slot-value): Mark as obsolete.
+        (eieio-object-class-name): Improve call to eieio-class-name.
+        (eieio-slot-descriptor-name, eieio-class-slots): New functions.
+        (object-slots): Use it.  Declare obsolete.
+        (eieio-constructor): Merge it with `make-instance'.
+        (initialize-instance): Use `dolist'.
+        (eieio-override-prin1, eieio-edebug-prin1-to-string):
+        Use eieio--class-print-name.
+
+        * emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
+        (eieio-class-name): Make it do what the docstring claims.
+        (eieio-defclass-internal): Simplify since `prots' isn't used any more.
+        (eieio--slot-name-index): Simplify accordingly.
+        (eieio-barf-if-slot-unbound): Pass the class object rather than its
+        name to `slot-unbound'.
+
+        * emacs-lisp/eieio-base.el (make-instance): Add a method here rather
+        than on eieio-constructor.
+
+2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+
         * emacs-lisp/cl-macs.el (cl-defstruct): Keep type=nil by default.
         * emacs-lisp/cl-preloaded.el (cl-struct-define): Add sanity checks
         about relationship between `type', `named', and `slots'.
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index 6bbae7e08a8..838a2693491 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,9 @@
+2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste error
+        (semanticdb-project-database => sym).  Avoid eieio--class-public-a
+        when possible.
+
 2015-02-04  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         Use cl-generic instead of EIEIO's defgeneric/defmethod.
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index e37b65a461e..b20a756f6b7 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -223,9 +223,11 @@ TOKTYPE is a hint to the type of tag desired."
             (symbol-name sym)
             "class"
             (semantic-elisp-desymbolify
-             ;; FIXME: This only gives the instance slots and ignores the
-             ;; class-allocated slots.
-             (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio--
+             (let ((class (find-class sym)))
+               (if (fboundp 'eieio-slot-descriptor-name)
+                   (mapcar #'eieio-slot-descriptor-name
+                           (eieio-class-slots class))
+                 (eieio--class-public-a class))))
             (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
             ))
           ((not toktype)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index fcf02b92736..1cc9f895f8a 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -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)
 
-(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest _slots)
+(cl-defmethod make-instance ((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,
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index e71c54d4123..408922a2daa 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -181,15 +181,15 @@ Currently under control of this var:
 CLASS is a symbol."                     ;FIXME: Is it a vector or a symbol?
   (and (symbolp class) (eieio--class-p (eieio--class-v class))))
 
+(defun eieio--class-print-name (class)
+  "Return a printed representation of CLASS."
+  (format "#<class %s>" (eieio-class-name class)))
+
 (defun eieio-class-name (class)
   "Return a Lisp like symbol name for CLASS."
-  ;; FIXME: What's a "Lisp like symbol name"?
-  ;; FIXME: CLOS returns a symbol, but the code returns a string.
-  (if (eieio--class-p class) (setq class (eieio--class-symbol class)))
-  (cl-check-type class class)
-  ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
-  ;; and I wanted a string.  Arg!
-  (format "#<class %s>" (symbol-name class)))
+  (setq class (eieio--class-object class))
+  (cl-check-type class eieio--class)
+  (eieio--class-symbol class))
 (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
 
 (defalias 'eieio--class-constructor #'identity
@@ -317,7 +317,7 @@ See `defclass' for more information."
          (newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
                    ;; The oldc class is a stub setup by eieio-defclass-autoload.
                    ;; Reuse it instead of creating a new one, so that existing
-                   ;; references are still valid.
+                   ;; references stay valid.
                    oldc
                  (eieio--class-make cname)))
          (groups nil) ;; list of groups id'd from slots
@@ -488,16 +488,10 @@ See `defclass' for more information."
     ;; Attach slot symbols into a hashtable, and store the index of
     ;; this slot as the value this table.
     (let* ((cnt 0)
-           (pubsyms (eieio--class-public-a newc))
-           (prots (eieio--class-protection newc))
            (oa (make-hash-table :test #'eq)))
-      (while pubsyms
-        (let ((newsym (list cnt)))
-          (setf (gethash (car pubsyms) oa) newsym)
-          (setq cnt (1+ cnt))
-          (if (car prots) (setcdr newsym (car prots))))
-        (setq pubsyms (cdr pubsyms)
-              prots (cdr prots)))
+      (dolist (pubsym (eieio--class-public-a newc))
+        (setf (gethash pubsym oa) cnt)
+        (setq cnt (1+ cnt)))
       (setf (eieio--class-symbol-hashtable newc) oa))
 
     ;; Set up a specialized doc string.
@@ -895,7 +889,7 @@ INSTANCE is the object being referenced.  SLOTNAME is the offending
 slot.  If the slot is ok, return VALUE.
 Argument FN is the function calling this verifier."
   (if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
-      (slot-unbound instance (eieio--object-class-name instance) slotname fn)
+      (slot-unbound instance (eieio--object-class-object instance) slotname fn)
     value))
 
 
@@ -1029,8 +1023,7 @@ The slot is a symbol which is installed in CLASS by the `defclass' call.
 If SLOT is the value created with :initarg instead,
 reverse-lookup that name, and recurse with the associated slot value."
   ;; Removed checks to outside this call
-  (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
-         (fsi (car fsym)))
+  (let* ((fsi (gethash slot (eieio--class-symbol-hashtable class))))
     (if (integerp fsi)
         (+ (eval-when-compile eieio--object-num-slots) fsi)
       (let ((fn (eieio--initarg-to-attribute class slot)))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 526090954a9..4f6b6d73183 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -272,34 +272,9 @@ This method is obsolete."
                             ;; but hide it so we don't trigger indefinitely.
                             `(,(car whole) (identity ,(car slots))
                               ,@(cdr slots)))))))
-             (apply #'eieio-constructor ',name slots))))))
+             (apply #'make-instance ',name slots))))))
 
 
-;;; CLOS style implementation of object creators.
-;;
-(defun make-instance (class &rest initargs)
-  "Make a new instance of CLASS based on INITARGS.
-CLASS is a class symbol.  For example:
-
-  (make-instance 'foo)
-
-  INITARGS is a property list with keywords based on the :initarg
-for each slot.  For example:
-
-  (make-instance 'foo :slot1 value1 :slotN valueN)
-
-Compatibility note:
-
-If the first element of INITARGS is a string, it is used as the
-name of the class.
-
-In EIEIO, the class' constructor requires a name for use when printing.
-`make-instance' in CLOS doesn't use names the way Emacs does, so the
-class is used as the name slot instead when INITARGS doesn't start with
-a string."
-  (apply (eieio--class-constructor class) initargs))
-
-
 ;;; Get/Set slots in an object.
 ;;
 (defmacro oref (obj slot)
@@ -311,6 +286,7 @@ created by the :initarg tag."
 
 (defalias 'slot-value 'eieio-oref)
 (defalias 'set-slot-value 'eieio-oset)
+(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
 
 (defmacro oref-default (obj slot)
   "Get the default value of OBJ (maybe a class) for SLOT.
@@ -363,7 +339,7 @@ variable name of the same name as the slot."
   (declare (obsolete eieio-named "25.1")))
 
 (defun eieio-object-name (obj &optional extra)
-  "Return a Lisp like symbol string for object OBJ.
+  "Return a printed representation for object OBJ.
 If EXTRA, include that in the string returned to represent the symbol."
   (cl-check-type obj eieio-object)
   (format "#<%s %s%s>" (eieio--object-class-name obj)
@@ -402,7 +378,7 @@ If EXTRA, include that in the string returned to represent the symbol."
 (defun eieio-object-class-name (obj)
   "Return a Lisp like symbol name for OBJ's class."
   (cl-check-type obj eieio-object)
-  (eieio-class-name (eieio--object-class-name obj)))
+  (eieio-class-name (eieio--object-class-object obj)))
 (define-obsolete-function-alias
   'object-class-name 'eieio-object-class-name "24.4")
 
@@ -463,10 +439,23 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
                 child (pop p)))
         (if child t))))
 
+(defun eieio-slot-descriptor-name (slot) slot)
+
+(defun eieio-class-slots (class)
+  "Return list of slots available in instances of CLASS."
+  ;; FIXME: This only gives the instance slots and ignores the
+  ;; class-allocated slots.
+  ;; FIXME: It only gives the slot's *names* rather than actual
+  ;; slot descriptors.
+  (setq class (eieio--class-object class))
+  (cl-check-type class eieio--class)
+  (eieio--class-public-a class))
+
 (defun object-slots (obj)
   "Return list of slots available in OBJ."
+  (declare (obsolete eieio-class-slots "25.1"))
   (cl-check-type obj eieio-object)
-  (eieio--class-public-a (eieio--object-class-object obj)))
+  (eieio-class-slots (eieio--object-class-object obj)))
 
 (defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
   (cl-check-type class eieio--class)
@@ -613,6 +602,9 @@ If SLOT is unbound, do nothing."
 ;;; Here are some CLOS items that need the CL package
 ;;
 
+;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
+;; common code between oref and oset, so as to reduce the redundant work done
+;; in (push foo (oref bar baz)), like we do for the `nth' expander?
 (gv-define-simple-setter eieio-oref eieio-oset)
 
 
@@ -636,20 +628,28 @@ This class is not stored in the `parent' slot of a class vector."
 
 (defalias 'standard-class 'eieio-default-superclass)
 
-(cl-defgeneric eieio-constructor (class &rest slots)
-  "Default constructor for CLASS `eieio-default-superclass'.")
+(cl-defgeneric make-instance (class &rest initargs)
+  "Make a new instance of CLASS based on INITARGS.
+For example:
+
+  (make-instance 'foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot.  For example:
+
+  (make-instance 'foo :slot1 value1 :slotN valueN)")
 
-(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
+(define-obsolete-function-alias 'constructor #'make-instance "25.1")
 
-(cl-defmethod eieio-constructor
-  ((class (subclass eieio-default-superclass)) &rest slots)
+(cl-defmethod make-instance
+    ((class (subclass eieio-default-superclass)) &rest slots)
   "Default constructor for CLASS `eieio-default-superclass'.
-SLOTS are the initialization slots used by `shared-initialize'.
+SLOTS are the initialization slots used by `initialize-instance'.
 This static method is called when an object is constructed.
 It allocates the vector used to represent an EIEIO object, and then
-calls `shared-initialize' on that object."
+calls `initialize-instance' on that object."
   (let* ((new-object (copy-sequence (eieio--class-default-object-cache
-                                     (eieio--class-v class)))))
+                                     (eieio--class-object class)))))
     (if (and slots
              (let ((x (car slots)))
                (or (stringp x) (null x))))
@@ -662,6 +662,7 @@ calls `shared-initialize' on that object."
     ;; Return the created object.
     new-object))
 
+;; FIXME: CLOS uses "&rest INITARGS" instead.
 (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.")
@@ -677,6 +678,7 @@ Called from the constructor routine."
         (eieio-oset obj rn (car (cdr slots)))))
     (setq slots (cdr (cdr slots)))))
 
+;; FIXME: CLOS uses "&rest INITARGS" instead.
 (cl-defgeneric initialize-instance (this &optional slots)
   "Construct the new object THIS based on SLOTS.")
 
@@ -693,9 +695,8 @@ dynamically set from SLOTS."
   ;; First, see if any of our defaults are `lambda', and
   ;; re-evaluate them and apply the value to our slots.
   (let* ((this-class (eieio--object-class-object this))
-         (slot (eieio--class-public-a this-class))
          (defaults (eieio--class-public-d this-class)))
-    (while slot
+    (dolist (slot (eieio--class-public-a this-class))
       ;; For each slot, see if we need to evaluate it.
       ;;
       ;; Paul Landes said in an email:
@@ -705,10 +706,9 @@ dynamically set from SLOTS."
       ;; > web.
       (let ((dflt (eieio-default-eval-maybe (car defaults))))
         (when (not (eq dflt (car defaults)))
-          (eieio-oset this (car slot) dflt) ))
+          (eieio-oset this slot dflt) ))
       ;; Next.
-      (setq slot (cdr slot)
-            defaults (cdr defaults))))
+      (setq defaults (cdr defaults))))
   ;; Shared initialize will parse our slots for us.
   (shared-initialize this slots))
 
@@ -742,7 +742,8 @@ Use `slot-boundp' to determine if a slot is bound or not.
 
 In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
 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)
+  (signal 'unbound-slot (list (eieio-class-name class)
+                              (eieio-object-name object)
                               slot-name fn)))
 
 (cl-defgeneric clone (obj &rest params)
@@ -861,7 +862,7 @@ this object."
         ((consp thing)
          (eieio-list-prin1 thing))
         ((eieio--class-p thing)
-         (princ (eieio-class-name thing)))
+         (princ (eieio--class-print-name thing)))
         (t (prin1 thing))))
 
 (defun eieio-list-prin1 (list)
@@ -902,7 +903,7 @@ of `eq'."
 Used as advice around `edebug-prin1-to-string', held in the
 variable PRINT-FUNCTION.  Optional argument NOESCAPE is passed to
 `prin1-to-string' when appropriate."
-  (cond ((eieio--class-p object) (eieio-class-name object))
+  (cond ((eieio--class-p object) (eieio--class-print-name object))
         ((eieio-object-p object) (object-print object))
         ((and (listp object) (or (eieio--class-p (car object))
                                  (eieio-object-p (car object))))