xemacs-beta: src/fileio.c comparison

comparison src/fileio.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 /* Synched up with: Mule 2.0, FSF 19.30. */
 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */
 #include <config.h>
 #include "lisp.h"
-#include <limits.h>
 #include "buffer.h"
 #include "events.h"
 #include "frame.h"
 #include "insdel.h"
 #ifdef HPUX_PRE_8_0
 #include <errnet.h>
 #endif /* HPUX_PRE_8_0 */
 #endif /* HPUX */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
-#define NOMINMAX 1
-#include <direct.h>
-#include <fcntl.h>
-#include <stdlib.h>
-#endif /* not WINDOWSNT */
-#ifdef WINDOWSNT
-#define CORRECT_DIR_SEPS(s) \
-do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
-else unixtodos_filename (s); \
-} while (0)
 #define IS_DRIVE(x) isalpha (x)
 /* Need to lower-case the drive letter, or else expanded
 filenames will sometimes compare inequal, because
 `expand-file-name' doesn't always down-case the drive letter.  */
 #define DRIVE_LETTER(x) tolower (x)
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 int lisp_to_time (Lisp_Object, time_t *);
 Lisp_Object time_to_lisp (time_t);
 /* Nonzero during writing of auto-save files */
 EXFUN (Frunning_temacs_p, 0);
 /* signal a file error when errno contains a meaningful value. */
 DOESNT_RETURN
-report_file_error (CONST char *string, Lisp_Object data)
+report_file_error (const char *string, Lisp_Object data)
 {
 /* #### dmoore - This uses current_buffer, better make sure no one
 has GC'd the current buffer.  File handlers are giving me a headache
 maybe I'll just always protect current_buffer around all of those
 calls. */
 Fcons (build_translated_string (string),
 		       Fcons (lisp_strerror (errno), data)));
 }
 void
-maybe_report_file_error (CONST char *string, Lisp_Object data,
+maybe_report_file_error (const char *string, Lisp_Object data,
 			 Lisp_Object class, Error_behavior errb)
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
 }
 /* signal a file error when errno does not contain a meaningful value. */
 DOESNT_RETURN
-signal_file_error (CONST char *string, Lisp_Object data)
+signal_file_error (const char *string, Lisp_Object data)
 {
 signal_error (Qfile_error,
 list2 (build_translated_string (string), data));
 }
 void
-maybe_signal_file_error (CONST char *string, Lisp_Object data,
+maybe_signal_file_error (const char *string, Lisp_Object data,
 			 Lisp_Object class, Error_behavior errb)
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
 		      list2 (build_translated_string (string), data),
 		      class, errb);
 }
 DOESNT_RETURN
-signal_double_file_error (CONST char *string1, CONST char *string2,
+signal_double_file_error (const char *string1, const char *string2,
 			  Lisp_Object data)
 {
 signal_error (Qfile_error,
 list3 (build_translated_string (string1),
 		       build_translated_string (string2),
 		       data));
 }
 void
-maybe_signal_double_file_error (CONST char *string1, CONST char *string2,
+maybe_signal_double_file_error (const char *string1, const char *string2,
 				Lisp_Object data, Lisp_Object class,
 				Error_behavior errb)
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 			     data),
 		      class, errb);
 }
 DOESNT_RETURN
