1 files changed, 35 insertions, 45 deletions

diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index f2020dfa74d..8a09dac2dff 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -63,25 +63,10 @@ SLOT-NAME is the offending slot.  FN is the function signaling the error."
     ;; Throw the regular signal.
     (call-next-method)))
 
-(defmethod clone ((obj eieio-instance-inheritor) &rest params)
+(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 (make-vector (length obj) eieio-unbound))
-	(nm (eieio--object-name obj))
-	(passname (and params (stringp (car params))))
-	(num 1))
-    (aset nobj 0 'object)
-    (setf (eieio--object-class nobj) (eieio--object-class obj))
-    ;; The following was copied from the default clone.
-    (if (not passname)
-	(save-match-data
-	  (if (string-match "-\\([0-9]+\\)" nm)
-	      (setq num (1+ (string-to-number (match-string 1 nm)))
-		    nm (substring nm 0 (match-beginning 0))))
-	  (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
-      (setf (eieio--object-name nobj) (car params)))
-    ;; Now initialize from params.
-    (if params (shared-initialize nobj (if passname (cdr params) params)))
+  (let ((nobj (call-next-method)))
     (oset nobj parent-instance obj)
     nobj))
 
@@ -155,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 constructor :STATIC ((class eieio-singleton) _name &rest _slots)
+(defmethod eieio-constructor :STATIC ((class 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,
@@ -270,7 +255,7 @@ malicious code.
 Note: This function recurses when a slot of :type of some object is
 identified, and needing more object creation."
   (let ((objclass (nth 0 inputlist))
-	(objname (nth 1 inputlist))
+	;; (objname (nth 1 inputlist))
 	(slots (nthcdr 2 inputlist))
 	(createslots nil))
 
@@ -293,7 +278,7 @@ identified, and needing more object creation."
 
       (setq slots (cdr (cdr slots))))
 
-    (apply 'make-instance objclass objname (nreverse createslots))
+    (apply #'make-instance objclass (nreverse createslots))
 
     ;;(eval inputlist)
     ))
@@ -308,7 +293,8 @@ Second, any text properties will be stripped from strings."
 	 (let ((slot-idx (eieio-slot-name-index class nil slot))
 	       (type nil)
 	       (classtype nil))
-	   (setq slot-idx (- slot-idx 3))
+	   (setq slot-idx (- slot-idx
+                             (eval-when-compile eieio--object-num-slots)))
 	   (setq type (aref (eieio--class-public-type (eieio--class-v class))
 			    slot-idx))
 
@@ -463,34 +449,38 @@ instance."
 
 
 ;;; Named object
-;;
-;; Named objects use the objects `name' as a slot, and that slot
-;; is accessed with the `object-name' symbol.
 
 (defclass eieio-named ()
-  ()
-  "Object with a name.
-Name storage already occurs in an object.  This object provides get/set
-access to it."
+  ((object-name :initarg :object-name :initform nil))
+  "Object with a name."
   :abstract t)
 
-(defmethod slot-missing ((obj eieio-named)
-			 slot-name operation &optional new-value)
-  "Called when a non-existent slot is accessed.
-For variable `eieio-named', provide an imaginary `object-name' slot.
-Argument OBJ is the named object.
-Argument SLOT-NAME is the slot that was attempted to be accessed.
-OPERATION is the type of access, such as `oref' or `oset'.
-NEW-VALUE is the value that was being set into SLOT if OPERATION were
-a set type."
-  (if (memq slot-name '(object-name :object-name))
-      (cond ((eq operation 'oset)
-	     (if (not (stringp new-value))
-		 (signal 'invalid-slot-type
-			 (list obj slot-name 'string new-value)))
-	     (eieio-object-set-name-string obj new-value))
-	    (t (eieio-object-name-string obj)))
-    (call-next-method)))
+(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)
+  "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)
+  "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))
+         (nm (slot-value obj 'object-name)))
+    (eieio-oset obj 'object-name
+                (or newname
+                    (save-match-data
+                      (if (and nm (string-match "-\\([0-9]+\\)" nm))
+                          (let ((num (1+ (string-to-number
+                                          (match-string 1 nm)))))
+                            (concat (substring nm 0 (match-beginning 0))
+                                    "-" (int-to-string num)))
+                        (concat nm "-1")))))
+    nobj))
 
 (provide 'eieio-base)