Update CEDET from upstream.

6 files changed, 366 insertions, 66 deletions

diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index b5600560cdd..6677e2c3abb 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -4,7 +4,6 @@
 ;;; Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam  <zappo@gnu.org>
-;; Version: 0.2
 ;; Keywords: OO, lisp
 ;; Package: eieio
 
@@ -225,8 +224,16 @@ a file.  Optional argument NAME specifies a default file name."
 			      ))))
   (oref this file))
 
-(defun eieio-persistent-read (filename)
-  "Read a persistent object from FILENAME, and return it."
+(defun eieio-persistent-read (filename &optional class allow-subclass)
+  "Read a persistent object from FILENAME, and return it.
+Signal an error if the object in FILENAME is not a constructor
+for CLASS.  Optional ALLOW-SUBCLASS says that it is ok for
+`eieio-peristent-read' to load in subclasses of class instead of
+being pendantic."
+  (unless class
+    (message "Unsafe call to `eieio-persistent-read'."))
+  (when (and class (not (class-p class)))
+    (signal 'wrong-type-argument (list 'class-p class)))
   (let ((ret nil)
 	(buffstr nil))
     (unwind-protect
@@ -239,13 +246,171 @@ a file.  Optional argument NAME specifies a default file name."
 	  ;; so that any initialize-instance calls that depend on
 	  ;; the current buffer will work.
 	  (setq ret (read buffstr))
-	  (if (not (child-of-class-p (car ret) 'eieio-persistent))
-	      (error "Corrupt object on disk"))
-	  (setq ret (eval ret))
+	  (when (not (child-of-class-p (car ret) 'eieio-persistent))
+	    (error "Corrupt object on disk: Unknown saved object"))
+	  (when (and class
+		     (not (or (eq (car ret) class ) ; same class
+			      (and allow-subclass
+				   (child-of-class-p (car ret) class)) ; subclasses
+			      )))
+	    (error "Corrupt object on disk: Invalid saved class"))
+	  (setq ret (eieio-persistent-convert-list-to-object ret))
 	  (oset ret file filename))
       (kill-buffer " *tmp eieio read*"))
     ret))
 
+(defun eieio-persistent-convert-list-to-object (inputlist)
+  "Convert the INPUTLIST, representing object creation to an object.
+While it is possible to just `eval' the INPUTLIST, this code instead
+validates the existing list, and explicitly creates objects instead of
+calling eval.  This avoids the possibility of accidentally running
+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))
+	(slots (nthcdr 2 inputlist))
+	(createslots nil))
+
+    ;; If OBJCLASS is an eieio autoload object, then we need to load it.
+    (eieio-class-un-autoload objclass)
+
+    (while slots
+      (let ((name (car slots))
+	    (value (car (cdr slots))))
+
+	;; Make sure that the value proposed for SLOT is valid.
+	;; In addition, strip out quotes, list functions, and update
+	;; object constructors as needed.
+	(setq value (eieio-persistent-validate/fix-slot-value
+		     objclass name value))
+
+	(push name createslots)
+	(push value createslots)
+	)
+
+      (setq slots (cdr (cdr slots))))
+
+    (apply 'make-instance objclass objname (nreverse createslots))
+
+    ;;(eval inputlist)
+    ))
+
+(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
+  "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
+A limited number of functions, such as quote, list, and valid object
+constructor functions are considered valid.
+Secondarilly, any text properties will be stripped from strings."
+  (cond ((consp proposed-value)
+	 ;; Lists with something in them need special treatment.
+	 (let ((slot-idx (eieio-slot-name-index class nil slot))
+	       (type nil)
+	       (classtype nil))
+	   (setq slot-idx (- slot-idx 3))
+	   (setq type (aref (aref (class-v class) class-public-type)
+			    slot-idx))
+
+	   (setq classtype (eieio-persistent-slot-type-is-class-p
+			    type))
+
+	   (cond ((eq (car proposed-value) 'quote)
+		  (car (cdr proposed-value)))
+
+		 ;; An empty list sometimes shows up as (list), which is dumb, but
+		 ;; we need to support it for backward compat.
+		 ((and (eq (car proposed-value) 'list)
+		       (= (length proposed-value) 1))
+		  nil)
+
+		  ;; We have a slot with a single object that can be
+		  ;; saved here.  Recurse and evaluate that
+		  ;; sub-object.
+		 ((and classtype (class-p classtype)
+		       (child-of-class-p (car proposed-value) classtype))
+		  (eieio-persistent-convert-list-to-object
+		   proposed-value))
+
+		 ;; List of object constructors.
+		 ((and (eq (car proposed-value) 'list)
+		       ;; 2nd item is a list.
+		       (consp (car (cdr proposed-value)))
+		       ;; 1st elt of 2nd item is a class name.
+		       (class-p (car (car (cdr proposed-value))))
+		       )
+
+		  ;; Check the value against the input class type.
+		  ;; If something goes wrong, issue a smart warning
+		  ;; about how a :type is needed for this to work.
+		  (unless (and
+			   ;; Do we have a type?
+			   (consp classtype) (class-p (car classtype)))
+		    (error "In save file, list of object constructors found, but no :type specified for slot %S"
+			   slot))
+
+		  ;; We have a predicate, but it doesn't satisfy the predicate?
+		  (dolist (PV (cdr proposed-value))
+		    (unless (child-of-class-p (car PV) (car classtype))
+		      (error "Corrupt object on disk")))
+
+		  ;; We have a list of objects here.  Lets load them
+		  ;; in.
+		  (let ((objlist nil))
+		    (dolist (subobj (cdr proposed-value))
+		      (push (eieio-persistent-convert-list-to-object subobj)
+			    objlist))
+		    ;; return the list of objects ... reversed.
+		    (nreverse objlist)))
+		 (t
+		  proposed-value))))
+
+	 ((stringp proposed-value)
+	  ;; Else, check for strings, remove properties.
+	  (substring-no-properties proposed-value))
+
+	 (t
+	  ;; Else, just return whatever the constant was.
+	  proposed-value))
+  )
+
+(defun eieio-persistent-slot-type-is-class-p (type)
+  "Return the class refered to in TYPE.
+If no class is referenced there, then return nil."
+  (cond ((class-p type)
+	 ;; If the type is a class, then return it.
+	 type)
+
+	((and (symbolp type) (string-match "-child$" (symbol-name type))
+	      (class-p (intern-soft (substring (symbol-name type) 0
+					       (match-beginning 0)))))
+	 ;; If it is the predicate ending with -child, then return
+	 ;; that class.  Unfortunately, in EIEIO, typep of just the
+	 ;; class is the same as if we used -child, so no further work needed.
+	 (intern-soft (substring (symbol-name type) 0
+				 (match-beginning 0))))
+
+	((and (symbolp type) (string-match "-list$" (symbol-name type))
+	      (class-p (intern-soft (substring (symbol-name type) 0
+					       (match-beginning 0)))))
+	 ;; If it is the predicate ending with -list, then return
+	 ;; that class and the predicate to use.
+	 (cons (intern-soft (substring (symbol-name type) 0
+				       (match-beginning 0)))
+	       type))
+
+	((and (consp type) (eq (car type) 'or))
+	 ;; If type is a list, and is an or, it is possibly something
+	 ;; like (or null myclass), so check for that.
+	 (let ((ans nil))
+	   (dolist (subtype (cdr type))
+	     (setq ans (eieio-persistent-slot-type-is-class-p
+			subtype)))
+	   ans))
+
+	(t
+	 ;; No match, not a class.
+	 nil)))
+
 (defmethod object-write ((this eieio-persistent) &optional comment)
   "Write persistent object THIS out to the current stream.
 Optional argument COMMENT is a header line comment."
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 59aeb161d8e..cab9caad108 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -332,6 +332,16 @@ Argument OBJ is the object that has been customized."
 Optional argument GROUP is the sub-group of slots to display."
   (eieio-customize-object obj group))
 
+(defvar eieio-custom-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map widget-keymap)
+    map)
+  "Keymap for EIEIO Custom mode")
+
+(define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom"
+  "Major mode for customizing EIEIO objects.
+\\{eieio-custom-mode-map}")
+
 (defmethod eieio-customize-object ((obj eieio-default-superclass)
 				   &optional group)
   "Customize OBJ in a specialized custom buffer.
@@ -347,6 +357,7 @@ These groups are specified with the `:group' slot flag."
 			       (symbol-name g) "*")))
     (setq buffer-read-only nil)
     (kill-all-local-variables)
+    (eieio-custom-mode)
     (erase-buffer)
     (let ((all (overlay-lists)))
       ;; Delete all the overlays.
@@ -363,7 +374,6 @@ These groups are specified with the `:group' slot flag."
     (widget-insert "\n")
     (eieio-custom-object-apply-reset obj)
     ;; Now initialize the buffer
-    (use-local-map widget-keymap)
     (widget-setup)
     ;;(widget-minor-mode)
     (goto-char (point-min))
@@ -461,8 +471,4 @@ Return the symbol for the group, or nil"
 
 (provide 'eieio-custom)
 
-;; Local variables:
-;; generated-autoload-file: "eieio.el"
-;; End:
-
 ;;; eieio-custom.el ends here
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index b7f0deb0ee2..ec470d21bf3 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -92,12 +92,11 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 				  "Class: ")
     ;; Loop over all the public slots
     (let ((publa (aref cv class-public-a))
-	  (publd (aref cv class-public-d))
 	  )
       (while publa
 	(if (slot-boundp obj (car publa))
-	    (let ((i (class-slot-initarg cl (car publa)))
-		  (v (eieio-oref obj (car publa))))
+	    (let* ((i (class-slot-initarg cl (car publa)))
+		   (v (eieio-oref obj (car publa))))
 	      (data-debug-insert-thing
 	       v prefix (concat
 			 (if i (symbol-name i)
@@ -112,7 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 		     " ")
 	     'font-lock-keyword-face))
 	  )
-	(setq publa (cdr publa) publd (cdr publd))))))
+	(setq publa (cdr publa))))))
 
 ;;; Augment the Data debug thing display list.
 (data-debug-add-specialized-thing (lambda (thing) (object-p thing))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index a899839f68a..64b240b9d5d 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -4,7 +4,6 @@
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
 ;; Keywords: OO, lisp
 ;; Package: eieio
 
@@ -30,6 +29,9 @@
 ;;
 
 (require 'eieio)
+(require 'button)
+(require 'help-mode)
+(require 'find-func)
 
 ;;; Code:
 ;;;###autoload
@@ -85,11 +87,16 @@ Optional HEADERFCN should be called to insert a few bits of info first."
 		     (called-interactively-p 'interactive))
 
     (when headerfcn (funcall headerfcn))
-
-    (if (class-option class :abstract)
-	(princ "Abstract "))
-    (princ "Class ")
     (prin1 class)
+    (princ " is a")
+    (if (class-option class :abstract)
+	(princ "n abstract"))
+    (princ " class")
+    ;; Print file location
+    (when (get class 'class-location)
+      (princ " in `")
+      (princ (file-name-nondirectory (get class 'class-location)))
+      (princ "'"))
     (terpri)
     ;; Inheritance tree information
     (let ((pl (class-parents class)))
@@ -251,8 +258,13 @@ Uses `eieio-describe-class' to describe the class being constructed."
   (eieio-describe-class
    fcn (lambda ()
 	 ;; Describe the constructor part.
-	 (princ "Object Constructor Function: ")
 	 (prin1 fcn)
+	 (princ " is an object constructor function")
+	 ;; Print file location
+	 (when (get fcn 'class-location)
+	   (princ " in `")
+	   (princ (file-name-nondirectory (get fcn 'class-location)))
+	   (princ "'"))
 	 (terpri)
 	 (princ "Creates an object of class ")
 	 (prin1 fcn)
@@ -262,6 +274,16 @@ Uses `eieio-describe-class' to describe the class being constructed."
 	 ))
   )
 
+(defun eieio-build-class-list (class)
+  "Return a list of all classes that inherit from CLASS."
+  (if (class-p class)
+      (apply #'append
+	     (mapcar
+	      (lambda (c)
+		(append (list c) (eieio-build-class-list c)))
+	      (class-children-fast class)))
+    (list class)))
+
 (defun eieio-build-class-alist (&optional class instantiable-only buildlist)
   "Return an alist of all currently active classes for completion purposes.
 Optional argument CLASS is the class to start with.
@@ -270,8 +292,9 @@ 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))
 	 (sublst (aref (class-v cc) class-children)))
-    (if (or (not instantiable-only) (not (class-abstract-p cc)))
-	(setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))
+    (unless (assoc (symbol-name cc) buildlist)
+      (when (or (not instantiable-only) (not (class-abstract-p cc)))
+	(setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
     (while sublst
       (setq buildlist (eieio-build-class-alist
 		       (car sublst) instantiable-only buildlist))
@@ -342,10 +365,10 @@ Also extracts information about all methods specific to this generic."
     (princ "Implementations:")
     (terpri)
     (terpri)
-    (let ((i 3)
+    (let ((i 4)
 	  (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
       ;; Loop over fanciful generics
-      (while (< i 6)
+      (while (< i 7)
 	(let ((gm (aref (get generic 'eieio-method-tree) i)))
 	  (when gm
 	    (princ "Generic ")
@@ -357,8 +380,9 @@ Also extracts information about all methods specific to this generic."
 	(setq i (1+ i)))
       (setq i 0)
       ;; Loop over defined class-specific methods
-      (while (< i 3)
-	(let ((gm (reverse (aref (get generic 'eieio-method-tree) i))))
+      (while (< i 4)
+	(let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
+	      location)
 	  (while gm
 	    (princ "`")
 	    (prin1 (car (car gm)))
@@ -375,6 +399,13 @@ Also extracts information about all methods specific to this generic."
 	    ;; 3 because of cdr
 	    (princ (or (documentation (cdr (car gm)))
 		       "Undocumented"))
+	    ;; Print file location if available
+	    (when (and (setq location (get generic 'method-locations))
+		       (setq location (assoc (caar gm) location)))
+	      (setq location (cadr location))
+	      (princ "\n\nDefined in `")
+	      (princ (file-name-nondirectory location))
+	      (princ "'\n"))
 	    (setq gm (cdr gm))
 	    (terpri)
 	    (terpri)))
@@ -554,7 +585,65 @@ Optional argument HISTORYVAR is the variable to use as history."
 
 ;;; HELP AUGMENTATION
 ;;
-;;;###autoload
+(define-button-type 'eieio-method-def
+  :supertype 'help-xref
+  'help-function (lambda (class method file)
+		   (eieio-help-find-method-definition class method file))
+  'help-echo (purecopy "mouse-2, RET: find method's definition"))
+
+(define-button-type 'eieio-class-def
+  :supertype 'help-xref
+  'help-function (lambda (class file)
+		   (eieio-help-find-class-definition class file))
+  'help-echo (purecopy "mouse-2, RET: find class definition"))
+
+(defun eieio-help-find-method-definition (class method file)
+  (let ((filename (find-library-name file))
+	location buf)
+    (when (null filename)
+      (error "Cannot find library %s" file))
+    (setq buf (find-file-noselect filename))
+    (with-current-buffer buf
+      (goto-char (point-min))
+      (when
+	  (re-search-forward
+	   ;; Regexp for searching methods.
+	   (concat "(defmethod[ \t\r\n]+" method
+		   "\\([ \t\r\n]+:[a-zA-Z]+\\)?"
+		   "[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
+		   class
+		   "\\s-*)")
+	   nil t)
+	(setq location (match-beginning 0))))
+    (if (null location)
+	(message "Unable to find location in file")
+      (pop-to-buffer buf)
+      (goto-char location)
+      (recenter)
+      (beginning-of-line))))
+
+(defun eieio-help-find-class-definition (class file)
+  (let ((filename (find-library-name file))
+	location buf)
+    (when (null filename)
+      (error "Cannot find library %s" file))
+    (setq buf (find-file-noselect filename))
+    (with-current-buffer buf
+      (goto-char (point-min))
+      (when
+	  (re-search-forward
+	   ;; Regexp for searching a class.
+	   (concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
+	   nil t)
+	(setq location (match-beginning 0))))
+    (if (null location)
+	(message "Unable to find location in file")
+      (pop-to-buffer buf)
+      (goto-char location)
+      (recenter)
+      (beginning-of-line))))
+
+
 (defun eieio-help-mode-augmentation-maybee (&rest unused)
   "For buffers thrown into help mode, augment for EIEIO.
 Arguments UNUSED are not used."
@@ -597,6 +686,26 @@ Arguments UNUSED are not used."
 	(goto-char (point-min))
 	(while (re-search-forward "^\\(Private \\)?Slot:" nil t)
 	    (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+	(goto-char (point-min))
+	(cond
+	 ((looking-at "\\(.+\\) is a generic function")
+	  (let ((mname (match-string 1))
+		cname)
+	    (while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
+	      (setq cname (match-string-no-properties 1))
+	      (help-xref-button 2 'eieio-method-def cname
+				mname
+				(cadr (assoc (intern cname)
+					     (get (intern mname)
+						  'method-locations)))))))
+	 ((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
+	  (let ((cname (match-string-no-properties 1)))
+	    (help-xref-button 2 'eieio-class-def cname
+			      (get (intern cname) 'class-location))))
+	 ((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
+	  (let ((cname (match-string-no-properties 1)))
+	    (help-xref-button 3 'eieio-class-def cname
+			      (get (intern cname) 'class-location)))))
 	))))
 
 ;;; SPEEDBAR SUPPORT
@@ -698,8 +807,4 @@ INDENT is the current indentation level."
 
 (provide 'eieio-opt)
 
-;; Local variables:
-;; generated-autoload-file: "eieio.el"
-;; End:
-
 ;;; eieio-opt.el ends here
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index f169e3f0cd2..327e5ced0e3 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -3,7 +3,6 @@
 ;; Copyright (C) 1999-2002, 2005, 2007-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
 ;; Keywords: OO, tools
 ;; Package: eieio
 
@@ -191,23 +190,24 @@ that path."
 
 ;;; DEFAULT SUPERCLASS baseline methods
 ;;
-;; First, define methods onto the superclass so all classes
-;; will have some minor support.
+;; First, define methods with no class defined.  These will work as if
+;; on the default superclass.  Specifying no class will allow these to be used
+;; when no other methods are found, allowing multiple inheritance to work
+;; reliably with eieio-speedbar.
 
-(defmethod eieio-speedbar-description ((object eieio-default-superclass))
+(defmethod eieio-speedbar-description (object)
   "Return a string describing OBJECT."
   (object-name-string object))
 
-(defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass))
+(defmethod eieio-speedbar-derive-line-path (object)
   "Return the path which OBJECT has something to do with."
   nil)
 
-(defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass))
+(defmethod eieio-speedbar-object-buttonname (object)
   "Return a string to use as a speedbar button for OBJECT."
   (object-name-string object))
 
-(defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass)
-					 depth)
+(defmethod eieio-speedbar-make-tag-line (object depth)
   "Insert a tag line into speedbar at point for OBJECT.
 By default, all objects appear as simple TAGS with no need to inherit from
 the special `eieio-speedbar' classes.  Child classes should redefine this
@@ -220,7 +220,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
 			  'speedbar-tag-face
 			  depth))
 
-(defmethod eieio-speedbar-handle-click ((object eieio-default-superclass))
+(defmethod eieio-speedbar-handle-click (object)
   "Handle a click action on OBJECT in speedbar.
 Any object can be represented as a tag in SPEEDBAR without special
 attributes.  These default objects will be pulled up in a custom
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 9304f0e3918..5feaa151fb8 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -4,7 +4,6 @@
 ;; Copyright (C) 1995-1996, 1998-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 1.3
 ;; Keywords: OO, lisp
 
 ;; This file is part of GNU Emacs.
@@ -94,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.")
 
-;; 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.")
 
@@ -410,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 (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
 
 	))))
 
@@ -539,6 +524,23 @@ See `defclass' for more information."
 	       (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
@@ -781,6 +783,16 @@ See `defclass' for more information."
     (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)
@@ -1254,8 +1266,10 @@ IMPL is the symbol holding the method implementation."
 		  (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)
@@ -2008,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)
-	       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 (and scoped-class
+	       (or (and (bound-and-true-p scoped-class)
 			(eieio-slot-originating-class-p scoped-class slot))
 		   eieio-initializing-object))
 	  (+ 3 fsi))
@@ -2319,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."
-  (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))
@@ -2403,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)))
+    ;; 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)))
@@ -2807,9 +2833,9 @@ this object."
     (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))
@@ -2876,7 +2902,6 @@ of `eq'."
 
 )
 
-
 ;;; Obsolete backward compatibility functions.
 ;; Needed to run byte-code compiled with the EIEIO of Emacs-23.