Update CEDET from upstream.
[bpt/emacs.git] / lisp / emacs-lisp / eieio.el
index 83c09b6..5feaa15 100644 (file)
@@ -1,10 +1,9 @@
 ;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
 ;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
-;;;              or maybe Eric's Implementation of Emacs Intrepreted Objects
+;;;              or maybe Eric's Implementation of Emacs Interpreted Objects
 
 
-;; Copyright (C) 1995-1996, 1998-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 1.3
 ;; Keywords: OO, lisp
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: OO, lisp
 
 ;; This file is part of GNU Emacs.
@@ -44,8 +43,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl))       ;FIXME: Use cl-lib!
 
 (defvar eieio-version "1.3"
   "Current version of EIEIO.")
 
 (defvar eieio-version "1.3"
   "Current version of EIEIO.")
@@ -57,7 +55,7 @@
 
 (eval-and-compile
 ;; About the above.  EIEIO must process its own code when it compiles
 
 (eval-and-compile
 ;; About the above.  EIEIO must process its own code when it compiles
-;; itself, thus, by eval-and-compiling outselves, we solve the problem.
+;; itself, thus, by eval-and-compiling ourselves, we solve the problem.
 
 ;; Compatibility
 (if (fboundp 'compiled-function-arglist)
 
 ;; Compatibility
 (if (fboundp 'compiled-function-arglist)
@@ -79,7 +77,7 @@
 ;;
 
 (defvar eieio-hook nil
 ;;
 
 (defvar eieio-hook nil
-  "*This hook is executed, then cleared each time `defclass' is called.")
+  "This hook is executed, then cleared each time `defclass' is called.")
 
 (defvar eieio-error-unsupported-class-tags nil
   "Non-nil to throw an error if an encountered tag is unsupported.
 
 (defvar eieio-error-unsupported-class-tags nil
   "Non-nil to throw an error if an encountered tag is unsupported.
@@ -87,7 +85,7 @@ This may prevent classes from CLOS applications from being used with EIEIO
 since EIEIO does not support all CLOS tags.")
 
 (defvar eieio-skip-typecheck nil
 since EIEIO does not support all CLOS tags.")
 
 (defvar eieio-skip-typecheck nil
-  "*If non-nil, skip all slot typechecking.
+  "If non-nil, skip all slot typechecking.
 Set this to t permanently if a program is functioning well to get a
 small speed increase.  This variable is also used internally to handle
 default setting for optimization purposes.")
 Set this to t permanently if a program is functioning well to get a
 small speed increase.  This variable is also used internally to handle
 default setting for optimization purposes.")
@@ -95,21 +93,6 @@ default setting for optimization purposes.")
 (defvar eieio-optimize-primary-methods-flag t
   "Non-nil means to optimize the method dispatch on primary methods.")
 
 (defvar eieio-optimize-primary-methods-flag t
   "Non-nil means to optimize the method dispatch on primary methods.")
 
-;; State Variables
-;; FIXME: These two constants below should have an `eieio-' prefix added!!
-(defvar this nil
-  "Inside a method, this variable is the object in question.
-DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots.
-
-Note: Embedded methods are no longer supported.  The variable THIS is
-still set for CLOS methods for the sake of routines like
-`call-next-method'.")
-
-(defvar scoped-class nil
-  "This is set to a class when a method is running.
-This is so we know we are allowed to check private parts or how to
-execute a `call-next-method'.  DO NOT SET THIS YOURSELF!")
-
 (defvar eieio-initializing-object  nil
   "Set to non-nil while initializing an object.")
 
 (defvar eieio-initializing-object  nil
   "Set to non-nil while initializing an object.")
 
@@ -395,7 +378,7 @@ It creates an autoload function for CNAME's constructor."
          (aset newc class-parent (cons SC (aref newc class-parent)))
          )
 
          (aset newc class-parent (cons SC (aref newc class-parent)))
          )
 
-       ;; turn this into a useable self-pointing symbol
+       ;; turn this into a usable self-pointing symbol
        (set cname cname)
 
        ;; Store the new class vector definition into the symbol.  We need to
        (set cname cname)
 
        ;; Store the new class vector definition into the symbol.  We need to
@@ -411,6 +394,7 @@ It creates an autoload function for CNAME's constructor."
        (autoload cname filename doc nil nil)
        (autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
        (autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
        (autoload cname filename doc nil nil)
        (autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
        (autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
+       (autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
 
        ))))
 
 
        ))))
 
@@ -431,10 +415,10 @@ See `defclass' for more information."
   (run-hooks 'eieio-hook)
   (setq eieio-hook nil)
 
   (run-hooks 'eieio-hook)
   (setq eieio-hook nil)
 
-  (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname)))
-  (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses)))
+  (if (not (listp superclasses))
+      (signal 'wrong-type-argument '(listp superclasses)))
 
 
-  (let* ((pname (if superclasses superclasses nil))
+  (let* ((pname superclasses)
         (newc (make-vector class-num-slots nil))
         (oldc (when (class-p cname) (class-v cname)))
         (groups nil) ;; list of groups id'd from slots
         (newc (make-vector class-num-slots nil))
         (oldc (when (class-p cname) (class-v cname)))
         (groups nil) ;; list of groups id'd from slots
@@ -509,7 +493,7 @@ See `defclass' for more information."
        ;; save parent in child
        (aset newc class-parent (list eieio-default-superclass))))
 
        ;; save parent in child
        (aset newc class-parent (list eieio-default-superclass))))
 
-    ;; turn this into a useable self-pointing symbol
+    ;; turn this into a usable self-pointing symbol
     (set cname cname)
 
     ;; These two tests must be created right away so we can have self-
     (set cname cname)
 
     ;; These two tests must be created right away so we can have self-
@@ -540,6 +524,23 @@ See `defclass' for more information."
               (and (eieio-object-p obj)
                    (object-of-class-p obj ,cname))))
 
               (and (eieio-object-p obj)
                    (object-of-class-p obj ,cname))))
 
+    ;; Create a handy list of the class test too
+    (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
+      (fset csym
+           `(lambda (obj)
+              ,(format
+                 "Test OBJ to see if it a list of objects which are a child of type %s"
+                 cname)
+              (when (listp obj)
+                (let ((ans t)) ;; nil is valid
+                  ;; Loop over all the elements of the input list, test
+                  ;; each to make sure it is a child of the desired object class.
+                  (while (and obj ans)
+                    (setq ans (and (eieio-object-p (car obj))
+                                   (object-of-class-p (car obj) ,cname)))
+                    (setq obj (cdr obj)))
+                  ans)))))
+
       ;; 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
       ;; 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
@@ -553,8 +554,8 @@ See `defclass' for more information."
       (put cname 'cl-deftype-handler
           (list 'lambda () `(list 'satisfies (quote ,csym)))))
 
       (put cname 'cl-deftype-handler
           (list 'lambda () `(list 'satisfies (quote ,csym)))))
 
-    ;; before adding new slots, lets add all the methods and classes
-    ;; in from the parent class
+    ;; Before adding new slots, let's add all the methods and classes
+    ;; in from the parent class.
     (eieio-copy-parents-into-subclass newc superclasses)
 
     ;; Store the new class vector definition into the symbol.  We need to
     (eieio-copy-parents-into-subclass newc superclasses)
 
     ;; Store the new class vector definition into the symbol.  We need to
@@ -652,9 +653,9 @@ See `defclass' for more information."
        ;; We need to id the group, and store them in a group list attribute.
        (mapc (lambda (cg) (add-to-list 'groups cg)) customg)
 
        ;; We need to id the group, and store them in a group list attribute.
        (mapc (lambda (cg) (add-to-list 'groups cg)) customg)
 
-       ;; anyone can have an accessor function.  This creates a function
+       ;; Anyone can have an accessor function.  This creates a function
        ;; of the specified name, and also performs a `defsetf' if applicable
        ;; of the specified name, and also performs a `defsetf' if applicable
-       ;; so that users can `setf' the space returned by this function
+       ;; so that users can `setf' the space returned by this function.
        (if acces
            (progn
              (eieio--defmethod
        (if acces
            (progn
              (eieio--defmethod
@@ -668,18 +669,26 @@ See `defclass' for more information."
                            ;; Else - Some error?  nil?
                            nil)))
 
                            ;; Else - Some error?  nil?
                            nil)))
 
-             ;; Provide a setf method.  It would be cleaner to use
-             ;; defsetf, but that would require CL at runtime.
-             (put acces 'setf-method
-                  `(lambda (widget)
-                     (let* ((--widget-sym-- (make-symbol "--widget--"))
-                            (--store-sym-- (make-symbol "--store--")))
-                       (list
-                        (list --widget-sym--)
-                        (list widget)
-                        (list --store-sym--)
-                        (list 'eieio-oset --widget-sym-- '',name --store-sym--)
-                        (list 'getfoo --widget-sym--)))))))
+              (if (fboundp 'gv-define-setter)
+                  ;; 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.
+                  (eval `(gv-define-setter ,acces (eieio--store eieio--object)
+                           (list 'eieio-oset eieio--object '',name
+                                 eieio--store)))
+                ;; Provide a setf method.  It would be cleaner to use
+                ;; defsetf, but that would require CL at runtime.
+                (put acces 'setf-method
+                     `(lambda (widget)
+                        (let* ((--widget-sym-- (make-symbol "--widget--"))
+                               (--store-sym-- (make-symbol "--store--")))
+                          (list
+                           (list --widget-sym--)
+                           (list widget)
+                           (list --store-sym--)
+                           (list 'eieio-oset --widget-sym-- '',name
+                                 --store-sym--)
+                           (list 'getfoo --widget-sym--))))))))
 
        ;; If a writer is defined, then create a generic method of that
        ;; name whose purpose is to set the value of the slot.
 
        ;; If a writer is defined, then create a generic method of that
        ;; name whose purpose is to set the value of the slot.
@@ -702,7 +711,8 @@ See `defclass' for more information."
        )
       (setq slots (cdr slots)))
 
        )
       (setq slots (cdr slots)))
 
