]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
Merge from emacs-24; up to 117698
[gnu-emacs] / src / fileio.c
index 8570a1604a33e97e6138539d609e8f16efe09a47..7d7b0b3148fc16f2c07be2100331a04aa580b660 100644 (file)
@@ -396,13 +396,6 @@ Otherwise return a directory name.
 Given a Unix syntax file name, returns a string ending in slash.  */)
   (Lisp_Object filename)
 {
-#ifndef DOS_NT
-  register const char *beg;
-#else
-  register char *beg;
-  Lisp_Object tem_fn;
-#endif
-  register const char *p;
   Lisp_Object handler;
 
   CHECK_STRING (filename);
@@ -417,12 +410,8 @@ Given a Unix syntax file name, returns a string ending in slash.  */)
       return STRINGP (handled_name) ? handled_name : Qnil;
     }
 
-#ifdef DOS_NT
-  beg = xlispstrdupa (filename);
-#else
-  beg = SSDATA (filename);
-#endif
-  p = beg + SBYTES (filename);
+  char *beg = SSDATA (filename);
+  char const *p = beg + SBYTES (filename);
 
   while (p != beg && !IS_DIRECTORY_SEP (p[-1])
 #ifdef DOS_NT
@@ -438,6 +427,11 @@ Given a Unix syntax file name, returns a string ending in slash.  */)
     return Qnil;
 #ifdef DOS_NT
   /* Expansion of "c:" to drive and default directory.  */
+  Lisp_Object tem_fn;
+  USE_SAFE_ALLOCA;
+  SAFE_ALLOCA_STRING (beg, filename);
+  p = beg + (p - SSDATA (filename));
+
   if (p[-1] == ':')
     {
       /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
@@ -481,6 +475,7 @@ Given a Unix syntax file name, returns a string ending in slash.  */)
       dostounix_filename (beg);
       tem_fn = make_specified_string (beg, -1, p - beg, 0);
     }
+  SAFE_FREE ();
   return tem_fn;
 #else  /* DOS_NT */
   return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
@@ -847,8 +842,6 @@ probably use `make-temp-file' instead, except in three circumstances:
   return make_temp_name (prefix, 0);
 }
 
-
-\f
 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
        doc: /* Convert filename NAME to absolute, and canonicalize it.
 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
@@ -878,7 +871,9 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
   /* These point to SDATA and need to be careful with string-relocation
      during GC (via DECODE_FILE).  */
   char *nm;
+  char *nmlim;
   const char *newdir;
+  const char *newdirlim;
   /* This should only point to alloca'd data.  */
   char *target;
 
@@ -886,10 +881,10 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
   struct passwd *pw;
 #ifdef DOS_NT
   int drive = 0;
-  bool collapse_newdir = 1;
+  bool collapse_newdir = true;
   bool is_escaped = 0;
 #endif /* DOS_NT */
-  ptrdiff_t length;
+  ptrdiff_t length, nbytes;
   Lisp_Object handler, result, handled_name;
   bool multibyte;
   Lisp_Object hdir;
@@ -989,7 +984,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
        {
          unsigned char *p = SDATA (name);
 
-         while (*p && ASCII_BYTE_P (*p))
+         while (*p && ASCII_CHAR_P (*p))
            p++;
          if (*p == '\0')
            {
@@ -1018,8 +1013,9 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
     default_directory = Fdowncase (default_directory);
 #endif
 
-  /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below.  */
-  nm = xlispstrdupa (name);
+  /* Make a local copy of NAME to protect it from GC in DECODE_FILE below.  */
+  SAFE_ALLOCA_STRING (nm, name);
+  nmlim = nm + SBYTES (name);
 
 #ifdef DOS_NT
   /* Note if special escape prefix is present, but remove for now.  */
@@ -1104,7 +1100,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          if (IS_DIRECTORY_SEP (nm[1]))
            {
              if (strcmp (nm, SSDATA (name)) != 0)
-               name = make_specified_string (nm, -1, strlen (nm), multibyte);
+               name = make_specified_string (nm, -1, nmlim - nm, multibyte);
            }
          else
 #endif
@@ -1115,18 +1111,19 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
 
              name = make_specified_string (nm, -1, p - nm, multibyte);
              temp[0] = DRIVE_LETTER (drive);
-             name = concat2 (build_string (temp), name);
+             AUTO_STRING (drive_prefix, temp);
+             name = concat2 (drive_prefix, name);
            }
 #ifdef WINDOWSNT
          if (!NILP (Vw32_downcase_file_names))
            name = Fdowncase (name);
 #endif
-         return name;
 #else /* not DOS_NT */
-         if (strcmp (nm, SSDATA (name)) == 0)
-           return name;
-         return make_specified_string (nm, -1, strlen (nm), multibyte);
+         if (strcmp (nm, SSDATA (name)) != 0)
+           name = make_specified_string (nm, -1, nmlim - nm, multibyte);
 #endif /* not DOS_NT */
+         SAFE_FREE ();
+         return name;
        }
     }
 
@@ -1146,7 +1143,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
      return an absolute name, if the final prefix is not absolute we
      append it to the current working directory.  */
 
-  newdir = 0;
+  newdir = newdirlim = 0;
 
   if (nm[0] == '~')            /* prefix ~ */
     {
@@ -1156,7 +1153,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          Lisp_Object tem;
 
          if (!(newdir = egetenv ("HOME")))
-           newdir = "";
+           newdir = newdirlim = "";
          nm++;
          /* `egetenv' may return a unibyte string, which will bite us since
             we expect the directory to be multibyte.  */
