X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac5b7072163d90f3006cdc35bc96c5b0fe55b306..36d8561d49cf066c6dbd69cf949561983a3ee790:/src/fileio.c?ds=sidebyside diff --git a/src/fileio.c b/src/fileio.c index a05dbd5f22..b152f0a74e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,5 +1,6 @@ /* File IO for GNU Emacs. - Copyright (C) 1985,86,87,88,93,94,95,96 Free Software Foundation, Inc. + Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -18,12 +19,15 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +#define _GNU_SOURCE /* for euidaccess */ + #include #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX) #include #endif +#include #include #include @@ -49,15 +53,6 @@ Boston, MA 02111-1307, USA. */ #include #endif -#ifdef MSDOS -#include "msdos.h" -#include -#if __DJGPP__ >= 2 -#include -#include -#endif -#endif - #include #ifdef VMS @@ -70,10 +65,10 @@ Boston, MA 02111-1307, USA. */ #include #ifndef vax11c +#ifndef USE_CRT_DLL extern int errno; #endif - -extern char *strerror (); +#endif #ifdef APOLLO #include @@ -103,6 +98,15 @@ extern char *strerror (); #include #endif /* not WINDOWSNT */ +#ifdef MSDOS +#include "msdos.h" +#include +#if __DJGPP__ >= 2 +#include +#include +#endif +#endif + #ifdef DOS_NT #define CORRECT_DIR_SEPS(s) \ do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ @@ -140,6 +144,9 @@ extern char *strerror (); #endif #endif +#include "commands.h" +extern int use_dialog_box; + #ifndef O_WRONLY #define O_WRONLY 1 #endif @@ -148,6 +155,10 @@ extern char *strerror (); #define O_RDONLY 0 #endif +#ifndef S_ISLNK +# define lstat stat +#endif + #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) @@ -158,6 +169,13 @@ int auto_saving; a new file with the same mode as the original */ int auto_save_mode_bits; +/* Coding system for file names, or nil if none. */ +Lisp_Object Vfile_name_coding_system; + +/* Coding system for file names used only when + Vfile_name_coding_system is nil. */ +Lisp_Object Vdefault_file_name_coding_system; + /* Alist of elements (REGEXP . HANDLER) for file names whose I/O is done with a special handler. */ Lisp_Object Vfile_name_handler_alist; @@ -168,6 +186,9 @@ Lisp_Object Vauto_save_file_format; /* Lisp functions for translating file formats */ Lisp_Object Qformat_decode, Qformat_annotate_function; +/* Function to be called to decide a coding system of a reading file. */ +Lisp_Object Vset_auto_coding_function; + /* Functions to be called to process text properties in inserted file. */ Lisp_Object Vafter_insert_file_functions; @@ -195,8 +216,14 @@ Lisp_Object Vdirectory_sep_char; extern Lisp_Object Vuser_login_name; +#ifdef WINDOWSNT +extern Lisp_Object Vw32_get_true_file_attributes; +#endif + extern int minibuf_level; +extern int minibuffer_auto_raise; + /* These variables describe handlers that have "already" had a chance to handle the current operation. @@ -208,42 +235,62 @@ static Lisp_Object Vinhibit_file_name_handlers; static Lisp_Object Vinhibit_file_name_operation; Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error; - +Lisp_Object Qexcl; Lisp_Object Qfile_name_history; Lisp_Object Qcar_less_than_car; +static int a_write P_ ((int, Lisp_Object, int, int, + Lisp_Object *, struct coding_system *)); +static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *)); + + +void report_file_error (string, data) char *string; Lisp_Object data; { Lisp_Object errstring; + int errorno = errno; - errstring = build_string (strerror (errno)); - - /* System error messages are capitalized. Downcase the initial - unless it is followed by a slash. */ - if (XSTRING (errstring)->data[1] != '/') - XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); + synchronize_system_messages_locale (); + errstring = code_convert_string_norecord (build_string (strerror (errorno)), + Vlocale_coding_system, 0); while (1) - Fsignal (Qfile_error, - Fcons (build_string (string), Fcons (errstring, data))); + switch (errorno) + { + case EEXIST: + Fsignal (Qfile_already_exists, Fcons (errstring, data)); + break; + default: + /* System error messages are capitalized. Downcase the initial + unless it is followed by a slash. */ + if (XSTRING (errstring)->data[1] != '/') + XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); + + Fsignal (Qfile_error, + Fcons (build_string (string), Fcons (errstring, data))); + } } +Lisp_Object close_file_unwind (fd) Lisp_Object fd; { - close (XFASTINT (fd)); + emacs_close (XFASTINT (fd)); + return Qnil; } /* Restore point, having saved it as a marker. */ +static Lisp_Object restore_point_unwind (location) Lisp_Object location; { - SET_PT (marker_position (location)); + Fgoto_char (location); Fset_marker (location, Qnil, Qnil); + return Qnil; } Lisp_Object Qexpand_file_name; @@ -255,6 +302,7 @@ Lisp_Object Qunhandled_file_name_directory; Lisp_Object Qfile_name_as_directory; Lisp_Object Qcopy_file; Lisp_Object Qmake_directory_internal; +Lisp_Object Qmake_directory; Lisp_Object Qdelete_directory; Lisp_Object Qdelete_file; Lisp_Object Qrename_file; @@ -300,19 +348,19 @@ use the standard functions without calling themselves recursively.") inhibited_handlers = Qnil; for (chain = Vfile_name_handler_alist; CONSP (chain); - chain = XCONS (chain)->cdr) + chain = XCDR (chain)) { Lisp_Object elt; - elt = XCONS (chain)->car; + elt = XCAR (chain); if (CONSP (elt)) { Lisp_Object string; - string = XCONS (elt)->car; + string = XCAR (elt); if (STRINGP (string) && fast_string_match (string, filename) >= 0) { Lisp_Object handler, tem; - handler = XCONS (elt)->cdr; + handler = XCDR (elt); tem = Fmemq (handler, inhibited_handlers); if (NILP (tem)) return handler; @@ -353,15 +401,18 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") #ifdef DOS_NT beg = strcpy (alloca (strlen (beg) + 1), beg); #endif - p = beg + XSTRING (filename)->size; + p = beg + STRING_BYTES (XSTRING (filename)); 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) + /* only recognise drive specifier at the beginning */ + && !(p[-1] == ':' + /* handle the "/:d:foo" and "/:foo" cases correctly */ + && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg)) + || (p == beg + 4 && IS_DIRECTORY_SEP (*beg)))) #endif ) p--; @@ -369,11 +420,20 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") return Qnil; #ifdef DOS_NT /* Expansion of "c:" to drive and default directory. */ - if (p == beg + 2 && beg[1] == ':') + if (p[-1] == ':') { /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ unsigned char *res = alloca (MAXPATHLEN + 1); - if (getdefdir (toupper (*beg) - 'A' + 1, res)) + unsigned char *r = res; + + if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':') + { + strncpy (res, beg, 2); + beg += 2; + r += 2; + } + + if (getdefdir (toupper (*beg) - 'A' + 1, r)) { if (!IS_DIRECTORY_SEP (res[strlen (res) - 1])) strcat (res, "/"); @@ -383,11 +443,14 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") } CORRECT_DIR_SEPS (beg); #endif /* DOS_NT */ - return make_string (beg, p - beg); + + if (STRING_MULTIBYTE (filename)) + return make_string (beg, p - beg); + return make_unibyte_string (beg, p - beg); } -DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory, - 1, 1, 0, +DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, + Sfile_name_nondirectory, 1, 1, 0, "Return file name FILENAME sans its directory.\n\ For example, in a Unix-syntax file name,\n\ this is everything after the last slash,\n\ @@ -407,7 +470,7 @@ or the entire name if it contains no slash.") return call2 (handler, Qfile_name_nondirectory, filename); beg = XSTRING (filename)->data; - end = p = beg + XSTRING (filename)->size; + end = p = beg + STRING_BYTES (XSTRING (filename)); while (p != beg && !IS_DIRECTORY_SEP (p[-1]) #ifdef VMS @@ -415,19 +478,25 @@ or the entire name if it contains no slash.") #endif /* VMS */ #ifdef DOS_NT /* only recognise drive specifier at beginning */ - && !(p[-1] == ':' && p == beg + 2) + && !(p[-1] == ':' + /* handle the "/:d:foo" case correctly */ + && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg)))) #endif - ) p--; + ) + p--; - return make_string (p, end - p); + if (STRING_MULTIBYTE (filename)) + return make_string (p, end - p); + return make_unibyte_string (p, end - p); } -DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0, +DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, + Sunhandled_file_name_directory, 1, 1, 0, "Return a directly usable directory name somehow associated with FILENAME.\n\ A `directly usable' directory name is one that may be used without the\n\ intervention of any file handler.\n\ If FILENAME is a directly usable file itself, return\n\ -(file-name-directory FILENAME).\n\ +\(file-name-directory FILENAME).\n\ The `call-process' and `start-process' functions use this function to\n\ get a current directory to run processes in.") (filename) @@ -453,6 +522,14 @@ file_name_as_directory (out, in) strcpy (out, in); + if (size < 0) + { + out[0] = '.'; + out[1] = '/'; + out[2] = 0; + return out; + } + #ifdef VMS /* Is it already a directory string? */ if (in[size] == ':' || in[size] == ']' || in[size] == '>') @@ -549,7 +626,7 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") if (!NILP (handler)) return call2 (handler, Qfile_name_as_directory, file); - buf = (char *) alloca (XSTRING (file)->size + 10); + buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10); return build_string (file_name_as_directory (buf, XSTRING (file)->data)); } @@ -563,6 +640,7 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") * Value is nonzero if the string output is different from the input. */ +int directory_file_name (src, dst) char *src, *dst; { @@ -744,35 +822,167 @@ it returns a file name such as \"[X]Y.DIR.1\".") /* 20 extra chars is insufficient for VMS, since we might perform a logical name translation. an equivalence string can be up to 255 chars long, so grab that much extra space... - sss */ - buf = (char *) alloca (XSTRING (directory)->size + 20 + 255); + buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255); #else - buf = (char *) alloca (XSTRING (directory)->size + 20); + buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20); #endif directory_file_name (XSTRING (directory)->data, buf); return build_string (buf); } +static char make_temp_name_tbl[64] = +{ + 'A','B','C','D','E','F','G','H', + 'I','J','K','L','M','N','O','P', + 'Q','R','S','T','U','V','W','X', + 'Y','Z','a','b','c','d','e','f', + 'g','h','i','j','k','l','m','n', + 'o','p','q','r','s','t','u','v', + 'w','x','y','z','0','1','2','3', + '4','5','6','7','8','9','-','_' +}; + +static unsigned make_temp_name_count, make_temp_name_count_initialized_p; + +/* Value is a temporary file name starting with PREFIX, a string. + + The Emacs process number forms part of the result, so there is + no danger of generating a name being used by another process. + In addition, this function makes an attempt to choose a name + which has no existing file. To make this work, PREFIX should be + an absolute file name. + + BASE64_P non-zero means add the pid as 3 characters in base64 + encoding. In this case, 6 characters will be added to PREFIX to + form the file name. Otherwise, if Emacs is running on a system + with long file names, add the pid as a decimal number. + + This function signals an error if no unique file name could be + generated. */ + +Lisp_Object +make_temp_name (prefix, base64_p) + Lisp_Object prefix; + int base64_p; +{ + Lisp_Object val; + int len; + int pid; + unsigned char *p, *data; + char pidbuf[20]; + int pidlen; + + CHECK_STRING (prefix, 0); + + /* 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. */ + + pid = (int) getpid (); + + if (base64_p) + { + pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; + pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; + pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6; + pidlen = 3; + } + else + { +#ifdef HAVE_LONG_FILE_NAMES + sprintf (pidbuf, "%d", pid); + pidlen = strlen (pidbuf); +#else + pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; + pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; + pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6; + pidlen = 3; +#endif + } + + len = XSTRING (prefix)->size; + val = make_uninit_string (len + 3 + pidlen); + data = XSTRING (val)->data; + bcopy(XSTRING (prefix)->data, data, len); + p = data + len; + + bcopy (pidbuf, p, pidlen); + p += pidlen; + + /* 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. + + We don't want make-temp-name to be called while dumping, + because then make_temp_name_count_initialized_p would get set + and then make_temp_name_count would not be set when Emacs starts. */ + + if (!make_temp_name_count_initialized_p) + { + make_temp_name_count = (unsigned) time (NULL); + make_temp_name_count_initialized_p = 1; + } + + while (1) + { + struct stat ignored; + unsigned num = make_temp_name_count; + + p[0] = make_temp_name_tbl[num & 63], num >>= 6; + p[1] = make_temp_name_tbl[num & 63], num >>= 6; + p[2] = make_temp_name_tbl[num & 63], num >>= 6; + + /* Poor man's congruential RN generator. Replace with + ++make_temp_name_count for debugging. */ + make_temp_name_count += 25229; + make_temp_name_count %= 225307; + + if (stat (data, &ignored) < 0) + { + /* We want to return only if errno is ENOENT. */ + if (errno == ENOENT) + return val; + else + /* The error here is dubious, but there is little else we + can do. The alternatives are to return nil, which is + as bad as (and in many cases worse than) throwing the + error, or to ignore the error, which will likely result + in looping through 225307 stat's, which is not only + dog-slow, but also useless since it will fallback to + the errow below, anyway. */ + report_file_error ("Cannot create temporary name for prefix", + Fcons (prefix, Qnil)); + /* not reached */ + } + } + + error ("Cannot create temporary name for prefix `%s'", + XSTRING (prefix)->data); + return Qnil; +} + + DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, "Generate temporary file name (string) starting with PREFIX (a string).\n\ The Emacs process number forms part of the result,\n\ -so there is no danger of generating a name being used by another process.") +so there is no danger of generating a name being used by another process.\n\ +\n\ +In addition, this function makes an attempt to choose a name\n\ +which has no existing file. To make this work,\n\ +PREFIX should be an absolute file name.\n\ +\n\ +There is a race condition between calling `make-temp-name' and creating the\n\ +file which opens all kinds of security holes. For that reason, you should\n\ +probably use `make-temp-file' instead.") (prefix) Lisp_Object prefix; { - Lisp_Object val; -#ifdef MSDOS - /* Don't use too many characters of the restricted 8+3 DOS - filename space. */ - val = concat2 (prefix, build_string ("a.XXX")); -#else - val = concat2 (prefix, build_string ("XXXXXX")); -#endif - mktemp (XSTRING (val)->data); -#ifdef DOS_NT - CORRECT_DIR_SEPS (XSTRING (val)->data); -#endif - return val; + return make_temp_name (prefix, 0); } + + DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert filename NAME to absolute, and canonicalize it.\n\ @@ -786,7 +996,7 @@ 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'.") - (name, default_directory) + (name, default_directory) Lisp_Object name, default_directory; { unsigned char *nm; @@ -806,6 +1016,7 @@ See also the function `substitute-in-file-name'.") #ifdef DOS_NT int drive = 0; int collapse_newdir = 1; + int is_escaped = 0; #endif /* DOS_NT */ int length; Lisp_Object handler; @@ -821,7 +1032,8 @@ See also the function `substitute-in-file-name'.") /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ if (NILP (default_directory)) default_directory = current_buffer->directory; - CHECK_STRING (default_directory, 1); + if (! STRINGP (default_directory)) + default_directory = build_string ("/"); if (!NILP (default_directory)) { @@ -848,7 +1060,7 @@ See also the function `substitute-in-file-name'.") is needed at all) without requiring it to be expanded now. */ #ifdef DOS_NT /* Detect MSDOS file names with drive specifiers. */ - && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) + && ! (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])) @@ -882,33 +1094,29 @@ See also the function `substitute-in-file-name'.") a local copy to modify, even if there ends up being no change. */ nm = strcpy (alloca (strlen (nm) + 1), nm); + /* Note if special escape prefix is present, but remove for now. */ + if (nm[0] == '/' && nm[1] == ':') + { + is_escaped = 1; + nm += 2; + } + /* 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 if (IS_DRIVE (colon[-1]) - && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2]))) - { - drive = colon[-1]; - nm = colon + 1; - } - else - { - while (--colon >= nm) - if (colon[0] == ':') - goto look_again; - } - } + even if the rest of the name appears to be relative. Only look for + drive specifier at the beginning. */ + if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1])) + { + drive = nm[0]; + nm += 2; + } + +#ifdef WINDOWSNT + /* If we see "c://somedir", we want to strip the first slash after the + colon when stripping the drive letter. Otherwise, this expands to + "//somedir". */ + if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) + nm++; +#endif /* WINDOWSNT */ #endif /* DOS_NT */ #ifdef WINDOWSNT @@ -919,16 +1127,16 @@ See also the function `substitute-in-file-name'.") } #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 nm is absolute, look for `/./' or `/../' 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 + && drive && !is_escaped #endif #ifdef WINDOWSNT - && (drive || IS_DIRECTORY_SEP (nm[1])) + && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped #endif #ifdef VMS || index (nm, ':') @@ -957,6 +1165,13 @@ See also the function `substitute-in-file-name'.") || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)))) lose = 1; + /* We want to replace multiple `/' in a row with a single + slash. */ + else if (p > nm + && IS_DIRECTORY_SEP (p[0]) + && IS_DIRECTORY_SEP (p[1])) + lose = 1; + #ifdef VMS if (p[0] == '\\') lose = 1; @@ -1174,6 +1389,14 @@ See also the function `substitute-in-file-name'.") && !newdir) { newdir = XSTRING (default_directory)->data; +#ifdef DOS_NT + /* Note if special escape prefix is present, but remove for now. */ + if (newdir[0] == '/' && newdir[1] == ':') + { + is_escaped = 1; + newdir += 2; + } +#endif } #ifdef DOS_NT @@ -1226,7 +1449,7 @@ See also the function `substitute-in-file-name'.") } /* Keep only a prefix from newdir if nm starts with slash - (//server/share for UNC, nothing otherwise). */ + (//server/share for UNC, nothing otherwise). */ if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir) { #ifdef WINDOWSNT @@ -1249,9 +1472,9 @@ See also the function `substitute-in-file-name'.") if (newdir) { /* Get rid of any slash at the end of newdir, unless newdir is - just // (an incomplete UNC name). */ + just / or // (an incomplete UNC name). */ length = strlen (newdir); - if (IS_DIRECTORY_SEP (newdir[length - 1]) + if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) #ifdef WINDOWSNT && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) #endif @@ -1270,10 +1493,11 @@ 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 + /* Reserve space for drive specifier and escape prefix, since either + or both may need to be inserted. (The Microsoft x86 compiler produces incorrect code if the following two lines are combined.) */ - target = (unsigned char *) alloca (tlen + 2); - target += 2; + target = (unsigned char *) alloca (tlen + 4); + target += 4; #else /* not DOS_NT */ target = (unsigned char *) alloca (tlen); #endif /* not DOS_NT */ @@ -1283,7 +1507,18 @@ See also the function `substitute-in-file-name'.") { #ifndef VMS if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) - strcpy (target, newdir); + { +#ifdef DOS_NT + /* If newdir is effectively "C:/", then the drive letter will have + been stripped and newdir will be "/". Concatenating with an + absolute directory in nm produces "//", which will then be + incorrectly treated as a network share. Ignore newdir in + this case (keeping the drive letter). */ + if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) + && newdir[1] == '\0')) +#endif + strcpy (target, newdir); + } else #endif file_name_as_directory (target, newdir); @@ -1297,7 +1532,8 @@ See also the function `substitute-in-file-name'.") /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */ - /* Now canonicalize by removing /. and /foo/.. if they appear. */ + /* Now canonicalize by removing `//', `/.' and `/foo/..' if they + appear. */ p = target; o = target; @@ -1350,17 +1586,6 @@ See also the function `substitute-in-file-name'.") { *o++ = *p++; } - 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 - and WindowsNT systems */ - && o != target -#endif /* APOLLO || WINDOWSNT */ - ) - { - o = target; - p++; - } else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) @@ -1384,6 +1609,14 @@ See also the function `substitute-in-file-name'.") ++o; p += 3; } + else if (p > target + && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) + { + /* Collapse multiple `/' in a row. */ + *o++ = *p++; + while (IS_DIRECTORY_SEP (*p)) + ++p; + } else { *o++ = *p++; @@ -1403,6 +1636,13 @@ See also the function `substitute-in-file-name'.") target[0] = DRIVE_LETTER (drive); target[1] = ':'; } + /* Reinsert the escape prefix if required. */ + if (is_escaped) + { + target -= 2; + target[0] = '/'; + target[1] = ':'; + } CORRECT_DIR_SEPS (target); #endif /* DOS_NT */ @@ -1448,7 +1688,7 @@ See also the function `substitute-in-file-name'.") nm = XSTRING (name)->data; /* If nm is absolute, flush ...// and detect /./ and /../. - If no /./ or /../ we can return right away. */ + If no /./ or /../ we can return right away. */ if ( nm[0] == '/' #ifdef VMS @@ -1462,7 +1702,7 @@ See also the function `substitute-in-file-name'.") { if (p[0] == '/' && p[1] == '/' #ifdef APOLLO - /* // at start of filename is meaningful on Apollo system */ + /* // at start of filename is meaningful on Apollo system. */ && nm != p #endif /* APOLLO */ ) @@ -1695,7 +1935,7 @@ See also the function `substitute-in-file-name'.") } else if (!strncmp (p, "//", 2) #ifdef APOLLO - /* // at start of filename is meaningful in Apollo system */ + /* // at start of filename is meaningful in Apollo system. */ && o != target #endif /* APOLLO */ ) @@ -1749,7 +1989,7 @@ duplicates what `expand-file-name' does.") unsigned char *nm; register unsigned char *s, *p, *o, *x, *endp; - unsigned char *target; + unsigned char *target = NULL; int total = 0; int substituted = 0; unsigned char *xnm; @@ -1769,16 +2009,16 @@ duplicates what `expand-file-name' does.") CORRECT_DIR_SEPS (nm); substituted = (strcmp (nm, XSTRING (filename)->data) != 0); #endif - endp = nm + XSTRING (filename)->size; + endp = nm + STRING_BYTES (XSTRING (filename)); - /* If /~ or // appears, discard everything through first slash. */ + /* If /~ or // appears, discard everything through first slash. */ for (p = nm; p != endp; p++) { if ((p[0] == '~' #if defined (APOLLO) || defined (WINDOWSNT) /* // at start of file name is meaningful in Apollo and - WindowsNT systems */ + WindowsNT systems. */ || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) #else /* not (APOLLO || WINDOWSNT) */ || IS_DIRECTORY_SEP (p[0]) @@ -1862,7 +2102,7 @@ duplicates what `expand-file-name' does.") /* If substitution required, recopy the string and do it */ /* Make space in stack frame for the new copy */ - xnm = (unsigned char *) alloca (XSTRING (filename)->size + total + 1); + xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1); x = xnm; /* Copy the rest of the name through, replacing $ constructs with values */ @@ -1906,13 +2146,26 @@ duplicates what `expand-file-name' does.") if (!o) goto badvar; - strcpy (x, o); - x += strlen (o); + if (STRING_MULTIBYTE (filename)) + { + /* If the original string is multibyte, + convert what we substitute into multibyte. */ + while (*o) + { + int c = unibyte_char_to_multibyte (*o++); + x += CHAR_STRING (c, x); + } + } + else + { + strcpy (x, o); + x += strlen (o); + } } *x = 0; - /* If /~ or // appears, discard everything through first slash. */ + /* If /~ or // appears, discard everything through first slash. */ for (p = xnm; p != x; p++) if ((p[0] == '~' @@ -1926,11 +2179,13 @@ duplicates what `expand-file-name' does.") xnm = p; #ifdef DOS_NT else if (IS_DRIVE (p[0]) && p[1] == ':' - && p > nm && IS_DIRECTORY_SEP (p[-1])) + && p > xnm && IS_DIRECTORY_SEP (p[-1])) xnm = p; #endif - return make_string (xnm, x - xnm); + if (STRING_MULTIBYTE (filename)) + return make_string (xnm, x - xnm); + return make_unibyte_string (xnm, x - xnm); badsubst: error ("Bad format environment-variable substitution"); @@ -1941,6 +2196,7 @@ duplicates what `expand-file-name' does.") /* NOTREACHED */ #endif /* not VMS */ + return Qnil; } /* A slightly faster and more convenient way to get @@ -1955,7 +2211,7 @@ expand_and_dir_to_file (filename, defdir) absname = Fexpand_file_name (filename, defdir); #ifdef VMS { - register int c = XSTRING (absname)->data[XSTRING (absname)->size - 1]; + register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1]; if (c == ':' || c == ']' || c == '>') absname = Fdirectory_file_name (absname); } @@ -1963,8 +2219,8 @@ expand_and_dir_to_file (filename, defdir) /* Remove final slash, if any (unless this is the root dir). stat behaves differently depending! */ 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])) + && IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1]) + && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2])) /* We cannot take shortcuts; they might be wrong for magic file names. */ absname = Fdirectory_file_name (absname); #endif @@ -1976,31 +2232,42 @@ expand_and_dir_to_file (filename, defdir) and bypass the error if the user says to go ahead. QUERYSTRING is a name for the action that is being considered to alter the file. + *STATPTR is used to store the stat information if the file exists. - If the file does not exist, STATPTR->st_mode is set to 0. */ + If the file does not exist, STATPTR->st_mode is set to 0. + If STATPTR is null, we don't store into it. + + If QUICK is nonzero, we ask for y or n, not yes or no. */ void -barf_or_query_if_file_exists (absname, querystring, interactive, statptr) +barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) Lisp_Object absname; unsigned char *querystring; int interactive; struct stat *statptr; + int quick; { - register Lisp_Object tem; + register Lisp_Object tem, encoded_filename; struct stat statbuf; struct gcpro gcpro1; + encoded_filename = ENCODE_FILE (absname); + /* stat is a good way to tell whether the file exists, regardless of what access permissions it has. */ - if (stat (XSTRING (absname)->data, &statbuf) >= 0) + if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0) { if (! interactive) Fsignal (Qfile_already_exists, Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); GCPRO1 (absname); - tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ", - XSTRING (absname)->data, querystring)); + tem = format1 ("File %s already exists; %s anyway? ", + XSTRING (absname)->data, querystring); + if (quick) + tem = Fy_or_n_p (tem); + else + tem = do_yes_or_no_p (tem); UNGCPRO; if (NILP (tem)) Fsignal (Qfile_already_exists, @@ -2027,20 +2294,23 @@ This is what happens in interactive use with M-x.\n\ Fourth arg KEEP-TIME non-nil means give the new file the same\n\ last-modified time as the old one. (This works on only some systems.)\n\ A prefix arg makes KEEP-TIME non-nil.") - (file, newname, ok_if_already_exists, keep_date) - Lisp_Object file, newname, ok_if_already_exists, keep_date; + (file, newname, ok_if_already_exists, keep_time) + Lisp_Object file, newname, ok_if_already_exists, keep_time; { int ifd, ofd, n; char buf[16 * 1024]; struct stat st, out_st; Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int count = specpdl_ptr - specpdl; int input_file_statable_p; + Lisp_Object encoded_file, encoded_newname; - GCPRO2 (file, newname); + encoded_file = encoded_newname = Qnil; + GCPRO4 (file, newname, encoded_file, encoded_newname); CHECK_STRING (file, 0); CHECK_STRING (newname, 1); + file = Fexpand_file_name (file, Qnil); newname = Fexpand_file_name (newname, Qnil); @@ -2052,16 +2322,35 @@ A prefix arg makes KEEP-TIME non-nil.") handler = Ffind_file_name_handler (newname, Qcopy_file); if (!NILP (handler)) RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname, - ok_if_already_exists, keep_date)); + ok_if_already_exists, keep_time)); + + encoded_file = ENCODE_FILE (file); + encoded_newname = ENCODE_FILE (newname); if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, "copy to it", - INTEGERP (ok_if_already_exists), &out_st); - else if (stat (XSTRING (newname)->data, &out_st) < 0) + barf_or_query_if_file_exists (encoded_newname, "copy to it", + INTEGERP (ok_if_already_exists), &out_st, 0); + else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0) out_st.st_mode = 0; - ifd = open (XSTRING (file)->data, O_RDONLY); +#ifdef WINDOWSNT + if (!CopyFile (XSTRING (encoded_file)->data, + XSTRING (encoded_newname)->data, + FALSE)) + report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); + else if (NILP (keep_time)) + { + EMACS_TIME now; + EMACS_GET_TIME (now); + if (set_file_times (XSTRING (encoded_newname)->data, + now, now)) + Fsignal (Qfile_date_error, + Fcons (build_string ("Cannot set file date"), + Fcons (newname, Qnil))); + } +#else /* not WINDOWSNT */ + ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0); if (ifd < 0) report_file_error ("Opening input file", Fcons (file, Qnil)); @@ -2071,7 +2360,7 @@ A prefix arg makes KEEP-TIME non-nil.") copyable by us. */ input_file_statable_p = (fstat (ifd, &st) >= 0); -#if !defined (MSDOS) || __DJGPP__ > 1 +#if !defined (DOS_NT) || __DJGPP__ > 1 if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) { @@ -2097,13 +2386,13 @@ A prefix arg makes KEEP-TIME non-nil.") #ifdef VMS /* Create the copy file with the same record format as the input file */ - ofd = sys_creat (XSTRING (newname)->data, 0666, ifd); + ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd); #else #ifdef MSDOS /* System's default file type was set to binary by _fmode in emacs.c. */ - ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE); + ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE); #else /* not MSDOS */ - ofd = creat (XSTRING (newname)->data, 0666); + ofd = creat (XSTRING (encoded_newname)->data, 0666); #endif /* not MSDOS */ #endif /* VMS */ if (ofd < 0) @@ -2113,29 +2402,30 @@ A prefix arg makes KEEP-TIME non-nil.") immediate_quit = 1; QUIT; - while ((n = read (ifd, buf, sizeof buf)) > 0) - if (write (ofd, buf, n) != n) + while ((n = emacs_read (ifd, buf, sizeof buf)) > 0) + if (emacs_write (ofd, buf, n) != n) report_file_error ("I/O error", Fcons (newname, Qnil)); immediate_quit = 0; /* Closing the output clobbers the file times on some systems. */ - if (close (ofd) < 0) + if (emacs_close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); if (input_file_statable_p) { - if (!NILP (keep_date)) + 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 (XSTRING (newname)->data, atime, mtime)) + if (set_file_times (XSTRING (encoded_newname)->data, + atime, mtime)) Fsignal (Qfile_date_error, Fcons (build_string ("Cannot set file date"), Fcons (newname, Qnil))); } #ifndef MSDOS - chmod (XSTRING (newname)->data, st.st_mode & 07777); + chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777); #else /* MSDOS */ #if defined (__DJGPP__) && __DJGPP__ > 1 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits, @@ -2143,12 +2433,13 @@ A prefix arg makes KEEP-TIME non-nil.") get only the READ bit, which will make the copied file read-only, so it's better not to chmod at all. */ if ((_djstat_flags & _STFAIL_WRITEBIT) == 0) - chmod (XSTRING (newname)->data, st.st_mode & 07777); + chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777); #endif /* DJGPP version 2 or newer */ #endif /* MSDOS */ } - close (ifd); + emacs_close (ifd); +#endif /* WINDOWSNT */ /* Discard the unwind protects. */ specpdl_ptr = specpdl + count; @@ -2165,6 +2456,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, { unsigned char *dir; Lisp_Object handler; + Lisp_Object encoded_dir; CHECK_STRING (directory, 0); directory = Fexpand_file_name (directory, Qnil); @@ -2173,7 +2465,9 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, if (!NILP (handler)) return call2 (handler, Qmake_directory_internal, directory); - dir = XSTRING (directory)->data; + encoded_dir = ENCODE_FILE (directory); + + dir = XSTRING (encoded_dir)->data; #ifdef WINDOWSNT if (mkdir (dir) != 0) @@ -2192,15 +2486,19 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete { unsigned char *dir; Lisp_Object handler; + Lisp_Object encoded_dir; CHECK_STRING (directory, 0); directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil)); - dir = XSTRING (directory)->data; handler = Ffind_file_name_handler (directory, Qdelete_directory); if (!NILP (handler)) return call2 (handler, Qdelete_directory, directory); + encoded_dir = ENCODE_FILE (directory); + + dir = XSTRING (encoded_dir)->data; + if (rmdir (dir) != 0) report_file_error ("Removing directory", Flist (1, &directory)); @@ -2214,6 +2512,8 @@ If file has multiple names, it continues to exist with the other names.") Lisp_Object filename; { Lisp_Object handler; + Lisp_Object encoded_file; + CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); @@ -2221,7 +2521,9 @@ If file has multiple names, it continues to exist with the other names.") if (!NILP (handler)) return call2 (handler, Qdelete_file, filename); - if (0 > unlink (XSTRING (filename)->data)) + encoded_file = ENCODE_FILE (filename); + + if (0 > unlink (XSTRING (encoded_file)->data)) report_file_error ("Removing old name", Flist (1, &filename)); return Qnil; } @@ -2258,9 +2560,11 @@ This is what happens in interactive use with M-x.") Lisp_Object args[2]; #endif Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object encoded_file, encoded_newname; - GCPRO2 (file, newname); + encoded_file = encoded_newname = Qnil; + GCPRO4 (file, newname, encoded_file, encoded_newname); CHECK_STRING (file, 0); CHECK_STRING (newname, 1); file = Fexpand_file_name (file, Qnil); @@ -2275,15 +2579,24 @@ This is what happens in interactive use with M-x.") RETURN_UNGCPRO (call4 (handler, Qrename_file, file, newname, ok_if_already_exists)); + encoded_file = ENCODE_FILE (file); + encoded_newname = ENCODE_FILE (newname); + +#ifdef DOS_NT + /* If the file names are identical but for the case, don't ask for + confirmation: they simply want to change the letter-case of the + file name. */ + if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))) +#endif if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, "rename to it", - INTEGERP (ok_if_already_exists), 0); + barf_or_query_if_file_exists (encoded_newname, "rename to it", + INTEGERP (ok_if_already_exists), 0, 0); #ifndef BSD4_1 - if (0 > rename (XSTRING (file)->data, XSTRING (newname)->data)) + if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)) #else - if (0 > link (XSTRING (file)->data, XSTRING (newname)->data) - || 0 > unlink (XSTRING (file)->data)) + if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data) + || 0 > unlink (XSTRING (encoded_file)->data)) #endif { if (errno == EXDEV) @@ -2323,9 +2636,11 @@ This is what happens in interactive use with M-x.") Lisp_Object args[2]; #endif Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + Lisp_Object encoded_file, encoded_newname; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - GCPRO2 (file, newname); + GCPRO4 (file, newname, encoded_file, encoded_newname); + encoded_file = encoded_newname = Qnil; CHECK_STRING (file, 0); CHECK_STRING (newname, 1); file = Fexpand_file_name (file, Qnil); @@ -2345,17 +2660,16 @@ This is what happens in interactive use with M-x.") RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file, newname, ok_if_already_exists)); + encoded_file = ENCODE_FILE (file); + encoded_newname = ENCODE_FILE (newname); + if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, "make it a new name", - INTEGERP (ok_if_already_exists), 0); -#ifdef WINDOWSNT - /* Windows does not support this operation. */ - report_file_error ("Adding new name", Flist (2, &file)); -#else /* not WINDOWSNT */ + barf_or_query_if_file_exists (encoded_newname, "make it a new name", + INTEGERP (ok_if_already_exists), 0, 0); unlink (XSTRING (newname)->data); - if (0 > link (XSTRING (file)->data, XSTRING (newname)->data)) + if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)) { #ifdef NO_ARG_ARRAY args[0] = file; @@ -2365,7 +2679,6 @@ This is what happens in interactive use with M-x.") report_file_error ("Adding new name", Flist (2, &file)); #endif } -#endif /* not WINDOWSNT */ UNGCPRO; return Qnil; @@ -2386,9 +2699,11 @@ This happens for interactive use with M-x.") Lisp_Object args[2]; #endif Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + Lisp_Object encoded_filename, encoded_linkname; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - GCPRO2 (filename, linkname); + GCPRO4 (filename, linkname, encoded_filename, encoded_linkname); + encoded_filename = encoded_linkname = Qnil; CHECK_STRING (filename, 0); CHECK_STRING (linkname, 1); /* If the link target has a ~, we must expand it to get @@ -2412,17 +2727,22 @@ This happens for interactive use with M-x.") RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, ok_if_already_exists)); + encoded_filename = ENCODE_FILE (filename); + encoded_linkname = ENCODE_FILE (linkname); + if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (linkname, "make it a link", - INTEGERP (ok_if_already_exists), 0); - if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) + barf_or_query_if_file_exists (encoded_linkname, "make it a link", + INTEGERP (ok_if_already_exists), 0, 0); + if (0 > symlink (XSTRING (encoded_filename)->data, + XSTRING (encoded_linkname)->data)) { /* If we didn't complain already, silently delete existing file. */ if (errno == EEXIST) { - unlink (XSTRING (linkname)->data); - if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) + unlink (XSTRING (encoded_linkname)->data); + if (0 <= symlink (XSTRING (encoded_filename)->data, + XSTRING (encoded_linkname)->data)) { UNGCPRO; return Qnil; @@ -2595,6 +2915,8 @@ See also `file-readable-p' and `file-attributes'.") if (!NILP (handler)) return call2 (handler, Qfile_exists_p, absname); + absname = ENCODE_FILE (absname); + return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil; } @@ -2617,6 +2939,8 @@ For a directory, this means you can access files in that directory.") if (!NILP (handler)) return call2 (handler, Qfile_executable_p, absname); + absname = ENCODE_FILE (absname); + return (check_executable (XSTRING (absname)->data) ? Qt : Qnil); } @@ -2641,12 +2965,15 @@ See also `file-exists-p' and `file-attributes'.") if (!NILP (handler)) return call2 (handler, Qfile_readable_p, absname); -#ifdef DOS_NT - /* Under MS-DOS and Windows, open does not work for directories. */ + absname = ENCODE_FILE (absname); + +#if defined(DOS_NT) || defined(macintosh) + /* Under MS-DOS, Windows, and Macintosh, open does not work for + directories. */ if (access (XSTRING (absname)->data, 0) == 0) return Qt; return Qnil; -#else /* not DOS_NT */ +#else /* not DOS_NT and not macintosh */ flags = O_RDONLY; #if defined (S_ISFIFO) && defined (O_NONBLOCK) /* Opening a fifo without O_NONBLOCK can wait. @@ -2658,12 +2985,12 @@ See also `file-exists-p' and `file-attributes'.") if (S_ISFIFO (statbuf.st_mode)) flags |= O_NONBLOCK; #endif - desc = open (XSTRING (absname)->data, flags); + desc = emacs_open (XSTRING (absname)->data, flags, 0); if (desc < 0) return Qnil; - close (desc); + emacs_close (desc); return Qt; -#endif /* not DOS_NT */ +#endif /* not DOS_NT and not macintosh */ } /* Having this before file-symlink-p mysteriously caused it to be forgotten @@ -2673,7 +3000,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, (filename) Lisp_Object filename; { - Lisp_Object absname, dir; + Lisp_Object absname, dir, encoded; Lisp_Object handler; struct stat statbuf; @@ -2686,9 +3013,11 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, if (!NILP (handler)) return call2 (handler, Qfile_writable_p, absname); - if (stat (XSTRING (absname)->data, &statbuf) >= 0) - return (check_writable (XSTRING (absname)->data) + encoded = ENCODE_FILE (absname); + if (stat (XSTRING (encoded)->data, &statbuf) >= 0) + return (check_writable (XSTRING (encoded)->data) ? Qt : Qnil); + dir = Ffile_name_directory (absname); #ifdef VMS if (!NILP (dir)) @@ -2698,8 +3027,19 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* MSDOS */ + + dir = ENCODE_FILE (dir); +#ifdef WINDOWSNT + /* The read-only attribute of the parent directory doesn't affect + whether a file or directory can be created within it. Some day we + should check ACLs though, which do affect this. */ + if (stat (XSTRING (dir)->data, &statbuf) < 0) + return Qnil; + return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; +#else return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "") ? Qt : Qnil); +#endif } DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, @@ -2709,10 +3049,11 @@ If there is no error, we return nil.") (filename, string) Lisp_Object filename, string; { - Lisp_Object handler; + Lisp_Object handler, encoded_filename; int fd; CHECK_STRING (filename, 0); + CHECK_STRING (string, 1); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2720,10 +3061,12 @@ If there is no error, we return nil.") if (!NILP (handler)) return call3 (handler, Qaccess_file, filename, string); - fd = open (XSTRING (filename)->data, O_RDONLY); + encoded_filename = ENCODE_FILE (filename); + + fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0); if (fd < 0) report_file_error (XSTRING (string)->data, Fcons (filename, Qnil)); - close (fd); + emacs_close (fd); return Qnil; } @@ -2751,24 +3094,39 @@ Otherwise returns nil.") if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); - bufsize = 100; - while (1) + filename = ENCODE_FILE (filename); + + bufsize = 50; + buf = NULL; + do { - buf = (char *) xmalloc (bufsize); + bufsize *= 2; + buf = (char *) xrealloc (buf, bufsize); bzero (buf, bufsize); + + errno = 0; valsize = readlink (XSTRING (filename)->data, buf, bufsize); - if (valsize < bufsize) break; - /* Buffer was not long enough */ - xfree (buf); - bufsize *= 2; - } - if (valsize == -1) - { - xfree (buf); - return Qnil; + if (valsize == -1) + { +#ifdef ERANGE + /* HP-UX reports ERANGE if buffer is too small. */ + if (errno == ERANGE) + valsize = bufsize; + else +#endif + { + xfree (buf); + return Qnil; + } + } } + while (valsize >= bufsize); + val = make_string (buf, valsize); + if (buf[0] == '/' && index (buf, ':')) + val = concat2 (build_string ("/:"), val); xfree (buf); + val = DECODE_FILE (val); return val; #else /* not S_IFLNK */ return Qnil; @@ -2776,9 +3134,9 @@ Otherwise returns nil.") } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, - "Return t if file FILENAME is the name of a directory as a file.\n\ -A directory name spec may be given instead; then the value is t\n\ -if the directory so specified exists and really is a directory.") + "Return t if FILENAME names an existing directory.\n\ +Symbolic links to directories count as directories.\n\ +See `file-symlink-p' to distinguish symlinks.") (filename) Lisp_Object filename; { @@ -2794,6 +3152,8 @@ if the directory so specified exists and really is a directory.") if (!NILP (handler)) return call2 (handler, Qfile_directory_p, absname); + absname = ENCODE_FILE (absname); + if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; @@ -2850,9 +3210,27 @@ This is the sort of file that holds an ordinary stream of data bytes.") if (!NILP (handler)) return call2 (handler, Qfile_regular_p, absname); + absname = ENCODE_FILE (absname); + +#ifdef WINDOWSNT + { + int result; + Lisp_Object tem = Vw32_get_true_file_attributes; + + /* Tell stat to use expensive method to get accurate info. */ + Vw32_get_true_file_attributes = Qt; + result = stat (XSTRING (absname)->data, &st); + Vw32_get_true_file_attributes = tem; + + if (result < 0) + return Qnil; + return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; + } +#else if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; +#endif } DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, @@ -2872,6 +3250,8 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, if (!NILP (handler)) return call2 (handler, Qfile_modes, absname); + absname = ENCODE_FILE (absname); + if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; #if defined (MSDOS) && __DJGPP__ < 2 @@ -2888,7 +3268,7 @@ Only the 12 low bits of MODE are used.") (filename, mode) Lisp_Object filename, mode; { - Lisp_Object absname; + Lisp_Object absname, encoded_absname; Lisp_Object handler; absname = Fexpand_file_name (filename, current_buffer->directory); @@ -2900,7 +3280,9 @@ Only the 12 low bits of MODE are used.") if (!NILP (handler)) return call3 (handler, Qset_file_modes, absname, mode); - if (chmod (XSTRING (absname)->data, XINT (mode)) < 0) + encoded_absname = ENCODE_FILE (absname); + + if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (absname, Qnil)); return Qnil; @@ -2934,9 +3316,13 @@ The value is an integer.") XSETINT (value, (~ realmask) & 0777); return value; } + -#ifdef unix +#ifdef __NetBSD__ +#define unix 42 +#endif +#ifdef unix DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", "Tell Unix to finish all pending disk updates.") () @@ -2977,6 +3363,11 @@ otherwise, if FILE2 does not exist, the answer is t.") if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); + GCPRO2 (absname1, absname2); + absname1 = ENCODE_FILE (absname1); + absname2 = ENCODE_FILE (absname2); + UNGCPRO; + if (stat (XSTRING (absname1)->data, &st) < 0) return Qnil; @@ -2996,46 +3387,134 @@ Lisp_Object Qfind_buffer_file_type; #define READ_BUF_SIZE (64 << 10) #endif -DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, - 1, 5, 0, - "Insert contents of file FILENAME after point.\n\ -Returns list of absolute file name and length of data inserted.\n\ -If second argument VISIT is non-nil, the buffer's visited filename\n\ -and last save file modtime are set, and it is marked unmodified.\n\ -If visiting and the file does not exist, visiting is completed\n\ -before the error is signaled.\n\ -The optional third and fourth arguments BEG and END\n\ -specify what portion of the file to insert.\n\ -If VISIT is non-nil, BEG and END must be nil.\n\ -\n\ -If optional fifth argument REPLACE is non-nil,\n\ -it means replace the current buffer contents (in the accessible portion)\n\ -with the file contents. This is better than simply deleting and inserting\n\ -the whole thing because (1) it preserves some marker positions\n\ -and (2) it puts less data in the undo list.\n\ -When REPLACE is non-nil, the value is the number of characters actually read,\n\ -which is often less than the number of characters to be read.\n\ -This does code conversion according to the value of\n\ - `coding-system-for-read' or `coding-system-alist', and sets the variable\n\ - `last-coding-system-used' to the coding system actually used.") - (filename, visit, beg, end, replace) - Lisp_Object filename, visit, beg, end, replace; +extern void adjust_markers_for_delete P_ ((int, int, int, int)); + +/* This function is called after Lisp functions to decide a coding + system are called, or when they cause an error. Before they are + called, the current buffer is set unibyte and it contains only a + newly inserted text (thus the buffer was empty before the + insertion). + + The functions may set markers, overlays, text properties, or even + alter the buffer contents, change the current buffer. + + Here, we reset all those changes by: + o set back the current buffer. + o move all markers and overlays to BEG. + o remove all text properties. + o set back the buffer multibyteness. */ + +static Lisp_Object +decide_coding_unwind (unwind_data) + Lisp_Object unwind_data; { - struct stat st; - register int fd; - register int inserted = 0; - register int how_much; - register int unprocessed; - int count = specpdl_ptr - specpdl; - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object handler, val, insval; + Lisp_Object multibyte, undo_list, buffer; + + multibyte = XCAR (unwind_data); + unwind_data = XCDR (unwind_data); + undo_list = XCAR (unwind_data); + buffer = XCDR (unwind_data); + + if (current_buffer != XBUFFER (buffer)) + set_buffer_internal (XBUFFER (buffer)); + adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE); + adjust_overlays_for_delete (BEG, Z - BEG); + BUF_INTERVALS (current_buffer) = 0; + TEMP_SET_PT_BOTH (BEG, BEG_BYTE); + + /* Now we are safe to change the buffer's multibyteness directly. */ + current_buffer->enable_multibyte_characters = multibyte; + current_buffer->undo_list = undo_list; + + return Qnil; +} + + +/* Used to pass values from insert-file-contents to read_non_regular. */ + +static int non_regular_fd; +static int non_regular_inserted; +static int non_regular_nbytes; + + +/* Read from a non-regular file. + Read non_regular_trytry bytes max from non_regular_fd. + Non_regular_inserted specifies where to put the read bytes. + Value is the number of bytes read. */ + +static Lisp_Object +read_non_regular () +{ + int nbytes; + + immediate_quit = 1; + QUIT; + nbytes = emacs_read (non_regular_fd, + BEG_ADDR + PT_BYTE - 1 + non_regular_inserted, + non_regular_nbytes); + Fsignal (Qquit, Qnil); + immediate_quit = 0; + return make_number (nbytes); +} + + +/* Condition-case handler used when reading from non-regular files + in insert-file-contents. */ + +static Lisp_Object +read_non_regular_quit () +{ + return Qnil; +} + + +DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, + 1, 5, 0, + "Insert contents of file FILENAME after point.\n\ +Returns list of absolute file name and number of bytes inserted.\n\ +If second argument VISIT is non-nil, the buffer's visited filename\n\ +and last save file modtime are set, and it is marked unmodified.\n\ +If visiting and the file does not exist, visiting is completed\n\ +before the error is signaled.\n\ +The optional third and fourth arguments BEG and END\n\ +specify what portion of the file to insert.\n\ +These arguments count bytes in the file, not characters in the buffer.\n\ +If VISIT is non-nil, BEG and END must be nil.\n\ +\n\ +If optional fifth argument REPLACE is non-nil,\n\ +it means replace the current buffer contents (in the accessible portion)\n\ +with the file contents. This is better than simply deleting and inserting\n\ +the whole thing because (1) it preserves some marker positions\n\ +and (2) it puts less data in the undo list.\n\ +When REPLACE is non-nil, the value is the number of characters actually read,\n\ +which is often less than the number of characters to be read.\n\ +\n\ +This does code conversion according to the value of\n\ +`coding-system-for-read' or `file-coding-system-alist',\n\ +and sets the variable `last-coding-system-used' to the coding system\n\ +actually used.") + (filename, visit, beg, end, replace) + Lisp_Object filename, visit, beg, end, replace; +{ + struct stat st; + register int fd; + int inserted = 0; + register int how_much; + register int unprocessed; + int count = BINDING_STACK_SIZE (); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object handler, val, insval, orig_filename; Lisp_Object p; - int total; + int total = 0; int not_regular = 0; - char read_buf[READ_BUF_SIZE]; + unsigned char read_buf[READ_BUF_SIZE]; struct coding_system coding; unsigned char buffer[1 << 14]; int replace_handled = 0; + int set_coding_system = 0; + int coding_system_decided = 0; + int gap_size; + int read_quit = 0; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3045,8 +3524,9 @@ This does code conversion according to the value of\n\ val = Qnil; p = Qnil; + orig_filename = Qnil; - GCPRO3 (filename, val, p); + GCPRO4 (filename, val, p, orig_filename); CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); @@ -3058,41 +3538,43 @@ This does code conversion according to the value of\n\ { val = call6 (handler, Qinsert_file_contents, filename, visit, beg, end, replace); + if (CONSP (val) && CONSP (XCDR (val))) + inserted = XINT (XCAR (XCDR (val))); goto handled; } - /* Decide the coding-system of the file. */ - { - Lisp_Object val = Vcoding_system_for_read; - if (NILP (current_buffer->enable_multibyte_characters)) - val = Qnil; - else if (NILP (val)) - { - Lisp_Object args[6], coding_systems; - - args[0] = Qinsert_file_contents, args[1] = filename, args[2] = visit, - args[3] = beg, args[4] = end, args[5] = replace; - coding_systems = Ffind_coding_system (6, args); - val = CONSP (coding_systems) ? XCONS (coding_systems)->car : Qnil; - } - setup_coding_system (Fcheck_coding_system (val), &coding); - } + orig_filename = filename; + filename = ENCODE_FILE (filename); fd = -1; +#ifdef WINDOWSNT + { + Lisp_Object tem = Vw32_get_true_file_attributes; + + /* Tell stat to use expensive method to get accurate info. */ + Vw32_get_true_file_attributes = Qt; + total = stat (XSTRING (filename)->data, &st); + Vw32_get_true_file_attributes = tem; + } + if (total < 0) +#else #ifndef APOLLO if (stat (XSTRING (filename)->data, &st) < 0) #else - if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0 + if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ +#endif /* WINDOWSNT */ { - if (fd >= 0) close (fd); + if (fd >= 0) emacs_close (fd); badopen: if (NILP (visit)) - report_file_error ("Opening input file", Fcons (filename, Qnil)); + report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); st.st_mtime = -1; how_much = 0; + if (!NILP (Vcoding_system_for_read)) + Fset (Qbuffer_file_coding_system, Vcoding_system_for_read); goto notfound; } @@ -3110,12 +3592,12 @@ This does code conversion according to the value of\n\ if (! NILP (replace) || ! NILP (beg) || ! NILP (end)) Fsignal (Qfile_error, Fcons (build_string ("not a regular file"), - Fcons (filename, Qnil))); + Fcons (orig_filename, Qnil))); } #endif if (fd < 0) - if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0) + if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0) goto badopen; /* Replacement should preserve point as it preserves markers. */ @@ -3128,9 +3610,16 @@ This does code conversion according to the value of\n\ if (! not_regular && st.st_size < 0) error ("File size is negative"); - if (!NILP (beg) || !NILP (end)) - if (!NILP (visit)) - error ("Attempt to visit less than an entire file"); + /* Prevent redisplay optimizations. */ + current_buffer->clip_changed = 1; + + if (!NILP (visit)) + { + if (!NILP (beg) || !NILP (end)) + error ("Attempt to visit less than an entire file"); + if (BEG < Z && NILP (replace)) + error ("Cannot do file visiting in a non-empty buffer"); + } if (!NILP (beg)) CHECK_NUMBER (beg, 0); @@ -3144,11 +3633,131 @@ This does code conversion according to the value of\n\ if (! not_regular) { XSETINT (end, st.st_size); - if (XINT (end) != st.st_size) + + /* Arithmetic overflow can occur if an Emacs integer cannot + represent the file size, or if the calculations below + overflow. The calculations below double the file size + twice, so check that it can be multiplied by 4 safely. */ + if (XINT (end) != st.st_size + || ((int) st.st_size * 4) / 4 != st.st_size) error ("Maximum buffer size exceeded"); + + /* The file size returned from stat may be zero, but data + may be readable nonetheless, for example when this is a + file in the /proc filesystem. */ + if (st.st_size == 0) + XSETINT (end, READ_BUF_SIZE); } } + if (BEG < Z) + { + /* Decide the coding system to use for reading the file now + because we can't use an optimized method for handling + `coding:' tag if the current buffer is not empty. */ + Lisp_Object val; + val = Qnil; + + if (!NILP (Vcoding_system_for_read)) + val = Vcoding_system_for_read; + else if (! NILP (replace)) + /* In REPLACE mode, we can use the same coding system + that was used to visit the file. */ + val = current_buffer->buffer_file_coding_system; + else + { + /* Don't try looking inside a file for a coding system + specification if it is not seekable. */ + if (! not_regular && ! NILP (Vset_auto_coding_function)) + { + /* Find a coding system specified in the heading two + lines or in the tailing several lines of the file. + We assume that the 1K-byte and 3K-byte for heading + and tailing respectively are sufficient for this + purpose. */ + int nread; + + if (st.st_size <= (1024 * 4)) + nread = emacs_read (fd, read_buf, 1024 * 4); + else + { + nread = emacs_read (fd, read_buf, 1024); + if (nread >= 0) + { + if (lseek (fd, st.st_size - (1024 * 3), 0) < 0) + report_file_error ("Setting file position", + Fcons (orig_filename, Qnil)); + nread += emacs_read (fd, read_buf + nread, 1024 * 3); + } + } + + if (nread < 0) + error ("IO error reading %s: %s", + XSTRING (orig_filename)->data, emacs_strerror (errno)); + else if (nread > 0) + { + struct buffer *prev = current_buffer; + int count1; + + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + + /* The call to temp_output_buffer_setup binds + standard-output. */ + count1 = specpdl_ptr - specpdl; + temp_output_buffer_setup (" *code-converting-work*"); + + set_buffer_internal (XBUFFER (Vstandard_output)); + current_buffer->enable_multibyte_characters = Qnil; + insert_1_both (read_buf, nread, nread, 0, 0, 0); + TEMP_SET_PT_BOTH (BEG, BEG_BYTE); + val = call2 (Vset_auto_coding_function, + filename, make_number (nread)); + set_buffer_internal (prev); + + /* Remove the binding for standard-output. */ + unbind_to (count1, Qnil); + + /* Discard the unwind protect for recovering the + current buffer. */ + specpdl_ptr--; + + /* Rewind the file for the actual read done later. */ + if (lseek (fd, 0, 0) < 0) + report_file_error ("Setting file position", + Fcons (orig_filename, Qnil)); + } + } + + if (NILP (val)) + { + /* If we have not yet decided a coding system, check + file-coding-system-alist. */ + Lisp_Object args[6], coding_systems; + + args[0] = Qinsert_file_contents, args[1] = orig_filename; + args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace; + coding_systems = Ffind_operation_coding_system (6, args); + if (CONSP (coding_systems)) + val = XCAR (coding_systems); + } + } + + setup_coding_system (Fcheck_coding_system (val), &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; + + if (NILP (current_buffer->enable_multibyte_characters) + && ! NILP (val)) + /* We must suppress all character code conversion except for + end-of-line conversion. */ + setup_raw_text_coding_system (&coding); + + coding.src_multibyte = 0; + coding.dst_multibyte + = !NILP (current_buffer->enable_multibyte_characters); + coding_system_decided = 1; + } + /* If requested, replace the accessible part of the buffer with the file contents. Avoid replacing text at the beginning or end of the buffer that matches the file contents; @@ -3164,14 +3773,14 @@ This does code conversion according to the value of\n\ But if we discover the need for conversion, we give up on this method and let the following if-statement handle the replace job. */ if (!NILP (replace) - && (! CODING_REQUIRE_CONVERSION (&coding) - || (coding.type == coding_type_automatic - && ! CODING_REQUIRE_TEXT_CONVERSION (&coding)) - || (coding.eol_type == CODING_EOL_AUTOMATIC - && ! CODING_REQUIRE_EOL_CONVERSION (&coding)))) + && BEGV < ZV + && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK)) { - int same_at_start = BEGV; - int same_at_end = ZV; + /* same_at_start and same_at_end count bytes, + because file access counts bytes + and BEG and END count bytes. */ + int same_at_start = BEGV_BYTE; + int same_at_end = ZV_BYTE; int overlap; /* There is still a possibility we will find the need to do code conversion. If that happens, we set this variable to 1 to @@ -3182,7 +3791,7 @@ This does code conversion according to the value of\n\ { if (lseek (fd, XINT (beg), 0) < 0) report_file_error ("Setting file position", - Fcons (filename, Qnil)); + Fcons (orig_filename, Qnil)); } immediate_quit = 1; @@ -3193,16 +3802,16 @@ This does code conversion according to the value of\n\ { int nread, bufpos; - nread = read (fd, buffer, sizeof buffer); + nread = emacs_read (fd, buffer, sizeof buffer); if (nread < 0) error ("IO error reading %s: %s", - XSTRING (filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); else if (nread == 0) break; - if (coding.type == coding_type_automatic) + if (coding.type == coding_type_undecided) detect_coding (&coding, buffer, nread); - if (CODING_REQUIRE_TEXT_CONVERSION (&coding)) + if (coding.common_flags & CODING_REQUIRE_DECODING_MASK) /* We found that the file should be decoded somehow. Let's give up here. */ { @@ -3210,9 +3819,10 @@ This does code conversion according to the value of\n\ break; } - if (coding.eol_type == CODING_EOL_AUTOMATIC) + if (coding.eol_type == CODING_EOL_UNDECIDED) detect_eol (&coding, buffer, nread); - if (CODING_REQUIRE_EOL_CONVERSION (&coding)) + if (coding.eol_type != CODING_EOL_UNDECIDED + && coding.eol_type != CODING_EOL_LF) /* We found that the format of eol should be decoded. Let's give up here. */ { @@ -3221,7 +3831,7 @@ This does code conversion according to the value of\n\ } bufpos = 0; - while (bufpos < nread && same_at_start < ZV + while (bufpos < nread && same_at_start < ZV_BYTE && FETCH_BYTE (same_at_start) == buffer[bufpos]) same_at_start++, bufpos++; /* If we found a discrepancy, stop the scan. @@ -3232,12 +3842,12 @@ This does code conversion according to the value of\n\ immediate_quit = 0; /* If the file matches the buffer completely, there's no need to replace anything. */ - if (same_at_start - BEGV == XINT (end)) + if (same_at_start - BEGV_BYTE == XINT (end)) { - close (fd); + emacs_close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ - del_range_1 (same_at_start, same_at_end, 0); + del_range_1 (same_at_start, same_at_end, 0, 0); goto handled; } immediate_quit = 1; @@ -3250,7 +3860,7 @@ This does code conversion according to the value of\n\ int total_read, nread, bufpos, curpos, trial; /* At what file position are we now scanning? */ - curpos = XINT (end) - (ZV - same_at_end); + curpos = XINT (end) - (ZV_BYTE - same_at_end); /* If the entire file matches the buffer tail, stop the scan. */ if (curpos == 0) break; @@ -3258,20 +3868,24 @@ This does code conversion according to the value of\n\ trial = min (curpos, sizeof buffer); if (lseek (fd, curpos - trial, 0) < 0) report_file_error ("Setting file position", - Fcons (filename, Qnil)); + Fcons (orig_filename, Qnil)); - total_read = 0; + total_read = nread = 0; while (total_read < trial) { - nread = read (fd, buffer + total_read, trial - total_read); - if (nread <= 0) + nread = emacs_read (fd, buffer + total_read, trial - total_read); + if (nread < 0) error ("IO error reading %s: %s", - XSTRING (filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); + else if (nread == 0) + break; total_read += nread; } + /* Scan this bufferful from the end, comparing with the Emacs buffer. */ bufpos = total_read; + /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (bufpos > 0 && same_at_end > same_at_start @@ -3286,29 +3900,51 @@ This does code conversion according to the value of\n\ we cannot use this method; giveup and try the other. */ if (same_at_end > same_at_start && FETCH_BYTE (same_at_end - 1) >= 0200 - && ! NILP (current_buffer->enable_multibyte_characters)) + && ! NILP (current_buffer->enable_multibyte_characters) + && (CODING_MAY_REQUIRE_DECODING (&coding))) giveup_match_end = 1; break; } + + if (nread == 0) + break; } immediate_quit = 0; if (! giveup_match_end) { + int temp; + /* We win! We can handle REPLACE the optimized way. */ + /* Extend the start of non-matching text area to multibyte + character boundary. */ + if (! NILP (current_buffer->enable_multibyte_characters)) + while (same_at_start > BEGV_BYTE + && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) + same_at_start--; + + /* Extend the end of non-matching text area to multibyte + character boundary. */ + if (! NILP (current_buffer->enable_multibyte_characters)) + while (same_at_end < ZV_BYTE + && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) + same_at_end++; + /* Don't try to reuse the same piece of text twice. */ - overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV); + overlap = (same_at_start - BEGV_BYTE + - (same_at_end + st.st_size - ZV)); if (overlap > 0) same_at_end += overlap; /* Arrange to read only the nonmatching middle part of the file. */ - XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV)); - XSETFASTINT (end, XINT (end) - (ZV - same_at_end)); + XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE)); + XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end)); - del_range_1 (same_at_start, same_at_end, 0); + del_range_byte (same_at_start, same_at_end, 0); /* Insert from the file at the proper position. */ - SET_PT (same_at_start); + temp = BYTE_TO_CHAR (same_at_start); + SET_PT_BOTH (temp, same_at_start); /* If display currently starts at beginning of line, keep it that way. */ @@ -3328,24 +3964,25 @@ This does code conversion according to the value of\n\ is needed, in a simple way that needs a lot of memory. The preceding if-statement handles the case of no conversion in a more optimized way. */ - if (!NILP (replace) && ! replace_handled) + if (!NILP (replace) && ! replace_handled && BEGV < ZV) { - int same_at_start = BEGV; - int same_at_end = ZV; + int same_at_start = BEGV_BYTE; + int same_at_end = ZV_BYTE; int overlap; int bufpos; /* Make sure that the gap is large enough. */ int bufsize = 2 * st.st_size; - unsigned char *conversion_buffer = (unsigned char *) malloc (bufsize); + unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize); + int temp; /* First read the whole file, performing code conversion into CONVERSION_BUFFER. */ if (lseek (fd, XINT (beg), 0) < 0) { - free (conversion_buffer); + xfree (conversion_buffer); report_file_error ("Setting file position", - Fcons (filename, Qnil)); + Fcons (orig_filename, Qnil)); } total = st.st_size; /* Total bytes in the file. */ @@ -3357,13 +3994,13 @@ This does code conversion according to the value of\n\ { /* try is reserved in some compilers (Microsoft C) */ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); - char *destination = read_buf + unprocessed; + unsigned char *destination = read_buf + unprocessed; int this; /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; - this = read (fd, destination, trytry); + this = emacs_read (fd, destination, trytry); immediate_quit = 0; if (this < 0 || this + unprocessed == 0) @@ -3374,9 +4011,9 @@ This does code conversion according to the value of\n\ how_much += this; - if (CODING_REQUIRE_CONVERSION (&coding)) + if (CODING_MAY_REQUIRE_DECODING (&coding)) { - int require, produced, consumed; + int require, result; this += unprocessed; @@ -3386,38 +4023,43 @@ This does code conversion according to the value of\n\ if (inserted + require + 2 * (total - how_much) > bufsize) { bufsize = inserted + require + 2 * (total - how_much); - conversion_buffer = (unsigned char *) realloc (conversion_buffer, bufsize); + conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize); } /* Convert this batch with results in CONVERSION_BUFFER. */ if (how_much >= total) /* This is the last block. */ - coding.last_block = 1; - produced = decode_coding (&coding, read_buf, - conversion_buffer + inserted, - this, bufsize - inserted, - &consumed); + coding.mode |= CODING_MODE_LAST_BLOCK; + if (coding.composing != COMPOSITION_DISABLED) + coding_allocate_composition_data (&coding, BEGV); + result = decode_coding (&coding, read_buf, + conversion_buffer + inserted, + this, bufsize - inserted); /* Save for next iteration whatever we didn't convert. */ - unprocessed = this - consumed; - bcopy (read_buf + consumed, read_buf, unprocessed); - this = produced; + unprocessed = this - coding.consumed; + bcopy (read_buf + coding.consumed, read_buf, unprocessed); + if (!NILP (current_buffer->enable_multibyte_characters)) + this = coding.produced; + else + this = str_as_unibyte (conversion_buffer + inserted, + coding.produced); } inserted += this; } - /* At this point, INSERTED is how many characters + /* At this point, INSERTED is how many characters (i.e. bytes) are present in CONVERSION_BUFFER. HOW_MUCH should equal TOTAL, or should be <= 0 if we couldn't read the file. */ if (how_much < 0) { - free (conversion_buffer); + xfree (conversion_buffer); if (how_much == -1) error ("IO error reading %s: %s", - XSTRING (filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); else if (how_much == -2) error ("maximum buffer size exceeded"); } @@ -3435,14 +4077,22 @@ This does code conversion according to the value of\n\ if (bufpos == inserted) { - free (conversion_buffer); - close (fd); + xfree (conversion_buffer); + emacs_close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ - del_range_1 (same_at_start, same_at_end, 0); + del_range_byte (same_at_start, same_at_end, 0); + inserted = 0; goto handled; } + /* Extend the start of non-matching text area to multibyte + character boundary. */ + if (! NILP (current_buffer->enable_multibyte_characters)) + while (same_at_start > BEGV_BYTE + && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) + same_at_start--; + /* Scan this bufferful from the end, comparing with the Emacs buffer. */ bufpos = inserted; @@ -3453,8 +4103,15 @@ This does code conversion according to the value of\n\ && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1]) same_at_end--, bufpos--; + /* Extend the end of non-matching text area to multibyte + character boundary. */ + if (! NILP (current_buffer->enable_multibyte_characters)) + while (same_at_end < ZV_BYTE + && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) + same_at_end++; + /* Don't try to reuse the same piece of text twice. */ - overlap = same_at_start - BEGV - (same_at_end + inserted - ZV); + overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE); if (overlap > 0) same_at_end += overlap; @@ -3466,14 +4123,31 @@ This does code conversion according to the value of\n\ /* Replace the chars that we need to replace, and update INSERTED to equal the number of bytes we are taking from the file. */ - inserted -= (Z - same_at_end) + (same_at_start - BEG); - move_gap (same_at_start); - del_range_1 (same_at_start, same_at_end, 0); - SET_PT (same_at_start); - insert_1 (conversion_buffer + same_at_start - BEG, inserted, 0, 0); - - free (conversion_buffer); - close (fd); + inserted -= (Z_BYTE - same_at_end) + (same_at_start - BEG_BYTE); + + if (same_at_end != same_at_start) + { + del_range_byte (same_at_start, same_at_end, 0); + temp = GPT; + same_at_start = GPT_BYTE; + } + else + { + temp = BYTE_TO_CHAR (same_at_start); + } + /* Insert from the file at the proper position. */ + SET_PT_BOTH (temp, same_at_start); + insert_1 (conversion_buffer + same_at_start - BEG_BYTE, inserted, + 0, 0, 0); + if (coding.cmp_data && coding.cmp_data->used) + coding_restore_composition (&coding, Fcurrent_buffer ()); + coding_free_composition_data (&coding); + + /* Set `inserted' to the number of inserted characters. */ + inserted = PT - temp; + + xfree (conversion_buffer); + emacs_close (fd); specpdl_ptr--; goto handled; @@ -3495,7 +4169,7 @@ This does code conversion according to the value of\n\ total = READ_BUF_SIZE; if (NILP (visit) && total > 0) - prepare_to_modify_buffer (PT, PT); + prepare_to_modify_buffer (PT, PT, NULL); move_gap (PT); if (GAP_SIZE < total) @@ -3504,145 +4178,223 @@ This does code conversion according to the value of\n\ if (XINT (beg) != 0 || !NILP (replace)) { if (lseek (fd, XINT (beg), 0) < 0) - report_file_error ("Setting file position", Fcons (filename, Qnil)); + report_file_error ("Setting file position", + Fcons (orig_filename, Qnil)); } /* In the following loop, HOW_MUCH contains the total bytes read so - far. Before exiting the loop, it is set to -1 if I/O error - occurs, set to -2 if the maximum buffer size is exceeded. */ + far for a regular file, and not changed for a special file. But, + before exiting the loop, it is set to a negative value if I/O + error occurs. */ how_much = 0; + /* Total bytes inserted. */ inserted = 0; - /* Bytes not processed in the previous loop because short gap size. */ - unprocessed = 0; - while (how_much < total) - { + + /* Here, we don't do code conversion in the loop. It is done by + code_convert_region after all data are read into the buffer. */ + { + int gap_size = GAP_SIZE; + + while (how_much < total) + { /* try is reserved in some compilers (Microsoft C) */ - int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); - char *destination = (CODING_REQUIRE_CONVERSION (&coding) - ? read_buf + unprocessed - : (char *) (POS_ADDR (PT + inserted - 1) + 1)); - int this; + int trytry = min (total - how_much, READ_BUF_SIZE); + int this; - /* Allow quitting out of the actual I/O. */ - immediate_quit = 1; - QUIT; - this = read (fd, destination, trytry); - immediate_quit = 0; + if (not_regular) + { + Lisp_Object val; - if (this < 0 || this + unprocessed == 0) - { - how_much = this; - break; - } + /* Maybe make more room. */ + if (gap_size < trytry) + { + make_gap (total - gap_size); + gap_size = GAP_SIZE; + } - /* For a regular file, where TOTAL is the real size, - count HOW_MUCH to compare with it. - For a special file, where TOTAL is just a buffer size, - so don't bother counting in HOW_MUCH. - (INSERTED is where we count the number of characters inserted.) */ - if (! not_regular) - how_much += this; + /* Read from the file, capturing `quit'. When an + error occurs, end the loop, and arrange for a quit + to be signaled after decoding the text we read. */ + non_regular_fd = fd; + non_regular_inserted = inserted; + non_regular_nbytes = trytry; + val = internal_condition_case_1 (read_non_regular, Qnil, Qerror, + read_non_regular_quit); + if (NILP (val)) + { + read_quit = 1; + break; + } - if (CODING_REQUIRE_CONVERSION (&coding)) - { - int require, produced, consumed; + this = XINT (val); + } + else + { + /* Allow quitting out of the actual I/O. We don't make text + part of the buffer until all the reading is done, so a C-g + here doesn't do any harm. */ + immediate_quit = 1; + QUIT; + this = emacs_read (fd, BEG_ADDR + PT_BYTE - 1 + inserted, trytry); + immediate_quit = 0; + } + + if (this <= 0) + { + how_much = this; + break; + } - this += unprocessed; - /* Make sure that the gap is large enough. */ - require = decoding_buffer_size (&coding, this); - if (GAP_SIZE < require) - make_gap (require - GAP_SIZE); + gap_size -= this; - if (! not_regular) - { - if (how_much >= total) /* This is the last block. */ - coding.last_block = 1; - } - else + /* For a regular file, where TOTAL is the real size, + count HOW_MUCH to compare with it. + For a special file, where TOTAL is just a buffer size, + so don't bother counting in HOW_MUCH. + (INSERTED is where we count the number of characters inserted.) */ + if (! not_regular) + how_much += this; + inserted += this; + } + } + + /* Make the text read part of the buffer. */ + GAP_SIZE -= inserted; + GPT += inserted; + GPT_BYTE += inserted; + ZV += inserted; + ZV_BYTE += inserted; + Z += inserted; + Z_BYTE += inserted; + + if (GAP_SIZE > 0) + /* Put an anchor to ensure multi-byte form ends at gap. */ + *GPT_ADDR = 0; + + emacs_close (fd); + + /* Discard the unwind protect for closing the file. */ + specpdl_ptr--; + + if (how_much < 0) + error ("IO error reading %s: %s", + XSTRING (orig_filename)->data, emacs_strerror (errno)); + + notfound: + + if (! coding_system_decided) + { + /* The coding system is not yet decided. Decide it by an + optimized method for handling `coding:' tag. + + Note that we can get here only if the buffer was empty + before the insertion. */ + Lisp_Object val; + val = Qnil; + + if (!NILP (Vcoding_system_for_read)) + val = Vcoding_system_for_read; + else + { + /* Since we are sure that the current buffer was empty + before the insertion, we can toggle + enable-multibyte-characters directly here without taking + care of marker adjustment and byte combining problem. By + this way, we can run Lisp program safely before decoding + the inserted text. */ + Lisp_Object unwind_data; + int count = specpdl_ptr - specpdl; + + unwind_data = Fcons (current_buffer->enable_multibyte_characters, + Fcons (current_buffer->undo_list, + Fcurrent_buffer ())); + current_buffer->enable_multibyte_characters = Qnil; + current_buffer->undo_list = Qt; + record_unwind_protect (decide_coding_unwind, unwind_data); + + if (inserted > 0 && ! NILP (Vset_auto_coding_function)) { - /* If we encounter EOF, say it is the last block. (The - data this will apply to is the UNPROCESSED characters - carried over from the last batch.) */ - if (this == 0) - coding.last_block = 1; + val = call2 (Vset_auto_coding_function, + filename, make_number (inserted)); } - produced = decode_coding (&coding, read_buf, - POS_ADDR (PT + inserted - 1) + 1, - this, GAP_SIZE, &consumed); - if (produced > 0) + if (NILP (val)) { - Lisp_Object temp; - - XSET (temp, Lisp_Int, Z + produced); - if (Z + produced != XINT (temp)) - { - how_much = -2; - break; - } + /* If the coding system is not yet decided, check + file-coding-system-alist. */ + Lisp_Object args[6], coding_systems; + + args[0] = Qinsert_file_contents, args[1] = orig_filename; + args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil; + coding_systems = Ffind_operation_coding_system (6, args); + if (CONSP (coding_systems)) + val = XCAR (coding_systems); } - unprocessed = this - consumed; - bcopy (read_buf + consumed, read_buf, unprocessed); - this = produced; - } - GPT += this; - GAP_SIZE -= this; - ZV += this; - Z += this; - if (GAP_SIZE > 0) - /* Put an anchor to ensure multi-byte form ends at gap. */ - *GPT_ADDR = 0; - inserted += this; - } + unbind_to (count, Qnil); + inserted = Z_BYTE - BEG_BYTE; + } - /* We don't have to consider file type of MSDOS because all files - are read as binary and end-of-line format has already been - decoded appropriately. */ -#if 0 -#ifdef DOS_NT - /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ - /* Determine file type from name and remove LFs from CR-LFs if the file - is deemed to be a text file. */ - { - current_buffer->buffer_file_type - = call1 (Qfind_buffer_file_type, filename); - if (NILP (current_buffer->buffer_file_type)) + /* The following kludgy code is to avoid some compiler bug. + We can't simply do + setup_coding_system (val, &coding); + on some system. */ { - int reduced_size - = inserted - crlf_to_lf (inserted, POS_ADDR (PT - 1) + 1); - ZV -= reduced_size; - Z -= reduced_size; - GPT -= reduced_size; - GAP_SIZE += reduced_size; - inserted -= reduced_size; + struct coding_system temp_coding; + setup_coding_system (val, &temp_coding); + bcopy (&temp_coding, &coding, sizeof coding); } - } -#endif /* DOS_NT */ -#endif /* 0 */ + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; + + if (NILP (current_buffer->enable_multibyte_characters) + && ! NILP (val)) + /* We must suppress all character code conversion except for + end-of-line conversion. */ + setup_raw_text_coding_system (&coding); + coding.src_multibyte = 0; + coding.dst_multibyte + = !NILP (current_buffer->enable_multibyte_characters); + } - if (inserted > 0) + if (!NILP (visit) + /* Can't do this if part of the buffer might be preserved. */ + && NILP (replace) + && (coding.type == coding_type_no_conversion + || coding.type == coding_type_raw_text)) { - record_insert (PT, inserted); - - /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ - offset_intervals (current_buffer, PT, inserted); - MODIFF++; + /* Visiting a file with these coding system makes the buffer + unibyte. */ + current_buffer->enable_multibyte_characters = Qnil; + coding.dst_multibyte = 0; } - close (fd); - - /* Discard the unwind protect for closing the file. */ - specpdl_ptr--; + if (inserted > 0 || coding.type == coding_type_ccl) + { + if (CODING_MAY_REQUIRE_DECODING (&coding)) + { + code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, + &coding, 0, 0); + inserted = coding.produced_char; + } + else + adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, + inserted); + } - if (how_much == -1) - error ("IO error reading %s: %s", - XSTRING (filename)->data, strerror (errno)); - else if (how_much == -2) - error ("maximum buffer size exceeded"); +#ifdef DOS_NT + /* Use the conversion type to determine buffer-file-type + (find-buffer-file-type is now used to help determine the + conversion). */ + if ((coding.eol_type == CODING_EOL_UNDECIDED + || coding.eol_type == CODING_EOL_LF) + && ! CODING_REQUIRE_DECODING (&coding)) + current_buffer->buffer_file_type = Qt; + else + current_buffer->buffer_file_type = Qnil; +#endif - notfound: handled: if (!NILP (visit)) @@ -3656,7 +4408,7 @@ This does code conversion according to the value of\n\ if (NILP (handler)) { current_buffer->modtime = st.st_mtime; - current_buffer->filename = filename; + current_buffer->filename = orig_filename; } SAVE_MODIFF = MODIFF; @@ -3673,57 +4425,79 @@ This does code conversion according to the value of\n\ if (not_regular) Fsignal (Qfile_error, Fcons (build_string ("not a regular file"), - Fcons (filename, Qnil))); - - /* If visiting nonexistent file, return nil. */ - if (current_buffer->modtime == -1) - report_file_error ("Opening input file", Fcons (filename, Qnil)); + Fcons (orig_filename, Qnil))); } /* Decode file format */ if (inserted > 0) { + int empty_undo_list_p = 0; + + /* If we're anyway going to discard undo information, don't + record it in the first place. The buffer's undo list at this + point is either nil or t when visiting a file. */ + if (!NILP (visit)) + { + empty_undo_list_p = NILP (current_buffer->undo_list); + current_buffer->undo_list = Qt; + } + insval = call3 (Qformat_decode, Qnil, make_number (inserted), visit); CHECK_NUMBER (insval, 0); inserted = XFASTINT (insval); + + if (!NILP (visit)) + current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt; } + if (set_coding_system) + Vlast_coding_system_used = coding.symbol; + /* Call after-change hooks for the inserted text, aside from the case of normal visiting (not with REPLACE), which is done in a new buffer "before" the buffer is changed. */ if (inserted > 0 && total > 0 && (NILP (visit) || !NILP (replace))) - signal_after_change (PT, 0, inserted); - - if (inserted > 0) { - p = Vafter_insert_file_functions; - if (!NILP (coding.post_read_conversion)) - p = Fcons (coding.post_read_conversion, p); + signal_after_change (PT, 0, inserted); + update_compositions (PT, PT, CHECK_BORDER); + } - while (!NILP (p)) + p = Vafter_insert_file_functions; + while (!NILP (p)) + { + insval = call1 (Fcar (p), make_number (inserted)); + if (!NILP (insval)) { - insval = call1 (Fcar (p), make_number (inserted)); - if (!NILP (insval)) - { - CHECK_NUMBER (insval, 0); - inserted = XFASTINT (insval); - } - QUIT; - p = Fcdr (p); + CHECK_NUMBER (insval, 0); + inserted = XFASTINT (insval); } + QUIT; + p = Fcdr (p); } + if (!NILP (visit) + && current_buffer->modtime == -1) + { + /* If visiting nonexistent file, return nil. */ + report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); + } + + if (read_quit) + Fsignal (Qquit, Qnil); + + /* ??? Retval needs to be dealt with in all cases consistently. */ if (NILP (val)) - val = Fcons (filename, + val = Fcons (orig_filename, Fcons (make_number (inserted), Qnil)); RETURN_UNGCPRO (unbind_to (count, val)); } -static Lisp_Object build_annotations (); +static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object, + Lisp_Object)); /* If build_annotations switched buffers, switch back to BUF. Kill the temporary buffer that was selected in the meantime. @@ -3746,13 +4520,14 @@ build_annotations_unwind (buf) return Qnil; } -DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6, - "r\nFWrite region to file: ", +DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7, + "r\nFWrite region to file: \ni\ni\ni\np", "Write current region into specified file.\n\ When called from a program, takes three arguments:\n\ START, END and FILENAME. START and END are buffer positions.\n\ Optional fourth argument APPEND if non-nil means\n\ - append to existing file contents (if any).\n\ + append to existing file contents (if any). If it is an integer,\n\ + seek to that offset in the file before writing.\n\ Optional fifth argument VISIT if t means\n\ set the last-save-file-modtime of buffer to this file's modtime\n\ and mark buffer not modified.\n\ @@ -3763,17 +4538,26 @@ If VISIT is neither t nor nil nor a string,\n\ that means do not print the \"Wrote file\" message.\n\ The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\ use for locking and unlocking, overriding FILENAME and VISIT.\n\ +The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\ + for an existing file with the same name. If MUSTBENEW is `excl',\n\ + that means to get an error if the file already exists; never overwrite.\n\ + If MUSTBENEW is neither nil nor `excl', that means ask for\n\ + confirmation before overwriting, but do go ahead and overwrite the file\n\ + if the user confirms.\n\ Kludgy feature: if START is a string, then that string is written\n\ to the file, instead of any buffer contents, and END is ignored.\n\ +\n\ This does code conversion according to the value of\n\ - `coding-system-for-write' or `coding-system-alist', and sets the variable\n\ - `last-coding-system-used' to the coding system actually used.") - (start, end, filename, append, visit, lockname) - Lisp_Object start, end, filename, append, visit, lockname; +`coding-system-for-write', `buffer-file-coding-system', or\n\ +`file-coding-system-alist', and sets the variable\n\ +`last-coding-system-used' to the coding system actually used.") + + (start, end, filename, append, visit, lockname, mustbenew) + Lisp_Object start, end, filename, append, visit, lockname, mustbenew; { register int desc; int failure; - int save_errno; + int save_errno = 0; unsigned char *fn; struct stat st; int tem; @@ -3785,32 +4569,128 @@ This does code conversion according to the value of\n\ Lisp_Object handler; Lisp_Object visit_file; Lisp_Object annotations; - int visiting, quietly; + Lisp_Object encoded_filename; + int visiting = (EQ (visit, Qt) || STRINGP (visit)); + int quietly = !NILP (visit); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct buffer *given_buffer; #ifdef DOS_NT - int buffer_file_type - = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; + int buffer_file_type = O_BINARY; #endif /* DOS_NT */ struct coding_system coding; - if (current_buffer->base_buffer && ! NILP (visit)) + if (current_buffer->base_buffer && visiting) error ("Cannot do file visiting in an indirect buffer"); if (!NILP (start) && !STRINGP (start)) validate_region (&start, &end); GCPRO4 (start, filename, visit, lockname); + + /* Decide the coding-system to encode the data with. */ + { + Lisp_Object val; + + if (auto_saving) + val = Qnil; + else if (!NILP (Vcoding_system_for_write)) + val = Vcoding_system_for_write; + else + { + /* If the variable `buffer-file-coding-system' is set locally, + it means that the file was read with some kind of code + conversion or the variable is explicitly set by users. We + had better write it out with the same coding system even if + `enable-multibyte-characters' is nil. + + If it is not set locally, we anyway have to convert EOL + format if the default value of `buffer-file-coding-system' + tells that it is not Unix-like (LF only) format. */ + int using_default_coding = 0; + int force_raw_text = 0; + + val = current_buffer->buffer_file_coding_system; + if (NILP (val) + || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) + { + val = Qnil; + if (NILP (current_buffer->enable_multibyte_characters)) + force_raw_text = 1; + } + + if (NILP (val)) + { + /* Check file-coding-system-alist. */ + Lisp_Object args[7], coding_systems; + + args[0] = Qwrite_region; args[1] = start; args[2] = end; + args[3] = filename; args[4] = append; args[5] = visit; + args[6] = lockname; + coding_systems = Ffind_operation_coding_system (7, args); + if (CONSP (coding_systems) && !NILP (XCDR (coding_systems))) + val = XCDR (coding_systems); + } + + if (NILP (val) + && !NILP (current_buffer->buffer_file_coding_system)) + { + /* If we still have not decided a coding system, use the + default value of buffer-file-coding-system. */ + val = current_buffer->buffer_file_coding_system; + using_default_coding = 1; + } + + if (!force_raw_text + && !NILP (Ffboundp (Vselect_safe_coding_system_function))) + /* Confirm that VAL can surely encode the current region. */ + val = call3 (Vselect_safe_coding_system_function, start, end, val); + + setup_coding_system (Fcheck_coding_system (val), &coding); + if (coding.eol_type == CODING_EOL_UNDECIDED + && !using_default_coding) + { + if (! EQ (default_buffer_file_coding.symbol, + buffer_defaults.buffer_file_coding_system)) + setup_coding_system (buffer_defaults.buffer_file_coding_system, + &default_buffer_file_coding); + if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED) + { + Lisp_Object subsidiaries; + + coding.eol_type = default_buffer_file_coding.eol_type; + subsidiaries = Fget (coding.symbol, Qeol_type); + if (VECTORP (subsidiaries) + && XVECTOR (subsidiaries)->size == 3) + coding.symbol + = XVECTOR (subsidiaries)->contents[coding.eol_type]; + } + } + + if (force_raw_text) + setup_raw_text_coding_system (&coding); + goto done_setup_coding; + } + + setup_coding_system (Fcheck_coding_system (val), &coding); + + done_setup_coding: + if (!STRINGP (start) && !NILP (current_buffer->selective_display)) + coding.mode |= CODING_MODE_SELECTIVE_DISPLAY; + } + + Vlast_coding_system_used = coding.symbol; + filename = Fexpand_file_name (filename, Qnil); + + if (! NILP (mustbenew) && !EQ (mustbenew, Qexcl)) + barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1); + if (STRINGP (visit)) visit_file = Fexpand_file_name (visit, Qnil); else visit_file = filename; UNGCPRO; - visiting = (EQ (visit, Qt) || STRINGP (visit)); - quietly = !NILP (visit); - annotations = Qnil; if (NILP (lockname)) @@ -3841,38 +4721,6 @@ This does code conversion according to the value of\n\ return val; } - /* Decide the coding-system to be encoded to. */ - { - Lisp_Object val; - - if (auto_saving || NILP (current_buffer->enable_multibyte_characters)) - val = Qnil; - else if (!NILP (Vcoding_system_for_write)) - val = Vcoding_system_for_write; - else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system, - Qnil))) - val = Fsymbol_value (Qbuffer_file_coding_system); - else - { - Lisp_Object args[7], coding_systems; - - args[0] = Qwrite_region, args[1] = start, args[2] = end, - args[3] = filename, args[4] = append, args[5] = visit, - args[6] = lockname; - coding_systems = Ffind_coding_system (7, args); - val = (CONSP (coding_systems) - ? XCONS (coding_systems)->cdr - : Fsymbol_value (Qbuffer_file_coding_system)); - } - setup_coding_system (Fcheck_coding_system (val), &coding); - if (!STRINGP (start) && !NILP (current_buffer->selective_display)) - coding.selective = 1; -#ifdef DOS_NT - if (!NILP (current_buffer->buffer_file_type)) - coding.eol_type = CODING_EOL_LF; -#endif /* DOS_NT */ - } - /* Special kludge to simplify auto-saving. */ if (NILP (start)) { @@ -3887,37 +4735,41 @@ This does code conversion according to the value of\n\ annotations = build_annotations (start, end, coding.pre_write_conversion); if (current_buffer != given_buffer) { - start = BEGV; - end = ZV; + XSETFASTINT (start, BEGV); + XSETFASTINT (end, ZV); } #ifdef CLASH_DETECTION if (!auto_saving) { +#if 0 /* This causes trouble for GNUS. */ /* If we've locked this file for some other buffer, query before proceeding. */ if (!visiting && EQ (Ffile_locked_p (lockname), Qt)) - call2 (intern ("ask-user-about-lock"), fn, Vuser_login_name); + call2 (intern ("ask-user-about-lock"), filename, Vuser_login_name); +#endif lock_file (lockname); } #endif /* CLASH_DETECTION */ - fn = XSTRING (filename)->data; + encoded_filename = ENCODE_FILE (filename); + + fn = XSTRING (encoded_filename)->data; desc = -1; if (!NILP (append)) #ifdef DOS_NT - desc = open (fn, O_WRONLY | buffer_file_type); + desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0); #else /* not DOS_NT */ - desc = open (fn, O_WRONLY); + desc = emacs_open (fn, O_WRONLY, 0); #endif /* not DOS_NT */ - if (desc < 0 && (NILP (append) || errno == ENOENT) ) + if (desc < 0 && (NILP (append) || errno == ENOENT)) #ifdef VMS if (auto_saving) /* Overwrite any previous version of autosave file */ { vms_truncate (fn); /* if fn exists, truncate to zero length */ - desc = open (fn, O_RDWR); + desc = emacs_open (fn, O_RDWR, 0); if (desc < 0) desc = creat_copy_attrs (STRINGP (current_buffer->filename) ? XSTRING (current_buffer->filename)->data : 0, @@ -3950,7 +4802,7 @@ This does code conversion according to the value of\n\ /* We can't make a new version; try to truncate and rewrite existing version if any. */ vms_truncate (fn); - desc = open (fn, O_RDWR); + desc = emacs_open (fn, O_RDWR, 0); } #endif } @@ -3960,16 +4812,17 @@ This does code conversion according to the value of\n\ } #else /* not VMS */ #ifdef DOS_NT - desc = open (fn, - O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, - S_IREAD | S_IWRITE); + desc = emacs_open (fn, + O_WRONLY | O_CREAT | buffer_file_type + | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC), + S_IREAD | S_IWRITE); #else /* not DOS_NT */ - desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); + desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT + | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + auto_saving ? auto_save_mode_bits : 0666); #endif /* not DOS_NT */ #endif /* not VMS */ - UNGCPRO; - if (desc < 0) { #ifdef CLASH_DETECTION @@ -3977,19 +4830,31 @@ This does code conversion according to the value of\n\ if (!auto_saving) unlock_file (lockname); errno = save_errno; #endif /* CLASH_DETECTION */ + UNGCPRO; report_file_error ("Opening output file", Fcons (filename, Qnil)); } record_unwind_protect (close_file_unwind, make_number (desc)); - if (!NILP (append)) - if (lseek (desc, 0, 2) < 0) - { + if (!NILP (append) && !NILP (Ffile_regular_p (filename))) + { + long ret; + + if (NUMBERP (append)) + ret = lseek (desc, XINT (append), 1); + else + ret = lseek (desc, 0, 2); + if (ret < 0) + { #ifdef CLASH_DETECTION - if (!auto_saving) unlock_file (lockname); + if (!auto_saving) unlock_file (lockname); #endif /* CLASH_DETECTION */ - report_file_error ("Lseek error", Fcons (filename, Qnil)); - } + UNGCPRO; + report_file_error ("Lseek error", Fcons (filename, Qnil)); + } + } + + UNGCPRO; #ifdef VMS /* @@ -4009,6 +4874,19 @@ This does code conversion according to the value of\n\ */ if (GPT > BEG && GPT_ADDR[-1] != '\n') move_gap (find_next_newline (GPT, 1)); +#else + /* Whether VMS or not, we must move the gap to the next of newline + when we must put designation sequences at beginning of line. */ + if (INTEGERP (start) + && coding.type == coding_type_iso2022 + && coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL + && GPT > BEG && GPT_ADDR[-1] != '\n') + { + int opoint = PT, opoint_byte = PT_BYTE; + scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0); + move_gap_both (PT, PT_BYTE); + SET_PT_BOTH (opoint, opoint_byte); + } #endif failure = 0; @@ -4016,46 +4894,45 @@ This does code conversion according to the value of\n\ if (STRINGP (start)) { - failure = 0 > a_write (desc, XSTRING (start)->data, - XSTRING (start)->size, 0, &annotations, &coding); + failure = 0 > a_write (desc, start, 0, XSTRING (start)->size, + &annotations, &coding); save_errno = errno; } else if (XINT (start) != XINT (end)) { - int nwritten = 0; + tem = CHAR_TO_BYTE (XINT (start)); + if (XINT (start) < GPT) { - register int end1 = XINT (end); - tem = XINT (start); - failure = 0 > a_write (desc, POS_ADDR (tem), - min (GPT, end1) - tem, tem, &annotations, - &coding); - nwritten += min (GPT, end1) - tem; + failure = 0 > a_write (desc, Qnil, XINT (start), + min (GPT, XINT (end)) - XINT (start), + &annotations, &coding); save_errno = errno; } if (XINT (end) > GPT && !failure) { - tem = XINT (start); - tem = max (tem, GPT); - failure = 0 > a_write (desc, POS_ADDR (tem), XINT (end) - tem, - tem, &annotations, &coding); - nwritten += XINT (end) - tem; + tem = max (XINT (start), GPT); + failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem, + &annotations, &coding); save_errno = errno; } } else { /* If file was empty, still need to write the annotations */ - failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding); + coding.mode |= CODING_MODE_LAST_BLOCK; + failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding); save_errno = errno; } - if (coding.require_flushing) + if (CODING_REQUIRE_FLUSHING (&coding) + && !(coding.mode & CODING_MODE_LAST_BLOCK) + && ! failure) { /* We have to flush out a data. */ - coding.last_block = 1; - failure = 0 > e_write (desc, "", 0, &coding); + coding.mode |= CODING_MODE_LAST_BLOCK; + failure = 0 > e_write (desc, Qnil, 0, 0, &coding); save_errno = errno; } @@ -4094,7 +4971,7 @@ This does code conversion according to the value of\n\ #endif /* NFS can report a write failure now. */ - if (close (desc) < 0) + if (emacs_close (desc) < 0) failure = 1, save_errno = errno; #ifdef VMS @@ -4127,7 +5004,8 @@ This does code conversion according to the value of\n\ current_buffer->modtime = st.st_mtime; if (failure) - error ("IO error writing %s: %s", fn, strerror (save_errno)); + error ("IO error writing %s: %s", XSTRING (filename)->data, + emacs_strerror (save_errno)); if (visiting) { @@ -4140,11 +5018,11 @@ This does code conversion according to the value of\n\ return Qnil; if (!auto_saving) - message ("Wrote %s", XSTRING (visit_file)->data); + message_with_string ("Wrote %s", visit_file, 1); return Qnil; } - + Lisp_Object merge (); DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, @@ -4171,6 +5049,7 @@ build_annotations (start, end, pre_write_conversion) Lisp_Object p, res; struct gcpro gcpro1, gcpro2; Lisp_Object original_buffer; + int i; XSETBUFFER (original_buffer, current_buffer); @@ -4189,8 +5068,8 @@ build_annotations (start, end, pre_write_conversion) been dealt with by this function. */ if (current_buffer != given_buffer) { - start = BEGV; - end = ZV; + XSETFASTINT (start, BEGV); + XSETFASTINT (end, ZV); annotations = Qnil; } Flength (res); /* Check basic validity of return value */ @@ -4203,21 +5082,26 @@ build_annotations (start, end, pre_write_conversion) p = Vauto_save_file_format; else p = current_buffer->file_format; - while (!NILP (p)) + for (i = 0; !NILP (p); p = Fcdr (p), ++i) { struct buffer *given_buffer = current_buffer; + Vwrite_region_annotations_so_far = annotations; - res = call4 (Qformat_annotate_function, Fcar (p), start, end, - original_buffer); + + /* Value is either a list of annotations or nil if the function + has written annotations to a temporary buffer, which is now + current. */ + res = call5 (Qformat_annotate_function, Fcar (p), start, end, + original_buffer, make_number (i)); if (current_buffer != given_buffer) { - start = BEGV; - end = ZV; + XSETFASTINT (start, BEGV); + XSETFASTINT (end, ZV); annotations = Qnil; } - Flength (res); - annotations = merge (annotations, res, Qcar_less_than_car); - p = Fcdr (p); + + if (CONSP (res)) + annotations = merge (annotations, res, Qcar_less_than_car); } /* At last, do the same for the function PRE_WRITE_CONVERSION @@ -4227,107 +5111,160 @@ build_annotations (start, end, pre_write_conversion) struct buffer *given_buffer = current_buffer; Vwrite_region_annotations_so_far = annotations; res = call2 (pre_write_conversion, start, end); - if (current_buffer != given_buffer) - { - start = BEGV; - end = ZV; - annotations = Qnil; - } Flength (res); - annotations = merge (annotations, res, Qcar_less_than_car); + annotations = (current_buffer != given_buffer + ? res + : merge (annotations, res, Qcar_less_than_car)); } UNGCPRO; return annotations; } - -/* Write to descriptor DESC the LEN characters starting at ADDR, - assuming they start at position POS in the buffer. + +/* Write to descriptor DESC the NCHARS chars starting at POS of STRING. + If STRING is nil, POS is the character position in the current buffer. Intersperse with them the annotations from *ANNOT - (those which fall within the range of positions POS to POS + LEN), + which fall within the range of POS to POS + NCHARS, each at its appropriate position. - Modify *ANNOT by discarding elements as we output them. + We modify *ANNOT by discarding elements as we use them up. + The return value is negative in case of system call failure. */ -int -a_write (desc, addr, len, pos, annot, coding) +static int +a_write (desc, string, pos, nchars, annot, coding) int desc; - register char *addr; - register int len; + Lisp_Object string; + register int nchars; int pos; Lisp_Object *annot; struct coding_system *coding; { Lisp_Object tem; int nextpos; - int lastpos = pos + len; + int lastpos = pos + nchars; while (NILP (*annot) || CONSP (*annot)) { tem = Fcar_safe (Fcar (*annot)); - if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) + nextpos = pos - 1; + if (INTEGERP (tem)) nextpos = XFASTINT (tem); - else - return e_write (desc, addr, lastpos - pos, coding); + + /* If there are no more annotations in this range, + output the rest of the range all at once. */ + if (! (nextpos >= pos && nextpos <= lastpos)) + return e_write (desc, string, pos, lastpos, coding); + + /* Output buffer text up to the next annotation's position. */ if (nextpos > pos) { - if (0 > e_write (desc, addr, nextpos - pos, coding)) + if (0 > e_write (desc, string, pos, nextpos, coding)) return -1; - addr += nextpos - pos; pos = nextpos; } + /* Output the annotation. */ tem = Fcdr (Fcar (*annot)); if (STRINGP (tem)) { - if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size, - coding)) + if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding)) return -1; } *annot = Fcdr (*annot); } + return 0; } #ifndef WRITE_BUF_SIZE #define WRITE_BUF_SIZE (16 * 1024) #endif -int -e_write (desc, addr, len, coding) +/* Write text in the range START and END into descriptor DESC, + encoding them with coding system CODING. If STRING is nil, START + and END are character positions of the current buffer, else they + are indexes to the string STRING. */ + +static int +e_write (desc, string, start, end, coding) int desc; - register char *addr; - register int len; + Lisp_Object string; + int start, end; struct coding_system *coding; { + register char *addr; + register int nbytes; char buf[WRITE_BUF_SIZE]; - int produced, consumed; + int return_val = 0; + + if (start >= end) + coding->composing = COMPOSITION_DISABLED; + if (coding->composing != COMPOSITION_DISABLED) + coding_save_composition (coding, start, end, string); + + if (STRINGP (string)) + { + addr = XSTRING (string)->data; + nbytes = STRING_BYTES (XSTRING (string)); + coding->src_multibyte = STRING_MULTIBYTE (string); + } + else if (start < end) + { + /* It is assured that the gap is not in the range START and END-1. */ + addr = CHAR_POS_ADDR (start); + nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start); + coding->src_multibyte + = !NILP (current_buffer->enable_multibyte_characters); + } + else + { + addr = ""; + nbytes = 0; + coding->src_multibyte = 1; + } /* We used to have a code for handling selective display here. But, now it is handled within encode_coding. */ while (1) { - produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE, - &consumed); - len -= consumed, addr += consumed; - if (produced == 0 && len > 0) + int result; + + result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE); + if (coding->produced > 0) { - /* There was a carry over because of invalid codes in the source. - We just write out them as is. */ - bcopy (addr, buf, len); - produced = len; - len = 0; + coding->produced -= emacs_write (desc, buf, coding->produced); + if (coding->produced) + { + return_val = -1; + break; + } } - if (produced > 0) + nbytes -= coding->consumed; + addr += coding->consumed; + if (result == CODING_FINISH_INSUFFICIENT_SRC + && nbytes > 0) { - produced -= write (desc, buf, produced); - if (produced) return -1; + /* The source text ends by an incomplete multibyte form. + There's no way other than write it out as is. */ + nbytes -= emacs_write (desc, addr, nbytes); + if (nbytes) + { + return_val = -1; + break; + } } - if (len <= 0) + if (nbytes <= 0) break; + start += coding->consumed_char; + if (coding->cmp_data) + coding_adjust_composition_offset (coding, start); } - return 0; -} + if (coding->cmp_data) + coding_free_composition_data (coding); + + return return_val; +} + DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, Sverify_visited_file_modtime, 1, 1, 0, "Return t if last mod time of BUF's visited file matches what BUF records.\n\ @@ -4338,6 +5275,7 @@ This means that the file has not been changed since it was visited or saved.") struct buffer *b; struct stat st; Lisp_Object handler; + Lisp_Object filename; CHECK_BUFFER (buf, 0); b = XBUFFER (buf); @@ -4352,7 +5290,9 @@ This means that the file has not been changed since it was visited or saved.") if (!NILP (handler)) return call2 (handler, Qverify_visited_file_modtime, buf); - if (stat (XSTRING (b->filename)->data, &st) < 0) + filename = ENCODE_FILE (b->filename); + + if (stat (XSTRING (filename)->data, &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. */ @@ -4417,7 +5357,10 @@ An argument specifies the modification time value to use\n\ 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 (XSTRING (filename)->data, &st) >= 0) + + filename = ENCODE_FILE (filename); + + if (stat (XSTRING (filename)->data, &st) >= 0) current_buffer->modtime = st.st_mtime; } @@ -4425,26 +5368,43 @@ An argument specifies the modification time value to use\n\ } Lisp_Object -auto_save_error () +auto_save_error (error) + Lisp_Object error; { + Lisp_Object args[3], msg; + int i, nbytes; + struct gcpro gcpro1; + ring_bell (); - message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); - Fsleep_for (make_number (1), Qnil); - message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data); - Fsleep_for (make_number (1), Qnil); - message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); - Fsleep_for (make_number (1), Qnil); + + args[0] = build_string ("Auto-saving %s: %s"); + args[1] = current_buffer->name; + args[2] = Ferror_message_string (error); + msg = Fformat (3, args); + GCPRO1 (msg); + nbytes = STRING_BYTES (XSTRING (msg)); + + for (i = 0; i < 3; ++i) + { + if (i == 0) + message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg)); + else + message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg)); + Fsleep_for (make_number (1), Qnil); + } + + UNGCPRO; return Qnil; } Lisp_Object auto_save_1 () { - unsigned char *fn; struct stat st; /* Get visited file's mode to become the auto save file's mode. */ - if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0) + if (! NILP (current_buffer->filename) + && stat (XSTRING (current_buffer->filename)->data, &st) >= 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = st.st_mode | 0600; else @@ -4453,16 +5413,26 @@ auto_save_1 () return Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, - Qnil, Qlambda, Qnil); + Qnil, Qlambda, Qnil, Qnil); } static Lisp_Object -do_auto_save_unwind (desc) /* used as unwind-protect function */ - Lisp_Object desc; +do_auto_save_unwind (stream) /* used as unwind-protect function */ + Lisp_Object stream; { auto_saving = 0; - if (XINT (desc) >= 0) - close (XINT (desc)); + if (!NILP (stream)) + fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 + | XFASTINT (XCDR (stream)))); + pop_message (); + return Qnil; +} + +static Lisp_Object +do_auto_save_unwind_1 (value) /* used as unwind-protect function */ + Lisp_Object value; +{ + minibuffer_auto_raise = XINT (value); return Qnil; } @@ -4482,14 +5452,14 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") struct buffer *old = current_buffer, *b; Lisp_Object tail, buf; int auto_saved = 0; - char *omessage = echo_area_glyphs; - int omessage_length = echo_area_glyphs_length; int do_handled_files; Lisp_Object oquit; - int listdesc; + FILE *stream; + Lisp_Object lispstream; int count = specpdl_ptr - specpdl; - int *ptr; - + int orig_minibuffer_auto_raise = minibuffer_auto_raise; + int message_p = push_message (); + /* Ordinarily don't quit within this function, but don't make it impossible to quit (in case we get hung in I/O). */ oquit = Vquit_flag; @@ -4507,22 +5477,42 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") if (STRINGP (Vauto_save_list_file_name)) { Lisp_Object listfile; + listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); -#ifdef DOS_NT - listdesc = open (XSTRING (listfile)->data, - O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, - S_IREAD | S_IWRITE); -#else /* not DOS_NT */ - listdesc = creat (XSTRING (listfile)->data, 0666); -#endif /* not DOS_NT */ + + /* Don't try to create the directory when shutting down Emacs, + because creating the directory might signal an error, and + that would leave Emacs in a strange state. */ + if (!NILP (Vrun_hooks)) + { + Lisp_Object dir; + dir = Ffile_name_directory (listfile); + if (NILP (Ffile_directory_p (dir))) + call2 (Qmake_directory, dir, Qt); + } + + stream = fopen (XSTRING (listfile)->data, "w"); + if (stream != NULL) + { + /* Arrange to close that file whether or not we get an error. + Also reset auto_saving to 0. */ + lispstream = Fcons (Qnil, Qnil); + XSETFASTINT (XCAR (lispstream), (EMACS_UINT)stream >> 16); + XSETFASTINT (XCDR (lispstream), (EMACS_UINT)stream & 0xffff); + } + else + lispstream = Qnil; } 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)); + { + stream = NULL; + lispstream = Qnil; + } + record_unwind_protect (do_auto_save_unwind, lispstream); + record_unwind_protect (do_auto_save_unwind_1, + make_number (minibuffer_auto_raise)); + minibuffer_auto_raise = 0; auto_saving = 1; /* First, save all files which don't have handlers. If Emacs is @@ -4531,26 +5521,26 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") autosave perfectly ordinary files because it couldn't handle some ange-ftp'd file. */ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) - for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) { - buf = XCONS (XCONS (tail)->car)->cdr; + buf = XCDR (XCAR (tail)); 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. */ if (STRINGP (b->auto_save_file_name) - && listdesc >= 0 && do_handled_files == 0) + && stream != NULL && do_handled_files == 0) { if (!NILP (b->filename)) { - write (listdesc, XSTRING (b->filename)->data, - XSTRING (b->filename)->size); + fwrite (XSTRING (b->filename)->data, 1, + STRING_BYTES (XSTRING (b->filename)), stream); } - write (listdesc, "\n", 1); - write (listdesc, XSTRING (b->auto_save_file_name)->data, - XSTRING (b->auto_save_file_name)->size); - write (listdesc, "\n", 1); + putc ('\n', stream); + fwrite (XSTRING (b->auto_save_file_name)->data, 1, + STRING_BYTES (XSTRING (b->auto_save_file_name)), stream); + putc ('\n', stream); } if (!NILP (current_only) @@ -4593,8 +5583,10 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") && NILP (no_message)) { /* It has shrunk too much; turn off auto-saving here. */ - message ("Buffer %s has shrunk a lot; auto save turned off there", - XSTRING (b->name)->data); + minibuffer_auto_raise = orig_minibuffer_auto_raise; + message_with_string ("Buffer %s has shrunk a lot; auto save turned off there", + b->name, 1); + minibuffer_auto_raise = 0; /* Turn off auto-saving until there's a real save, and prevent any more warnings. */ XSETINT (b->save_length, -1); @@ -4624,10 +5616,10 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") if (auto_saved && NILP (no_message)) { - if (omessage) + if (message_p) { - sit_for (1, 0, 0, 0); - message2 (omessage, omessage_length); + sit_for (1, 0, 0, 0, 0); + restore_message (); } else message1 ("Auto-saving...done"); @@ -4681,14 +5673,16 @@ double_dollars (val) register int n; int osize, count; - osize = XSTRING (val)->size; - /* Quote "$" as "$$" to get it past substitute-in-file-name */ + osize = STRING_BYTES (XSTRING (val)); + + /* Count the number of $ characters. */ for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) if (*old++ == '$') count++; if (count > 0) { old = XSTRING (val)->data; - val = Fmake_string (make_number (osize + count), make_number (0)); + val = make_uninit_multibyte_string (XSTRING (val)->size + count, + osize + count); new = XSTRING (val)->data; for (n = osize; n > 0; n--) if (*old != '$') @@ -4787,13 +5781,19 @@ Default name to DEFAULT-FILENAME if user enters a null string.\n\ Fourth arg MUSTMATCH non-nil means require existing file's name.\n\ Non-nil and non-t means also require confirmation after completion.\n\ Fifth arg INITIAL specifies text to start with.\n\ -DIR defaults to current buffer's directory default.") +DIR defaults to current buffer's directory default.\n\ +\n\ +If this command was invoked with the mouse, use a file dialog box if\n\ +`use-dialog-box' is non-nil, and the window system or X toolkit in use\n\ +provides a file dialog box..") (prompt, dir, default_filename, mustmatch, initial) Lisp_Object prompt, dir, default_filename, mustmatch, initial; { - Lisp_Object val, insdef, insdef1, tem; + Lisp_Object val, insdef, tem; struct gcpro gcpro1, gcpro2; register char *homedir; + int replace_in_history = 0; + int add_to_history = 0; int count; if (NILP (dir)) @@ -4809,8 +5809,13 @@ 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); + /* homedir can be NULL in temacs, since Vprocess_environment is not + yet set up. We shouldn't crash in that case. */ + if (homedir != 0) + { + homedir = strcpy (alloca (strlen (homedir) + 1), homedir); + CORRECT_DIR_SEPS (homedir); + } #endif if (homedir != 0 && STRINGP (dir) @@ -4818,9 +5823,25 @@ DIR defaults to current buffer's directory default.") && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)])) { dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, - XSTRING (dir)->size - strlen (homedir) + 1); + STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1); XSTRING (dir)->data[0] = '~'; } + /* Likewise for default_filename. */ + if (homedir != 0 + && STRINGP (default_filename) + && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir)) + && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)])) + { + default_filename + = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1, + STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1); + XSTRING (default_filename)->data[0] = '~'; + } + if (!NILP (default_filename)) + { + CHECK_STRING (default_filename, 3); + default_filename = double_dollars (default_filename); + } if (insert_default_directory && STRINGP (dir)) { @@ -4833,111 +5854,114 @@ DIR defaults to current buffer's directory default.") args[1] = initial; insdef = Fconcat (2, args); pos = make_number (XSTRING (double_dollars (dir))->size); - insdef1 = Fcons (double_dollars (insdef), pos); + insdef = Fcons (double_dollars (insdef), pos); } else - insdef1 = double_dollars (insdef); + insdef = double_dollars (insdef); } else if (STRINGP (initial)) - { - insdef = initial; - insdef1 = Fcons (double_dollars (insdef), 0); - } + insdef = Fcons (double_dollars (initial), make_number (0)); else - insdef = Qnil, insdef1 = Qnil; + insdef = Qnil; -#ifdef VMS count = specpdl_ptr - specpdl; +#ifdef VMS specbind (intern ("completion-ignore-case"), Qt); #endif - GCPRO2 (insdef, default_filename); - val = Fcompleting_read (prompt, intern ("read-file-name-internal"), - dir, mustmatch, insdef1, - Qfile_name_history); + specbind (intern ("minibuffer-completing-file-name"), Qt); -#ifdef VMS - unbind_to (count, Qnil); + GCPRO2 (insdef, default_filename); + +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) + if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) + && use_dialog_box + && have_menus_p ()) + { + /* If DIR contains a file name, split it. */ + Lisp_Object file; + file = Ffile_name_nondirectory (dir); + if (XSTRING (file)->size && NILP (default_filename)) + { + default_filename = file; + dir = Ffile_name_directory (dir); + } + if (!NILP(default_filename)) + default_filename = Fexpand_file_name (default_filename, dir); + val = Fx_file_dialog (prompt, dir, default_filename, mustmatch); + add_to_history = 1; + } + else #endif + val = Fcompleting_read (prompt, intern ("read-file-name-internal"), + dir, mustmatch, insdef, + Qfile_name_history, default_filename, Qnil); + + tem = Fsymbol_value (Qfile_name_history); + if (CONSP (tem) && EQ (XCAR (tem), val)) + replace_in_history = 1; + + /* If Fcompleting_read returned the inserted default string itself + (rather than a new string with the same contents), + it has to mean that the user typed RET with the minibuffer empty. + In that case, we really want to return "" + so that commands such as set-visited-file-name can distinguish. */ + if (EQ (val, default_filename)) + { + /* In this case, Fcompleting_read has not added an element + to the history. Maybe we should. */ + if (! replace_in_history) + add_to_history = 1; + + val = build_string (""); + } + unbind_to (count, Qnil); UNGCPRO; if (NILP (val)) error ("No file name specified"); - tem = Fstring_equal (val, insdef); + + tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef); + if (!NILP (tem) && !NILP (default_filename)) - return default_filename; - if (XSTRING (val)->size == 0 && NILP (insdef)) + val = default_filename; + else if (XSTRING (val)->size == 0 && NILP (insdef)) { if (!NILP (default_filename)) - return default_filename; + val = default_filename; else error ("No default file name"); } - return Fsubstitute_in_file_name (val); -} + val = Fsubstitute_in_file_name (val); -#if 0 /* Old version */ -DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (prompt, dir, defalt, mustmatch, initial) - Lisp_Object prompt, dir, defalt, mustmatch, initial; -{ - Lisp_Object val, insdef, tem; - struct gcpro gcpro1, gcpro2; - register char *homedir; - int count; - - if (NILP (dir)) - dir = current_buffer->directory; - if (NILP (defalt)) - defalt = current_buffer->filename; - - /* If dir starts with user's homedir, change that to ~. */ - homedir = (char *) egetenv ("HOME"); - if (homedir != 0 - && STRINGP (dir) - && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) - && XSTRING (dir)->data[strlen (homedir)] == '/') + if (replace_in_history) + /* Replace what Fcompleting_read added to the history + with what we will actually return. */ + XCAR (Fsymbol_value (Qfile_name_history)) = double_dollars (val); + else if (add_to_history) { - dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, - XSTRING (dir)->size - strlen (homedir) + 1); - XSTRING (dir)->data[0] = '~'; + /* Add the value to the history--but not if it matches + the last value already there. */ + Lisp_Object val1 = double_dollars (val); + tem = Fsymbol_value (Qfile_name_history); + if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1))) + Fset (Qfile_name_history, + Fcons (val1, tem)); } + + return val; +} - if (!NILP (initial)) - insdef = initial; - else if (insert_default_directory) - insdef = dir; - else - insdef = build_string (""); - -#ifdef VMS - count = specpdl_ptr - specpdl; - specbind (intern ("completion-ignore-case"), Qt); -#endif - - GCPRO2 (insdef, defalt); - val = Fcompleting_read (prompt, intern ("read-file-name-internal"), - dir, mustmatch, - insert_default_directory ? insdef : Qnil, - Qfile_name_history); - -#ifdef VMS - unbind_to (count, Qnil); -#endif - - UNGCPRO; - if (NILP (val)) - error ("No file name specified"); - tem = Fstring_equal (val, insdef); - if (!NILP (tem) && !NILP (defalt)) - return defalt; - return Fsubstitute_in_file_name (val); + +void +init_fileio_once () +{ + /* Must be set before any path manipulation is performed. */ + XSETFASTINT (Vdirectory_sep_char, '/'); } -#endif /* Old version */ + +void syms_of_fileio () { Qexpand_file_name = intern ("expand-file-name"); @@ -4949,6 +5973,7 @@ syms_of_fileio () Qfile_name_as_directory = intern ("file-name-as-directory"); Qcopy_file = intern ("copy-file"); Qmake_directory_internal = intern ("make-directory-internal"); + Qmake_directory = intern ("make-directory"); Qdelete_directory = intern ("delete-directory"); Qdelete_file = intern ("delete-file"); Qrename_file = intern ("rename-file"); @@ -4980,6 +6005,7 @@ syms_of_fileio () staticpro (&Qfile_name_as_directory); staticpro (&Qcopy_file); staticpro (&Qmake_directory_internal); + staticpro (&Qmake_directory); staticpro (&Qdelete_directory); staticpro (&Qdelete_file); staticpro (&Qrename_file); @@ -5012,12 +6038,30 @@ syms_of_fileio () staticpro (&Qfile_already_exists); Qfile_date_error = intern ("file-date-error"); staticpro (&Qfile_date_error); + Qexcl = intern ("excl"); + staticpro (&Qexcl); #ifdef DOS_NT Qfind_buffer_file_type = intern ("find-buffer-file-type"); staticpro (&Qfind_buffer_file_type); #endif /* DOS_NT */ + DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system, + "*Coding system for encoding file names.\n\ +If it is nil, default-file-name-coding-system (which see) is used."); + Vfile_name_coding_system = Qnil; + + DEFVAR_LISP ("default-file-name-coding-system", + &Vdefault_file_name_coding_system, + "Default coding system for encoding file names.\n\ +This variable is used only when file-name-coding-system is nil.\n\ +\n\ +This variable is set/changed by the command set-language-environment.\n\ +User should not set this variable manually,\n\ +instead use file-name-coding-system to get a constant encoding\n\ +of file names regardless of the current language environment."); + Vdefault_file_name_coding_system = Qnil; + DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format, "*Format in which to write auto-save files.\n\ Should be a list of symbols naming formats that are defined in `format-alist'.\n\ @@ -5064,8 +6108,10 @@ nil means use format `var'. This variable is meaningful only on VMS."); 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 = '/'; +what the normal separator is.\n\ +\n\ +WARNING: This variable is deprecated and will be removed in the near\n\ +future. DO NOT USE IT."); DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ @@ -5082,6 +6128,19 @@ The function `find-file-name-handler' checks this list for a handler\n\ for its argument."); Vfile_name_handler_alist = Qnil; + DEFVAR_LISP ("set-auto-coding-function", + &Vset_auto_coding_function, + "If non-nil, a function to call to decide a coding system of file.\n\ +Two arguments are passed to this function: the file name\n\ +and the length of a file contents following the point.\n\ +This function should return a coding system to decode the file contents.\n\ +It should check the file name against `auto-coding-alist'.\n\ +If no coding system is decided, it should check a coding system\n\ +specified in the heading lines with the format:\n\ + -*- ... coding: CODING-SYSTEM; ... -*-\n\ +or local variable spec of the tailing lines with `coding:' tag."); + Vset_auto_coding_function = Qnil; + DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, "A list of functions to be called at the end of `insert-file-contents'.\n\ Each is passed one argument, the number of bytes inserted. It should return\n\ @@ -5183,3 +6242,4 @@ a non-nil value."); defsubr (&Sunix_sync); #endif } +