]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
merge from trunk
[gnu-emacs] / src / fileio.c
index a19fcd9f66380a33364a6607589d063caa192c70..7cad8d29da2dc0ad60e4f23a0335c79ab299b288 100644 (file)
@@ -366,8 +366,7 @@ Given a Unix syntax file name, returns a string ending in slash.  */)
     }
 
 #ifdef DOS_NT
-  beg = alloca (SBYTES (filename) + 1);
-  memcpy (beg, SSDATA (filename), SBYTES (filename) + 1);
+  beg = xlispstrdupa (filename);
 #else
   beg = SSDATA (filename);
 #endif
@@ -505,6 +504,10 @@ get a current directory to run processes in.  */)
   return Ffile_name_directory (filename);
 }
 
+/* Maximum number of bytes that DST will be longer than SRC
+   in file_name_as_directory.  This occurs when SRCLEN == 0.  */
+enum { file_name_as_directory_slop = 2 };
+
 /* Convert from file name SRC of length SRCLEN to directory name in
    DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
    string.  On UNIX, just make sure there is a terminating /.  Return
@@ -522,14 +525,10 @@ file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
       return 2;
     }
 
-  strcpy (dst, src);
-
+  memcpy (dst, src, srclen);
   if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
-    {
-      dst[srclen] = DIRECTORY_SEP;
-      dst[srclen + 1] = '\0';
-      srclen++;
-    }
+    dst[srclen++] = DIRECTORY_SEP;
+  dst[srclen] = 0;
 #ifdef DOS_NT
   dostounix_filename (dst, multibyte);
 #endif
@@ -548,7 +547,8 @@ For a Unix-syntax file name, just appends a slash.  */)
 {
   char *buf;
   ptrdiff_t length;
-  Lisp_Object handler;
+  Lisp_Object handler, val;
+  USE_SAFE_ALLOCA;
 
   CHECK_STRING (file);
   if (NILP (file))
@@ -570,10 +570,12 @@ For a Unix-syntax file name, just appends a slash.  */)
   if (!NILP (Vw32_downcase_file_names))
     file = Fdowncase (file);
 #endif
-  buf = alloca (SBYTES (file) + 10);
+  buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
   length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
                                   STRING_MULTIBYTE (file));
-  return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
+  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
+  SAFE_FREE ();
+  return val;
 }
 \f
 /* Convert from directory name SRC of length SRCLEN to file name in
@@ -585,18 +587,17 @@ static ptrdiff_t
 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
 {
   /* Process as Unix format: just remove any final slash.
-     But leave "/" unchanged; do not change it to "".  */
-  strcpy (dst, src);
-  if (srclen > 1
-      && IS_DIRECTORY_SEP (dst[srclen - 1])
+     But leave "/" and "//" unchanged.  */
+  while (srclen > 1
 #ifdef DOS_NT
-      && !IS_ANY_SEP (dst[srclen - 2])
+        && !IS_ANY_SEP (src[srclen - 2])
 #endif
-      )
-    {
-      dst[srclen - 1] = 0;
-      srclen--;
-    }
+        && IS_DIRECTORY_SEP (src[srclen - 1])
+        && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
+    srclen--;
+
+  memcpy (dst, src, srclen);
+  dst[srclen] = 0;
 #ifdef DOS_NT
   dostounix_filename (dst, multibyte);
 #endif
@@ -614,7 +615,8 @@ In Unix-syntax, this function just removes the final slash.  */)
 {
   char *buf;
   ptrdiff_t length;
-  Lisp_Object handler;
+  Lisp_Object handler, val;
+  USE_SAFE_ALLOCA;
 
   CHECK_STRING (directory);
 
@@ -637,10 +639,12 @@ In Unix-syntax, this function just removes the final slash.  */)
   if (!NILP (Vw32_downcase_file_names))
     directory = Fdowncase (directory);
 #endif