@@ -1171,13 +1168,15 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          else
 #endif
            tem = build_string (newdir);
+         newdirlim = newdir + SBYTES (tem);
          if (multibyte && !STRING_MULTIBYTE (tem))
            {
              hdir = DECODE_FILE (tem);
              newdir = SSDATA (hdir);
+             newdirlim = newdir + SBYTES (hdir);
            }
 #ifdef DOS_NT
-         collapse_newdir = 0;
+         collapse_newdir = false;
 #endif
        }
       else                     /* ~user/filename */
@@ -1201,14 +1200,16 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
                 bite us since we expect the directory to be
                 multibyte.  */
              tem = make_unibyte_string (newdir, strlen (newdir));
+             newdirlim = newdir + SBYTES (tem);
              if (multibyte && !STRING_MULTIBYTE (tem))
                {
                  hdir = DECODE_FILE (tem);
                  newdir = SSDATA (hdir);
+                 newdirlim = newdir + SBYTES (hdir);
                }
              nm = p;
 #ifdef DOS_NT
-             collapse_newdir = 0;
+             collapse_newdir = false;
 #endif
            }
 
@@ -1234,8 +1235,11 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
              Lisp_Object tem = build_string (adir);
 
              tem = DECODE_FILE (tem);
+             newdirlim = adir + SBYTES (tem);
              memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
            }
+         else
+           newdirlim = adir + strlen (adir);
        }
       if (!adir)
        {
@@ -1245,6 +1249,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          adir[1] = ':';
          adir[2] = '/';
          adir[3] = 0;
+         newdirlim = adir + 3;
        }
       newdir = adir;
     }
@@ -1265,6 +1270,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
       && !newdir)
     {
       newdir = SSDATA (default_directory);
+      newdirlim = newdir + SBYTES (default_directory);
 #ifdef DOS_NT
       /* Note if special escape prefix is present, but remove for now.  */
       if (newdir[0] == '/' && newdir[1] == ':')
@@ -1309,12 +1315,15 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
            }
          if (!IS_DIRECTORY_SEP (nm[0]))
            {
-             ptrdiff_t newlen = strlen (newdir);
-             char *tmp = alloca (newlen + file_name_as_directory_slop
-                                 + strlen (nm) + 1);
-             file_name_as_directory (tmp, newdir, newlen, multibyte);
-             strcat (tmp, nm);
+             ptrdiff_t nmlen = nmlim - nm;
+             ptrdiff_t newdirlen = newdirlim - newdir;
+             char *tmp = alloca (newdirlen + file_name_as_directory_slop
+                                 + nmlen + 1);
+             ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
+                                                      multibyte);
+             memcpy (tmp + dlen, nm, nmlen + 1);
              nm = tmp;
+             nmlim = nm + dlen + nmlen;
            }
          adir = alloca (adir_size);
          if (drive)
@@ -1329,8 +1338,11 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
              Lisp_Object tem = build_string (adir);
 
              tem = DECODE_FILE (tem);
+             newdirlim = adir + SBYTES (tem);
              memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
            }