-signal_double_file_error_2 (CONST char *string1, CONST char *string2,
+signal_double_file_error_2 (const char *string1, const char *string2,
 			    Lisp_Object data1, Lisp_Object data2)
 {
 signal_error (Qfile_error,
 list4 (build_translated_string (string1),
 		       build_translated_string (string2),
 		       data1, data2));
 }
 void
-maybe_signal_double_file_error_2 (CONST char *string1, CONST char *string2,
+maybe_signal_double_file_error_2 (const char *string1, const char *string2,
 				  Lisp_Object data1, Lisp_Object data2,
 				  Lisp_Object class, Error_behavior errb)
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 QUIT;
 return sys_read_1 (fildes, buf, size, 1);
 }
 ssize_t
-write_allowing_quit (int fildes, CONST void *buf, size_t size)
+write_allowing_quit (int fildes, const void *buf, size_t size)
 {
 QUIT;
 return sys_write_1 (fildes, buf, size, 1);
 }
 Otherwise return a directory spec.
 Given a Unix syntax file name, returns a string ending in slash.
 */
 (file))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben */
 Bufbyte *beg;
 Bufbyte *p;
 Lisp_Object handler;
 CHECK_STRING (file);
 #endif
 beg = XSTRING_DATA (file);
 p = beg + XSTRING_LENGTH (file);
 while (p != beg && !IS_ANY_SEP (p[-1])
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	 /* only recognize drive specifier at beginning */
 	 && !(p[-1] == ':' && p == beg + 2)
 #endif
 ) p--;
 if (p == beg)
 return Qnil;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* Expansion of "c:" to drive and default directory.  */
 /* (NT does the right thing.)  */
 if (p == beg + 2 && beg[1] == ':')
 {
 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
-Bufbyte *res = alloca (MAXPATHLEN + 1);
+Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1);
-if (getdefdir (toupper (*beg) - 'A' + 1, res))
+if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN))
 	{
 	  char *c=((char *) res) + strlen ((char *) res);
 	  if (!IS_DIRECTORY_SEP (*c))
 	    {
 	      *c++ = DIRECTORY_SEP;
 	    }
 	  beg = res;
 	  p = beg + strlen ((char *) beg);
 	}
 }
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 return make_string (beg, p - beg);
 }
 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
 Return file name NAME sans its directory.
 this is everything after the last slash,
 or the entire name if it contains no slash.
 */
 (file))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben */
 Bufbyte *beg, *p, *end;
 Lisp_Object handler;
 CHECK_STRING (file);
 beg = XSTRING_DATA (file);
 end = p = beg + XSTRING_LENGTH (file);
 while (p != beg && !IS_ANY_SEP (p[-1])
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	 /* only recognize drive specifier at beginning */
 	 && !(p[-1] == ':' && p == beg + 2)
 #endif
 ) p--;
 The `call-process' and `start-process' functions use this function to
 get a current directory to run processes in.
 */
 (filename))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben */
 Lisp_Object handler;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
 static char *
 file_name_as_directory (char *out, char *in)
 {
+/* This function cannot GC */
 int size = strlen (in);
 if (size == 0)
 {
 out[0] = '.';
 For a Unix-syntax file name, just appends a slash,
 except for (file-name-as-directory \"\") => \"./\".
 */
 (file))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben */
 char *buf;
 Lisp_Object handler;
 CHECK_STRING (file);
 *
 * Value is nonzero if the string output is different from the input.
 */
 static int
-directory_file_name (CONST char *src, char *dst)
+directory_file_name (const char *src, char *dst)
 {
+/* This function cannot GC */
 long slen = strlen (src);
 /* Process as Unix format: just remove any final slash.
 But leave "/" unchanged; do not change it to "".  */
 strcpy (dst, src);
 if (slen > 1
 && IS_DIRECTORY_SEP (dst[slen - 1])
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 && !IS_ANY_SEP (dst[slen - 2])
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 )
 dst[slen - 1] = 0;
 return 1;
 }
 a directory is different from its name as a file.
 In Unix-syntax, this function just removes the final slash.
 */
 (directory))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben */
 char *buf;
 Lisp_Object handler;
 CHECK_STRING (directory);
 arbitrary limit broke generation of Gnus Incoming* files.
 This implementation is better than what one usually finds in libc.
 --hniksic */
+static unsigned int temp_name_rand;
 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
-Generate temporary file name starting with PREFIX.
+Generate a temporary file name starting with PREFIX.
 The Emacs process number forms part of the result, so there is no
 danger of generating a name being used by another process.
 In addition, this function makes an attempt to choose a name that
 does not specify an existing file.  To make this work, PREFIX should
 be an absolute file name.
 */
 (prefix))
 {
-static char tbl[64] = {
+static const char tbl[64] =
+{
 'A','B','C','D','E','F','G','H',
 'I','J','K','L','M','N','O','P',
 'Q','R','S','T','U','V','W','X',
 'Y','Z','a','b','c','d','e','f',
 'g','h','i','j','k','l','m','n',
 'o','p','q','r','s','t','u','v',
 'w','x','y','z','0','1','2','3',
-'4','5','6','7','8','9','-','_' };
+'4','5','6','7','8','9','-','_'
-static unsigned count, count_initialized_p;
+};
 Lisp_Object val;
 Bytecount len;
 Bufbyte *p, *data;
-unsigned pid;
 CHECK_STRING (prefix);
 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
 a bad idea because:
 memcpy (data, XSTRING_DATA (prefix), len);
 p = data + len;
 /* VAL is created by adding 6 characters to PREFIX.  The first three
 are the PID of this process, in base 64, and the second three are
-incremented if the file already exists.  This ensures 262144
+a pseudo-random number seeded from process startup time.  This
-unique file names per PID per PREFIX.  */
+ensures 262144 unique file names per PID per PREFIX per machine.  */
-pid = (unsigned)getpid ();
+{
-*p++ = tbl[pid & 63], pid >>= 6;
+unsigned int pid = (unsigned int) getpid ();
-*p++ = tbl[pid & 63], pid >>= 6;
+*p++ = tbl[(pid >>  0) & 63];
-*p++ = tbl[pid & 63], pid >>= 6;
+*p++ = tbl[(pid >>  6) & 63];
+*p++ = tbl[(pid >> 12) & 63];
+}
 /* Here we try to minimize useless stat'ing when this function is
 invoked many times successively with the same PREFIX.  We achieve
-this by initializing count to a random value, and incrementing it
+this by using a very pseudo-random number generator to generate
-afterwards.  */
+file names unique to this process, with a very long cycle. */
-if (!count_initialized_p)
-{
-count = (unsigned)time (NULL);
-/* Dumping temacs with a non-zero count_initialized_p wouldn't
-make much sense.  */
-if (NILP (Frunning_temacs_p ()))
-	count_initialized_p = 1;
-}
 while (1)
 {
 struct stat ignored;
-unsigned num = count;
+p[0] = tbl[(temp_name_rand >>  0) & 63];
-p[0] = tbl[num & 63], num >>= 6;
+p[1] = tbl[(temp_name_rand >>  6) & 63];
-p[1] = tbl[num & 63], num >>= 6;
+p[2] = tbl[(temp_name_rand >> 12) & 63];
-p[2] = tbl[num & 63], num >>= 6;
 /* Poor man's congruential RN generator.  Replace with ++count
 for debugging.  */
-count += 25229;
+temp_name_rand += 25229;
-count %= 225307;
+temp_name_rand %= 225307;
 QUIT;
-if (stat ((CONST char *) data, &ignored) < 0)
+if (xemacs_stat ((const char *) data, &ignored) < 0)
 	{
 	  /* We want to return only if errno is ENOENT.  */
 	  if (errno == ENOENT)
 	    return val;
 An initial `~USER/' expands to USER's home directory.
 See also the function `substitute-in-file-name'.
 */
 (name, default_directory))
 {
-/* This function can GC */
+/* This function can GC.  GC-checked 2000-07-11 ben */
 Bufbyte *nm;
 Bufbyte *newdir, *p, *o;
 int tlen;
 Bufbyte *target;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 int drive = 0;
 int collapse_newdir = 1;
 #else
 struct passwd *pw;
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 int length;
 Lisp_Object handler;
-#ifdef __CYGWIN32__
+#ifdef CYGWIN
 char *user;
 #endif
+struct gcpro gcpro1, gcpro2;
+/* both of these get set below */
+GCPRO2 (name, default_directory);
 CHECK_STRING (name);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (name, Qexpand_file_name);
 if (!NILP (handler))
-return call3_check_string (handler, Qexpand_file_name, name,
+{
-			       default_directory);
+UNGCPRO;
+return call3_check_string (handler, Qexpand_file_name, name,
+				 default_directory);
+}
 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted.  */
 if (NILP (default_directory))
 default_directory = current_buffer->directory;
 if (! STRINGP (default_directory))
 if (!NILP (default_directory))
 {
 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
 if (!NILP (handler))
-	return call3 (handler, Qexpand_file_name, name, default_directory);
+	{
+	  UNGCPRO;
+	  return call3 (handler, Qexpand_file_name, name, default_directory);
+	}
 }
 o = XSTRING_DATA (default_directory);
 /* Make sure DEFAULT_DIRECTORY is properly expanded.
 The EQ test avoids infinite recursion.  */
 if (! NILP (default_directory) && !EQ (default_directory, name)
 /* Save time in some common cases - as long as default_directory
 	 is not relative, it can be canonicalized with name below (if it
 	 is needed at all) without requiring it to be expanded now.  */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
-/* Detect MSDOS file names with drive specifiers.  */
+/* Detect Windows file names with drive specifiers.  */
 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
 /* Detect Windows file names in UNC format.  */
 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
 /* Detect Unix absolute file names (/... alone is not absolute on
-	 DOS or Windows).  */
+	 Windows).  */
 && ! (IS_DIRECTORY_SEP (o[0]))
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 )
-{
-struct gcpro gcpro1;
+default_directory = Fexpand_file_name (default_directory, Qnil);
-GCPRO1 (name);
-default_directory = Fexpand_file_name (default_directory, Qnil);
-UNGCPRO;
-}
 #ifdef FILE_SYSTEM_CASE
 name = FILE_SYSTEM_CASE (name);
 #endif
 /* #### dmoore - this is ugly, clean this up.  Looks like nm pointing
 into name should be safe during all of this, though. */
 nm = XSTRING_DATA (name);
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* We will force directory separators to be either all \ or /, so make
 a local copy to modify, even if there ends up being no change. */
-nm = strcpy (alloca (strlen (nm) + 1), nm);
+nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
 /* Find and remove drive specifier if present; this makes nm absolute
 even if the rest of the name appears to be relative. */
 {
-Bufbyte *colon = strrchr (nm, ':');
+Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
 if (colon)
 /* Only recognize colon as part of drive specifier if there is a
 	 single alphabetic character preceding the colon (and if the
 	 character before the drive letter, if present, is a directory
 /* If we see "c://somedir", we want to strip the first slash after the
 colon when stripping the drive letter.  Otherwise, this expands to
 "//somedir".  */
 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
 nm++;
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 /* If nm is absolute, look for /./ or /../ sequences; if none are
 found, we can probably return right away.  We will avoid allocating
 a new string if name is already fully expanded.  */
 if (
 IS_DIRECTORY_SEP (nm[0])
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 && (drive || IS_DIRECTORY_SEP (nm[1]))
 #endif
 )
 {
 /* If it turns out that the filename we want to return is just a
 	    lose = 1;
 	  p++;
 	}
 if (!lose)
 	{
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	  /* Make sure directories are all separated with / or \ as
 	     desired, but avoid allocation of a new string when not
 	     required. */
 	  CORRECT_DIR_SEPS (nm);
 	  if (IS_DIRECTORY_SEP (nm[1]))
 	    {
 	      name = make_string (nm - 2, p - nm + 2);
 	      XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
 	      XSTRING_DATA (name)[1] = ':';
 	    }
-	  return name;
+	  RETURN_UNGCPRO (name);
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
 	  if (nm == XSTRING_DATA (name))
-	    return name;
+	    RETURN_UNGCPRO (name);
-	  return build_string ((char *) nm);
+	  RETURN_UNGCPRO (build_string ((char *) nm));
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 	}
 }
 /* At this point, nm might or might not be an absolute file name.  We
 need to expand ~ or ~user if present, otherwise prefix nm with
 	    TO_INTERNAL_FORMAT (C_STRING, newdir_external,
 				C_STRING_ALLOCA, (* ((char **) &newdir)),
 				Qfile_name);
 	  nm++;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	  collapse_newdir = 0;
 #endif
 	}
 else			/* ~user/filename */
 	{
 	     names the user who runs this instance of XEmacs.  While
 	     NT is single-user (for the moment) you still can have
 	     multiple user profiles users defined, each with its HOME.
 	     Therefore, the following should be reworked to handle
 	     this case.  */
-#ifdef  WINDOWSNT
+#ifdef  WIN32_NATIVE
 	  /* Now if the file given is "~foo/file" and HOME="c:/", then
 	     we want the file to be named "c:/file" ("~foo" becomes
 	     "c:/").  The variable o has "~foo", so we can use the
 	     length of that string to offset nm.  August Hill, 31 Aug
 	     1998.  */
 	  newdir = (Bufbyte *) get_home_directory();
 	  dostounix_filename (newdir);
 	  nm += strlen(o) + 1;
-#else  /* not WINDOWSNT */
+#else  /* not WIN32_NATIVE */
-#ifdef __CYGWIN32__
+#ifdef CYGWIN
 	  if ((user = user_login_name (NULL)) != NULL)
 	    {
 	      /* Does the user login name match the ~name? */
 	      if (strcmp (user, (char *) o + 1) == 0)
 	        {
 	          nm = p;
 		}
 	    }
 if (! newdir)
 {
-#endif /* __CYGWIN32__ */
+#endif /* CYGWIN */
 	  /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
 	     occurring in it. (It can call select()). */
 	  slow_down_interrupts ();
 	  pw = (struct passwd *) getpwnam ((char *) o + 1);
 	  speed_up_interrupts ();
 	  if (pw)
 	    {
 	      newdir = (Bufbyte *) pw -> pw_dir;
 	      nm = p;
 	    }
-#ifdef __CYGWIN32__
+#ifdef CYGWIN
 	    }
 #endif
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 	  /* If we don't find a user of that name, leave the name
 	     unchanged; don't move nm forward to p.  */
 	}
 }
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* On DOS and Windows, nm is absolute if a drive name was specified;
 use the drive's current directory as the prefix if needed.  */
 if (!newdir && drive)
 {
 /* Get default directory if needed to make nm absolute. */
 if (!IS_DIRECTORY_SEP (nm[0]))
 	{
 	  newdir = alloca (MAXPATHLEN + 1);
-	  if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
+	  if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
 	    newdir = NULL;
 	}
 if (!newdir)
 	{
 	  /* Either nm starts with /, or drive isn't mounted. */
 	  newdir[1] = ':';
 	  newdir[2] = '/';
 	  newdir[3] = 0;
 	}
 }
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 /* Finally, if no prefix has been specified and nm is not absolute,
 then it must be expanded relative to default_directory. */
 if (1
-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE
 /* /... alone is not absolute on DOS and Windows. */
 && !IS_DIRECTORY_SEP (nm[0])
 #else
 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
 #endif
 && !newdir)
 {
 newdir = XSTRING_DATA (default_directory);
 }
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 if (newdir)
 {
 /* First ensure newdir is an absolute name. */
 if (
-	  /* Detect MSDOS file names with drive specifiers.  */
+	  /* Detect Windows file names with drive specifiers.  */
 	  ! (IS_DRIVE (newdir[0])
 	     && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
 	  /* Detect Windows file names in UNC format.  */
 	  && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
 	  /* Detect drive spec by itself */
 	      nm = tmp;
 	    }
 	  newdir = alloca (MAXPATHLEN + 1);
 	  if (drive)
 	    {
-	      if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
+	      if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
 		newdir = "/";
 	    }
 	  else
 	    getwd (newdir);
 	}
 	    }
 	  else
 	    newdir = "";
 	}
 }
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 if (newdir)
 {
 /* Get rid of any slash at the end of newdir, unless newdir is
 	 just // (an incomplete UNC name).  */
 length = strlen ((char *) newdir);
 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	  && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
 #endif
 	  )
 	{
 	  Bufbyte *temp = (Bufbyte *) alloca (length);
 else
 tlen = 0;
 /* Now concatenate the directory and name to new space in the stack frame */
 tlen += strlen ((char *) nm) + 1;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* Add reserved space for drive name.  (The Microsoft x86 compiler
 produces incorrect code if the following two lines are combined.)  */
 target = (Bufbyte *) alloca (tlen + 2);
 target += 2;
-#else  /* not WINDOWSNT */
+#else  /* not WIN32_NATIVE */
 target = (Bufbyte *) alloca (tlen);
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 *target = 0;
 if (newdir)
 {
 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
 	  /* Keep initial / only if this is the whole name.  */
 	  if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
 	    ++o;
 	  p += 3;
 	}
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* if drive is set, we're not dealing with an UNC, so
 	 multiple dir-seps are redundant (and reportedly cause trouble
 	 under win95) */
 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
 	  ++p;
 	{
 	  *o++ = *p++;
 	}
 }
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* At last, set drive name, except for network file name.  */
 if (drive)
 {
 target -= 2;
 target[0] = DRIVE_LETTER (drive);
 else
 {
 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
 }
 CORRECT_DIR_SEPS (target);
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
-return make_string (target, o - target);
+RETURN_UNGCPRO (make_string (target, o - target));
 }
