From: Richard M. Stallman <rms@gnu.org>
Date: Sat, 23 Apr 2005 16:19:37 +0000 (+0000)
Subject: (Fcopy_file): New arg MUSTBENEW.
X-Git-Tag: ttn-vms-21-2-B4~814
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c50f15d05a0f7da0a2e5a36e9bf8c626c5817d6b;p=emacs.git

(Fcopy_file): New arg MUSTBENEW.
(Frename_file): Pass new arg to Fcopy_file.
---

diff --git a/src/fileio.c b/src/fileio.c
index e4786974860..aaf75da4abb 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2388,7 +2388,7 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
   return;
 }
 
-DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
+DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
        "fCopy file: \nGCopy %s to file: \np\nP",
        doc: /* Copy FILE to NEWNAME.  Both args must be strings.
 If NEWNAME names a directory, copy FILE there.
@@ -2397,11 +2397,19 @@ unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
 A number as third arg means request confirmation if NEWNAME already exists.
 This is what happens in interactive use with M-x.
 Always sets the file modes of the output file to match the input file.
+
 Fourth arg KEEP-TIME non-nil means give the output file the same
 last-modified time as the old one.  (This works on only some systems.)
+The optional fifth arg MUSTBENEW, if non-nil, insists on a check
+  for an existing file with the same name.  If MUSTBENEW is `excl',
+  that means to get an error if the file already exists; never overwrite.
+  If MUSTBENEW is neither nil nor `excl', that means ask for
+  confirmation before overwriting, but do go ahead and overwrite the file
+  if the user confirms.
+
 A prefix arg makes KEEP-TIME non-nil.  */)
-     (file, newname, ok_if_already_exists, keep_time)
-     Lisp_Object file, newname, ok_if_already_exists, keep_time;
+  (file, newname, ok_if_already_exists, keep_time, mustbenew)
+     Lisp_Object file, newname, ok_if_already_exists, keep_time, mustbenew;
 {
   int ifd, ofd, n;
   char buf[16 * 1024];
@@ -2417,6 +2425,9 @@ A prefix arg makes KEEP-TIME non-nil.  */)
   CHECK_STRING (file);
   CHECK_STRING (newname);
 
+  if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
+    barf_or_query_if_file_exists (newname, "overwrite", 1, 0, 1);
+
   if (!NILP (Ffile_directory_p (newname)))
     newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
   else
@@ -2517,9 +2528,15 @@ A prefix arg makes KEEP-TIME non-nil.  */)
 #else
 #ifdef MSDOS
   /* System's default file type was set to binary by _fmode in emacs.c.  */
-  ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE);
-#else /* not MSDOS */
-  ofd = creat (SDATA (encoded_newname), 0666);
+  ofd = emacs_open (SDATA (encoded_newname),
+		    O_WRONLY | O_CREAT | buffer_file_type
+		    | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
+		    S_IREAD | S_IWRITE);
+#else  /* not MSDOS */
+  ofd = emacs_open (SDATA (encoded_newname),
+		    O_WRONLY | O_TRUNC | O_CREAT
+		    | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
+		    0666);
 #endif /* not MSDOS */
 #endif /* VMS */
   if (ofd < 0)
@@ -2749,7 +2766,8 @@ This is what happens in interactive use with M-x.  */)
             Fcopy_file (file, newname,
                         /* We have already prompted if it was an integer,
                            so don't have copy-file prompt again.  */
-                        NILP (ok_if_already_exists) ? Qnil : Qt, Qt);
+                        NILP (ok_if_already_exists) ? Qnil : Qt,
+			Qt, Qnil);
 	  Fdelete_file (file);
 	}
       else