diff options
| -rw-r--r-- | src/fileio.c | 647 |
1 files changed, 414 insertions, 233 deletions
diff --git a/src/fileio.c b/src/fileio.c index 7493a29f1a4..d01b70c7af7 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,5 +1,5 @@ /* File IO for GNU Emacs. - Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc. + Copyright (C) 1985,86,87,88,93,94,95,96 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -93,6 +93,21 @@ extern char *strerror (); #include <fcntl.h> #endif /* not WINDOWSNT */ +#ifdef DOS_NT +#define CORRECT_DIR_SEPS(s) \ + do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ + else unixtodos_filename (s); \ + } while (0) +/* On Windows, drive letters must be alphabetic - on DOS, the Netware + redirector allows the six letters between 'Z' and 'a' as well. */ +#ifdef MSDOS +#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z') +#endif +#ifdef WINDOWSNT +#define IS_DRIVE(x) isalpha (x) +#endif +#endif + #ifdef VMS #include <file.h> #include <rmsdef.h> @@ -129,7 +144,7 @@ int auto_saving; a new file with the same mode as the original */ int auto_save_mode_bits; -/* Alist of elements (REGEXP . HANDLER) for file names +/* Alist of elements (REGEXP . HANDLER) for file names whose I/O is done with a special handler. */ Lisp_Object Vfile_name_handler_alist; @@ -160,6 +175,10 @@ int insert_default_directory; Zero means use var format. */ int vms_stmlf_recfm; +/* On NT, specifies the directory separator character, used (eg.) when + expanding file names. This can be bound to / or \. */ +Lisp_Object Vdirectory_sep_char; + /* These variables describe handlers that have "already" had a chance to handle the current operation. @@ -203,7 +222,7 @@ close_file_unwind (fd) /* Restore point, having saved it as a marker. */ restore_point_unwind (location) - Lisp_Object location; + Lisp_Object location; { SET_PT (marker_position (location)); Fset_marker (location, Qnil, Qnil); @@ -312,44 +331,38 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") filename = FILE_SYSTEM_CASE (filename); #endif beg = XSTRING (filename)->data; +#ifdef DOS_NT + beg = strcpy (alloca (strlen (beg) + 1), beg); +#endif p = beg + XSTRING (filename)->size; - while (p != beg && !IS_ANY_SEP (p[-1]) + while (p != beg && !IS_DIRECTORY_SEP (p[-1]) #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ +#ifdef DOS_NT + /* only recognise drive specifier at beginning */ + && !(p[-1] == ':' && p == beg + 2) +#endif ) p--; if (p == beg) return Qnil; #ifdef DOS_NT /* Expansion of "c:" to drive and default directory. */ - /* (NT does the right thing.) */ if (p == beg + 2 && beg[1] == ':') { - int drive = (*beg) - 'a'; /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ - unsigned char *res = alloca (MAXPATHLEN + 5); - unsigned char *res1; -#ifdef WINDOWSNT - res1 = res; - /* The NT version places the drive letter at the beginning already. */ -#else /* not WINDOWSNT */ - /* On MSDOG we must put the drive letter in by hand. */ - res1 = res + 2; -#endif /* not WINDOWSNT */ - if (getdefdir (drive + 1, res)) + unsigned char *res = alloca (MAXPATHLEN + 1); + if (getdefdir (toupper (*beg) - 'A' + 1, res)) { -#ifdef MSDOS - res[0] = drive + 'a'; - res[1] = ':'; -#endif /* MSDOS */ - if (IS_DIRECTORY_SEP (res[strlen (res) - 1])) + if (!IS_DIRECTORY_SEP (res[strlen (res) - 1])) strcat (res, "/"); beg = res; p = beg + strlen (beg); } } + CORRECT_DIR_SEPS (beg); #endif /* DOS_NT */ return make_string (beg, p - beg); } @@ -377,10 +390,14 @@ or the entire name if it contains no slash.") beg = XSTRING (filename)->data; end = p = beg + XSTRING (filename)->size; - while (p != beg && !IS_ANY_SEP (p[-1]) + while (p != beg && !IS_DIRECTORY_SEP (p[-1]) #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ +#ifdef DOS_NT + /* only recognise drive specifier at beginning */ + && !(p[-1] == ':' && p == beg + 2) +#endif ) p--; return make_string (p, end - p); @@ -476,11 +493,14 @@ file_name_as_directory (out, in) } #else /* not VMS */ /* For Unix syntax, Append a slash if necessary */ - if (!IS_ANY_SEP (out[size])) + if (!IS_DIRECTORY_SEP (out[size])) { out[size + 1] = DIRECTORY_SEP; out[size + 2] = '\0'; } +#ifdef DOS_NT + CORRECT_DIR_SEPS (out); +#endif #endif /* not VMS */ return out; } @@ -519,7 +539,7 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") * On VMS: * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1 - * On UNIX, it's simple: just make sure there is a terminating / + * On UNIX, it's simple: just make sure there isn't a terminating / * Value is nonzero if the string output is different from the input. */ @@ -555,7 +575,7 @@ directory_file_name (src, dst) nam.nam$b_nop |= NAM$M_SYNCHK; /* We call SYS$PARSE to handle such things as [--] for us. */ - if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL) + if (SYS$PARSE (&fab, 0, 0) == RMS$_NORMAL) { slen = nam.nam$b_esl; if (esa[slen - 1] == ';' && esa[slen - 2] == '.') @@ -624,7 +644,7 @@ directory_file_name (src, dst) then translate the device and recurse. */ if (dst[slen - 1] == ':' && dst[slen - 2] != ':' /* skip decnet nodes */ - && strcmp(src + slen, "[000000]") == 0) + && strcmp (src + slen, "[000000]") == 0) { dst[slen - 1] = '\0'; if ((ptr = egetenv (dst)) @@ -661,7 +681,7 @@ directory_file_name (src, dst) || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/')) dst[slen - 1] = 0; #else - if (slen > 1 + if (slen > 1 && IS_DIRECTORY_SEP (dst[slen - 1]) #ifdef DOS_NT && !IS_ANY_SEP (dst[slen - 2]) @@ -669,6 +689,9 @@ directory_file_name (src, dst) ) dst[slen - 1] = 0; #endif +#ifdef DOS_NT + CORRECT_DIR_SEPS (dst); +#endif return 1; } @@ -726,6 +749,9 @@ so there is no danger of generating a name being used by another process.") val = concat2 (prefix, build_string ("XXXXXX")); #endif mktemp (XSTRING (val)->data); +#ifdef DOS_NT + CORRECT_DIR_SEPS (XSTRING (val)->data); +#endif return val; } @@ -734,10 +760,10 @@ DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\ (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\ the current buffer's value of default-directory is used.\n\ -Path components that are `.' are removed, and \n\ -path components followed by `..' are removed, along with the `..' itself;\n\ +File name components that are `.' are removed, and \n\ +so are file name components followed by `..', along with the `..' itself;\n\ note that these simplifications are done without checking the resulting\n\ -paths in the file system.\n\ +file names in the file system.\n\ An initial `~/' expands to your home directory.\n\ An initial `~USER/' expands to USER's home directory.\n\ See also the function `substitute-in-file-name'.") @@ -745,7 +771,7 @@ See also the function `substitute-in-file-name'.") Lisp_Object name, default_directory; { unsigned char *nm; - + register unsigned char *newdir, *p, *o; int tlen; unsigned char *target; @@ -759,13 +785,11 @@ See also the function `substitute-in-file-name'.") int dots = 0; #endif /* VMS */ #ifdef DOS_NT - /* Demacs 1.1.2 91/10/20 Manabu Higashida */ - int drive = -1; - int relpath = 0; - unsigned char *tmp, *defdir; + int drive = 0; #endif /* DOS_NT */ + int length; Lisp_Object handler; - + CHECK_STRING (name, 0); /* If the file name has special constructs in it, @@ -799,15 +823,22 @@ See also the function `substitute-in-file-name'.") The EQ test avoids infinite recursion. */ if (! NILP (default_directory) && !EQ (default_directory, name) - /* Save time in some common cases. */ + /* 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 DOS_NT - /* Detect MSDOS file names with device names. */ - && ! (XSTRING (default_directory)->size >= 3 - && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])) + /* Detect MSDOS file names with drive specifiers. */ + && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) +#ifdef WINDOWSNT + /* Detect Windows file names in UNC format. */ + && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) #endif - /* Detect Unix absolute file names. */ - && ! (XSTRING (default_directory)->size >= 2 - && IS_DIRECTORY_SEP (o[0]))) +#else /* not DOS_NT */ + /* Detect Unix absolute file names (/... alone is not absolute on + DOS or Windows). */ + && ! (IS_DIRECTORY_SEP (o[0])) +#endif /* not DOS_NT */ + ) { struct gcpro gcpro1; @@ -825,29 +856,38 @@ See also the function `substitute-in-file-name'.") #endif nm = XSTRING (name)->data; - -#ifdef MSDOS - /* First map all backslashes to slashes. */ - dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); -#endif #ifdef DOS_NT - /* Now strip drive name. */ + /* 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); + + /* Find and remove drive specifier if present; this makes nm absolute + even if the rest of the name appears to be relative. */ { unsigned char *colon = rindex (nm, ':'); + if (colon) + /* Only recognize colon as part of drive specifier if there is a + single alphabetic character preceeding the colon (and if the + character before the drive letter, if present, is a directory + separator); this is to support the remote system syntax used by + ange-ftp, and the "po:username" syntax for POP mailboxes. */ + look_again: if (nm == colon) nm++; - else + else if (IS_DRIVE (colon[-1]) + && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2]))) { drive = colon[-1]; nm = colon + 1; - if (!IS_DIRECTORY_SEP (*nm)) - { - defdir = alloca (MAXPATHLEN + 1); - relpath = getdefdir (tolower (drive) - 'a' + 1, defdir); - } - } + } + else + { + while (--colon >= nm) + if (colon[0] == ':') + goto look_again; + } } #endif /* DOS_NT */ @@ -856,31 +896,43 @@ See also the function `substitute-in-file-name'.") p = nm; while (*p) { - /* Since we know the path is absolute, we can assume that each - element starts with a "/". */ + /* Since we are expecting the name to be absolute, we can assume + that each element starts with a "/". */ - /* "//" anywhere isn't necessarily hairy; we just start afresh - with the second slash. */ if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) #if defined (APOLLO) || defined (WINDOWSNT) - /* // at start of filename is meaningful on Apollo + /* // at start of filename is meaningful on Apollo and WindowsNT systems */ && nm != p #endif /* APOLLO || WINDOWSNT */ ) nm = p + 1; - /* "~" is hairy as the start of any path element. */ if (IS_DIRECTORY_SEP (p[0]) && p[1] == '~') nm = p + 1; p++; } - /* If nm is absolute, flush ...// and detect /./ and /../. - If no /./ or /../ we can return right away. */ +#ifdef WINDOWSNT + /* Discard any previous drive specifier if nm is now in UNC format. */ + if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) + { + drive = 0; + } +#endif + + /* 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 MSDOS + && drive +#endif +#ifdef WINDOWSNT + && (drive || IS_DIRECTORY_SEP (nm[1])) +#endif #ifdef VMS || index (nm, ':') #endif /* VMS */ @@ -897,7 +949,7 @@ See also the function `substitute-in-file-name'.") p = nm; while (*p) { - /* Since we know the path is absolute, we can assume that each + /* Since we know the name is absolute, we can assume that each element starts with a "/". */ /* "." and ".." are hairy. */ @@ -957,7 +1009,7 @@ See also the function `substitute-in-file-name'.") nm = brack + 1; brack = 0; } - /* if /pathname/dev:, move nm to dev: */ + /* if /name/dev:, move nm to dev: */ else if (slash) nm = slash + 1; /* if node::dev:, move colon following dev */ @@ -989,7 +1041,28 @@ See also the function `substitute-in-file-name'.") if (index (nm, '/')) return build_string (sys_translate_unix (nm)); #endif /* VMS */ -#ifndef DOS_NT +#ifdef DOS_NT + /* Make sure directories are all separated with / or \ as + desired, but avoid allocation of a new string when not + required. */ + CORRECT_DIR_SEPS (nm); +#ifdef WINDOWSNT + if (IS_DIRECTORY_SEP (nm[1])) + { + if (strcmp (nm, XSTRING (name)->data) != 0) + name = build_string (nm); + } + else +#endif + /* drive must be set, so this is okay */ + if (strcmp (nm - 2, XSTRING (name)->data) != 0) + { + name = make_string (nm - 2, p - nm + 2); + XSTRING (name)->data[0] = drive; + XSTRING (name)->data[1] = ':'; + } + return name; +#else /* not DOS_NT */ if (nm == XSTRING (name)->data) return name; return build_string (nm); @@ -997,7 +1070,21 @@ See also the function `substitute-in-file-name'.") } } - /* Now determine directory to start with and put it in newdir */ + /* 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 + default_directory if nm is not absolute, and finally collapse /./ + and /foo/../ sequences. + + We set newdir to be the appropriate prefix if one is needed: + - the relevant user directory if nm starts with ~ or ~user + - the specified drive's working dir (DOS/NT only) if nm does not + start with / + - the value of default_directory. + + Note that these prefixes are not guaranteed to be absolute (except + for the working dir of a drive). Therefore, to ensure we always + return an absolute name, if the final prefix is not absolute we + append it to the current working directory. */ newdir = 0; @@ -1011,14 +1098,12 @@ See also the function `substitute-in-file-name'.") { if (!(newdir = (unsigned char *) egetenv ("HOME"))) newdir = (unsigned char *) ""; + nm++; #ifdef DOS_NT - /* Problem when expanding "~\" if HOME is not on current drive. - Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */ - if (newdir[1] == ':') - drive = newdir[0]; - dostounix_filename (newdir); + if (IS_DIRECTORY_SEP (nm[0])) + /* Make nm look like a relative file name. */ + nm++; #endif - nm++; #ifdef VMS nm++; /* Don't leave the slash in nm. */ #endif /* VMS */ @@ -1034,10 +1119,6 @@ See also the function `substitute-in-file-name'.") bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; -#ifdef WINDOWSNT - newdir = (unsigned char *) egetenv ("HOME"); - dostounix_filename (newdir); -#else /* not WINDOWSNT */ pw = (struct passwd *) getpwnam (o + 1); if (pw) { @@ -1046,41 +1127,136 @@ See also the function `substitute-in-file-name'.") nm = p + 1; /* skip the terminator */ #else nm = p; +#ifdef DOS_NT + if (IS_DIRECTORY_SEP (nm[0])) + /* Make nm look like a relative name. */ + nm++; +#endif #endif /* VMS */ } -#endif /* not WINDOWSNT */ /* If we don't find a user of that name, leave the name unchanged; don't move nm forward to p. */ } } - if (!IS_ANY_SEP (nm[0]) -#ifdef VMS - && !index (nm, ':') -#endif /* not VMS */ #ifdef DOS_NT - && drive == -1 + /* 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)) + newdir = NULL; + } + if (!newdir) + { + /* Either nm starts with /, or drive isn't mounted. */ + newdir = alloca (4); + newdir[0] = drive; + newdir[1] = ':'; + newdir[2] = '/'; + newdir[3] = 0; + } + } #endif /* DOS_NT */ + + /* Finally, if no prefix has been specified and nm is not absolute, + then it must be expanded relative to default_directory. */ + + if ( +#ifndef DOS_NT + /* /... alone is not absolute on DOS and Windows. */ + !IS_DIRECTORY_SEP (nm[0]) +#endif +#ifdef WINDOWSNT + !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) +#endif +#ifdef VMS + && !index (nm, ':') +#endif && !newdir) { newdir = XSTRING (default_directory)->data; } #ifdef DOS_NT - if (newdir == 0 && relpath) - newdir = defdir; + if (newdir) + { + /* First ensure newdir is an absolute name. */ + if ( + /* Detect MSDOS file names with drive specifiers. */ + ! (IS_DRIVE (newdir[0]) + && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) +#ifdef WINDOWSNT + /* Detect Windows file names in UNC format. */ + && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) +#endif + ) + { + /* Effectively, let newdir be (expand-file-name newdir cwd). + Because of the admonition against calling expand-file-name + when we have pointers into lisp strings, we accomplish this + indirectly by prepending newdir to nm if necessary, and using + cwd (or the wd of newdir's drive) as the new newdir. */ + + if (IS_DRIVE (newdir[0]) && newdir[1] == ':') + { + drive = newdir[0]; + newdir += 2; + } + if (!IS_DIRECTORY_SEP (nm[0])) + { + char * tmp = alloca (strlen (newdir) + strlen (nm) + 2); + file_name_as_directory (tmp, newdir); + strcat (tmp, nm); + nm = tmp; + } + newdir = alloca (MAXPATHLEN + 1); + if (drive) + { + if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) + newdir = "/"; + } + else + getwd (newdir); + } + + /* Strip off drive name from prefix, if present. */ + if (IS_DRIVE (newdir[0]) && newdir[1] == ':') + { + drive = newdir[0]; + newdir += 2; + } + + /* Keep only a prefix from newdir if nm starts with slash + (//server/share for UNC, nothing otherwise). */ + if (IS_DIRECTORY_SEP (nm[0])) + { +#ifdef WINDOWSNT + if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) + { + newdir = strcpy (alloca (strlen (newdir) + 1), newdir); + p = newdir + 2; + while (*p && !IS_DIRECTORY_SEP (*p)) p++; + p++; + while (*p && !IS_DIRECTORY_SEP (*p)) p++; + *p = 0; + } + else +#endif + newdir = ""; + } + } #endif /* DOS_NT */ - if (newdir != 0) + + if (newdir) { /* Get rid of any slash at the end of newdir. */ - int length = strlen (newdir); - /* Adding `length > 1 &&' makes ~ expand into / when homedir - is the root dir. People disagree about whether that is right. - Anyway, we can't take the risk of this change now. */ -#ifdef DOS_NT - if (newdir[1] != ':' && length > 1) -#endif + length = strlen (newdir); if (IS_DIRECTORY_SEP (newdir[length - 1])) { unsigned char *temp = (unsigned char *) alloca (length); @@ -1096,7 +1272,7 @@ See also the function `substitute-in-file-name'.") /* Now concatenate the directory and name to new space in the stack frame */ tlen += strlen (nm) + 1; #ifdef DOS_NT - /* Add reserved space for drive name. (The Microsoft x86 compiler + /* Add reserved space for drive name. (The Microsoft x86 compiler produces incorrect code if the following two lines are combined.) */ target = (unsigned char *) alloca (tlen + 2); target += 2; @@ -1121,6 +1297,8 @@ See also the function `substitute-in-file-name'.") strcpy (target, sys_translate_unix (target)); #endif /* VMS */ + /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */ + /* Now canonicalize by removing /. and /foo/.. if they appear. */ p = target; @@ -1176,10 +1354,10 @@ See also the function `substitute-in-file-name'.") } else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) #if defined (APOLLO) || defined (WINDOWSNT) - /* // at start of filename is meaningful in Apollo + /* // at start of filename is meaningful in Apollo and WindowsNT systems */ && o != target -#endif /* APOLLO */ +#endif /* APOLLO || WINDOWSNT */ ) { o = target; @@ -1203,14 +1381,6 @@ See also the function `substitute-in-file-name'.") { while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) ; -#if defined (APOLLO) || defined (WINDOWSNT) - if (o == target + 1 - && IS_DIRECTORY_SEP (o[-1]) && IS_DIRECTORY_SEP (o[0])) - ++o; - else -#endif /* APOLLO || WINDOWSNT */ - if (o == target && IS_ANY_SEP (*o)) - ++o; p += 3; } else @@ -1221,18 +1391,18 @@ See also the function `substitute-in-file-name'.") } #ifdef DOS_NT - /* at last, set drive name. */ - if (target[1] != ':' + /* At last, set drive name. */ #ifdef WINDOWSNT - /* Allow network paths that look like "\\foo" */ - && !(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])) + /* Except for network file name. */ + if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]))) #endif /* WINDOWSNT */ - ) { + if (!drive) abort (); target -= 2; - target[0] = (drive < 0 ? getdisk () + 'A' : drive); + target[0] = drive; target[1] = ':'; } + CORRECT_DIR_SEPS (target); #endif /* DOS_NT */ return make_string (target, o - target); @@ -1252,7 +1422,7 @@ See also the function `substitute-in-file-name'.") Lisp_Object name, defalt; { unsigned char *nm; - + register unsigned char *newdir, *p, *o; int tlen; unsigned char *target; @@ -1266,7 +1436,7 @@ See also the function `substitute-in-file-name'.") int lbrack = 0, rbrack = 0; int dots = 0; #endif /* VMS */ - + CHECK_STRING (name, 0); #ifdef VMS @@ -1275,7 +1445,7 @@ See also the function `substitute-in-file-name'.") #endif nm = XSTRING (name)->data; - + /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */ if ( @@ -1351,13 +1521,13 @@ See also the function `substitute-in-file-name'.") nm = brack + 1; brack = 0; } - /* if /pathname/dev:, move nm to dev: */ + /* If /name/dev:, move nm to dev: */ else if (slash) nm = slash + 1; - /* if node::dev:, move colon following dev */ + /* If node::dev:, move colon following dev */ else if (colon && colon[-1] == ':') colon = p; - /* if dev1:dev2:, move nm to dev2: */ + /* If dev1:dev2:, move nm to dev2: */ else if (colon && colon[-1] != ':') { nm = colon + 1; @@ -1593,9 +1763,10 @@ duplicates what `expand-file-name' does.") return call2 (handler, Qsubstitute_in_file_name, filename); nm = XSTRING (filename)->data; -#ifdef MSDOS - dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); - substituted = !strcmp (nm, XSTRING (filename)->data); +#ifdef DOS_NT + nm = strcpy (alloca (strlen (nm) + 1), nm); + CORRECT_DIR_SEPS (nm); + substituted = (strcmp (nm, XSTRING (filename)->data) != 0); #endif endp = nm + XSTRING (filename)->size; @@ -1603,17 +1774,14 @@ duplicates what `expand-file-name' does.") for (p = nm; p != endp; p++) { - if ((p[0] == '~' || -#ifdef APOLLO - /* // at start of file name is meaningful in Apollo system */ - (p[0] == '/' && p - 1 != nm) -#else /* not APOLLO */ -#ifdef WINDOWSNT - (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) -#else /* not WINDOWSNT */ - p[0] == '/' -#endif /* not WINDOWSNT */ -#endif /* not APOLLO */ + if ((p[0] == '~' +#if defined (APOLLO) || defined (WINDOWSNT) + /* // at start of file name is meaningful in Apollo and + WindowsNT systems */ + || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) +#else /* not (APOLLO || WINDOWSNT) */ + || IS_DIRECTORY_SEP (p[0]) +#endif /* not (APOLLO || WINDOWSNT) */ ) && p != nm && (0 @@ -1626,7 +1794,9 @@ duplicates what `expand-file-name' does.") substituted = 1; } #ifdef DOS_NT - if (p[0] && p[1] == ':') + /* 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; @@ -1745,22 +1915,18 @@ duplicates what `expand-file-name' does.") for (p = xnm; p != x; p++) if ((p[0] == '~' -#ifdef APOLLO - /* // at start of file name is meaningful in Apollo system */ - || (p[0] == '/' && p - 1 != xnm) -#else /* not APOLLO */ -#ifdef WINDOWSNT +#if defined (APOLLO) || defined (WINDOWSNT) || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) -#else /* not WINDOWSNT */ - || p[0] == '/' -#endif /* not WINDOWSNT */ -#endif /* not APOLLO */ +#else /* not (APOLLO || WINDOWSNT) */ + || IS_DIRECTORY_SEP (p[0]) +#endif /* not (APOLLO || WINDOWSNT) */ ) && p != nm && IS_DIRECTORY_SEP (p[-1])) xnm = p; #ifdef DOS_NT - else if (p[0] && p[1] == ':') - xnm = p; + else if (IS_DRIVE (p[0]) && p[1] == ':' + && p > nm && IS_DIRECTORY_SEP (p[-1])) + xnm = p; #endif return make_string (xnm, x - xnm); @@ -1783,25 +1949,25 @@ Lisp_Object expand_and_dir_to_file (filename, defdir) Lisp_Object filename, defdir; { - register Lisp_Object abspath; + register Lisp_Object absname; - abspath = Fexpand_file_name (filename, defdir); + absname = Fexpand_file_name (filename, defdir); #ifdef VMS { - register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1]; + register int c = XSTRING (absname)->data[XSTRING (absname)->size - 1]; if (c == ':' || c == ']' || c == '>') - abspath = Fdirectory_file_name (abspath); + absname = Fdirectory_file_name (absname); } #else - /* Remove final slash, if any (unless path is root). + /* Remove final slash, if any (unless this is the root dir). stat behaves differently depending! */ - if (XSTRING (abspath)->size > 1 - && IS_DIRECTORY_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size - 1]) - && !IS_DEVICE_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size-2])) + if (XSTRING (absname)->size > 1 + && IS_DIRECTORY_SEP (XSTRING (absname)->data[XSTRING (absname)->size - 1]) + && !IS_DEVICE_SEP (XSTRING (absname)->data[XSTRING (absname)->size-2])) /* We cannot take shortcuts; they might be wrong for magic file names. */ - abspath = Fdirectory_file_name (abspath); + absname = Fdirectory_file_name (absname); #endif - return abspath; + return absname; } /* Signal an error if the file ABSNAME already exists. @@ -1904,7 +2070,7 @@ A prefix arg makes KEEP-TIME non-nil.") copyable by us. */ input_file_statable_p = (fstat (ifd, &st) >= 0); -#ifndef DOS_NT +#ifndef MSDOS if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) { @@ -2308,10 +2474,10 @@ DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, Lisp_Object path, login; { int netresult; - + CHECK_STRING (path, 0); - CHECK_STRING (login, 0); - + CHECK_STRING (login, 0); + netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); if (netresult == -1) @@ -2323,7 +2489,7 @@ DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, 1, 1, 0, - "Return t if file FILENAME specifies an absolute path name.\n\ + "Return t if file FILENAME specifies an absolute file name.\n\ On Unix, this is a name starting with a `/' or a `~'.") (filename) Lisp_Object filename; @@ -2340,7 +2506,7 @@ On Unix, this is a name starting with a `/' or a `~'.") && ptr[1] != '.') #endif /* VMS */ #ifdef DOS_NT - || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\')) + || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2])) #endif ) return Qt; @@ -2360,12 +2526,16 @@ check_executable (filename) struct stat st; if (stat (filename, &st) < 0) return 0; +#ifdef WINDOWSNT + return ((st.st_mode & S_IEXEC) != 0); +#else return (S_ISREG (st.st_mode) && len >= 5 && (stricmp ((suffix = filename + len-4), ".com") == 0 || stricmp (suffix, ".exe") == 0 || stricmp (suffix, ".bat") == 0) || (st.st_mode & S_IFMT) == S_IFDIR); +#endif /* not WINDOWSNT */ #else /* not DOS_NT */ #ifdef HAVE_EACCESS return (eaccess (filename, 1) >= 0); @@ -2409,20 +2579,20 @@ See also `file-readable-p' and `file-attributes'.") (filename) Lisp_Object filename; { - Lisp_Object abspath; + Lisp_Object absname; Lisp_Object handler; struct stat statbuf; CHECK_STRING (filename, 0); - abspath = Fexpand_file_name (filename, Qnil); + absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_exists_p); + handler = Ffind_file_name_handler (absname, Qfile_exists_p); if (!NILP (handler)) - return call2 (handler, Qfile_exists_p, abspath); + return call2 (handler, Qfile_exists_p, absname); - return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil; + return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil; } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, @@ -2432,19 +2602,19 @@ For a directory, this means you can access files in that directory.") Lisp_Object filename; { - Lisp_Object abspath; + Lisp_Object absname; Lisp_Object handler; CHECK_STRING (filename, 0); - abspath = Fexpand_file_name (filename, Qnil); + absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_executable_p); + handler = Ffind_file_name_handler (absname, Qfile_executable_p); if (!NILP (handler)) - return call2 (handler, Qfile_executable_p, abspath); + return call2 (handler, Qfile_executable_p, absname); - return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil); + return (check_executable (XSTRING (absname)->data) ? Qt : Qnil); } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, @@ -2453,32 +2623,31 @@ See also `file-exists-p' and `file-attributes'.") (filename) Lisp_Object filename; { - Lisp_Object abspath; + Lisp_Object absname; Lisp_Object handler; int desc; CHECK_STRING (filename, 0); - abspath = Fexpand_file_name (filename, Qnil); + absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_readable_p); + handler = Ffind_file_name_handler (absname, Qfile_readable_p); if (!NILP (handler)) - return call2 (handler, Qfile_readable_p, abspath); + return call2 (handler, Qfile_readable_p, absname); -#ifdef MSDOS - /* Under MS-DOS, open does not work't right, because it doesn't work for - directories (MS-DOS won't let you open a directory). */ - if (access (XSTRING (abspath)->data, 0) == 0) +#ifdef DOS_NT + /* Under MS-DOS and Windows, open does not work for directories. */ + if (access (XSTRING (absname)->data, 0) == 0) return Qt; return Qnil; -#else /* not MSDOS */ - desc = open (XSTRING (abspath)->data, O_RDONLY); +#else /* not DOS_NT */ + desc = open (XSTRING (absname)->data, O_RDONLY); if (desc < 0) return Qnil; close (desc); return Qt; -#endif /* not MSDOS */ +#endif /* not DOS_NT */ } /* Having this before file-symlink-p mysteriously caused it to be forgotten @@ -2488,23 +2657,23 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, (filename) Lisp_Object filename; { - Lisp_Object abspath, dir; + Lisp_Object absname, dir; Lisp_Object handler; struct stat statbuf; CHECK_STRING (filename, 0); - abspath = Fexpand_file_name (filename, Qnil); + absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_writable_p); + handler = Ffind_file_name_handler (absname, Qfile_writable_p); if (!NILP (handler)) - return call2 (handler, Qfile_writable_p, abspath); + return call2 (handler, Qfile_writable_p, absname); - if (stat (XSTRING (abspath)->data, &statbuf) >= 0) - return (check_writable (XSTRING (abspath)->data) + if (stat (XSTRING (absname)->data, &statbuf) >= 0) + return (check_writable (XSTRING (absname)->data) ? Qt : Qnil); - dir = Ffile_name_directory (abspath); + dir = Ffile_name_directory (absname); #ifdef VMS if (!NILP (dir)) dir = Fdirectory_file_name (dir); @@ -2571,19 +2740,19 @@ if the directory so specified exists and really is a directory.") (filename) Lisp_Object filename; { - register Lisp_Object abspath; + register Lisp_Object absname; struct stat st; Lisp_Object handler; - abspath = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_directory_p); + handler = Ffind_file_name_handler (absname, Qfile_directory_p); if (!NILP (handler)) - return call2 (handler, Qfile_directory_p, abspath); + return call2 (handler, Qfile_directory_p, absname); - if (stat (XSTRING (abspath)->data, &st) < 0) + if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; } @@ -2627,19 +2796,19 @@ This is the sort of file that holds an ordinary stream of data bytes.") (filename) Lisp_Object filename; { - register Lisp_Object abspath; + register Lisp_Object absname; struct stat st; Lisp_Object handler; - abspath = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_regular_p); + handler = Ffind_file_name_handler (absname, Qfile_regular_p); if (!NILP (handler)) - return call2 (handler, Qfile_regular_p, abspath); + return call2 (handler, Qfile_regular_p, absname); - if (stat (XSTRING (abspath)->data, &st) < 0) + if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; } @@ -2649,24 +2818,24 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, (filename) Lisp_Object filename; { - Lisp_Object abspath; + Lisp_Object absname; struct stat st; Lisp_Object handler; - abspath = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_modes); + handler = Ffind_file_name_handler (absname, Qfile_modes); if (!NILP (handler)) - return call2 (handler, Qfile_modes, abspath); + return call2 (handler, Qfile_modes, absname); - if (stat (XSTRING (abspath)->data, &st) < 0) + if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; -#ifdef DOS_NT - if (check_executable (XSTRING (abspath)->data)) +#ifdef MSDOS + if (check_executable (XSTRING (absname)->data)) st.st_mode |= S_IEXEC; -#endif /* DOS_NT */ +#endif /* MSDOS */ return make_number (st.st_mode & 07777); } @@ -2677,20 +2846,20 @@ Only the 12 low bits of MODE are used.") (filename, mode) Lisp_Object filename, mode; { - Lisp_Object abspath; + Lisp_Object absname; Lisp_Object handler; - abspath = Fexpand_file_name (filename, current_buffer->directory); + absname = Fexpand_file_name (filename, current_buffer->directory); CHECK_NUMBER (mode, 1); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qset_file_modes); + handler = Ffind_file_name_handler (absname, Qset_file_modes); if (!NILP (handler)) - return call3 (handler, Qset_file_modes, abspath, mode); + return call3 (handler, Qset_file_modes, absname, mode); - if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) - report_file_error ("Doing chmod", Fcons (abspath, Qnil)); + if (chmod (XSTRING (absname)->data, XINT (mode)) < 0) + report_file_error ("Doing chmod", Fcons (absname, Qnil)); return Qnil; } @@ -2703,7 +2872,7 @@ This setting is inherited by subprocesses.") Lisp_Object mode; { CHECK_NUMBER (mode, 0); - + umask ((~ XINT (mode)) & 0777); return Qnil; @@ -2743,7 +2912,7 @@ otherwise, if FILE2 does not exist, the answer is t.") (file1, file2) Lisp_Object file1, file2; { - Lisp_Object abspath1, abspath2; + Lisp_Object absname1, absname2; struct stat st; int mtime1; Lisp_Object handler; @@ -2752,26 +2921,26 @@ otherwise, if FILE2 does not exist, the answer is t.") CHECK_STRING (file1, 0); CHECK_STRING (file2, 0); - abspath1 = Qnil; - GCPRO2 (abspath1, file2); - abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); - abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); + absname1 = Qnil; + GCPRO2 (absname1, file2); + absname1 = expand_and_dir_to_file (file1, current_buffer->directory); + absname2 = expand_and_dir_to_file (file2, current_buffer->directory); UNGCPRO; /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); + handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p); if (NILP (handler)) - handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); + handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p); if (!NILP (handler)) - return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); + return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); - if (stat (XSTRING (abspath1)->data, &st) < 0) + if (stat (XSTRING (absname1)->data, &st) < 0) return Qnil; mtime1 = st.st_mtime; - if (stat (XSTRING (abspath2)->data, &st) < 0) + if (stat (XSTRING (absname2)->data, &st) < 0) return Qt; return (mtime1 > st.st_mtime) ? Qt : Qnil; @@ -3148,7 +3317,7 @@ and (2) it puts less data in the undo list.") /* Decode file format */ if (inserted > 0) { - insval = call3 (Qformat_decode, + insval = call3 (Qformat_decode, Qnil, make_number (inserted), visit); CHECK_NUMBER (insval, 0); inserted = XFASTINT (insval); @@ -3156,7 +3325,7 @@ and (2) it puts less data in the undo list.") if (inserted > 0 && NILP (visit) && total > 0) signal_after_change (point, 0, inserted); - + if (inserted > 0) { p = Vafter_insert_file_functions; @@ -3186,7 +3355,7 @@ static Lisp_Object build_annotations (); /* If build_annotations switched buffers, switch back to BUF. Kill the temporary buffer that was selected in the meantime. */ -static Lisp_Object +static Lisp_Object build_annotations_unwind (buf) Lisp_Object buf; { @@ -3273,7 +3442,7 @@ to the file, instead of any buffer contents, and END is ignored.") handler = Ffind_file_name_handler (filename, Qwrite_region); /* If FILENAME has no handler, see if VISIT has one. */ if (NILP (handler) && STRINGP (visit)) - handler = Ffind_file_name_handler (visit, Qwrite_region); + handler = Ffind_file_name_handler (visit, Qwrite_region); if (!NILP (handler)) { @@ -3371,8 +3540,8 @@ to the file, instead of any buffer contents, and END is ignored.") } #else /* not VMS */ #ifdef DOS_NT - desc = open (fn, - O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, + desc = open (fn, + O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, S_IREAD | S_IWRITE); #else /* not DOS_NT */ desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); @@ -3476,7 +3645,7 @@ to the file, instead of any buffer contents, and END is ignored.") } #endif - /* Spurious "file has changed on disk" warnings have been + /* Spurious "file has changed on disk" warnings have been observed on Suns as well. It seems that `close' can change the modtime, under nfs. @@ -3882,7 +4051,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") Lisp_Object listfile; listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); #ifdef DOS_NT - listdesc = open (XSTRING (listfile)->data, + listdesc = open (XSTRING (listfile)->data, O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE); #else /* not DOS_NT */ @@ -3891,7 +4060,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") } else listdesc = -1; - + /* Arrange to close that file whether or not we get an error. Also reset auto_saving to 0. */ record_unwind_protect (do_auto_save_unwind, make_number (listdesc)); @@ -3908,7 +4077,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") { buf = XCONS (XCONS (tail)->car)->cdr; b = XBUFFER (buf); - + /* Record all the buffers that have auto save mode in the special file that lists them. For each of these buffers, Record visited name (if any) and auto save name. */ @@ -4179,6 +4348,10 @@ DIR defaults to current buffer's directory default.") /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); +#ifdef DOS_NT + homedir = strcpy (alloca (strlen (homedir) + 1), homedir); + CORRECT_DIR_SEPS (homedir); +#endif if (homedir != 0 && STRINGP (dir) && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) @@ -4372,7 +4545,7 @@ syms_of_fileio () Qfile_error = intern ("file-error"); staticpro (&Qfile_error); - Qfile_already_exists = intern("file-already-exists"); + Qfile_already_exists = intern ("file-already-exists"); staticpro (&Qfile_already_exists); #ifdef DOS_NT @@ -4415,6 +4588,14 @@ same format as a regular save would use."); nil means use format `var'. This variable is meaningful only on VMS."); vms_stmlf_recfm = 0; + DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char, + "Directory separator character for built-in functions that return file names.\n\ +The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\ +This variable affects the built-in functions only on Windows,\n\ +on other platforms, it is initialized so that Lisp code can find out\n\ +what the normal separator is."); + Vdirectory_sep_char = '/'; + DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ If a file name matches REGEXP, then all I/O on that file is done by calling\n\ |