-#if 0 /* FSFmacs */
-/* another older version of expand-file-name; */
-#endif
 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
 Return the canonical name of the given FILE.
 Second arg DEFAULT is directory to start with if FILE is relative
 (does not start with slash); if DEFAULT is nil or missing,
 No component of the resulting pathname will be a symbolic link, as
 in the realpath() function.
 */
 (filename, default_))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben. */
 Lisp_Object expanded_name;
-Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 expanded_name = Fexpand_file_name (filename, default_);
 if (!STRINGP (expanded_name))
 return Qnil;
 GCPRO1 (expanded_name);
-handler = Ffind_file_name_handler (expanded_name, Qfile_truename);
-UNGCPRO;
+{
+Lisp_Object handler =
-if (!NILP (handler))
+Ffind_file_name_handler (expanded_name, Qfile_truename);
-return call2_check_string (handler, Qfile_truename, expanded_name);
+if (!NILP (handler))
+RETURN_UNGCPRO
+	(call2_check_string (handler, Qfile_truename, expanded_name));
+}
 {
 char resolved_path[MAXPATHLEN];
 Extbyte *path;
 Extbyte *p;
 			ALLOCA, (path, elen),
 			Qfile_name);
 p = path;
 if (elen > MAXPATHLEN)
 goto toolong;
 /* Try doing it all at once. */
 /* !! Does realpath() Mule-encapsulate?
 Answer: Nope! So we do it above */
 if (!xrealpath ((char *) path, resolved_path))
 {
 	/* Didn't resolve it -- have to do it one component at a time. */
 	/* "realpath" is a typically useless, stupid un*x piece of crap.
 	   It claims to return a useful value in the "error" case, but since
 	   there is no indication provided of how far along the pathname
 	   the function went before erring, there is no way to use the
-	   partial result returned.  What a piece of junk. */
+	   partial result returned.  What a piece of junk.
+	   The above comment refers to historical versions of
+	   realpath().  The Unix98 specs state:
+	   "On successful completion, realpath() returns a
+	   pointer to the resolved name. Otherwise, realpath()
+	   returns a null pointer and sets errno to indicate the
+	   error, and the contents of the buffer pointed to by
+	   resolved_name are undefined."
+	   Since we depend on undocumented semantics of various system realpath()s,
+	   we just use our own version in realpath.c. */
 	for (;;)
 	  {
 	    p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
 	    if (p)
 	      *p = 0;
-	    /* memset (resolved_path, 0, sizeof (resolved_path)); */
 	    if (xrealpath ((char *) path, resolved_path))
 	      {
 		if (p)
 		  *p = '/';
 		else
 		int rlen = strlen (resolved_path);
 		/* "On failure, it returns NULL, sets errno to indicate
 		   the error, and places in resolved_path the absolute pathname
 		   of the path component which could not be resolved." */
-		if (p)
+		if (p)
 		  {
 		    int plen = elen - (p - path);
 		    if (rlen > 1 && resolved_path[rlen - 1] == '/')
 		      rlen = rlen - 1;
 	      goto lose;
 	  }
 }
 {
+Lisp_Object resolved_name;
 int rlen = strlen (resolved_path);
 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
 	{
 	  if (rlen + 1 > countof (resolved_path))
 	    goto toolong;
-	  resolved_path[rlen] = '/';
+	  resolved_path[rlen++] = '/';
-	  resolved_path[rlen + 1] = 0;
+	  resolved_path[rlen] = '\0';
-	  rlen = rlen + 1;
 	}
-return make_ext_string ((Bufbyte *) resolved_path, rlen, Qbinary);
+TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
+			  LISP_STRING, resolved_name,
+			  Qfile_name);
+RETURN_UNGCPRO (resolved_name);
 }
 toolong:
 errno = ENAMETOOLONG;
 goto lose;
 lose:
 report_file_error ("Finding truename", list1 (expanded_name));
 }