+         else
+           newdirlim = adir + strlen (adir);
          newdir = adir;
        }
 
@@ -1349,35 +1361,32 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
          if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
              && !IS_DIRECTORY_SEP (newdir[2]))
            {
-             char *adir = strcpy (alloca (strlen (newdir) + 1), newdir);
+             char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
              char *p = adir + 2;
              while (*p && !IS_DIRECTORY_SEP (*p)) p++;
              p++;
              while (*p && !IS_DIRECTORY_SEP (*p)) p++;
              *p = 0;
              newdir = adir;
+             newdirlim = newdir + strlen (adir);
            }
          else
 #endif
-           newdir = "";
+           newdir = newdirlim = "";
        }
     }
 #endif /* DOS_NT */
 
-  if (newdir)
-    {
-      /* Ignore any slash at the end of newdir, unless newdir is
-        just "/" or "//".  */
-      length = strlen (newdir);
-      while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
-            && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
-       length--;
-    }
-  else
-    length = 0;
+  /* Ignore any slash at the end of newdir, unless newdir is
+     just "/" or "//".  */
+  length = newdirlim - newdir;
+  while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
+        && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
+    length--;
 
   /* Now concatenate the directory and name to new space in the stack frame.  */
-  tlen = length + file_name_as_directory_slop + strlen (nm) + 1;
+  tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
+  eassert (tlen > file_name_as_directory_slop + 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
@@ -1388,6 +1397,7 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
   target = SAFE_ALLOCA (tlen);
 #endif /* not DOS_NT */
   *target = 0;
+  nbytes = 0;
 
   if (newdir)
     {
@@ -1405,13 +1415,14 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
            {
              memcpy (target, newdir, length);
              target[length] = 0;
+             nbytes = length;
            }
        }
       else
-       file_name_as_directory (target, newdir, length, multibyte);
+       nbytes = file_name_as_directory (target, newdir, length, multibyte);
     }
 
-  strcat (target, nm);
+  memcpy (target + nbytes, nm, nmlim - nm + 1);
 
   /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
      appear.  */
@@ -1717,7 +1728,8 @@ search_embedded_absfilename (char *nm, char *endp)
          for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
          if (p[0] == '~' && s > p + 1) /* We've got "/~something/".  */
            {
-             char *o = alloca (s - p + 1);
+             USE_SAFE_ALLOCA;
+             char *o = SAFE_ALLOCA (s - p + 1);
              struct passwd *pw;
              memcpy (o, p, s - p);
              o [s - p] = 0;
@@ -1728,6 +1740,7 @@ search_embedded_absfilename (char *nm, char *endp)
              block_input ();
              pw = getpwnam (o + 1);
              unblock_input ();
+             SAFE_FREE ();
              if (pw)
                return p;
            }
@@ -1776,7 +1789,8 @@ 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 = xlispstrdupa (filename);
+  USE_SAFE_ALLOCA;
+  SAFE_ALLOCA_STRING (nm, filename);
 
 #ifdef DOS_NT
   dostounix_filename (nm);
@@ -1790,8 +1804,13 @@ those `/' is discarded.  */)
     /* Start over with the new string, so we check the file-name-handler
        again.  Important with filenames like "/home/foo//:/hello///there"
        which would substitute to "/:/hello///there" rather than "/there".  */
-    return Fsubstitute_in_file_name
-      (make_specified_string (p, -1, endp - p, multibyte));
+    {
+      Lisp_Object result
+       = (Fsubstitute_in_file_name
+          (make_specified_string (p, -1, endp - p, multibyte)));
+      SAFE_FREE ();
+      return result;
+    }
 
   /* See if any variables are substituted into the string.  */
 
@@ -1813,6 +1832,7 @@ those `/' is discarded.  */)
       if (!NILP (Vw32_downcase_file_names))
        filename = Fdowncase (filename);
 #endif
+      SAFE_FREE ();
       return filename;
     }
 