-  buf = alloca (SBYTES (directory) + 20);
+  buf = SAFE_ALLOCA (SBYTES (directory) + 1);
   length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
                                STRING_MULTIBYTE (directory));
-  return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
+  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
+  SAFE_FREE ();
+  return val;
 }
 
 static const char make_temp_name_tbl[64] =
@@ -838,6 +842,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
   Lisp_Object handler, result, handled_name;
   bool multibyte;
   Lisp_Object hdir;
+  USE_SAFE_ALLOCA;
 
   CHECK_STRING (name);
 
@@ -944,8 +949,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
 #endif
 
   /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below.  */
-  nm = alloca (SBYTES (name) + 1);
-  memcpy (nm, SSDATA (name), SBYTES (name) + 1);
+  nm = xlispstrdupa (name);
 
 #ifdef DOS_NT
   /* Note if special escape prefix is present, but remove for now.  */
@@ -1013,11 +1017,11 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
                  || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
                                      || p[3] == 0))))
            lose = 1;
-         /* We want to replace multiple `/' in a row with a single
-            slash.  */
-         else if (p > nm
-                  && IS_DIRECTORY_SEP (p[0])
-                  && IS_DIRECTORY_SEP (p[1]))
+         /* Replace multiple slashes with a single one, except
+            leave leading "//" alone.  */
+         else if (IS_DIRECTORY_SEP (p[0])
+                  && IS_DIRECTORY_SEP (p[1])
+                  && (p != nm || IS_DIRECTORY_SEP (p[2])))
            lose = 1;
          p++;
        }
@@ -1100,10 +1104,11 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
       else                     /* ~user/filename */
        {
          char *o, *p;
-         for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++);
-         o = alloca (p - nm + 1);
+         for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
+           continue;
+         o = SAFE_ALLOCA (p - nm + 1);
          memcpy (o, nm, p - nm);
-         o [p - nm] = 0;
+         o[p - nm] = 0;
 
          block_input ();
          pw = getpwnam (o + 1);
@@ -1219,7 +1224,8 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          if (!IS_DIRECTORY_SEP (nm[0]))
            {
              ptrdiff_t newlen = strlen (newdir);
-             char *tmp = alloca (newlen + strlen (nm) + 2);
+             char *tmp = alloca (newlen + file_name_as_directory_slop
+                                 + strlen (nm) + 1);
              file_name_as_directory (tmp, newdir, newlen, multibyte);
              strcat (tmp, nm);
              nm = tmp;
@@ -1273,31 +1279,18 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
 
   if (newdir)
     {
-      /* Get rid of any slash at the end of newdir, unless newdir is
-        just / or // (an incomplete UNC name).  */
+      /* Ignore any slash at the end of newdir, unless newdir is
+        just "/" or "//".  */
       length = strlen (newdir);
-      tlen = length + 1;
-      if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
-#ifdef WINDOWSNT
-         && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
-#endif
-         )
-       {
-         char *temp = alloca (length);
-         memcpy (temp, newdir, length - 1);
-         temp[length - 1] = 0;
-         length--;
-         newdir = temp;
-       }
+      while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
+            && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
+       length--;
     }
   else
-    {
-      length = 0;
-      tlen = 0;
-    }
+    length = 0;
 
   /* Now concatenate the directory and name to new space in the stack frame.  */
-  tlen += strlen (nm) + 1;
+  tlen = length + file_name_as_directory_slop + strlen (nm) + 1;
 #ifdef DOS_NT
   /* Reserve space for drive specifier and escape prefix, since either
      or both may need to be inserted.  (The Microsoft x86 compiler
@@ -1305,7 +1298,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
   target = alloca (tlen + 4);
   target += 4;
 #else  /* not DOS_NT */
-  target = alloca (tlen);
+  target = SAFE_ALLOCA (tlen);
 #endif /* not DOS_NT */
   *target = 0;
 
@@ -1322,7 +1315,10 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
                && newdir[1] == '\0'))
 #endif