-return Qnil;	/* suppress compiler warning */
+RETURN_UNGCPRO (Qnil);
 }
 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
 Substitute environment variables referred to in FILENAME.
 If `/~' appears, all of FILENAME through that `/' is discarded.
 */
 (string))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC.  GC checked 2000-07-28 ben. */
 Bufbyte *nm;
 Bufbyte *s, *p, *o, *x, *endp;
 Bufbyte *target = 0;
 int total = 0;
 /* If /~ or // appears, discard everything through first slash. */
 for (p = nm; p != endp; p++)
 {
 if ((p[0] == '~'
-#if defined (WINDOWSNT) || defined (__CYGWIN32__)
+#if defined (WIN32_NATIVE) || defined (CYGWIN)
 	   /* // at start of file name is meaningful in WindowsNT systems */
 	   || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
-#else /* not (WINDOWSNT || __CYGWIN32__) */
+#else /* not (WIN32_NATIVE || CYGWIN) */
 	   || IS_DIRECTORY_SEP (p[0])
-#endif /* not (WINDOWSNT || __CYGWIN32__) */
+#endif /* not (WIN32_NATIVE || CYGWIN) */
 	   )
 	  && p != nm
 	  && (IS_DIRECTORY_SEP (p[-1])))
 	{
 	  nm = p;
 	  substituted = 1;
 	}
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* see comment in expand-file-name about drive specifiers */
 else if (IS_DRIVE (p[0]) && p[1] == ':'
 	       && p > nm && IS_DIRECTORY_SEP (p[-1]))
 	{
 	  nm = p;
 	  substituted = 1;
 	}
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 }
 /* See if any variables are substituted into the string
 and find the total length of their values in `total' */
 	/* Copy out the variable name */
 	target = (Bufbyte *) alloca (s - o + 1);
 	strncpy ((char *) target, (char *) o, s - o);
 	target[s - o] = 0;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	strupr (target); /* $home == $HOME etc.  */
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 	/* Get variable value */
 	o = (Bufbyte *) egetenv ((char *) target);
 	if (!o) goto badvar;
 	total += strlen ((char *) o);
 	/* Copy out the variable name */
 	target = (Bufbyte *) alloca (s - o + 1);
 	strncpy ((char *) target, (char *) o, s - o);
 	target[s - o] = 0;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	strupr (target); /* $home == $HOME etc.  */
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 	/* Get variable value */
 	o = (Bufbyte *) egetenv ((char *) target);
 	if (!o)
 	  goto badvar;
 /* If /~ or // appears, discard everything through first slash. */
 for (p = xnm; p != x; p++)
 if ((p[0] == '~'
-#if defined (WINDOWSNT)
+#if defined (WIN32_NATIVE)
 	 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
 	 || IS_DIRECTORY_SEP (p[0])
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 	 )
 	/* don't do p[-1] if that would go off the beginning --jwz */
 	&& p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
 xnm = p;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 else if (IS_DRIVE (p[0]) && p[1] == ':'
 	     && p > nm && IS_DIRECTORY_SEP (p[-1]))
 	xnm = p;
 #endif
 return make_string (xnm, x - xnm);
 badsubst:
-error ("Bad format environment-variable substitution");
+syntax_error ("Bad format environment-variable substitution", string);
 missingclose:
-error ("Missing \"}\" in environment-variable substitution");
+syntax_error ("Missing \"}\" in environment-variable substitution",
+		string);
 badvar:
-error ("Substituting nonexistent environment variable \"%s\"",
+syntax_error_2 ("Substituting nonexistent environment variable",
-	 target);
+		  string, build_string (target));
 /* NOTREACHED */
 return Qnil;	/* suppress compiler warning */
 }
 (directory-file-name (expand-file-name FOO)).  */
 Lisp_Object
 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
 {
-/* This function can call lisp */
+/* This function can call Lisp.  GC checked 2000-07-28 ben */
 Lisp_Object abspath;
 struct gcpro gcpro1;
 abspath = Fexpand_file_name (filename, defdir);
 GCPRO1 (abspath);
 to alter the file.
 *STATPTR is used to store the stat information if the file exists.
 If the file does not exist, STATPTR->st_mode is set to 0.  */
 static void
-barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring,
+barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
 			      int interactive, struct stat *statptr)
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can call Lisp.  GC checked 2000-07-28 ben */
 struct stat statbuf;
 /* stat is a good way to tell whether the file exists,
 regardless of what access permissions it has.  */
