Update copyright year to 2015

[gnu-emacs] / lisp / emacs-lisp / eieio-base.el

diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 24d680181bb71c80b1a01ed88f470fc245f1300c..7478908051ccc310df37101010320e6b75b171c2 100644 (file)
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,6 +1,6 @@
-;;; eieio-base.el --- Base classes for EIEIO.
+;;; eieio-base.el --- Base classes for EIEIO.  -*- lexical-binding:t -*-
 
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2013 Free Software
+;;; Copyright (C) 2000-2002, 2004-2005, 2007-2015 Free Software
 ;;; Foundation, Inc.
 
 ;; Author: Eric M. Ludlam  <zappo@gnu.org>
@@ -31,6 +31,7 @@
 ;;; Code:
 
 (require 'eieio)
+(eval-when-compile (require 'cl-lib))
 
 ;;; eieio-instance-inheritor
 ;;
@@ -51,7 +52,8 @@ 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) class slot-name fn)
+(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."
   (if (slot-boundp object 'parent-instance)
@@ -65,19 +67,19 @@ SLOT-NAME is the offending slot.  FN is the function signaling the error."
   "Clone OBJ, initializing `:parent' to OBJ.
 All slots are unbound, except those initialized with PARAMS."
   (let ((nobj (make-vector (length obj) eieio-unbound))
-       (nm (aref obj object-name))
+       (nm (eieio--object-name obj))
        (passname (and params (stringp (car params))))
        (num 1))
     (aset nobj 0 'object)
-    (aset nobj object-class (aref obj object-class))
+    (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))))
-         (aset nobj object-name (concat nm "-" (int-to-string num))))
-      (aset nobj object-name (car params)))
+         (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)))
     (oset nobj parent-instance obj)
@@ -117,7 +119,7 @@ a variable symbol used to store a list of all instances."
   :abstract t)
 
 (defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
-                                      &rest slots)
+                                      &rest _slots)
   "Make sure THIS is in our master list of this class.
 Optional argument SLOTS are the initialization arguments."
   ;; Theoretically, this is never called twice for a given instance.
@@ -153,7 +155,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 constructor :STATIC ((class eieio-singleton) _name &rest _slots)
   "Constructor for singleton CLASS.
 NAME and SLOTS initialize the new object.
 This constructor guarantees that no matter how many you request,
@@ -232,8 +234,7 @@ for CLASS.  Optional ALLOW-SUBCLASS says that it is ok for
 being pedantic."
   (unless class
     (message "Unsafe call to `eieio-persistent-read'."))
-  (when (and class (not (class-p class)))
-    (signal 'wrong-type-argument (list 'class-p class)))
+  (when class (eieio--check-type class-p class))
   (let ((ret nil)
        (buffstr nil))
     (unwind-protect
@@ -308,7 +309,7 @@ Second, any text properties will be stripped from strings."
               (type nil)
               (classtype nil))
           (setq slot-idx (- slot-idx 3))
-          (setq type (aref (aref (class-v class) class-public-type)
+          (setq type (aref (eieio--class-public-type (class-v class))
                            slot-idx))
 
           (setq classtype (eieio-persistent-slot-type-is-class-p
@@ -482,14 +483,13 @@ 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 (or (eq slot-name 'object-name)
-         (eq slot-name :object-name))
+  (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)))
-            (object-set-name-string obj new-value))
-           (t (object-name-string obj)))
+            (eieio-object-set-name-string obj new-value))
+           (t (eieio-object-name-string obj)))
     (call-next-method)))
 
 (provide 'eieio-base)