-    ;; Now that everything has been loaded up, all our lists are backwards!  Fix that up now.
+    ;; Now that everything has been loaded up, all our lists are backwards!
+    ;; Fix that up now.
     (aset newc class-public-a (nreverse (aref newc class-public-a)))
     (aset newc class-public-d (nreverse (aref newc class-public-d)))
     (aset newc class-public-doc (nreverse (aref newc class-public-doc)))
     (aset newc class-public-a (nreverse (aref newc class-public-a)))
     (aset newc class-public-d (nreverse (aref newc class-public-d)))
     (aset newc class-public-doc (nreverse (aref newc class-public-doc)))
@@ -773,6 +783,16 @@ See `defclass' for more information."
     (put cname 'variable-documentation
         (class-option-assoc options :documentation))
 
     (put cname 'variable-documentation
         (class-option-assoc options :documentation))
 
+    ;; Save the file location where this class is defined.
+    (let ((fname (if load-in-progress
+                    load-file-name
+                  buffer-file-name))
+         loc)
+      (when fname
+       (when (string-match "\\.elc$" fname)
+         (setq fname (substring fname 0 (1- (length fname)))))
+       (put cname 'class-location fname)))
+
     ;; We have a list of custom groups.  Store them into the options.
     (let ((g (class-option-assoc options :custom-groups)))
       (mapc (lambda (cg) (add-to-list 'g cg)) groups)
     ;; We have a list of custom groups.  Store them into the options.
     (let ((g (class-option-assoc options :custom-groups)))
       (mapc (lambda (cg) (add-to-list 'g cg)) groups)
@@ -826,7 +846,7 @@ if default value is nil."
   ;; Make sure we duplicate those items that are sequences.
   (condition-case nil
       (if (sequencep d) (setq d (copy-sequence d)))
   ;; Make sure we duplicate those items that are sequences.
   (condition-case nil
       (if (sequencep d) (setq d (copy-sequence d)))
-    ;; This copy can fail on a cons cell with a non-cons in the cdr.  Lets skip it if it doesn't work.
+    ;; This copy can fail on a cons cell with a non-cons in the cdr.  Let's skip it if it doesn't work.
     (error nil))
   (if (sequencep type) (setq type (copy-sequence type)))
   (if (sequencep cust) (setq cust (copy-sequence cust)))
     (error nil))
   (if (sequencep type) (setq type (copy-sequence type)))
   (if (sequencep cust) (setq cust (copy-sequence cust)))
@@ -958,7 +978,7 @@ if default value is nil."
          (progn
            (eieio-perform-slot-validation-for-default a type value skipnil)
            ;; Here we have found a :class version of a slot.  This
          (progn
            (eieio-perform-slot-validation-for-default a type value skipnil)
            ;; Here we have found a :class version of a slot.  This
-           ;; requires a very different aproach.
+           ;; requires a very different approach.
            (aset newc class-class-allocation-a (cons a (aref newc class-class-allocation-a)))
            (aset newc class-class-allocation-doc (cons doc (aref newc class-class-allocation-doc)))
            (aset newc class-class-allocation-type (cons type (aref newc class-class-allocation-type)))
            (aset newc class-class-allocation-a (cons a (aref newc class-class-allocation-a)))
            (aset newc class-class-allocation-doc (cons doc (aref newc class-class-allocation-doc)))
            (aset newc class-class-allocation-type (cons type (aref newc class-class-allocation-type)))
@@ -992,7 +1012,7 @@ if default value is nil."
              ;; EML - Note: the only reason to override a class bound slot
              ;;       is to change the default, so allow unbound in.
 
              ;; EML - Note: the only reason to override a class bound slot
              ;;       is to change the default, so allow unbound in.
 
-             ;; If we have a repeat, only update the vlaue...
+             ;; If we have a repeat, only update the value...
              (eieio-perform-slot-validation-for-default a tp value skipnil)
              (setcar dp value))
 
              (eieio-perform-slot-validation-for-default a tp value skipnil)
              (setcar dp value))
 
@@ -1246,8 +1266,10 @@ IMPL is the symbol holding the method implementation."
                  (eieio-generic-call-methodname ',method)
                  (eieio-generic-call-arglst local-args)
                  )
                  (eieio-generic-call-methodname ',method)
                  (eieio-generic-call-arglst local-args)
                  )
-             (apply #',impl local-args)
-              ;;(,impl local-args)
+             ,(if (< emacs-major-version 24)
+                 `(apply ,(list 'quote impl) local-args)
+               `(apply #',impl local-args))
+             ;(,impl local-args)
              )))))))
 
 (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
              )))))))
 
 (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
@@ -1312,20 +1334,20 @@ Summary:
 (defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
   (let ((key
 (defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
   (let ((key
-    ;; find optional keys
+         ;; find optional keys
          (cond ((or (eq ':BEFORE kind)
                     (eq ':before kind))
          (cond ((or (eq ':BEFORE kind)
                     (eq ':before kind))
-                method-before)
+                method-before)
                ((or (eq ':AFTER kind)
                     (eq ':after kind))
                ((or (eq ':AFTER kind)
                     (eq ':after kind))
-                method-after)
+                method-after)
                ((or (eq ':PRIMARY kind)
                     (eq ':primary kind))
                ((or (eq ':PRIMARY kind)
                     (eq ':primary kind))
-                method-primary)
+                method-primary)
                ((or (eq ':STATIC kind)
                     (eq ':static kind))
                ((or (eq ':STATIC kind)
                     (eq ':static kind))
-                method-static)
-               ;; Primary key
+                method-static)
+               ;; Primary key
                (t method-primary))))
     ;; Make sure there is a generic (when called from defclass).
     (eieio--defalias
                (t method-primary))))
     ;; Make sure there is a generic (when called from defclass).
     (eieio--defalias
@@ -1338,8 +1360,8 @@ Summary:
     ;; under the type `primary' which is a non-specific calling of the
     ;; function.
     (if argclass
     ;; under the type `primary' which is a non-specific calling of the
     ;; function.
     (if argclass
-         (if (not (class-p argclass))
-             (error "Unknown class type %s in method parameters"
+        (if (not (class-p argclass))
+            (error "Unknown class type %s in method parameters"
                    argclass))
       (if (= key -1)
          (signal 'wrong-type-argument (list :static 'non-class-arg)))
                    argclass))
       (if (= key -1)
          (signal 'wrong-type-argument (list :static 'non-class-arg)))
@@ -1470,7 +1492,7 @@ created by the :initarg tag."
         (c (eieio-slot-name-index class obj slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
         (c (eieio-slot-name-index class obj slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
-       ;; Lets check that info out.
+       ;; Let's check that info out.
        (if (setq c (eieio-class-slot-name-index class slot))
            ;; Oref that slot.
            (aref (aref (class-v class) class-class-allocation-values) c)
        (if (setq c (eieio-class-slot-name-index class slot))
            ;; Oref that slot.
            (aref (aref (class-v class) class-class-allocation-values) c)
@@ -1503,7 +1525,7 @@ Fills in OBJ's SLOT with its default value."
         (c (eieio-slot-name-index cl obj slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
         (c (eieio-slot-name-index cl obj slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
-       ;; Lets check that info out.
+       ;; Let's check that info out.
        (if (setq c
                  (eieio-class-slot-name-index cl slot))
            ;; Oref that slot.
        (if (setq c
                  (eieio-class-slot-name-index cl slot))
            ;; Oref that slot.
@@ -1549,7 +1571,7 @@ Fills in OBJ's SLOT with VALUE."
   (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
   (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
-       ;; Lets check that info out.
+       ;; Let's check that info out.
        (if (setq c
                  (eieio-class-slot-name-index (aref obj object-class) slot))
            ;; Oset that slot.
        (if (setq c
                  (eieio-class-slot-name-index (aref obj object-class) slot))
            ;; Oset that slot.
@@ -1581,7 +1603,7 @@ Fills in the default value in CLASS' in SLOT with VALUE."
         (c (eieio-slot-name-index class nil slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
         (c (eieio-slot-name-index class nil slot)))
     (if (not c)
        ;; It might be missing because it is a :class allocated slot.
-       ;; Lets check that info out.
+       ;; Let's check that info out.
        (if (setq c (eieio-class-slot-name-index class slot))
            (progn
              ;; Oref that slot.
        (if (setq c (eieio-class-slot-name-index class slot))
            (progn
              ;; Oref that slot.
@@ -2000,13 +2022,13 @@ reverse-lookup that name, and recurse with the associated slot value."
         ((not (get fsym 'protection))
          (+ 3 fsi))
         ((and (eq (get fsym 'protection) 'protected)
         ((not (get fsym 'protection))
          (+ 3 fsi))
         ((and (eq (get fsym 'protection) 'protected)
-              scoped-class
+              (bound-and-true-p scoped-class)
               (or (child-of-class-p class scoped-class)
                   (and (eieio-object-p obj)
                        (child-of-class-p class (object-class obj)))))
          (+ 3 fsi))
         ((and (eq (get fsym 'protection) 'private)
               (or (child-of-class-p class scoped-class)
                   (and (eieio-object-p obj)
                        (child-of-class-p class (object-class obj)))))
          (+ 3 fsi))
         ((and (eq (get fsym 'protection) 'private)
-              (or (and scoped-class
+              (or (and (bound-and-true-p scoped-class)
                        (eieio-slot-originating-class-p scoped-class slot))
                   eieio-initializing-object))
          (+ 3 fsi))
                        (eieio-slot-originating-class-p scoped-class slot))
                   eieio-initializing-object))
          (+ 3 fsi))
@@ -2044,7 +2066,7 @@ During executions, the list is first generated, then as each next method
 is called, the next method is popped off the stack.")
 
 (defvar eieio-pre-method-execution-hooks nil
 is called, the next method is popped off the stack.")
 
 (defvar eieio-pre-method-execution-hooks nil
-  "*Hooks run just before a method is executed.
+  "Abnormal hook run just before an EIEIO method is executed.
 The hook function must accept one argument, the list of forms
 about to be executed.")
 
 The hook function must accept one argument, the list of forms
 about to be executed.")
 
@@ -2311,7 +2333,7 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of
 arguments passed in at the top level.
 
 Use `next-method-p' to find out if there is a next method to call."
 arguments passed in at the top level.
 
 Use `next-method-p' to find out if there is a next method to call."
-  (if (not scoped-class)
+  (if (not (bound-and-true-p scoped-class))
       (error "`call-next-method' not called within a class specific method"))
   (if (and (/= eieio-generic-call-key method-primary)
           (/= eieio-generic-call-key method-static))
       (error "`call-next-method' not called within a class specific method"))
   (if (and (/= eieio-generic-call-key method-primary)
           (/= eieio-generic-call-key method-static))
@@ -2395,6 +2417,18 @@ CLASS is the class this method is associated with."
     (if (< key method-num-lists)
        (let ((nsym (intern (symbol-name class) (aref emto key))))
          (fset nsym method)))
     (if (< key method-num-lists)
        (let ((nsym (intern (symbol-name class) (aref emto key))))
          (fset nsym method)))
+    ;; Save the defmethod file location in a symbol property.
+    (let ((fname (if load-in-progress
+                    load-file-name
+                  buffer-file-name))
+         loc)
+      (when fname
+       (when (string-match "\\.elc$" fname)
+         (setq fname (substring fname 0 (1- (length fname)))))
+       (setq loc (get method-name 'method-locations))
+       (add-to-list 'loc
+                    (list class fname))
+       (put method-name 'method-locations loc)))
     ;; Now optimize the entire obarray
     (if (< key method-num-lists)
        (let ((eieiomt-optimizing-obarray (aref emto key)))
     ;; Now optimize the entire obarray
     (if (< key method-num-lists)
        (let ((eieiomt-optimizing-obarray (aref emto key)))
@@ -2543,8 +2577,13 @@ This is usually a symbol that starts with `:'."
 ;;; Here are some CLOS items that need the CL package
 ;;
 
 ;;; Here are some CLOS items that need the CL package
 ;;
 
-(defsetf slot-value (obj slot) (store) (list 'eieio-oset obj slot store))
-(defsetf eieio-oref (obj slot) (store) (list 'eieio-oset obj slot store))
+(defsetf eieio-oref eieio-oset)
+
+(if (eval-when-compile (fboundp 'gv-define-expander))
+    ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
+    ;; follows aliases.
+    nil
+(defsetf slot-value eieio-oset)
 
 ;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
 (define-setf-method oref (obj slot)
 
 ;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
 (define-setf-method oref (obj slot)
@@ -2558,12 +2597,12 @@ This is usually a symbol that starts with `:'."
            (list store-temp)
            (list 'set-slot-value obj-temp slot-temp
                  store-temp)
            (list store-temp)
            (list 'set-slot-value obj-temp slot-temp
                  store-temp)
-           (list 'slot-value obj-temp slot-temp)))))
+           (list 'slot-value obj-temp slot-temp))))))
 
 \f
 ;;;
 ;; We want all objects created by EIEIO to have some default set of
 
 \f
 ;;;
 ;; We want all objects created by EIEIO to have some default set of
-;; behaviours so we can create object utilities, and allow various
+;; behaviors so we can create object utilities, and allow various
 ;; types of error checking.  To do this, create the default EIEIO
 ;; class, and when no parent class is specified, use this as the
 ;; default.  (But don't store it in the other classes as the default,
 ;; types of error checking.  To do this, create the default EIEIO
 ;; class, and when no parent class is specified, use this as the
 ;; default.  (But don't store it in the other classes as the default,
@@ -2794,9 +2833,9 @@ this object."
     (princ (make-string (* eieio-print-depth 2) ? ))
     (princ "(")
     (princ (symbol-name (class-constructor (object-class this))))
     (princ (make-string (* eieio-print-depth 2) ? ))
     (princ "(")
     (princ (symbol-name (class-constructor (object-class this))))
-    (princ " \"")
-    (princ (object-name-string this))
-    (princ "\"\n")
+    (princ " ")
+    (prin1 (object-name-string this))
+    (princ "\n")
     ;; Loop over all the public slots
     (let ((publa (aref cv class-public-a))
          (publd (aref cv class-public-d))
     ;; Loop over all the public slots
     (let ((publa (aref cv class-public-a))
          (publd (aref cv class-public-d))
@@ -2863,7 +2902,106 @@ of `eq'."
 
 )
 
 
 )
 
-\f
+;;; Obsolete backward compatibility functions.
+;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
+
+(defun eieio-defmethod (method args)
+  "Obsolete work part of an old version of the `defmethod' macro."
+  (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
+    ;; find optional keys
+    (setq key
+         (cond ((or (eq ':BEFORE (car args))
+                    (eq ':before (car args)))
+                (setq args (cdr args))
+                method-before)
+               ((or (eq ':AFTER (car args))
+                    (eq ':after (car args)))
+                (setq args (cdr args))
+                method-after)
+               ((or (eq ':PRIMARY (car args))
+                    (eq ':primary (car args)))
+                (setq args (cdr args))
+                method-primary)
+               ((or (eq ':STATIC (car args))
+                    (eq ':static (car args)))
+                (setq args (cdr args))
+                method-static)
+               ;; Primary key
+               (t method-primary)))
+    ;; get body, and fix contents of args to be the arguments of the fn.
+    (setq body (cdr args)
+         args (car args))
+    (setq loopa args)
+    ;; Create a fixed version of the arguments
+    (while loopa
+      (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa))
+                        argfix))
+      (setq loopa (cdr loopa)))
+    ;; make sure there is a generic
+    (eieio-defgeneric
+     method
+     (if (stringp (car body))
+        (car body) (format "Generically created method `%s'." method)))
+    ;; create symbol for property to bind to.  If the first arg is of
+    ;; the form (varname vartype) and `vartype' is a class, then
+    ;; that class will be the type symbol.  If not, then it will fall
+    ;; under the type `primary' which is a non-specific calling of the
+    ;; function.
+    (setq firstarg (car args))
+    (if (listp firstarg)
+       (progn
+         (setq argclass  (nth 1 firstarg))
+         (if (not (class-p argclass))
+             (error "Unknown class type %s in method parameters"
+                    (nth 1 firstarg))))
+      (if (= key -1)
+         (signal 'wrong-type-argument (list :static 'non-class-arg)))
+      ;; generics are higher
+      (setq key (eieio-specialized-key-to-generic-key key)))
+    ;; Put this lambda into the symbol so we can find it
+    (if (byte-code-function-p (car-safe body))
+       (eieiomt-add method (car-safe body) key argclass)
+      (eieiomt-add method (append (list 'lambda (reverse argfix)) body)
+                  key argclass))
+    )
+
+  (when eieio-optimize-primary-methods-flag
+    ;; Optimizing step:
+    ;;
+    ;; If this method, after this setup, only has primary methods, then
+    ;; we can setup the generic that way.
+    (if (generic-primary-only-p method)
+       ;; If there is only one primary method, then we can go one more
+       ;; optimization step.
+       (if (generic-primary-only-one-p method)
+           (eieio-defgeneric-reset-generic-form-primary-only-one method)
+         (eieio-defgeneric-reset-generic-form-primary-only method))
+      (eieio-defgeneric-reset-generic-form method)))
+
+  method)
+(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
+
+(defun eieio-defgeneric (method doc-string)
+  "Obsolete work part of an old version of the `defgeneric' macro."
+  (if (and (fboundp method) (not (generic-p method))
+          (or (byte-code-function-p (symbol-function method))
+              (not (eq 'autoload (car (symbol-function method)))))
+          )
+      (error "You cannot create a generic/method over an existing symbol: %s"
+            method))
+  ;; Don't do this over and over.
+  (unless (fboundp 'method)
+    ;; This defun tells emacs where the first definition of this
+    ;; method is defined.
+    `(defun ,method nil)
+    ;; Make sure the method tables are installed.
+    (eieiomt-install method)
+    ;; Apply the actual body of this function.
+    (fset method (eieio-defgeneric-form method doc-string))
+    ;; Return the method
+    'method))
+(make-obsolete 'eieio-defgeneric nil "24.1")
+
 ;;; Interfacing with edebug
 ;;
 (defun eieio-edebug-prin1-to-string (object &optional noescape)
 ;;; Interfacing with edebug
 ;;
 (defun eieio-edebug-prin1-to-string (object &optional noescape)
@@ -2938,7 +3076,7 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
 ;;; Start of automatically extracted autoloads.
 \f
 ;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
 ;;; Start of automatically extracted autoloads.
 \f
 ;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
-;;;;;;  "cf1bd64c76a6e6406545e8c5a5530d43")
+;;;;;;  "928623502e8bf40454822355388542b5")
 ;;; Generated autoloads from eieio-custom.el
 
 (autoload 'customize-object "eieio-custom" "\
 ;;; Generated autoloads from eieio-custom.el
 
 (autoload 'customize-object "eieio-custom" "\
@@ -2951,7 +3089,7 @@ Optional argument GROUP is the sub-group of slots to display.
 \f
 ;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
 ;;;;;;  eieio-describe-constructor eieio-describe-class eieio-browse)
 \f
 ;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
 ;;;;;;  eieio-describe-constructor eieio-describe-class eieio-browse)
-;;;;;;  "eieio-opt" "eieio-opt.el" "1bed0a56310f402683419139ebc18d7f")
+;;;;;;  "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e")
 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\
 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\
@@ -2960,7 +3098,6 @@ If optional ROOT-CLASS, then start with that, otherwise start with
 variable `eieio-default-superclass'.
 
 \(fn &optional ROOT-CLASS)" t nil)
 variable `eieio-default-superclass'.
 
 \(fn &optional ROOT-CLASS)" t nil)
-
 (defalias 'describe-class 'eieio-describe-class)
 
 (autoload 'eieio-describe-class "eieio-opt" "\
 (defalias 'describe-class 'eieio-describe-class)
 
 (autoload 'eieio-describe-class "eieio-opt" "\
@@ -2975,7 +3112,6 @@ Describe the constructor function FCN.
 Uses `eieio-describe-class' to describe the class being constructed.
 
 \(fn FCN)" t nil)
 Uses `eieio-describe-class' to describe the class being constructed.
 
 \(fn FCN)" t nil)
-
 (defalias 'describe-generic 'eieio-describe-generic)
 
 (autoload 'eieio-describe-generic "eieio-opt" "\
 (defalias 'describe-generic 'eieio-describe-generic)
 
 (autoload 'eieio-describe-generic "eieio-opt" "\