-if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
+if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
 {
 Lisp_Object tem;
 if (interactive)
 	{
 	  Lisp_Object prompt;
 	  struct gcpro gcpro1;
 	  prompt = emacs_doprnt_string_c
-	    ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
+	    ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
 	     Qnil, -1, XSTRING_DATA (absname),
 	     GETTEXT (querystring));
 	  GCPRO1 (prompt);
 	  tem = call1 (Qyes_or_no_p, prompt);
 last-modified time as the old one.  (This works on only some systems.)
 A prefix arg makes KEEP-TIME non-nil.
 */
 (filename, newname, ok_if_already_exists, keep_time))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can call Lisp.  GC checked 2000-07-28 ben */
 int ifd, ofd, n;
 char buf[16 * 1024];
 struct stat st, out_st;
 Lisp_Object handler;
 int speccount = specpdl_depth ();
 args[0] = newname;
 args[1] = Qnil; args[2] = Qnil;
 NGCPRO1 (*args);
 ngcpro1.nvars = 3;
-if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
+if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
-	args[i++] = build_string ("/");
+					   XSTRING_LENGTH (newname) - 1)))
+	args[i++] = Fchar_to_string (Vdirectory_sep_char);
 args[i++] = Ffile_name_nondirectory (filename);
 newname = Fconcat (i, args);
 NUNGCPRO;
 }
 if (NILP (ok_if_already_exists)
 || INTP (ok_if_already_exists))
 barf_or_query_if_file_exists (newname, "copy to it",
 				  INTP (ok_if_already_exists), &out_st);
-else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0)
+else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
 out_st.st_mode = 0;
 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
 if (ifd < 0)
 report_file_error ("Opening input file", list1 (filename));
 /* We can only copy regular files and symbolic links.  Other files are not
 copyable by us. */
 input_file_statable_p = (fstat (ifd, &st) >= 0);
-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE
 if (out_st.st_mode != 0
 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
 {
 errno = 0;
 report_file_error ("Input and output files are the same",
 /* Closing the output clobbers the file times on some systems.  */
 if (close (ofd) < 0)
 report_file_error ("I/O error", list1 (newname));
 if (input_file_statable_p)
-{
-if (!NILP (keep_time))
 {
-EMACS_TIME atime, mtime;
+	if (!NILP (keep_time))
-EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
+	  {
-EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
+	    EMACS_TIME atime, mtime;
-if (set_file_times ((char *) XSTRING_DATA (newname), atime,
+	    EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
-			    mtime))
+	    EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
-	  report_file_error ("I/O error", list1 (newname));
+	    if (set_file_times ((char *) XSTRING_DATA (newname), atime,
+				mtime))
+	      report_file_error ("I/O error", list1 (newname));
+	  }
+	chmod ((const char *) XSTRING_DATA (newname),
+	       st.st_mode & 07777);
 }
-chmod ((CONST char *) XSTRING_DATA (newname),
-	     st.st_mode & 07777);
-}
 /* We'll close it by hand */
 XCAR (ofd_locative) = Qnil;
 /* Close ifd */
 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
 {
 return Fsignal (Qfile_error,
 		      list3 (build_translated_string ("Creating directory"),
-			     build_translated_string ("pathame too long"),
+			     build_translated_string ("pathname too long"),
 			     dirname_));
 }
 strncpy (dir, (char *) XSTRING_DATA (dirname_),
 	   XSTRING_LENGTH (dirname_) + 1);
 return Qnil;
 }
 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
-Delete specified file.  One argument, a file name string.
+Delete the file named FILENAME (a string).
-If file has multiple names, it continues to exist with the other names.
+If FILENAME has multiple names, it continues to exist with the other names.
 */
 (filename))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Lisp_Object handler;
 || INTP (ok_if_already_exists))
 barf_or_query_if_file_exists (newname, "rename to it",
 				  INTP (ok_if_already_exists), 0);
 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