-           strcpy (target, newdir);
+           {
+             memcpy (target, newdir, length);
+             target[length] = 0;
+           }
        }
       else
        file_name_as_directory (target, newdir, length, multibyte);
@@ -1382,8 +1378,9 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
              ++o;
            p += 3;
          }
-       else if (p > target && IS_DIRECTORY_SEP (p[1]))
-         /* Collapse multiple `/' in a row.  */
+       else if (IS_DIRECTORY_SEP (p[1])
+                && (p != target || IS_DIRECTORY_SEP (p[2])))
+         /* Collapse multiple "/", except leave leading "//" alone.  */
          p++;
        else
          {
@@ -1431,11 +1428,12 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
     {
       handled_name = call3 (handler, Qexpand_file_name,
                            result, default_directory);
-      if (STRINGP (handled_name))
-       return handled_name;
-      error ("Invalid handler in `file-name-handler-alist'");
+      if (STRINGP (handled_name))
+       error ("Invalid handler in `file-name-handler-alist'");
+      result = handled_name;
     }
 
+  SAFE_FREE ();
   return result;
 }
 
@@ -1693,8 +1691,7 @@ those `/' is discarded.  */)
   /* Always work on a copy of the string, in case GC happens during
      decode of environment variables, causing the original Lisp_String
      data to be relocated.  */
-  nm = alloca (SBYTES (filename) + 1);
-  memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
+  nm = xlispstrdupa (filename);
 
 #ifdef DOS_NT
   dostounix_filename (nm, multibyte);
@@ -3860,7 +3857,8 @@ by calling `format-decode', which see.  */)
       if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
        {
          emacs_close (fd);
-         specpdl_ptr--;
+         clear_unwind_protect (fd_index);
+
          /* Truncate the buffer to the size of the file.  */
          del_range_1 (same_at_start, same_at_end, 0, 0);
          goto handled;
@@ -4745,25 +4743,39 @@ This does code conversion according to the value of
 
 This calls `write-region-annotate-functions' at the start, and
 `write-region-post-annotation-function' at the end.  */)
-  (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
+  (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
+   Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
+{
+  return write_region (start, end, filename, append, visit, lockname, mustbenew,
+                      -1);
+}
+
+/* Like Fwrite_region, except that if DESC is nonnegative, it is a file
+   descriptor for FILENAME, so do not open or close FILENAME.  */
+
+Lisp_Object
+write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
+             Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
+             Lisp_Object mustbenew, int desc)
 {
-  int desc;
   int open_flags;
   int mode;
   off_t offset IF_LINT (= 0);
+  bool open_and_close_file = desc < 0;
   bool ok;
   int save_errno = 0;
   const char *fn;
   struct stat st;
   EMACS_TIME modtime;
   ptrdiff_t count = SPECPDL_INDEX ();
-  ptrdiff_t count1;
+  ptrdiff_t count1 IF_LINT (= 0);
   Lisp_Object handler;
   Lisp_Object visit_file;
   Lisp_Object annotations;
   Lisp_Object encoded_filename;
   bool visiting = (EQ (visit, Qt) || STRINGP (visit));
   bool quietly = !NILP (visit);
+  bool file_locked = 0;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   struct buffer *given_buffer;
   struct coding_system coding;
@@ -4831,7 +4843,6 @@ This calls `write-region-annotate-functions' at the start, and
   record_unwind_protect (build_annotations_unwind,
                         Vwrite_region_annotation_buffers);
   Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
-  count1 = SPECPDL_INDEX ();
 
   given_buffer = current_buffer;
 
@@ -4870,8 +4881,11 @@ This calls `write-region-annotate-functions' at the start, and
     coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
 
 #ifdef CLASH_DETECTION
-  if (!auto_saving)
-    lock_file (lockname);
+  if (open_and_close_file && !auto_saving)
+    {
+      lock_file (lockname);
+      file_locked = 1;
+    }
 #endif /* CLASH_DETECTION */
 
   encoded_filename = ENCODE_FILE (filename);
@@ -4888,19 +4902,23 @@ This calls `write-region-annotate-functions' at the start, and
   mode = auto_saving ? auto_save_mode_bits : 0666;
 #endif
 
-  desc = emacs_open (fn, open_flags, mode);
-
-  if (desc < 0)
+  if (open_and_close_file)
     {
-      int open_errno = errno;
+      desc = emacs_open (fn, open_flags, mode);
+      if (desc < 0)
+       {
+         int open_errno = errno;
 #ifdef CLASH_DETECTION
-      if (!auto_saving) unlock_file (lockname);
+         if (file_locked)
+           unlock_file (lockname);
 #endif /* CLASH_DETECTION */
-      UNGCPRO;
-      report_file_errno ("Opening output file", filename, open_errno);
-    }
+         UNGCPRO;
+         report_file_errno ("Opening output file", filename, open_errno);
+       }
 
-  record_unwind_protect_int (close_file_unwind, desc);
+      count1 = SPECPDL_INDEX ();
+      record_unwind_protect_int (close_file_unwind, desc);
+    }
 
   if (NUMBERP (append))
     {
@@ -4909,7 +4927,8 @@ This calls `write-region-annotate-functions' at the start, and
        {
          int lseek_errno = errno;
 #ifdef CLASH_DETECTION
-         if (!auto_saving) unlock_file (lockname);
+         if (file_locked)
+           unlock_file (lockname);
 #endif /* CLASH_DETECTION */
          UNGCPRO;
          report_file_errno ("Lseek error", filename, lseek_errno);
@@ -4944,9 +4963,9 @@ This calls `write-region-annotate-functions' at the start, and
 
   immediate_quit = 0;
 
-  /* fsync is not crucial for auto-save files, since they might lose
-     some work anyway.  */
-  if (!auto_saving && !write_region_inhibit_fsync)
+  /* fsync is not crucial for temporary files.  Nor for auto-save
+     files, since they might lose some work anyway.  */
+  if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
     {
       /* Transfer data and metadata to disk, retrying if interrupted.
         fsync can report a write failure here, e.g., due to disk full
@@ -4970,12 +4989,15 @@ This calls `write-region-annotate-functions' at the start, and
        ok = 0, save_errno = errno;
     }
 
-  /* NFS can report a write failure now.  */
-  if (emacs_close (desc) < 0)
-    ok = 0, save_errno = errno;
+  if (open_and_close_file)
+    {
+      /* NFS can report a write failure now.  */
+      if (emacs_close (desc) < 0)
+       ok = 0, save_errno = errno;
 
-  /* Discard the unwind protect for close_file_unwind.  */
-  specpdl_ptr = specpdl + count1;
+      /* Discard the unwind protect for close_file_unwind.  */
+      specpdl_ptr = specpdl + count1;
+    }
 
   /* Some file systems have a bug where st_mtime is not updated
      properly after a write.  For example, CIFS might not see the
@@ -5051,7 +5073,7 @@ This calls `write-region-annotate-functions' at the start, and
   unbind_to (count, Qnil);
 
 #ifdef CLASH_DETECTION
-  if (!auto_saving)
+  if (file_locked)
     unlock_file (lockname);
 #endif /* CLASH_DETECTION */
 
@@ -5095,8 +5117,6 @@ This calls `write-region-annotate-functions' at the start, and
   return Qnil;
 }
 \f
-Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
-
 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
        doc: /* Return t if (car A) is numerically less than (car B).  */)
   (Lisp_Object a, Lisp_Object b)
@@ -5619,9 +5639,8 @@ A non-nil CURRENT-ONLY argument means save only current buffer.  */)
      couldn't handle some ange-ftp'd file.  */
 
   for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
-    for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
+    FOR_EACH_LIVE_BUFFER (tail, buf)
       {
-       buf = XCDR (XCAR (tail));
        b = XBUFFER (buf);
 
        /* Record all the buffers that have auto save mode