@@ -1831,14 +1851,14 @@ those `/' is discarded.  */)
     {
       Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
 
-      xname = Fdowncase (xname);
-      return xname;
+      filename = Fdowncase (xname);
     }
   else
 #endif
-  return (xnm == SSDATA (filename)
-         ? filename
-         : make_specified_string (xnm, -1, x - xnm, multibyte));
+  if (xnm != SSDATA (filename))
+    filename = make_specified_string (xnm, -1, x - xnm, multibyte);
+  SAFE_FREE ();
+  return filename;
 }
 \f
 /* A slightly faster and more convenient way to get
@@ -2671,7 +2691,10 @@ emacs_readlinkat (int fd, char const *filename)
 
   val = build_unibyte_string (buf);
   if (buf[0] == '/' && strchr (buf, ':'))
-    val = concat2 (build_unibyte_string ("/:"), val);
+    {
+      AUTO_STRING (slash_colon, "/:");
+      val = concat2 (slash_colon, val);
+    }
   if (buf != readlink_buf)
     xfree (buf);
   val = DECODE_FILE (val);
@@ -2765,23 +2788,24 @@ searchable directory.  */)
     }
 
   absname = ENCODE_FILE (absname);
-  return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil;
+  return file_accessible_directory_p (absname) ? Qt : Qnil;
 }
 
 /* If FILE is a searchable directory or a symlink to a
    searchable directory, return true.  Otherwise return
    false and set errno to an error number.  */
 bool
-file_accessible_directory_p (char const *file)
+file_accessible_directory_p (Lisp_Object file)
 {
 #ifdef DOS_NT
   /* There's no need to test whether FILE is searchable, as the
      searchable/executable bit is invented on DOS_NT platforms.  */
-  return file_directory_p (file);
+  return file_directory_p (SSDATA (file));
 #else
   /* On POSIXish platforms, use just one system call; this avoids a
      race and is typically faster.  */
-  ptrdiff_t len = strlen (file);
+  const char *data = SSDATA (file);
+  ptrdiff_t len = SBYTES (file);
   char const *dir;
   bool ok;
   int saved_errno;
@@ -2793,15 +2817,15 @@ file_accessible_directory_p (char const *file)
      "/" and "//" are distinct on some platforms, whereas "/", "///",
      "////", etc. are all equivalent.  */
   if (! len)
-    dir = file;
+    dir = data;
   else
     {
       /* Just check for trailing '/' when deciding whether to append '/'.
         That's simpler than testing the two special cases "/" and "//",
         and it's a safe optimization here.  */
       char *buf = SAFE_ALLOCA (len + 3);
-      memcpy (buf, file, len);
-      strcpy (buf + len, &"/."[file[len - 1] == '/']);
+      memcpy (buf, data, len);
+      strcpy (buf + len, &"/."[data[len - 1] == '/']);
       dir = buf;
     }
 
@@ -2910,7 +2934,7 @@ or if SELinux is disabled, or if Emacs lacks SELinux support.  */)
     }
 #endif
 
-  return Flist (sizeof (values) / sizeof (values[0]), values);
+  return Flist (ARRAYELTS (values), values);
 }
 \f
 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
@@ -3624,13 +3648,14 @@ by calling `format-decode', which see.  */)
                report_file_error ("Read error", orig_filename);
              else if (nread > 0)
                {
+                 AUTO_STRING (name, " *code-converting-work*");
                  struct buffer *prev = current_buffer;
                  Lisp_Object workbuf;
                  struct buffer *buf;
 
                  record_unwind_current_buffer ();
 
-                 workbuf = Fget_buffer_create (build_string (" *code-converting-work*"));
+                 workbuf = Fget_buffer_create (name);
                  buf = XBUFFER (workbuf);
 
                  delete_all_overlays (buf);
@@ -4082,13 +4107,11 @@ by calling `format-decode', which see.  */)
 
   if (NILP (visit) && total > 0)
     {
-#ifdef CLASH_DETECTION
       if (!NILP (BVAR (current_buffer, file_truename))
          /* Make binding buffer-file-name to nil effective.  */
          && !NILP (BVAR (current_buffer, filename))
          && SAVE_MODIFF >= MODIFF)
        we_locked_file = 1;
-#endif /* CLASH_DETECTION */
       prepare_to_modify_buffer (PT, PT, NULL);
     }
 
@@ -4188,10 +4211,8 @@ by calling `format-decode', which see.  */)
 
   if (inserted == 0)
     {
-#ifdef CLASH_DETECTION
       if (we_locked_file)
        unlock_file (BVAR (current_buffer, file_truename));
-#endif
       Vdeactivate_mark = old_Vdeactivate_mark;
     }
   else
@@ -4343,14 +4364,12 @@ by calling `format-decode', which see.  */)
       SAVE_MODIFF = MODIFF;
       BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
       XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
-#ifdef CLASH_DETECTION
       if (NILP (handler))
        {
          if (!NILP (BVAR (current_buffer, file_truename)))
            unlock_file (BVAR (current_buffer, file_truename));
          unlock_file (filename);
        }
-#endif /* CLASH_DETECTION */
       if (not_regular)
        xsignal2 (Qfile_error,
                  build_string ("not a regular file"), orig_filename);
@@ -4809,13 +4828,11 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
     = choose_write_coding_system (start, end, filename,
                                  append, visit, lockname, &coding);
 
-#ifdef CLASH_DETECTION
   if (open_and_close_file && !auto_saving)
     {
       lock_file (lockname);
       file_locked = 1;
     }
-#endif /* CLASH_DETECTION */
 
   encoded_filename = ENCODE_FILE (filename);
   fn = SSDATA (encoded_filename);
@@ -4837,10 +4854,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
       if (desc < 0)
        {
          int open_errno = errno;
-#ifdef CLASH_DETECTION
          if (file_locked)
            unlock_file (lockname);
-#endif /* CLASH_DETECTION */
          UNGCPRO;
          report_file_errno ("Opening output file", filename, open_errno);
        }
@@ -4855,10 +4870,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
       if (ret < 0)
        {
          int lseek_errno = errno;
-#ifdef CLASH_DETECTION
          if (file_locked)
            unlock_file (lockname);
-#endif /* CLASH_DETECTION */
          UNGCPRO;
          report_file_errno ("Lseek error", filename, lseek_errno);
        }
@@ -5001,10 +5014,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
 
   unbind_to (count, Qnil);
 
-#ifdef CLASH_DETECTION
   if (file_locked)
     unlock_file (lockname);
-#endif /* CLASH_DETECTION */
 
   /* Do this before reporting IO error
      to avoid a "file has changed on disk" warning on
@@ -5309,20 +5320,12 @@ If BUF is omitted or nil, it defaults to the current buffer.
 See Info node `(elisp)Modification Time' for more details.  */)
   (Lisp_Object buf)
 {
-  struct buffer *b;
+  struct buffer *b = decode_buffer (buf);
   struct stat st;
   Lisp_Object handler;
   Lisp_Object filename;
   struct timespec mtime;
 
-  if (NILP (buf))
-    b = current_buffer;
-  else
-    {
-      CHECK_BUFFER (buf);
-      b = XBUFFER (buf);
-    }
-
   if (!STRINGP (BVAR (b, filename))) return Qt;
   if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
 
@@ -5416,7 +5419,7 @@ An argument specifies the modification time value to use
 static Lisp_Object
 auto_save_error (Lisp_Object error_val)
 {
-  Lisp_Object args[3], msg;
+  Lisp_Object msg;
   int i;
   struct gcpro gcpro1;
 
@@ -5424,10 +5427,10 @@ auto_save_error (Lisp_Object error_val)
 
   ring_bell (XFRAME (selected_frame));
 
-  args[0] = build_string ("Auto-saving %s: %s");
-  args[1] = BVAR (current_buffer, name);
-  args[2] = Ferror_message_string (error_val);
-  msg = Fformat (3, args);
+  AUTO_STRING (format, "Auto-saving %s: %s");
+  msg = Fformat (3, ((Lisp_Object [])
+                    {format, BVAR (current_buffer, name),
+                     Ferror_message_string (error_val)}));
   GCPRO1 (msg);
 
   for (i = 0; i < 3; ++i)
@@ -5770,24 +5773,6 @@ before any other event (mouse or keypress) is handled.  */)
   return Qnil;
 }
 
-Lisp_Object
-Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object initial, Lisp_Object predicate)
-{
-  struct gcpro gcpro1;
-  Lisp_Object args[7];
-
-  GCPRO1 (default_filename);
-  args[0] = intern ("read-file-name");
-  args[1] = prompt;
-  args[2] = dir;
-  args[3] = default_filename;
-  args[4] = mustmatch;
-  args[5] = initial;
-  args[6] = predicate;
-  RETURN_UNGCPRO (Ffuncall (7, args));
-}
-
-\f
 void
 init_fileio (void)
 {