-WINDOWSNT here; I've removed it.  --marcpa */
+WIN32_NATIVE here; I've removed it.  --marcpa */
-/* FSFmacs only calls rename() here under BSD 4.1, and calls
+/* We have configure check for rename() and emulate using
-link() and unlink() otherwise, but that's bogus.  Sometimes
+link()/unlink() if necessary. */
-rename() succeeds where link()/unlink() fail, and we have
-configure check for rename() and emulate using link()/unlink()
-if necessary. */
 if (0 > rename ((char *) XSTRING_DATA (filename),
 		  (char *) XSTRING_DATA (newname)))
 {
 if (errno == EXDEV)
 	{
 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
 on NT here. --marcpa */
 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
 Reverted to previous behavior pending a working fix. (jhar) */
-#if defined(WINDOWSNT)
+#if defined(WIN32_NATIVE)
 /* Windows does not support this operation.  */
 report_file_error ("Adding new name", Flist (2, &filename));
-#else /* not defined(WINDOWSNT) */
+#else /* not defined(WIN32_NATIVE) */
 unlink ((char *) XSTRING_DATA (newname));
 if (0 > link ((char *) XSTRING_DATA (filename),
 		(char *) XSTRING_DATA (newname)))
 {
 report_file_error ("Adding new name",
 			 list2 (filename, newname));
 }
-#endif /* defined(WINDOWSNT) */
+#endif /* defined(WIN32_NATIVE) */
 UNGCPRO;
 return Qnil;
 }
-#ifdef S_IFLNK
 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
 Make a symbolic link to FILENAME, named LINKNAME.  Both args strings.
 Signals a `file-already-exists' error if a file LINKNAME already exists
 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
 This happens for interactive use with M-x.
 */
 (filename, linkname, ok_if_already_exists))
 {
 /* This function can GC.  GC checked 1997.06.04. */
+/* XEmacs change: run handlers even if local machine doesn't have symlinks */
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (filename, linkname);
 CHECK_STRING (filename);
 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
 if (!NILP (handler))
 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
 			   linkname, ok_if_already_exists));
+#ifdef S_IFLNK
 if (NILP (ok_if_already_exists)
 || INTP (ok_if_already_exists))
 barf_or_query_if_file_exists (linkname, "make it a link",
 				  INTP (ok_if_already_exists), 0);
 		   (char *) XSTRING_DATA (linkname)))
 {
 report_file_error ("Making symbolic link",
 			 list2 (filename, linkname));
 }
+#endif /* S_IFLNK */
 UNGCPRO;
 return Qnil;
 }
-#endif /* S_IFLNK */
 #ifdef HPUX_NET
 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
 Open a network connection to PATH using LOGIN as the login string.
 CHECK_STRING (login);
 /* netunam, being a strange-o system call only used once, is not
 encapsulated. */
-TO_EXTERNAL_FORMAT (LISP_STRING, path,  C_STRING_ALLOCA, path_ext,  Qfile_name);
+LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
-TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative);
+LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
 netresult = netunam (path_ext, login_ext);
 return netresult == -1 ? Qnil : Qt;
 }
 Bufbyte *ptr;
 CHECK_STRING (filename);
 ptr = XSTRING_DATA (filename);
 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	  || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
 #endif
 	  ) ? Qt : Qnil;
 }
 /* Return nonzero if file FILENAME exists and can be executed.  */
 static int
 check_executable (char *filename)
 {
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 struct stat st;
-if (stat (filename, &st) < 0)
+if (xemacs_stat (filename, &st) < 0)
 return 0;
 return ((st.st_mode & S_IEXEC) != 0);
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
 #ifdef HAVE_EACCESS
-return eaccess (filename, 1) >= 0;
+return eaccess (filename, X_OK) >= 0;
 #else
 /* Access isn't quite right because it uses the real uid
 and we really want to test with the effective uid.
 But Unix doesn't give us a right way to do it.  */
-return access (filename, 1) >= 0;
+return access (filename, X_OK) >= 0;
 #endif /* HAVE_EACCESS */
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 }
 /* Return nonzero if file FILENAME exists and can be written.  */
 static int
-check_writable (CONST char *filename)
+check_writable (const char *filename)
 {
 #ifdef HAVE_EACCESS
-return (eaccess (filename, 2) >= 0);
+return (eaccess (filename, W_OK) >= 0);
 #else
 /* Access isn't quite right because it uses the real uid
 and we really want to test with the effective uid.
 But Unix doesn't give us a right way to do it.
 Opening with O_WRONLY could work for an ordinary file,
 but would lose for directories.  */
-return (access (filename, 2) >= 0);
+return (access (filename, W_OK) >= 0);
 #endif
 }
 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
 Return t if file FILENAME exists.  (This does not mean you can read it.)
 See also `file-readable-p' and `file-attributes'.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can call lisp; GC checked 2000-07-11 ben */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct stat statbuf;
 struct gcpro gcpro1;
 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_exists_p, abspath);
-return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
+return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
 }
 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
 Return t if FILENAME can be executed by you.
 For a directory, this means you can access files in that directory.
 */
 (filename))
 {
-/* This function can GC.  GC checked 1997.04.10. */
+/* This function can GC.  GC checked 07-11-2000 ben. */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
 if (!NILP (handler))
 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
-#if defined(WINDOWSNT) || defined(__CYGWIN32__)
+#if defined(WIN32_NATIVE) || defined(CYGWIN)
 /* Under MS-DOS and Windows, open does not work for directories.  */
 UNGCPRO;
 if (access (XSTRING_DATA (abspath), 0) == 0)
 return Qt;
 else
 return Qnil;
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
 {
 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
 UNGCPRO;
 if (desc < 0)
 return Qnil;
 close (desc);
 return Qt;
 }
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 }
 /* Having this before file-symlink-p mysteriously caused it to be forgotten
 on the RT/PC.  */
 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_writable_p, abspath);
-if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
+if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
 return (check_writable ((char *) XSTRING_DATA (abspath))
 	    ? Qt : Qnil);
 GCPRO1 (abspath);
 Otherwise returns nil.
 */
 (filename))
 {
 /* This function can GC.  GC checked 1997.04.10. */
+/* XEmacs change: run handlers even if local machine doesn't have symlinks */
 #ifdef S_IFLNK
 char *buf;
 int bufsize;
 int valsize;
 Lisp_Object val;
+#endif
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_symlink_p, filename);
+#ifdef S_IFLNK
 bufsize = 100;
 while (1)
 {
 buf = xnew_array_and_zero (char, bufsize);
 valsize = readlink ((char *) XSTRING_DATA (filename),
 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_directory_p, abspath);
-if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
 return Qnil;
 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
 }
 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
 if (!NILP (handler))
 return call2 (handler, Qfile_accessible_directory_p,
 		  filename);
-#if !defined(WINDOWSNT)
+#if !defined(WIN32_NATIVE)
 if (NILP (Ffile_directory_p (filename)))
 return (Qnil);
 else
 return Ffile_executable_p (filename);
 #else
 tem = (NILP (Ffile_directory_p (filename))
 	   || NILP (Ffile_executable_p (filename)));
 UNGCPRO;
 return tem ? Qnil : Qt;
 }
-#endif /* !defined(WINDOWSNT) */
+#endif /* !defined(WIN32_NATIVE) */
 }
 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
 Return t if file FILENAME is the name of a regular file.
 This is the sort of file that holds an ordinary stream of data bytes.
 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_regular_p, abspath);
