#include <config.h>
#include "lisp.h"
-#include <limits.h>
#include "buffer.h"
#include "events.h"
#endif /* HPUX_PRE_8_0 */
#endif /* HPUX */
-#ifdef WINDOWSNT
-#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)
+#if defined(WIN32_NATIVE) || defined(CYGWIN)
+#define WIN32_FILENAMES
+#ifdef WIN32_NATIVE
+#include "nt.h"
+#endif /* WIN32_NATIVE */
#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 */
+#ifndef CORRECT_DIR_SEPS
+#define CORRECT_DIR_SEPS(s) \
+ normalize_filename(s, DIRECTORY_SEP)
+/* Default implementation that coerces a file to use path_sep. */
+static void
+normalize_filename (Bufbyte *fp, Bufbyte path_sep)
+{
+ /* Always lower-case drive letters a-z, even if the filesystem
+ preserves case in filenames.
+ This is so filenames can be compared by string comparison
+ functions that are case-sensitive. Even case-preserving filesystems
+ do not distinguish case in drive letters. */
+ if (fp[1] == ':' && *fp >= 'A' && *fp <= 'Z')
+ {
+ *fp += 'a' - 'A';
+ fp += 2;
+ }
+
+ while (*fp)
+ {
+ if (*fp == '/' || *fp == '\\')
+ *fp = path_sep;
+ fp++;
+ }
+}
+#endif /* CORRECT_DIR_SEPS */
+#endif /* WIN32_NATIVE || CYGWIN */
int lisp_to_time (Lisp_Object, time_t *);
Lisp_Object time_to_lisp (time_t);
/* File name in which we write a list of all our auto save files. */
Lisp_Object Vauto_save_list_file_name;
+/* Prefix used to construct Vauto_save_list_file_name. */
+Lisp_Object Vauto_save_list_file_prefix;
+
+/* When non-nil, it prevents auto-save list file creation. */
+int inhibit_auto_save_session;
+
int disable_auto_save_when_buffer_shrinks;
Lisp_Object Vdirectory_sep_char;
\f
DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
-Return the directory component in file name NAME.
-Return nil if NAME does not include a directory.
+Return the directory component in file name FILENAME.
+Return nil if FILENAME does not include a directory.
Otherwise return a directory spec.
Given a Unix syntax file name, returns a string ending in slash.
*/
- (file))
+ (filename))
{
- /* 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);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file, Qfile_name_directory);
+ handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
- return call2_check_string_or_nil (handler, Qfile_name_directory, file);
+ return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
#ifdef FILE_SYSTEM_CASE
- file = FILE_SYSTEM_CASE (file);
+ filename = FILE_SYSTEM_CASE (filename);
#endif
- beg = XSTRING_DATA (file);
- p = beg + XSTRING_LENGTH (file);
+ beg = XSTRING_DATA (filename);
+ p = beg + XSTRING_LENGTH (filename);
while (p != beg && !IS_ANY_SEP (p[-1])
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* only recognize drive specifier at beginning */
&& !(p[-1] == ':' && p == beg + 2)
#endif
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);
- if (getdefdir (toupper (*beg) - 'A' + 1, res))
+ Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1);
+ if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN))
{
char *c=((char *) res) + strlen ((char *) res);
if (!IS_DIRECTORY_SEP (*c))
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.
+Return file name FILENAME sans its directory.
For example, in a Unix-syntax file name,
this is everything after the last slash,
or the entire name if it contains no slash.
*/
- (file))
+ (filename))
{
- /* 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);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
+ handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
- return call2_check_string (handler, Qfile_name_nondirectory, file);
+ return call2_check_string (handler, Qfile_name_nondirectory, filename);
- beg = XSTRING_DATA (file);
- end = p = beg + XSTRING_LENGTH (file);
+ beg = XSTRING_DATA (filename);
+ end = p = beg + XSTRING_LENGTH (filename);
while (p != beg && !IS_ANY_SEP (p[-1])
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* only recognize drive specifier at beginning */
&& !(p[-1] == ':' && p == beg + 2)
#endif
The `call-process' and `start-process' functions use this function to
get a current directory to run processes in.
*/
- (filename))
+ (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,
static char *
file_name_as_directory (char *out, char *in)
{
+ /* This function cannot GC */
int size = strlen (in);
if (size == 0)
For a Unix-syntax file name, just appends a slash,
except for (file-name-as-directory \"\") => \"./\".
*/
- (file))
+ (filename))
{
- /* 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);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
+ handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
if (!NILP (handler))
- return call2_check_string (handler, Qfile_name_as_directory, file);
+ return call2_check_string (handler, Qfile_name_as_directory, filename);
- buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
+ buf = (char *) alloca (XSTRING_LENGTH (filename) + 10);
return build_string (file_name_as_directory
- (buf, (char *) XSTRING_DATA (file)));
+ (buf, (char *) XSTRING_DATA (filename)));
}
\f
/*
static int
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_FILENAMES
&& !IS_ANY_SEP (dst[slen - 2])
-#endif /* WINDOWSNT */
+#endif /* WIN32_FILENAMES */
)
dst[slen - 1] = 0;
return 1;
}
DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
-Return the file name of the directory named DIR.
-This is the name of the file that holds the data for the directory DIR.
+Return the file name of the directory named DIRECTORY.
+This is the name of the file that holds the data for the directory.
This operation exists because a directory is also a file, but its name as
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;
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.
*/
(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',
'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','-','_' };
- static unsigned count, count_initialized_p;
+ '4','5','6','7','8','9','-','_'
+ };
Lisp_Object val;
Bytecount len;
Bufbyte *p, *data;
- unsigned pid;
CHECK_STRING (prefix);
/* 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
- unique file names per PID per PREFIX. */
+ a pseudo-random number seeded from process startup time. This
+ ensures 262144 unique file names per PID per PREFIX per machine. */
- pid = (unsigned)getpid ();
- *p++ = tbl[pid & 63], pid >>= 6;
- *p++ = tbl[pid & 63], pid >>= 6;
- *p++ = tbl[pid & 63], pid >>= 6;
+ {
+ unsigned int pid = (unsigned int) getpid ();
+ *p++ = tbl[(pid >> 0) & 63];
+ *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
- afterwards. */
- 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;
- }
+ this by using a very pseudo-random number generator to generate
+ file names unique to this process, with a very long cycle. */
while (1)
{
struct stat ignored;
- unsigned num = count;
- p[0] = tbl[num & 63], num >>= 6;
- p[1] = tbl[num & 63], num >>= 6;
- p[2] = tbl[num & 63], num >>= 6;
+ p[0] = tbl[(temp_name_rand >> 0) & 63];
+ p[1] = tbl[(temp_name_rand >> 6) & 63];
+ p[2] = tbl[(temp_name_rand >> 12) & 63];
/* Poor man's congruential RN generator. Replace with ++count
for debugging. */
- count += 25229;
- count %= 225307;
+ temp_name_rand += 25229;
+ 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)
Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
-the current buffer's value of default-directory is used.
+the current buffer's value of `default-directory' is used.
File name components that are `.' are removed, and
so are file name components followed by `..', along with the `..' itself;
note that these simplifications are done without checking the resulting
*/
(name, default_directory))
{
- /* This function can GC */
+ /* This function can GC. GC-checked 2000-11-18 */
Bufbyte *nm;
Bufbyte *newdir, *p, *o;
int tlen;
Bufbyte *target;
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
int drive = 0;
int collapse_newdir = 1;
-#else
+#endif
+#ifndef WIN32_NATIVE
struct passwd *pw;
-#endif /* WINDOWSNT */
+#endif /* WIN32_FILENAMES */
int length;
- Lisp_Object handler;
-#ifdef __CYGWIN32__
+ Lisp_Object handler = Qnil;
+#ifdef CYGWIN
char *user;
#endif
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ /* both of these get set below */
+ GCPRO3 (name, default_directory, handler);
CHECK_STRING (name);
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);
+ RETURN_UNGCPRO (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))
{
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, default_directory);
+ RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
+ name, default_directory));
}
o = XSTRING_DATA (default_directory);
/* 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
- /* Detect MSDOS file names with drive specifiers. */
+#ifdef WIN32_FILENAMES
+ /* 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 */
-
+#endif /* not WIN32_FILENAMES */
+#ifndef 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;
- GCPRO1 (name);
- default_directory = Fexpand_file_name (default_directory, Qnil);
- UNGCPRO;
- }
+ default_directory = Fexpand_file_name (default_directory, Qnil);
#ifdef FILE_SYSTEM_CASE
name = FILE_SYSTEM_CASE (name);
into name should be safe during all of this, though. */
nm = XSTRING_DATA (name);
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* 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 = (Bufbyte *) 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 (colon[0] == ':')
goto look_again;
}
+ }
}
/* If we see "c://somedir", we want to strip the first slash after the
"//somedir". */
if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
nm++;
-#endif /* WINDOWSNT */
+#endif /* WIN32_FILENAMES */
/* 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 (!lose)
{
-#ifdef WINDOWSNT
- /* 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]))
- {
- if (strcmp (nm, XSTRING_DATA (name)) != 0)
- name = build_string (nm);
- }
- /* drive must be set, so this is okay */
- else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
+#ifdef WIN32_FILENAMES
+ if (drive || IS_DIRECTORY_SEP (nm[1]))
{
- name = make_string (nm - 2, p - nm + 2);
- XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
- XSTRING_DATA (name)[1] = ':';
+ /* 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]))
+ {
+ if (strcmp ((char *) nm, (char *) XSTRING_DATA (name)) != 0)
+ name = build_string ((Bufbyte *) nm);
+ }
+ /* drive must be set, so this is okay */
+ else if (strcmp ((char *) nm - 2,
+ (char *) XSTRING_DATA (name)) != 0)
+ {
+ name = make_string (nm - 2, p - nm + 2);
+ XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
+ XSTRING_DATA (name)[1] = ':';
+ }
+ RETURN_UNGCPRO (name);
}
- return name;
-#else /* not WINDOWSNT */
+#endif /* not WIN32_FILENAMES */
+#ifndef WIN32_NATIVE
if (nm == XSTRING_DATA (name))
- return name;
- return build_string ((char *) nm);
-#endif /* not WINDOWSNT */
+ RETURN_UNGCPRO (name);
+ RETURN_UNGCPRO (build_string ((char *) nm));
+#endif /* not WIN32_NATIVE */
}
}
Qfile_name);
nm++;
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
collapse_newdir = 0;
#endif
}
memcpy (o, (char *) nm, p - nm);
o [p - nm] = 0;
- /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
- which does not work. The following works only if ~USER
- 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
- /* 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 */
-#ifdef __CYGWIN32__
+ /* #### While NT is single-user (for the moment) you still
+ can have multiple user profiles users defined, each with
+ its HOME. So maybe possibly we should think about handling
+ ~user. --ben */
+#ifndef WIN32_NATIVE
+#ifdef CYGWIN
if ((user = user_login_name (NULL)) != NULL)
{
/* Does the user login name match the ~name? */
}
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 ();
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_FILENAMES
/* 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)
{
+#ifdef WIN32_NATIVE
/* 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))
+ newdir = (Bufbyte *) alloca (MAXPATHLEN + 1);
+ if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
newdir = NULL;
}
+#endif /* WIN32_NATIVE */
if (!newdir)
{
/* Either nm starts with /, or drive isn't mounted. */
- newdir = alloca (4);
+ newdir = (Bufbyte *) alloca (4);
newdir[0] = DRIVE_LETTER (drive);
newdir[1] = ':';
newdir[2] = '/';
newdir[3] = 0;
}
}
-#endif /* WINDOWSNT */
+#endif /* WIN32_FILENAMES */
/* 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
+#endif
+#ifdef WIN32_FILENAMES
&& !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
#endif
&& !newdir)
newdir = XSTRING_DATA (default_directory);
}
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
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 */
&& ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
+ /* Detect unix format. */
+#ifndef WIN32_NATIVE
+ && ! (IS_DIRECTORY_SEP (newdir[0]))
+#endif
)
{
/* Effectively, let newdir be (expand-file-name newdir cwd).
}
if (!IS_DIRECTORY_SEP (nm[0]))
{
- char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
- file_name_as_directory (tmp, newdir);
- strcat (tmp, nm);
+ Bufbyte *tmp = (Bufbyte *) alloca (strlen ((char *) newdir) +
+ strlen ((char *) nm) + 2);
+ file_name_as_directory ((char *) tmp, (char *) newdir);
+ strcat ((char *) tmp, (char *) nm);
nm = tmp;
}
- newdir = alloca (MAXPATHLEN + 1);
+ newdir = (Bufbyte *) alloca (MAXPATHLEN + 1);
if (drive)
{
- if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
- newdir = "/";
+#ifdef WIN32_NATIVE
+ if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN))
+#endif
+ newdir = (Bufbyte *) "/";
}
else
- getwd (newdir);
+ getcwd ((char *) newdir, MAXPATHLEN);
}
/* Strip off drive name from prefix, if present. */
/* Keep only a prefix from newdir if nm starts with slash
(/ /server/share for UNC, nothing otherwise). */
- if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
+ if (IS_DIRECTORY_SEP (nm[0])
+#ifndef WIN32_NATIVE
+ && IS_DIRECTORY_SEP (nm[1])
+#endif
+ && collapse_newdir)
{
if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
{
- newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
+ newdir =
+ (Bufbyte *)
+ strcpy ((char *) alloca (strlen ((char *) newdir) + 1),
+ (char *) newdir);
p = newdir + 2;
while (*p && !IS_DIRECTORY_SEP (*p)) p++;
p++;
*p = 0;
}
else
- newdir = "";
+ newdir = (Bufbyte *) "";
}
}
-#endif /* WINDOWSNT */
+#endif /* WIN32_FILENAMES */
if (newdir)
{
just // (an incomplete UNC name). */
length = strlen ((char *) newdir);
if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
)
/* Now concatenate the directory and name to new space in the stack frame */
tlen += strlen ((char *) nm) + 1;
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* 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_FILENAMES */
target = (Bufbyte *) alloca (tlen);
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_FILENAMES */
*target = 0;
if (newdir)
++o;
p += 3;
}
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* if drive is set, we're not dealing with an UNC, so
multiple dir-seps are redundant (and reportedly cause trouble
under win95) */
}
}
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* At last, set drive name, except for network file name. */
if (drive)
{
target[0] = DRIVE_LETTER (drive);
target[1] = ':';
}
+#ifdef WIN32_NATIVE
else
{
assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
}
+#endif
CORRECT_DIR_SEPS (target);
-#endif /* WINDOWSNT */
+#endif /* WIN32_FILENAMES */
- 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
+Return the canonical name of FILENAME.
+Second arg DEFAULT is directory to start with if FILENAME is relative
(does not start with slash); if DEFAULT is nil or missing,
- the current buffer's value of default-directory is used.
+ the current buffer's value of `default-directory' is used.
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);
return Qnil;
GCPRO1 (expanded_name);
- handler = Ffind_file_name_handler (expanded_name, Qfile_truename);
- UNGCPRO;
- if (!NILP (handler))
- return call2_check_string (handler, Qfile_truename, expanded_name);
+ {
+ Lisp_Object handler =
+ Ffind_file_name_handler (expanded_name, Qfile_truename);
+
+ if (!NILP (handler))
+ RETURN_UNGCPRO
+ (call2_check_string (handler, Qfile_truename, expanded_name));
+ }
{
char resolved_path[MAXPATHLEN];
p = path;
if (elen > MAXPATHLEN)
goto toolong;
-
+
/* Try doing it all at once. */
/* !! Does realpath() Mule-encapsulate?
Answer: Nope! So we do it above */
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;
+ Extbyte *pos;
+
+#ifdef WIN32_FILENAMES
+ if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
+ && IS_DIRECTORY_SEP (p[2]))
+ /* don't test c: on windows */
+ p = p+2;
+ else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
+ /* start after // */
+ p = p+1;
+#endif
+ for (pos = p + 1; pos < path + elen; pos++)
+ if (IS_DIRECTORY_SEP (*pos))
+ {
+ *(p = pos) = 0;
+ break;
+ }
+ if (p != pos)
+ p = 0;
- /* memset (resolved_path, 0, sizeof (resolved_path)); */
if (xrealpath ((char *) path, resolved_path))
{
if (p)
- *p = '/';
+ *p = DIRECTORY_SEP;
else
break;
/* "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] == '/')
+ if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
rlen = rlen - 1;
if (plen + rlen + 1 > countof (resolved_path))
goto toolong;
- resolved_path[rlen] = '/';
+ resolved_path[rlen] = DIRECTORY_SEP;
memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
}
break;
}
{
+ 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 (elen > 0 && IS_DIRECTORY_SEP (XSTRING_BYTE (expanded_name, elen - 1))
+ && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
{
if (rlen + 1 > countof (resolved_path))
goto toolong;
- resolved_path[rlen] = '/';
- resolved_path[rlen + 1] = 0;
- rlen = rlen + 1;
+ resolved_path[rlen++] = DIRECTORY_SEP;
+ resolved_path[rlen] = '\0';
}
- 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:
lose:
report_file_error ("Finding truename", list1 (expanded_name));
}
- return Qnil; /* suppress compiler warning */
+ RETURN_UNGCPRO (Qnil);
}
\f
Substitute environment variables referred to in FILENAME.
`$FOO' where FOO is an environment variable name means to substitute
the value of that variable. The variable name should be terminated
-with a character not a letter, digit or underscore; otherwise, enclose
+with a character, not a letter, digit or underscore; otherwise, enclose
the entire variable name in braces.
If `/~' appears, all of FILENAME through that `/' is discarded.
-
*/
- (string))
+ (filename))
{
- /* 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 *xnm;
Lisp_Object handler;
- CHECK_STRING (string);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
+ handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
if (!NILP (handler))
return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
- string);
+ filename);
- nm = XSTRING_DATA (string);
- endp = nm + XSTRING_LENGTH (string);
+ nm = XSTRING_DATA (filename);
+ endp = nm + XSTRING_LENGTH (filename);
/* 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_FILENAMES)
/* // 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_FILENAMES) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (WINDOWSNT || __CYGWIN32__) */
+#endif /* not (WIN32_FILENAMES) */
)
&& p != nm
&& (IS_DIRECTORY_SEP (p[-1])))
nm = p;
substituted = 1;
}
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
/* 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_FILENAMES */
}
/* See if any variables are substituted into the string
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 (!substituted)
- return string;
+ return filename;
- /* If substitution required, recopy the string and do it */
+ /* If substitution required, recopy the filename and do it */
/* Make space in stack frame for the new copy */
- xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
+ xnm = (Bufbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
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);
for (p = xnm; p != x; p++)
if ((p[0] == '~'
-#if defined (WINDOWSNT)
+#if defined (WIN32_FILENAMES)
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
-#else /* not WINDOWSNT */
+#else /* not WIN32_FILENAMES */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_FILENAMES */
)
/* 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_FILENAMES
else if (IS_DRIVE (p[0]) && p[1] == ':'
&& p > nm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
return make_string (xnm, x - xnm);
badsubst:
- error ("Bad format environment-variable substitution");
+ syntax_error ("Bad format environment-variable substitution", filename);
missingclose:
- error ("Missing \"}\" in environment-variable substitution");
+ syntax_error ("Missing \"}\" in environment-variable substitution",
+ filename);
badvar:
- error ("Substituting nonexistent environment variable \"%s\"",
- target);
+ syntax_error_2 ("Substituting nonexistent environment variable",
+ filename, build_string ((char *) target));
/* NOTREACHED */
return Qnil; /* suppress compiler warning */
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;
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;
DEFUN ("copy-file", Fcopy_file, 2, 4,
"fCopy file: \nFCopy %s to file: \np\nP", /*
-Copy FILE to NEWNAME. Both args must be strings.
+Copy FILENAME to NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if file NEWNAME already exists,
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
*/
(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;
args[1] = Qnil; args[2] = Qnil;
NGCPRO1 (*args);
ngcpro1.nvars = 3;
- if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
- args[i++] = build_string ("/");
+ if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
+ XSTRING_LENGTH (newname) - 1)))
+
+ args[i++] = Fchar_to_string (Vdirectory_sep_char);
args[i++] = Ffile_name_nondirectory (filename);
newname = Fconcat (i, args);
NUNGCPRO;
|| 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);
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)
{
report_file_error ("I/O error", list1 (newname));
if (input_file_statable_p)
- {
- if (!NILP (keep_time))
{
- EMACS_TIME atime, mtime;
- EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
- EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times ((char *) XSTRING_DATA (newname), atime,
- mtime))
- report_file_error ("I/O error", list1 (newname));
+ if (!NILP (keep_time))
+ {
+ EMACS_TIME atime, mtime;
+ EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
+ EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
+ if (set_file_times (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;
{
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_),
}
DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
-Delete specified file. One argument, a file name string.
-If file has multiple names, it continues to exist with the other names.
+Delete the file named FILENAME (a string).
+If FILENAME has multiple names, it continues to exist with the other names.
*/
(filename))
{
\f
DEFUN ("rename-file", Frename_file, 2, 3,
"fRename file: \nFRename %s to file: \np", /*
-Rename FILE as NEWNAME. Both args strings.
-If file has names other than FILE, it continues to have those names.
+Rename FILENAME as NEWNAME. Both args must be strings.
+If file has names other than FILENAME, it continues to have those names.
Signals a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
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
- link() and unlink() otherwise, but that's bogus. Sometimes
- rename() succeeds where link()/unlink() fail, and we have
- configure check for rename() and emulate using link()/unlink()
- if necessary. */
+ /* We have configure check for rename() and emulate using
+ link()/unlink() if necessary. */
if (0 > rename ((char *) XSTRING_DATA (filename),
(char *) XSTRING_DATA (newname)))
{
DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
"fAdd name to file: \nFName to add to %s: \np", /*
-Give FILE additional name NEWNAME. Both args strings.
+Give FILENAME additional name NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
/* 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),
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.
(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;
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",
report_file_error ("Making symbolic link",
list2 (filename, linkname));
}
+#endif /* S_IFLNK */
+
UNGCPRO;
return Qnil;
}
-#endif /* S_IFLNK */
#ifdef HPUX_NET
/* 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);
- TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative);
+ LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
+ LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
netresult = netunam (path_ext, login_ext);
CHECK_STRING (filename);
ptr = XSTRING_DATA (filename);
return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
-#ifdef WINDOWSNT
+#ifdef WIN32_FILENAMES
|| (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
#endif
) ? Qt : Qnil;
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. */
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
}
*/
(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;
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, /*
(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;
if (!NILP (handler))
RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
-#if defined(WINDOWSNT) || defined(__CYGWIN32__)
+#if defined(WIN32_FILENAMES)
/* 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_FILENAMES */
{
int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
UNGCPRO;
close (desc);
return Qt;
}
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_FILENAMES */
}
/* Having this before file-symlink-p mysteriously caused it to be forgotten
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);
(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;
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
+#ifdef S_IFLNK
bufsize = 100;
while (1)
{
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;
}
return call2 (handler, Qfile_accessible_directory_p,
filename);
-#if !defined(WINDOWSNT)
+#if !defined(WIN32_NATIVE)
if (NILP (Ffile_directory_p (filename)))
return (Qnil);
else
UNGCPRO;
return tem ? Qnil : Qt;
}
-#endif /* !defined(WINDOWSNT) */
+#endif /* !defined(WIN32_NATIVE) */
}
DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
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;
}
\f
DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
-Return mode bits of FILE, as an integer.
+Return mode bits of file named FILENAME, as an integer.
*/
(filename))
{
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 ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
-Set mode bits of FILE to MODE (an integer).
+Set mode bits of file named FILENAME to MODE (an integer).
Only the 12 low bits of MODE are used.
*/
(filename, mode))
DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
Set the file permission bits for newly created files.
-MASK should be an integer; if a permission's bit in MASK is 1,
-subsequently created files will not have that permission enabled.
-Only the low 9 bits are used.
+The argument MODE should be an integer; if a bit in MODE is 1,
+subsequently created files will not have the permission corresponding
+to that bit enabled. Only the low 9 bits are used.
This setting is inherited by subprocesses.
*/
(mode))
*/
())
{
-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE
sync ();
#endif
return Qnil;
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;
decoding is stored into it. It will in general be different from CODESYS
if CODESYS specifies automatic encoding detection or end-of-line detection.
-Currently BEG and END refer to byte positions (as opposed to character
+Currently START and END refer to byte positions (as opposed to character
positions), even in Mule. (Fixing this is very difficult.)
*/
- (filename, visit, beg, end, replace, codesys, used_codesys))
+ (filename, visit, start, end, replace, codesys, used_codesys))
{
/* This function can call lisp */
- /* #### dmoore - this function hasn't been checked for gc recently */
struct stat st;
int fd;
int saverrno = 0;
if (!NILP (handler))
{
val = call6 (handler, Qinsert_file_contents, filename,
- visit, beg, end, replace);
+ visit, start, end, replace);
goto handled;
}
CHECK_SYMBOL (used_codesys);
#endif
- if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
+ if ( (!NILP (start) || !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:
#ifdef S_IFREG
/* Signal an error if we are accessing a non-regular file, with
- REPLACE, BEG or END being non-nil. */
+ REPLACE, START or END being non-nil. */
if (!S_ISREG (st.st_mode))
{
not_regular = 1;
if (!NILP (visit))
goto notfound;
- if (!NILP (replace) || !NILP (beg) || !NILP (end))
+ if (!NILP (replace) || !NILP (start) || !NILP (end))
{
end_multiple_change (buf, mc_count);
- return Fsignal (Qfile_error,
- list2 (build_translated_string("not a regular file"),
- filename));
+ RETURN_UNGCPRO
+ (Fsignal (Qfile_error,
+ list2 (build_translated_string("not a regular file"),
+ filename)));
}
}
#endif /* S_IFREG */
- if (!NILP (beg))
- CHECK_INT (beg);
+ if (!NILP (start))
+ CHECK_INT (start);
else
- beg = Qzero;
+ start = Qzero;
if (!NILP (end))
CHECK_INT (end);
same_at_end += overlap;
/* Arrange to read only the nonmatching middle part of the file. */
- beg = make_int (same_at_start - BUF_BEGV (buf));
+ start = make_int (same_at_start - BUF_BEGV (buf));
end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
buffer_delete_range (buf, same_at_start, same_at_end,
if (!not_regular)
{
- total = XINT (end) - XINT (beg);
+ total = XINT (end) - XINT (start);
/* Make sure point-max won't overflow after this insertion. */
if (total != XINT (make_int (total)))
will make the stream functions read as much as possible. */
total = -1;
- if (XINT (beg) != 0
+ if (XINT (start) != 0
#ifdef FSFMACS_SPEEDY_INSERT
/* why was this here? asked jwz. The reason is that the replace-mode
connivings above will normally put the file pointer other than
#endif /* !FSFMACS_SPEEDY_INSERT */
)
{
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (lseek (fd, XINT (start), 0) < 0)
report_file_error ("Setting file position", list1 (filename));
}
occurs inside of the filedesc stream. */
while (1)
{
- ssize_t this_len;
+ Lstream_data_count this_len;
Charcount cc_inserted;
QUIT;
it could be called here. But that's just silly.
There's no reason C code can't call out to Lisp
code, and it's a lot cleaner this way. */
+ /* Note: compute-buffer-file-truename is called for
+ side-effect! Its return value is intentionally
+ ignored. */
if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
call1 (Qcompute_buffer_file_truename, make_buffer (buf));
}
*/
(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);
Lisp_Object annotations = Qnil;
struct buffer *given_buffer;
Bufpos start1, end1;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ 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,
+ /* [[ 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);
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);
current_buffer->filename = visit_file;
MARK_MODELINE_CHANGED;
}
+ NUNGCPRO;
+ UNGCPRO;
return val;
}
}
#ifdef CLASH_DETECTION
if (!auto_saving)
- {
- 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;
- }
+ lock_file (lockname);
#endif /* CLASH_DETECTION */
/* Special kludge to simplify auto-saving. */
if (desc < 0)
{
desc = open ((char *) XSTRING_DATA (fn),
- (O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY),
- ((auto_saving) ? auto_save_mode_bits : CREAT_MODE));
+ O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
+ auto_saving ? auto_save_mode_bits : CREAT_MODE);
}
if (desc < 0)
{
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);
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).
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)
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)
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s",
- XSTRING_DATA (fn),
- strerror (save_errno));
+ {
+ errno = save_errno;
+ report_file_error ("Writing file", list1 (fn));
+ }
if (visiting)
{
}
else if (quietly)
{
+ NUNGCPRO;
+ UNGCPRO;
return Qnil;
}
message ("Wrote %s", XSTRING_DATA (visit_file));
else
{
- struct gcpro gcpro1;
- Lisp_Object fsp;
- GCPRO1 (fn);
+ Lisp_Object fsp = Qnil;
+ 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;
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
-Return t if last mod time of BUF's visited file matches what BUF records.
+Return t if last mod time of BUFFER's visited file matches what BUFFER records.
This means that the file has not been changed since it was visited or saved.
*/
- (buf))
+ (buffer))
{
- /* 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);
- b = XBUFFER (buf);
+ CHECK_BUFFER (buffer);
+ b = XBUFFER (buffer);
if (!STRINGP (b->filename)) return Qt;
if (b->modtime == 0) return Qt;
handler = Ffind_file_name_handler (b->filename,
Qverify_visited_file_modtime);
if (!NILP (handler))
- return call2 (handler, Qverify_visited_file_modtime, buf);
+ return call2 (handler, Qverify_visited_file_modtime, buffer);
- 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. */
}
else
{
- Lisp_Object filename;
+ Lisp_Object filename = Qnil;
struct stat st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3;
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;
}
/* 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
return
/* !!#### need to deal with this 'escape-quoted everywhere */
Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
-#ifdef MULE
- Qescape_quoted
+#ifdef FILE_CODING
+ current_buffer->buffer_file_coding_system
#else
Qnil
#endif
/* Open the auto-save list file, if necessary.
We only do this now so that the file only exists
if we actually auto-saved any files. */
- if (!auto_saved && STRINGP (listfile) && listdesc < 0)
+ if (!auto_saved && !inhibit_auto_save_session
+ && !NILP (Vauto_save_list_file_prefix)
+ && STRINGP (listfile) && listdesc < 0)
{
listdesc = open ((char *) XSTRING_DATA (listfile),
O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
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 (&Qfile_already_exists, "file-already-exists",
- "File already exists", Qfile_error);
+ DEFERROR_STANDARD (Qfile_error, Qio_error);
+ DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
DEFSUBR (Ffind_file_name_handler);
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 */
*/ );
Vauto_save_list_file_name = Qnil;
+ DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
+Prefix for generating auto-save-list-file-name.
+Emacs's pid and the system name will be appended to
+this prefix to create a unique file name.
+*/ );
+ Vauto_save_list_file_prefix = build_string ("~/.saves-");
+
+ DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
+When non-nil, inhibit auto save list file creation.
+*/ );
+ inhibit_auto_save_session = 0;
+
DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
&disable_auto_save_when_buffer_shrinks /*
If non-nil, auto-saving is disabled when a buffer shrinks too much.
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 ('/');
+ 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));
+ }
}
projects / chise / xemacs-chise.git.1 / blobdiff