Update copyright year to 2016

[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 5b3d9029c53b003eeefa51c4fa4cef5da9b7c6c5..b99905cf1982722354f86a224ed11c7454df12b7 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.  -*- lexical-binding:t -*-
 
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2015 Free Software
+;;; Copyright (C) 2000-2002, 2004-2005, 2007-2016 Free Software
 ;;; Foundation, Inc.
 
 ;; Author: Eric M. Ludlam  <zappo@gnu.org>
@@ -294,7 +294,8 @@ Second, 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 slot)
-                             (eval-when-compile eieio--object-num-slots)))
+                             (eval-when-compile
+                               (length (cl-struct-slot-info 'eieio--object)))))
                 (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
                                                       slot-idx)))
                 (classtype (eieio-persistent-slot-type-is-class-p type)))
@@ -428,37 +429,28 @@ Optional argument COMMENT is a header line comment."
   "Save persistent object THIS to disk.
 Optional argument FILE overrides the file name specified in the object
 instance."
-  (save-excursion
-    (let ((b (set-buffer (get-buffer-create " *tmp object write*")))
-         (default-directory (file-name-directory (oref this file)))
-         (cfn (oref this file)))
-      (unwind-protect
-         (save-excursion
-           (erase-buffer)
-           (let ((standard-output (current-buffer)))
-             (oset this file
-                   (if file
-                       (eieio-persistent-path-relative this file)
-                     (file-name-nondirectory cfn)))
-             (object-write this (oref this file-header-line)))
-           (let ((backup-inhibited (not (oref this do-backups)))
-                 (cs (car (find-coding-systems-region
-                           (point-min) (point-max)))))
-             (unless (eq cs 'undecided)
-               (setq buffer-file-coding-system cs))
-             ;; Old way - write file.  Leaves message behind.
-             ;;(write-file cfn nil)
-
-             ;; New way - Avoid the vast quantities of error checking
-             ;; just so I can get at the special flags that disable
-             ;; displaying random messages.
-             (write-region (point-min) (point-max)
-                           cfn nil 1)
-             ))
-       ;; Restore :file, and kill the tmp buffer
-       (oset this file cfn)
-       (setq buffer-file-name nil)
-       (kill-buffer b)))))
+  (when file (setq file (expand-file-name file)))
+  (with-temp-buffer
+    (let* ((cfn (or file (oref this file)))
+           (default-directory (file-name-directory cfn)))
+      (cl-letf ((standard-output (current-buffer))
+                ((oref this file)       ;FIXME: Why change it?
+                 (if file
+                     ;; FIXME: Makes a name relative to (oref this file),
+                     ;; whereas I think it should be relative to cfn.
+                     (eieio-persistent-path-relative this file)
+                   (file-name-nondirectory cfn))))
+        (object-write this (oref this file-header-line)))
+      (let ((backup-inhibited (not (oref this do-backups)))
+            (coding-system-for-write 'utf-8-emacs))
+        ;; Old way - write file.  Leaves message behind.
+        ;;(write-file cfn nil)
+
+        ;; New way - Avoid the vast quantities of error checking
+        ;; just so I can get at the special flags that disable
+        ;; displaying random messages.
+        (write-region (point-min) (point-max) cfn nil 1)
+        ))))
 
 ;; Notes on the persistent object:
 ;; It should also set up some hooks to help it keep itself up to date.
@@ -498,6 +490,15 @@ All slots are unbound, except those initialized with PARAMS."
                         (concat nm "-1")))))
     nobj))
 
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+  (if (not (stringp (car args)))
+      (cl-call-next-method)
+    (funcall (if eieio-backward-compatibility #'ignore #'message)
+             "Obsolete: name passed without :object-name to %S constructor"
+             class)
+    (apply #'cl-call-next-method class :object-name args)))
+
+
 (provide 'eieio-base)
 
 ;;; eieio-base.el ends here