-if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
 return Qnil;
 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
 }
 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
 handler = Ffind_file_name_handler (abspath, Qfile_modes);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_modes, abspath);
-if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
 return Qnil;
 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
 #if 0
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
 if (check_executable (XSTRING_DATA (abspath)))
 st.st_mode |= S_IEXEC;
-#endif /* DOS_NT */
+#endif /* WIN32_NATIVE */
 #endif /* 0 */
 return make_int (st.st_mode & 07777);
 }
 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
 Tell Unix to finish all pending disk updates.
 */
 ())
 {
-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE
 sync ();
 #endif
 return Qnil;
 }
 UNGCPRO;
 if (!NILP (handler))
 return call3 (handler, Qfile_newer_than_file_p, abspath1,
 		  abspath2);
-if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
 return Qnil;
 mtime1 = st.st_mtime;
-if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
 return Qt;
 return (mtime1 > st.st_mtime) ? Qt : Qnil;
 }
 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
 error ("Attempt to visit less than an entire file");
 fd = -1;
-if (stat ((char *) XSTRING_DATA (filename), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
 {
 if (fd >= 0) close (fd);
 badopen:
 if (NILP (visit))
 	report_file_error ("Opening input file", list1 (filename));
 If support for Mule exists in this Emacs, the file is encoded according
 to the value of CODESYS.  If this is nil, no code conversion occurs.
 */
 (start, end, filename, append, visit, lockname, codesys))
 {
-/* This function can call lisp */
+/* This function can call lisp.  GC checked 2000-07-28 ben */
 int desc;
 int failure;
 int save_errno = 0;
 struct stat st;
-Lisp_Object fn;
+Lisp_Object fn = Qnil;
 int speccount = specpdl_depth ();
 int visiting_other = STRINGP (visit);
 int visiting = (EQ (visit, Qt) || visiting_other);
 int quietly = (!visiting && !NILP (visit));
 Lisp_Object visit_file = Qnil;
 Lisp_Object annotations = Qnil;
 struct buffer *given_buffer;
 Bufpos start1, end1;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-/* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
+struct gcpro ngcpro1, ngcpro2;
+Lisp_Object curbuf;
+XSETBUFFER (curbuf, current_buffer);
+/* start, end, visit, and append are never modified in this fun
+so we don't protect them. */
+GCPRO5 (visit_file, filename, codesys, lockname, annotations);
+NGCPRO2 (curbuf, fn);
+/* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
 we should signal an error rather than blissfully continuing
 along.  ARGH, this function is going to lose lose lose.  We need
 to protect the current_buffer from being destroyed, but the
-multiple return points make this a pain in the butt. */
+multiple return points make this a pain in the butt. ]] we do
+protect curbuf now. --ben */
 #ifdef FILE_CODING
 codesys = Fget_coding_system (codesys);
 #endif /* FILE_CODING */
 if (current_buffer->base_buffer && ! NILP (visit))
-error ("Cannot do file visiting in an indirect buffer");
+invalid_operation ("Cannot do file visiting in an indirect buffer",
+		       curbuf);
 if (!NILP (start) && !STRINGP (start))
 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
 {
 Lisp_Object handler;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-GCPRO5 (start, filename, visit, visit_file, lockname);
 if (visiting_other)
 visit_file = Fexpand_file_name (visit, Qnil);
 else
 visit_file = filename;
 filename = Fexpand_file_name (filename, Qnil);
-UNGCPRO;
 if (NILP (lockname))
 lockname = visit_file;
+/* We used to UNGCPRO here.  BAD!  visit_file is used below after
+more Lisp calling. */
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qwrite_region);
 /* If FILENAME has no handler, see if VISIT has one.  */
 if (NILP (handler) && STRINGP (visit))
 	    BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
 	    current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
 	    current_buffer->filename = visit_file;
 	    MARK_MODELINE_CHANGED;
 	  }
+	NUNGCPRO;
+	UNGCPRO;
 	return val;
 }
 }
 #ifdef CLASH_DETECTION
 if (!auto_saving)
-{
+lock_file (lockname);
-Lisp_Object curbuf;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-XSETBUFFER (curbuf, current_buffer);
-GCPRO5 (start, filename, visit_file, lockname, curbuf);
-lock_file (lockname);
-UNGCPRO;
-}
 #endif /* CLASH_DETECTION */
 /* Special kludge to simplify auto-saving.  */
 if (NILP (start))
 {
 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
 }
 if (desc < 0)
 {
 desc = open ((char *) XSTRING_DATA (fn),
-(O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY),
+O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
-		   ((auto_saving) ? auto_save_mode_bits : CREAT_MODE));
+		   auto_saving ? auto_save_mode_bits : CREAT_MODE);
 }
 if (desc < 0)
 {
 #ifdef CLASH_DETECTION
 }
 {
 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
 Lisp_Object instream = Qnil, outstream = Qnil;
-struct gcpro gcpro1, gcpro2;
+struct gcpro nngcpro1, nngcpro2;
 /* need to gcpro; QUIT could happen out of call to write() */
-GCPRO2 (instream, outstream);
+NNGCPRO2 (instream, outstream);
 record_unwind_protect (close_file_unwind, desc_locative);
 if (!NILP (append))
 {
 {
 	failure = 1;
 	save_errno = errno;
 }
 Lstream_close (XLSTREAM (instream));
-UNGCPRO;
 #ifdef HAVE_FSYNC
 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
 Disk full in NFS may be reported here.  */
 /* mib says that closing the file will try to write as fast as NFS can do
 /* Spurious "file has changed on disk" warnings used to be seen on
 systems where close() can change the modtime.  This is known to
 happen on various NFS file systems, on Windows, and on Linux.
 Rather than handling this on a per-system basis, we
-unconditionally do the stat() after the close(). */
+unconditionally do the xemacs_stat() after the close(). */
 /* NFS can report a write failure now.  */
 if (close (desc) < 0)
 {
 	failure = 1;
 /* Discard the close unwind-protect.  Execute the one for
 build_annotations (switches back to the original current buffer
 as necessary). */
 XCAR (desc_locative) = Qnil;
 unbind_to (speccount, Qnil);
+NNUNGCPRO;
 }
-stat ((char *) XSTRING_DATA (fn), &st);
+xemacs_stat ((char *) XSTRING_DATA (fn), &st);
 #ifdef CLASH_DETECTION
 if (!auto_saving)
 unlock_file (lockname);
 #endif /* CLASH_DETECTION */
 next attempt to save.  */
 if (visiting)
 current_buffer->modtime = st.st_mtime;
 if (failure)
-error ("IO error writing %s: %s",
+{
-XSTRING_DATA (fn),
+errno = save_errno;
-strerror (save_errno));
+report_file_error ("Writing file", list1 (fn));
+}
 if (visiting)
 {
 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
 current_buffer->filename = visit_file;
 MARK_MODELINE_CHANGED;
 }
 else if (quietly)
 {
+NUNGCPRO;
+UNGCPRO;
 return Qnil;
 }
 if (!auto_saving)
 {
 if (visiting_other)
 message ("Wrote %s", XSTRING_DATA (visit_file));
 else
 	{
-	  struct gcpro gcpro1;
 	  Lisp_Object fsp;
-	  GCPRO1 (fn);
+	  struct gcpro nngcpro1;
+	  NNGCPRO1 (fsp);
 	  fsp = Ffile_symlink_p (fn);
 	  if (NILP (fsp))
 	    message ("Wrote %s", XSTRING_DATA (fn));
 	  else
 	    message ("Wrote %s (symlink to %s)",
 		     XSTRING_DATA (fn), XSTRING_DATA (fsp));
-	  UNGCPRO;
+	  NNUNGCPRO;
 	}
 }
+NUNGCPRO;
+UNGCPRO;
 return Qnil;
 }
 /* #### This is such a load of shit!!!!  There is no way we should define
 something so stupid as a subr, just sort the fucking list more
 Return t if last mod time of BUF's visited file matches what BUF records.
 This means that the file has not been changed since it was visited or saved.
 */
 (buf))
 {
-/* This function can call lisp */
+/* This function can call lisp; GC checked 2000-07-11 ben */
 struct buffer *b;
 struct stat st;
 Lisp_Object handler;
 CHECK_BUFFER (buf);
 handler = Ffind_file_name_handler (b->filename,
 Qverify_visited_file_modtime);
 if (!NILP (handler))
 return call2 (handler, Qverify_visited_file_modtime, buf);
-if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
+if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
 {
 /* If the file doesn't exist now and didn't exist before,
 	 we say that it isn't modified, provided the error is a tame one.  */
 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
 	st.st_mtime = -1;
 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
 UNGCPRO;
 if (!NILP (handler))
 	/* The handler can find the file name the same way we did.  */
 	return call2 (handler, Qset_visited_file_modtime, Qnil);
-else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0)
+else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
 	current_buffer->modtime = st.st_mtime;
 }
 return Qnil;
 }
 if (!STRINGP (a))
 return (Qnil);
 /* Get visited file's mode to become the auto save file's mode.  */
 if (STRINGP (fn) &&
-stat ((char *) XSTRING_DATA (fn), &st) >= 0)
+xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
 /* But make sure we can overwrite it later!  */
 auto_save_mode_bits = st.st_mode | 0600;
 else
 /* default mode for auto-save files of buffers with no file is
 readable by owner only.  This may annoy some small number of
 		  continue;
 		}
 	      set_buffer_internal (b);
 	      if (!auto_saved && NILP (no_message))
 		{
-		  static CONST unsigned char *msg
+		  static const unsigned char *msg
-		    = (CONST unsigned char *) "Auto-saving...";
+		    = (const unsigned char *) "Auto-saving...";
 		  echo_area_message (selected_frame (), msg, Qnil,
-				     0, strlen ((CONST char *) msg),
+				     0, strlen ((const char *) msg),
 				     Qauto_saving);
 		}
 	      /* Open the auto-save list file, if necessary.
 		 We only do this now so that the file only exists
 		 the special file that lists them.  For each of
 		 these buffers, record visited name (if any) and
 		 auto save name.  */
 	      if (listdesc >= 0)
 		{
-		  CONST Extbyte *auto_save_file_name_ext;
+		  const Extbyte *auto_save_file_name_ext;
 		  Extcount auto_save_file_name_ext_len;
 		  TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
 				      ALLOCA, (auto_save_file_name_ext,
 					       auto_save_file_name_ext_len),
 				      Qfile_name);
 		  if (!NILP (b->filename))
 		    {
-		      CONST Extbyte *filename_ext;
+		      const Extbyte *filename_ext;
 		      Extcount filename_ext_len;
 		      TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
 					  ALLOCA, (filename_ext,
 						   filename_ext_len),
 /* Show "...done" only if the echo area would otherwise be empty. */
 if (auto_saved && NILP (no_message)
 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
 {
-static CONST unsigned char *msg
+static const unsigned char *msg
-= (CONST unsigned char *)"Auto-saving...done";
+= (const unsigned char *)"Auto-saving...done";
 echo_area_message (selected_frame (), msg, Qnil, 0,
-			 strlen ((CONST char *) msg), Qauto_saving);
+			 strlen ((const char *) msg), Qauto_saving);
 }
 Vquit_flag = oquit;
 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
 defsymbol (&Qformat_decode, "format-decode");
 defsymbol (&Qformat_annotate_function, "format-annotate-function");
 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
-deferror (&Qfile_error, "file-error", "File error", Qio_error);
+DEFERROR_STANDARD (Qfile_error, Qio_error);
-deferror (&Qfile_already_exists, "file-already-exists",
+DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
-	    "File already exists", Qfile_error);
 DEFSUBR (Ffind_file_name_handler);
 DEFSUBR (Ffile_name_directory);
 DEFSUBR (Ffile_name_nondirectory);
 DEFSUBR (Fmake_directory_internal);
 DEFSUBR (Fdelete_directory);
 DEFSUBR (Fdelete_file);
 DEFSUBR (Frename_file);
 DEFSUBR (Fadd_name_to_file);
-#ifdef S_IFLNK
 DEFSUBR (Fmake_symbolic_link);
-#endif /* S_IFLNK */
 #ifdef HPUX_NET
 DEFSUBR (Fsysnetunam);
 #endif /* HPUX_NET */
 DEFSUBR (Ffile_name_absolute_p);
 DEFSUBR (Ffile_exists_p);
 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
 This variable affects the built-in functions only on Windows,
 on other platforms, it is initialized so that Lisp code can find out
 what the normal separator is.
 */ );
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 Vdirectory_sep_char = make_char ('\\');
 #else
 Vdirectory_sep_char = make_char ('/');
 #endif
-}
+reinit_vars_of_fileio ();
+}
+void
+reinit_vars_of_fileio (void)
+{
+/* We want temp_name_rand to be initialized to a value likely to be
+unique to the process, not to the executable.  The danger is that
+two different XEmacs processes using the same binary on different
+machines creating temp files in the same directory will be
+unlucky enough to have the same pid.  If we randomize using
+process startup time, then in practice they will be unlikely to
+collide. We use the microseconds field so that scripts that start
+simultaneous XEmacs processes on multiple machines will have less
+chance of collision.  */
+{
+EMACS_TIME thyme;
+EMACS_GET_TIME (thyme);
+temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));
+}
+}

Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 442:abe6d1db359e r21-2-36