X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6d6ebdc1d86c561a9a5c2763e92b7dc248a2b4b6..149f3ffd37da17d15537f7a11c0c8ef6c752d5be:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 26853a83c2..48510cd6ed 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,5 +1,5 @@ /* File IO for GNU Emacs. - Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001 + Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -19,11 +19,9 @@ 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) +#ifdef HAVE_FCNTL_H #include #endif @@ -74,16 +72,6 @@ extern int errno; #include #endif -#ifndef USG -#ifndef VMS -#ifndef BSD4_1 -#ifndef WINDOWSNT -#define HAVE_FSYNC -#endif -#endif -#endif -#endif - #include "lisp.h" #include "intervals.h" #include "buffer.h" @@ -159,9 +147,6 @@ extern int use_dialog_box; # define lstat stat #endif -#define min(a, b) ((a) < (b) ? (a) : (b)) -#define max(a, b) ((a) > (b) ? (a) : (b)) - /* Nonzero during writing of auto-save files */ int auto_saving; @@ -169,6 +154,13 @@ int auto_saving; a new file with the same mode as the original */ int auto_save_mode_bits; +/* The symbol bound to coding-system-for-read when + insert-file-contents is called for recovering a file. This is not + an actual coding system name, but just an indicator to tell + insert-file-contents to use `emacs-mule' with a special flag for + auto saving and recovering a file. */ +Lisp_Object Qauto_save_coding; + /* Coding system for file names, or nil if none. */ Lisp_Object Vfile_name_coding_system; @@ -192,8 +184,13 @@ Lisp_Object Vset_auto_coding_function; /* Functions to be called to process text properties in inserted file. */ Lisp_Object Vafter_insert_file_functions; +/* Lisp function for setting buffer-file-coding-system and the + multibyteness of the current buffer after inserting a file. */ +Lisp_Object Qafter_insert_file_set_coding; + /* Functions to be called to create text property annotations for file. */ Lisp_Object Vwrite_region_annotate_functions; +Lisp_Object Qwrite_region_annotate_functions; /* During build_annotations, each time an annotation function is called, this holds the annotations made by the previous functions. */ @@ -202,6 +199,12 @@ Lisp_Object Vwrite_region_annotations_so_far; /* File name in which we write a list of all our auto save files. */ Lisp_Object Vauto_save_list_file_name; +/* Function to call to read a file name. */ +Lisp_Object Vread_file_name_function; + +/* Current predicate used by read_file_name_internal. */ +Lisp_Object Vread_file_name_predicate; + /* Nonzero means, when reading a filename in the minibuffer, start out by inserting the default directory into the minibuffer. */ int insert_default_directory; @@ -247,7 +250,7 @@ static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *)); void report_file_error (string, data) - char *string; + const char *string; Lisp_Object data; { Lisp_Object errstring; @@ -266,8 +269,8 @@ report_file_error (string, data) 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]); + if (SREF (errstring, 1) != '/') + SSET (errstring, 0, DOWNCASE (SREF (errstring, 0))); Fsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); @@ -326,21 +329,24 @@ Lisp_Object Qverify_visited_file_modtime; Lisp_Object Qset_visited_file_modtime; DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0, - "Return FILENAME's handler function for OPERATION, if it has one.\n\ -Otherwise, return nil.\n\ -A file name is handled if one of the regular expressions in\n\ -`file-name-handler-alist' matches it.\n\n\ -If OPERATION equals `inhibit-file-name-operation', then we ignore\n\ -any handlers that are members of `inhibit-file-name-handlers',\n\ -but we still do run any other handlers. This lets handlers\n\ -use the standard functions without calling themselves recursively.") - (filename, operation) - Lisp_Object filename, operation; + doc: /* Return FILENAME's handler function for OPERATION, if it has one. +Otherwise, return nil. +A file name is handled if one of the regular expressions in +`file-name-handler-alist' matches it. + +If OPERATION equals `inhibit-file-name-operation', then we ignore +any handlers that are members of `inhibit-file-name-handlers', +but we still do run any other handlers. This lets handlers +use the standard functions without calling themselves recursively. */) + (filename, operation) + Lisp_Object filename, operation; { /* This function must not munge the match data. */ - Lisp_Object chain, inhibited_handlers; + Lisp_Object chain, inhibited_handlers, result; + int pos = -1; - CHECK_STRING (filename, 0); + result = Qnil; + CHECK_STRING (filename); if (EQ (operation, Vinhibit_file_name_operation)) inhibited_handlers = Vinhibit_file_name_handlers; @@ -355,38 +361,47 @@ use the standard functions without calling themselves recursively.") if (CONSP (elt)) { Lisp_Object string; + int match_pos; string = XCAR (elt); - if (STRINGP (string) && fast_string_match (string, filename) >= 0) + if (STRINGP (string) + && (match_pos = fast_string_match (string, filename)) > pos) { Lisp_Object handler, tem; handler = XCDR (elt); tem = Fmemq (handler, inhibited_handlers); if (NILP (tem)) - return handler; + { + result = handler; + pos = match_pos; + } } } QUIT; } - return Qnil; + return result; } DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, - 1, 1, 0, - "Return the directory component in file name FILENAME.\n\ -Return nil if FILENAME does not include a directory.\n\ -Otherwise return a directory spec.\n\ -Given a Unix syntax file name, returns a string ending in slash;\n\ -on VMS, perhaps instead a string ending in `:', `]' or `>'.") - (filename) + 1, 1, 0, + doc: /* Return the directory component in file name FILENAME. +Return nil if FILENAME does not include a directory. +Otherwise return a directory spec. +Given a Unix syntax file name, returns a string ending in slash; +on VMS, perhaps instead a string ending in `:', `]' or `>'. */) + (filename) Lisp_Object filename; { +#ifndef DOS_NT + register const unsigned char *beg; +#else register unsigned char *beg; - register unsigned char *p; +#endif + register const unsigned char *p; Lisp_Object handler; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -397,11 +412,11 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") #ifdef FILE_SYSTEM_CASE filename = FILE_SYSTEM_CASE (filename); #endif - beg = XSTRING (filename)->data; + beg = SDATA (filename); #ifdef DOS_NT beg = strcpy (alloca (strlen (beg) + 1), beg); #endif - p = beg + STRING_BYTES (XSTRING (filename)); + p = beg + SBYTES (filename); while (p != beg && !IS_DIRECTORY_SEP (p[-1]) #ifdef VMS @@ -444,24 +459,22 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") CORRECT_DIR_SEPS (beg); #endif /* DOS_NT */ - if (STRING_MULTIBYTE (filename)) - return make_string (beg, p - beg); - return make_unibyte_string (beg, p - beg); + return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); } 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\ -or the entire name if it contains no slash.") - (filename) + doc: /* Return file name FILENAME sans its directory. +For example, in a Unix-syntax file name, +this is everything after the last slash, +or the entire name if it contains no slash. */) + (filename) Lisp_Object filename; { - register unsigned char *beg, *p, *end; + register const unsigned char *beg, *p, *end; Lisp_Object handler; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -469,8 +482,8 @@ or the entire name if it contains no slash.") if (!NILP (handler)) return call2 (handler, Qfile_name_nondirectory, filename); - beg = XSTRING (filename)->data; - end = p = beg + STRING_BYTES (XSTRING (filename)); + beg = SDATA (filename); + end = p = beg + SBYTES (filename); while (p != beg && !IS_DIRECTORY_SEP (p[-1]) #ifdef VMS @@ -485,22 +498,20 @@ or the entire name if it contains no slash.") ) p--; - if (STRING_MULTIBYTE (filename)) - return make_string (p, end - p); - return make_unibyte_string (p, end - p); + return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename)); } 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\ -The `call-process' and `start-process' functions use this function to\n\ -get a current directory to run processes in.") - (filename) - Lisp_Object filename; + doc: /* Return a directly usable directory name somehow associated with FILENAME. +A `directly usable' directory name is one that may be used without the +intervention of any file handler. +If FILENAME is a directly usable file itself, return +\(file-name-directory FILENAME). +The `call-process' and `start-process' functions use this function to +get a current directory to run processes in. */) + (filename) + Lisp_Object filename; { Lisp_Object handler; @@ -591,7 +602,8 @@ file_name_as_directory (out, in) /* For Unix syntax, Append a slash if necessary */ if (!IS_DIRECTORY_SEP (out[size])) { - out[size + 1] = DIRECTORY_SEP; + /* Cannot use DIRECTORY_SEP, which could have any value */ + out[size + 1] = '/'; out[size + 2] = '\0'; } #ifdef DOS_NT @@ -603,20 +615,20 @@ file_name_as_directory (out, in) DEFUN ("file-name-as-directory", Ffile_name_as_directory, Sfile_name_as_directory, 1, 1, 0, - "Return a string representing file FILENAME interpreted as a directory.\n\ -This operation exists because a directory is also a file, but its name as\n\ -a directory is different from its name as a file.\n\ -The result can be used as the value of `default-directory'\n\ -or passed as second argument to `expand-file-name'.\n\ -For a Unix-syntax file name, just appends a slash.\n\ -On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") - (file) + doc: /* Return a string representing the file name FILE interpreted as a directory. +This operation exists because a directory is also a file, but its name as +a directory is different from its name as a file. +The result can be used as the value of `default-directory' +or passed as second argument to `expand-file-name'. +For a Unix-syntax file name, just appends a slash. +On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */) + (file) Lisp_Object file; { char *buf; Lisp_Object handler; - CHECK_STRING (file, 0); + CHECK_STRING (file); if (NILP (file)) return Qnil; @@ -626,8 +638,10 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") if (!NILP (handler)) return call2 (handler, Qfile_name_as_directory, file); - buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10); - return build_string (file_name_as_directory (buf, XSTRING (file)->data)); + buf = (char *) alloca (SBYTES (file) + 10); + file_name_as_directory (buf, SDATA (file)); + return make_specified_string (buf, -1, strlen (buf), + STRING_MULTIBYTE (file)); } /* @@ -793,21 +807,21 @@ directory_file_name (src, dst) } DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, - 1, 1, 0, - "Returns the file name of the directory named DIRECTORY.\n\ -This is the name of the file that holds the data for the directory DIRECTORY.\n\ -This operation exists because a directory is also a file, but its name as\n\ -a directory is different from its name as a file.\n\ -In Unix-syntax, this function just removes the final slash.\n\ -On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\ -it returns a file name such as \"[X]Y.DIR.1\".") - (directory) + 1, 1, 0, + doc: /* Returns the file name of the directory named DIRECTORY. +This is the name of the file that holds the data for the directory DIRECTORY. +This operation exists because a directory is also a file, but its name as +a directory is different from its name as a file. +In Unix-syntax, this function just removes the final slash. +On VMS, given a VMS-syntax directory name such as \"[X.Y]\", +it returns a file name such as \"[X]Y.DIR.1\". */) + (directory) Lisp_Object directory; { char *buf; Lisp_Object handler; - CHECK_STRING (directory, 0); + CHECK_STRING (directory); if (NILP (directory)) return Qnil; @@ -822,12 +836,13 @@ 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 (STRING_BYTES (XSTRING (directory)) + 20 + 255); + buf = (char *) alloca (SBYTES (directory) + 20 + 255); #else - buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20); + buf = (char *) alloca (SBYTES (directory) + 20); #endif - directory_file_name (XSTRING (directory)->data, buf); - return build_string (buf); + directory_file_name (SDATA (directory), buf); + return make_specified_string (buf, -1, strlen (buf), + STRING_MULTIBYTE (directory)); } static char make_temp_name_tbl[64] = @@ -845,13 +860,13 @@ static char make_temp_name_tbl[64] = 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 @@ -871,8 +886,8 @@ make_temp_name (prefix, base64_p) unsigned char *p, *data; char pidbuf[20]; int pidlen; - - CHECK_STRING (prefix, 0); + + CHECK_STRING (prefix); /* VAL is created by adding 6 characters to PREFIX. The first three are the PID of this process, in base 64, and the second @@ -900,11 +915,11 @@ make_temp_name (prefix, base64_p) pidlen = 3; #endif } - - len = XSTRING (prefix)->size; + + len = SCHARS (prefix); val = make_uninit_string (len + 3 + pidlen); - data = XSTRING (val)->data; - bcopy(XSTRING (prefix)->data, data, len); + data = SDATA (val); + bcopy(SDATA (prefix), data, len); p = data + len; bcopy (pidbuf, p, pidlen); @@ -959,24 +974,28 @@ make_temp_name (prefix, base64_p) } error ("Cannot create temporary name for prefix `%s'", - XSTRING (prefix)->data); + SDATA (prefix)); 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.\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) + doc: /* Generate temporary file name (string) 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. + +There is a race condition between calling `make-temp-name' and creating the +file which opens all kinds of security holes. For that reason, you should +probably use `make-temp-file' instead, except in three circumstances: + +* If you are creating the file in the user's home directory. +* If you are creating a directory rather than an ordinary file. +* If you are taking special precautions as `make-temp-file' does. */) + (prefix) Lisp_Object prefix; { return make_temp_name (prefix, 0); @@ -985,18 +1004,18 @@ probably use `make-temp-file' instead.") DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, - "Convert filename NAME to absolute, and canonicalize it.\n\ -Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\ - (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\ -the current buffer's value of default-directory is used.\n\ -File name components that are `.' are removed, and \n\ -so are file name components followed by `..', along with the `..' itself;\n\ -note that these simplifications are done without checking the resulting\n\ -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) + doc: /* Convert filename NAME to absolute, and canonicalize it. +Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative + (does not start with slash); if DEFAULT-DIRECTORY is nil or missing, +the current buffer's value of default-directory is used. +File name components that are `.' are removed, and +so are file name components followed by `..', along with the `..' itself; +note that these simplifications are done without checking the resulting +file names in the file system. +An initial `~/' expands to your home directory. +An initial `~USER/' expands to USER's home directory. +See also the function `substitute-in-file-name'. */) + (name, default_directory) Lisp_Object name, default_directory; { unsigned char *nm; @@ -1019,9 +1038,9 @@ See also the function `substitute-in-file-name'.") int is_escaped = 0; #endif /* DOS_NT */ int length; - Lisp_Object handler; + Lisp_Object handler, result; - CHECK_STRING (name, 0); + CHECK_STRING (name); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -1033,7 +1052,23 @@ See also the function `substitute-in-file-name'.") if (NILP (default_directory)) default_directory = current_buffer->directory; if (! STRINGP (default_directory)) - default_directory = build_string ("/"); + { +#ifdef DOS_NT + /* "/" is not considered a root directory on DOS_NT, so using "/" + here causes an infinite recursion in, e.g., the following: + + (let (default-directory) + (expand-file-name "a")) + + To avoid this, we set default_directory to the root of the + current drive. */ + extern char *emacs_root_dir (void); + + default_directory = build_string (emacs_root_dir ()); +#else + default_directory = build_string ("/"); +#endif + } if (!NILP (default_directory)) { @@ -1042,7 +1077,7 @@ See also the function `substitute-in-file-name'.") return call3 (handler, Qexpand_file_name, name, default_directory); } - o = XSTRING (default_directory)->data; + o = SDATA (default_directory); /* Make sure DEFAULT_DIRECTORY is properly expanded. It would be better to do this down below where we actually use @@ -1087,7 +1122,7 @@ See also the function `substitute-in-file-name'.") name = FILE_SYSTEM_CASE (name); #endif - nm = XSTRING (name)->data; + nm = SDATA (name); #ifdef DOS_NT /* We will force directory separators to be either all \ or /, so make @@ -1171,7 +1206,7 @@ See also the function `substitute-in-file-name'.") && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) lose = 1; - + #ifdef VMS if (p[0] == '\\') lose = 1; @@ -1251,7 +1286,11 @@ See also the function `substitute-in-file-name'.") { #ifdef VMS if (index (nm, '/')) - return build_string (sys_translate_unix (nm)); + { + nm = sys_translate_unix (nm); + return make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (name)); + } #endif /* VMS */ #ifdef DOS_NT /* Make sure directories are all separated with / or \ as @@ -1261,23 +1300,28 @@ See also the function `substitute-in-file-name'.") #ifdef WINDOWSNT if (IS_DIRECTORY_SEP (nm[1])) { - if (strcmp (nm, XSTRING (name)->data) != 0) - name = build_string (nm); + if (strcmp (nm, SDATA (name)) != 0) + name = make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (name)); } else #endif /* drive must be set, so this is okay */ - if (strcmp (nm - 2, XSTRING (name)->data) != 0) + if (strcmp (nm - 2, SDATA (name)) != 0) { - name = make_string (nm - 2, p - nm + 2); - XSTRING (name)->data[0] = DRIVE_LETTER (drive); - XSTRING (name)->data[1] = ':'; + char temp[] = " :"; + + name = make_specified_string (nm, -1, p - nm, + STRING_MULTIBYTE (name)); + temp[0] = DRIVE_LETTER (drive); + name = concat2 (build_string (temp), name); } return name; #else /* not DOS_NT */ - if (nm == XSTRING (name)->data) + if (nm == SDATA (name)) return name; - return build_string (nm); + return make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (name)); #endif /* not DOS_NT */ } } @@ -1388,7 +1432,7 @@ See also the function `substitute-in-file-name'.") #endif && !newdir) { - newdir = XSTRING (default_directory)->data; + newdir = SDATA (default_directory); #ifdef DOS_NT /* Note if special escape prefix is present, but remove for now. */ if (newdir[0] == '/' && newdir[1] == ':') @@ -1514,7 +1558,7 @@ See also the function `substitute-in-file-name'.") 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]) + if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) && newdir[1] == '\0')) #endif strcpy (target, newdir); @@ -1646,10 +1690,32 @@ See also the function `substitute-in-file-name'.") CORRECT_DIR_SEPS (target); #endif /* DOS_NT */ - return make_string (target, o - target); + result = make_specified_string (target, -1, o - target, + STRING_MULTIBYTE (name)); + + /* Again look to see if the file name has special constructs in it + and perhaps call the corresponding file handler. This is needed + for filenames such as "/foo/../user@host:/bar/../baz". Expanding + the ".." component gives us "/user@host:/bar/../baz" which needs + to be expanded again. */ + handler = Ffind_file_name_handler (result, Qexpand_file_name); + if (!NILP (handler)) + return call3 (handler, Qexpand_file_name, result, default_directory); + + return result; } #if 0 +/* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION! + This is the old version of expand-file-name, before it was thoroughly + rewritten for Emacs 10.31. We leave this version here commented-out, + because the code is very complex and likely to have subtle bugs. If + bugs _are_ found, it might be of interest to look at the old code and + see what did it do in the relevant situation. + + Don't remove this code: it's true that it will be accessible via CVS, + but a few years from deletion, people will forget it is there. */ + /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */ DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert FILENAME to absolute, and canonicalize it.\n\ @@ -1678,14 +1744,14 @@ See also the function `substitute-in-file-name'.") int dots = 0; #endif /* VMS */ - CHECK_STRING (name, 0); + CHECK_STRING (name); #ifdef VMS /* Filenames on VMS are always upper case. */ name = Fupcase (name); #endif - nm = XSTRING (name)->data; + nm = SDATA (name); /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */ @@ -1794,7 +1860,7 @@ See also the function `substitute-in-file-name'.") if (index (nm, '/')) return build_string (sys_translate_unix (nm)); #endif /* VMS */ - if (nm == XSTRING (name)->data) + if (nm == SDATA (name)) return name; return build_string (nm); } @@ -1854,8 +1920,8 @@ See also the function `substitute-in-file-name'.") { if (NILP (defalt)) defalt = current_buffer->directory; - CHECK_STRING (defalt, 1); - newdir = XSTRING (defalt)->data; + CHECK_STRING (defalt); + newdir = SDATA (defalt); } /* Now concatenate the directory and name to new space in the stack frame */ @@ -1974,16 +2040,17 @@ See also the function `substitute-in-file-name'.") #endif DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, - Ssubstitute_in_file_name, 1, 1, 0, - "Substitute environment variables referred to in FILENAME.\n\ -`$FOO' where FOO is an environment variable name means to substitute\n\ -the value of that variable. The variable name should be terminated\n\ -with a character not a letter, digit or underscore; otherwise, enclose\n\ -the entire variable name in braces.\n\ -If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\ -On VMS, `$' substitution is not done; this function does little and only\n\ -duplicates what `expand-file-name' does.") - (filename) + Ssubstitute_in_file_name, 1, 1, 0, + doc: /* Substitute environment variables referred to in FILENAME. +`$FOO' where FOO is an environment variable name means to substitute +the value of that variable. The variable name should be terminated +with a character not a letter, digit or underscore; otherwise, enclose +the entire variable name in braces. +If `/~' appears, all of FILENAME through that `/' is discarded. + +On VMS, `$' substitution is not done; this function does little and only +duplicates what `expand-file-name' does. */) + (filename) Lisp_Object filename; { unsigned char *nm; @@ -1993,9 +2060,10 @@ duplicates what `expand-file-name' does.") int total = 0; int substituted = 0; unsigned char *xnm; + struct passwd *pw; Lisp_Object handler; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2003,26 +2071,26 @@ duplicates what `expand-file-name' does.") if (!NILP (handler)) return call2 (handler, Qsubstitute_in_file_name, filename); - nm = XSTRING (filename)->data; + nm = SDATA (filename); #ifdef DOS_NT nm = strcpy (alloca (strlen (nm) + 1), nm); CORRECT_DIR_SEPS (nm); - substituted = (strcmp (nm, XSTRING (filename)->data) != 0); + substituted = (strcmp (nm, SDATA (filename)) != 0); #endif - endp = nm + STRING_BYTES (XSTRING (filename)); + endp = nm + SBYTES (filename); /* 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. */ +#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) + /* // at start of file name is meaningful in Apollo, + WindowsNT and Cygwin systems. */ || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) -#else /* not (APOLLO || WINDOWSNT) */ +#else /* not (APOLLO || WINDOWSNT || CYGWIN) */ || IS_DIRECTORY_SEP (p[0]) -#endif /* not (APOLLO || WINDOWSNT) */ +#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ ) && p != nm && (0 @@ -2031,8 +2099,27 @@ duplicates what `expand-file-name' does.") #endif /* VMS */ || IS_DIRECTORY_SEP (p[-1]))) { - nm = p; - substituted = 1; + for (s = p; *s && (!IS_DIRECTORY_SEP (*s) +#ifdef VMS + && *s != ':' +#endif /* VMS */ + ); s++); + if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */ + { + o = (unsigned char *) alloca (s - p + 1); + bcopy ((char *) p, o, s - p); + o [s - p] = 0; + + pw = (struct passwd *) getpwnam (o + 1); + } + /* If we have ~/ or ~user and `user' exists, discard + everything up to ~. But if `user' does not exist, leave + ~user alone, it might be a literal file name. */ + if (IS_DIRECTORY_SEP (p[0]) || s == p + 1 || pw) + { + nm = p; + substituted = 1; + } } #ifdef DOS_NT /* see comment in expand-file-name about drive specifiers */ @@ -2046,7 +2133,8 @@ duplicates what `expand-file-name' does.") } #ifdef VMS - return build_string (nm); + return make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (filename)); #else /* See if any variables are substituted into the string @@ -2092,9 +2180,13 @@ duplicates what `expand-file-name' does.") /* Get variable value */ o = (unsigned char *) egetenv (target); - if (!o) goto badvar; - total += strlen (o); - substituted = 1; + if (o) + { + total += strlen (o); + substituted = 1; + } + else if (*p == '}') + goto badvar; } if (!substituted) @@ -2102,7 +2194,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 (STRING_BYTES (XSTRING (filename)) + total + 1); + xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1); x = xnm; /* Copy the rest of the name through, replacing $ constructs with values */ @@ -2144,9 +2236,11 @@ duplicates what `expand-file-name' does.") /* Get variable value */ o = (unsigned char *) egetenv (target); if (!o) - goto badvar; - - if (STRING_MULTIBYTE (filename)) + { + *x++ = '$'; + strcpy (x, target); x+= strlen (target); + } + else if (STRING_MULTIBYTE (filename)) { /* If the original string is multibyte, convert what we substitute into multibyte. */ @@ -2169,11 +2263,11 @@ duplicates what `expand-file-name' does.") for (p = xnm; p != x; p++) if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) +#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) -#else /* not (APOLLO || WINDOWSNT) */ +#else /* not (APOLLO || WINDOWSNT || CYGWIN) */ || IS_DIRECTORY_SEP (p[0]) -#endif /* not (APOLLO || WINDOWSNT) */ +#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ ) && p != xnm && IS_DIRECTORY_SEP (p[-1])) xnm = p; @@ -2183,9 +2277,7 @@ duplicates what `expand-file-name' does.") xnm = p; #endif - if (STRING_MULTIBYTE (filename)) - return make_string (xnm, x - xnm); - return make_unibyte_string (xnm, x - xnm); + return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename)); badsubst: error ("Bad format environment-variable substitution"); @@ -2211,16 +2303,16 @@ expand_and_dir_to_file (filename, defdir) absname = Fexpand_file_name (filename, defdir); #ifdef VMS { - register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1]; + register int c = SREF (absname, SBYTES (absname) - 1); if (c == ':' || c == ']' || c == '>') absname = Fdirectory_file_name (absname); } #else /* 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[STRING_BYTES (XSTRING (absname)) - 1]) - && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2])) + if (SCHARS (absname) > 1 + && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1)) + && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2))) /* We cannot take shortcuts; they might be wrong for magic file names. */ absname = Fdirectory_file_name (absname); #endif @@ -2255,15 +2347,15 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) /* stat is a good way to tell whether the file exists, regardless of what access permissions it has. */ - if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0) + if (stat (SDATA (encoded_filename), &statbuf) >= 0) { if (! interactive) Fsignal (Qfile_already_exists, Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); GCPRO1 (absname); - tem = format1 ("File %s already exists; %s anyway? ", - XSTRING (absname)->data, querystring); + tem = format2 ("File %s already exists; %s anyway? ", + absname, build_string (querystring)); if (quick) tem = Fy_or_n_p (tem); else @@ -2285,16 +2377,18 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) } DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, - "fCopy file: \nFCopy %s to file: \np\nP", - "Copy FILE to NEWNAME. Both args must be strings.\n\ -Signals a `file-already-exists' error if file NEWNAME already exists,\n\ -unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\ -A number as third arg means request confirmation if NEWNAME already exists.\n\ -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_time) + "fCopy file: \nFCopy %s to file: \np\nP", + doc: /* Copy FILE to NEWNAME. Both args must be strings. +If NEWNAME names a directory, copy FILE there. +Signals a `file-already-exists' error if file NEWNAME already exists, +unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. +A number as third arg means request confirmation if NEWNAME already exists. +This is what happens in interactive use with M-x. +Fourth arg KEEP-TIME non-nil means give the new file the same +last-modified time as the old one. (This works on only some systems.) +A prefix arg makes KEEP-TIME non-nil. +Also set the file modes of the target file to match the source file. */) + (file, newname, ok_if_already_exists, keep_time) Lisp_Object file, newname, ok_if_already_exists, keep_time; { int ifd, ofd, n; @@ -2302,17 +2396,21 @@ A prefix arg makes KEEP-TIME non-nil.") struct stat st, out_st; Lisp_Object handler; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); int input_file_statable_p; Lisp_Object encoded_file, encoded_newname; encoded_file = encoded_newname = Qnil; GCPRO4 (file, newname, encoded_file, encoded_newname); - CHECK_STRING (file, 0); - CHECK_STRING (newname, 1); + CHECK_STRING (file); + CHECK_STRING (newname); + + if (!NILP (Ffile_directory_p (newname))) + newname = Fexpand_file_name (file, newname); + else + newname = Fexpand_file_name (newname, Qnil); file = Fexpand_file_name (file, Qnil); - newname = Fexpand_file_name (newname, Qnil); /* If the input file name has special constructs in it, call the corresponding file handler. */ @@ -2331,10 +2429,43 @@ A prefix arg makes KEEP-TIME non-nil.") || INTEGERP (ok_if_already_exists)) 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) + else if (stat (SDATA (encoded_newname), &out_st) < 0) out_st.st_mode = 0; - ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0); +#ifdef WINDOWSNT + if (!CopyFile (SDATA (encoded_file), + SDATA (encoded_newname), + FALSE)) + report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); + /* CopyFile retains the timestamp by default. */ + else if (NILP (keep_time)) + { + EMACS_TIME now; + DWORD attributes; + char * filename; + + EMACS_GET_TIME (now); + filename = SDATA (encoded_newname); + + /* Ensure file is writable while its modified time is set. */ + attributes = GetFileAttributes (filename); + SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY); + if (set_file_times (filename, now, now)) + { + /* Restore original attributes. */ + SetFileAttributes (filename, attributes); + Fsignal (Qfile_date_error, + Fcons (build_string ("Cannot set file date"), + Fcons (newname, Qnil))); + } + /* Restore original attributes. */ + SetFileAttributes (filename, attributes); + } +#else /* not WINDOWSNT */ + immediate_quit = 1; + ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0); + immediate_quit = 0; + if (ifd < 0) report_file_error ("Opening input file", Fcons (file, Qnil)); @@ -2370,13 +2501,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 (encoded_newname)->data, 0666, ifd); + ofd = sys_creat (SDATA (encoded_newname), 0666, ifd); #else #ifdef MSDOS /* System's default file type was set to binary by _fmode in emacs.c. */ - ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE); + ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE); #else /* not MSDOS */ - ofd = creat (XSTRING (encoded_newname)->data, 0666); + ofd = creat (SDATA (encoded_newname), 0666); #endif /* not MSDOS */ #endif /* VMS */ if (ofd < 0) @@ -2402,14 +2533,14 @@ A prefix arg makes KEEP-TIME non-nil.") 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 (encoded_newname)->data, + if (set_file_times (SDATA (encoded_newname), atime, mtime)) Fsignal (Qfile_date_error, Fcons (build_string ("Cannot set file date"), Fcons (newname, Qnil))); } #ifndef MSDOS - chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777); + chmod (SDATA (encoded_newname), st.st_mode & 07777); #else /* MSDOS */ #if defined (__DJGPP__) && __DJGPP__ > 1 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits, @@ -2417,12 +2548,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 (encoded_newname)->data, st.st_mode & 07777); + chmod (SDATA (encoded_newname), st.st_mode & 07777); #endif /* DJGPP version 2 or newer */ #endif /* MSDOS */ } emacs_close (ifd); +#endif /* WINDOWSNT */ /* Discard the unwind protects. */ specpdl_ptr = specpdl + count; @@ -2433,15 +2565,15 @@ A prefix arg makes KEEP-TIME non-nil.") DEFUN ("make-directory-internal", Fmake_directory_internal, Smake_directory_internal, 1, 1, 0, - "Create a new directory named DIRECTORY.") - (directory) + doc: /* Create a new directory named DIRECTORY. */) + (directory) Lisp_Object directory; { - unsigned char *dir; + const unsigned char *dir; Lisp_Object handler; Lisp_Object encoded_dir; - CHECK_STRING (directory, 0); + CHECK_STRING (directory); directory = Fexpand_file_name (directory, Qnil); handler = Ffind_file_name_handler (directory, Qmake_directory_internal); @@ -2450,7 +2582,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, encoded_dir = ENCODE_FILE (directory); - dir = XSTRING (encoded_dir)->data; + dir = SDATA (encoded_dir); #ifdef WINDOWSNT if (mkdir (dir) != 0) @@ -2463,15 +2595,15 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, } DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", - "Delete the directory named DIRECTORY.") - (directory) + doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */) + (directory) Lisp_Object directory; { - unsigned char *dir; + const unsigned char *dir; Lisp_Object handler; Lisp_Object encoded_dir; - CHECK_STRING (directory, 0); + CHECK_STRING (directory); directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil)); handler = Ffind_file_name_handler (directory, Qdelete_directory); @@ -2480,7 +2612,7 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete encoded_dir = ENCODE_FILE (directory); - dir = XSTRING (encoded_dir)->data; + dir = SDATA (encoded_dir); if (rmdir (dir) != 0) report_file_error ("Removing directory", Flist (1, &directory)); @@ -2489,15 +2621,22 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete } DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", - "Delete file named FILENAME.\n\ -If file has multiple names, it continues to exist with the other names.") - (filename) + doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink. +If file has multiple names, it continues to exist with the other names. */) + (filename) Lisp_Object filename; { Lisp_Object handler; Lisp_Object encoded_file; + struct gcpro gcpro1; - CHECK_STRING (filename, 0); + GCPRO1 (filename); + if (!NILP (Ffile_directory_p (filename)) + && NILP (Ffile_symlink_p (filename))) + Fsignal (Qfile_error, + Fcons (build_string ("Removing old name: is a directory"), + Fcons (filename, Qnil))); + UNGCPRO; filename = Fexpand_file_name (filename, Qnil); handler = Ffind_file_name_handler (filename, Qdelete_file); @@ -2506,7 +2645,7 @@ If file has multiple names, it continues to exist with the other names.") encoded_file = ENCODE_FILE (filename); - if (0 > unlink (XSTRING (encoded_file)->data)) + if (0 > unlink (SDATA (encoded_file))) report_file_error ("Removing old name", Flist (1, &filename)); return Qnil; } @@ -2529,14 +2668,14 @@ internal_delete_file (filename) } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, - "fRename file: \nFRename %s to file: \np", - "Rename FILE as NEWNAME. Both args strings.\n\ -If file has names other than FILE, it continues to have those names.\n\ -Signals a `file-already-exists' error if a file NEWNAME already exists\n\ -unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ -A number as third arg means request confirmation if NEWNAME already exists.\n\ -This is what happens in interactive use with M-x.") - (file, newname, ok_if_already_exists) + "fRename file: \nFRename %s to file: \np", + doc: /* Rename FILE as NEWNAME. Both args strings. +If file has names other than FILE, it continues to have those names. +Signals a `file-already-exists' error if a file NEWNAME already exists +unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. +A number as third arg means request confirmation if NEWNAME already exists. +This is what happens in interactive use with M-x. */) + (file, newname, ok_if_already_exists) Lisp_Object file, newname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY @@ -2548,8 +2687,8 @@ This is what happens in interactive use with M-x.") encoded_file = encoded_newname = Qnil; GCPRO4 (file, newname, encoded_file, encoded_newname); - CHECK_STRING (file, 0); - CHECK_STRING (newname, 1); + CHECK_STRING (file); + CHECK_STRING (newname); file = Fexpand_file_name (file, Qnil); newname = Fexpand_file_name (newname, Qnil); @@ -2576,10 +2715,10 @@ This is what happens in interactive use with M-x.") 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 (encoded_file)->data, XSTRING (encoded_newname)->data)) + if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname))) #else - if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data) - || 0 > unlink (XSTRING (encoded_file)->data)) + if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)) + || 0 > unlink (SDATA (encoded_file))) #endif { if (errno == EXDEV) @@ -2606,13 +2745,13 @@ This is what happens in interactive use with M-x.") } DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, - "fAdd name to file: \nFName to add to %s: \np", - "Give FILE additional name NEWNAME. Both args strings.\n\ -Signals a `file-already-exists' error if a file NEWNAME already exists\n\ -unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ -A number as third arg means request confirmation if NEWNAME already exists.\n\ -This is what happens in interactive use with M-x.") - (file, newname, ok_if_already_exists) + "fAdd name to file: \nFName to add to %s: \np", + doc: /* Give FILE additional name NEWNAME. Both args strings. +Signals a `file-already-exists' error if a file NEWNAME already exists +unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. +A number as third arg means request confirmation if NEWNAME already exists. +This is what happens in interactive use with M-x. */) + (file, newname, ok_if_already_exists) Lisp_Object file, newname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY @@ -2624,8 +2763,8 @@ This is what happens in interactive use with M-x.") GCPRO4 (file, newname, encoded_file, encoded_newname); encoded_file = encoded_newname = Qnil; - CHECK_STRING (file, 0); - CHECK_STRING (newname, 1); + CHECK_STRING (file); + CHECK_STRING (newname); file = Fexpand_file_name (file, Qnil); newname = Fexpand_file_name (newname, Qnil); @@ -2651,8 +2790,8 @@ This is what happens in interactive use with M-x.") 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 (encoded_file)->data, XSTRING (encoded_newname)->data)) + unlink (SDATA (newname)); + if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))) { #ifdef NO_ARG_ARRAY args[0] = file; @@ -2669,13 +2808,13 @@ This is what happens in interactive use with M-x.") #ifdef S_IFLNK DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, - "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", - "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\ -Signals a `file-already-exists' error if a file LINKNAME already exists\n\ -unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ -A number as third arg means request confirmation if LINKNAME already exists.\n\ -This happens for interactive use with M-x.") - (filename, linkname, ok_if_already_exists) + "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", + doc: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings. +Signals a `file-already-exists' error if a file LINKNAME already exists +unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. +A number as third arg means request confirmation if LINKNAME already exists. +This happens for interactive use with M-x. */) + (filename, linkname, ok_if_already_exists) Lisp_Object filename, linkname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY @@ -2687,12 +2826,12 @@ This happens for interactive use with M-x.") GCPRO4 (filename, linkname, encoded_filename, encoded_linkname); encoded_filename = encoded_linkname = Qnil; - CHECK_STRING (filename, 0); - CHECK_STRING (linkname, 1); + CHECK_STRING (filename); + CHECK_STRING (linkname); /* If the link target has a ~, we must expand it to get a truly valid file name. Otherwise, do not expand; we want to permit links to relative file names. */ - if (XSTRING (filename)->data[0] == '~') + if (SREF (filename, 0) == '~') filename = Fexpand_file_name (filename, Qnil); linkname = Fexpand_file_name (linkname, Qnil); @@ -2717,15 +2856,15 @@ This happens for interactive use with M-x.") || INTEGERP (ok_if_already_exists)) 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 (0 > symlink (SDATA (encoded_filename), + SDATA (encoded_linkname))) { /* If we didn't complain already, silently delete existing file. */ if (errno == EEXIST) { - unlink (XSTRING (encoded_linkname)->data); - if (0 <= symlink (XSTRING (encoded_filename)->data, - XSTRING (encoded_linkname)->data)) + unlink (SDATA (encoded_linkname)); + if (0 <= symlink (SDATA (encoded_filename), + SDATA (encoded_linkname))) { UNGCPRO; return Qnil; @@ -2749,23 +2888,23 @@ This happens for interactive use with M-x.") DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, 2, 2, "sDefine logical name: \nsDefine logical name %s as: ", - "Define the job-wide logical name NAME to have the value STRING.\n\ -If STRING is nil or a null string, the logical name NAME is deleted.") - (name, string) + doc: /* Define the job-wide logical name NAME to have the value STRING. +If STRING is nil or a null string, the logical name NAME is deleted. */) + (name, string) Lisp_Object name; Lisp_Object string; { - CHECK_STRING (name, 0); + CHECK_STRING (name); if (NILP (string)) - delete_logical_name (XSTRING (name)->data); + delete_logical_name (SDATA (name)); else { - CHECK_STRING (string, 1); + CHECK_STRING (string); - if (XSTRING (string)->size == 0) - delete_logical_name (XSTRING (name)->data); + if (SCHARS (string) == 0) + delete_logical_name (SDATA (name)); else - define_logical_name (XSTRING (name)->data, XSTRING (string)->data); + define_logical_name (SDATA (name), SDATA (string)); } return string; @@ -2775,16 +2914,16 @@ If STRING is nil or a null string, the logical name NAME is deleted.") #ifdef HPUX_NET DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, - "Open a network connection to PATH using LOGIN as the login string.") + doc: /* Open a network connection to PATH using LOGIN as the login string. */) (path, login) Lisp_Object path, login; { int netresult; - CHECK_STRING (path, 0); - CHECK_STRING (login, 0); + CHECK_STRING (path); + CHECK_STRING (login); - netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); + netresult = netunam (SDATA (path), SDATA (login)); if (netresult == -1) return Qnil; @@ -2795,15 +2934,15 @@ DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, 1, 1, 0, - "Return t if file FILENAME specifies an absolute file name.\n\ -On Unix, this is a name starting with a `/' or a `~'.") + doc: /* Return t if file FILENAME specifies an absolute file name. +On Unix, this is a name starting with a `/' or a `~'. */) (filename) Lisp_Object filename; { - unsigned char *ptr; + const unsigned char *ptr; - CHECK_STRING (filename, 0); - ptr = XSTRING (filename)->data; + CHECK_STRING (filename); + ptr = SDATA (filename); if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' #ifdef VMS /* ??? This criterion is probably wrong for '<'. */ @@ -2880,16 +3019,16 @@ check_writable (filename) } DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, - "Return t if file FILENAME exists. (This does not mean you can read it.)\n\ -See also `file-readable-p' and `file-attributes'.") - (filename) + doc: /* Return t if file FILENAME exists. (This does not mean you can read it.) +See also `file-readable-p' and `file-attributes'. */) + (filename) Lisp_Object filename; { Lisp_Object absname; Lisp_Object handler; struct stat statbuf; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -2900,20 +3039,19 @@ See also `file-readable-p' and `file-attributes'.") absname = ENCODE_FILE (absname); - return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil; + return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil; } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, - "Return t if FILENAME can be executed by you.\n\ -For a directory, this means you can access files in that directory.") - (filename) - Lisp_Object filename; - + doc: /* Return t if FILENAME can be executed by you. +For a directory, this means you can access files in that directory. */) + (filename) + Lisp_Object filename; { Lisp_Object absname; Lisp_Object handler; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -2924,13 +3062,13 @@ For a directory, this means you can access files in that directory.") absname = ENCODE_FILE (absname); - return (check_executable (XSTRING (absname)->data) ? Qt : Qnil); + return (check_executable (SDATA (absname)) ? Qt : Qnil); } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, - "Return t if file FILENAME exists and you can read it.\n\ -See also `file-exists-p' and `file-attributes'.") - (filename) + doc: /* Return t if file FILENAME exists and you can read it. +See also `file-exists-p' and `file-attributes'. */) + (filename) Lisp_Object filename; { Lisp_Object absname; @@ -2939,7 +3077,7 @@ See also `file-exists-p' and `file-attributes'.") int flags; struct stat statbuf; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -2950,43 +3088,44 @@ See also `file-exists-p' and `file-attributes'.") absname = ENCODE_FILE (absname); -#ifdef DOS_NT - /* Under MS-DOS and Windows, open does not work for directories. */ - if (access (XSTRING (absname)->data, 0) == 0) +#if defined(DOS_NT) || defined(macintosh) + /* Under MS-DOS, Windows, and Macintosh, open does not work for + directories. */ + if (access (SDATA (absname), 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. We don't want to wait. But we don't want to mess wth O_NONBLOCK except in the case of a fifo, on a system which handles it. */ - desc = stat (XSTRING (absname)->data, &statbuf); + desc = stat (SDATA (absname), &statbuf); if (desc < 0) return Qnil; if (S_ISFIFO (statbuf.st_mode)) flags |= O_NONBLOCK; #endif - desc = emacs_open (XSTRING (absname)->data, flags, 0); + desc = emacs_open (SDATA (absname), flags, 0); if (desc < 0) return Qnil; 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 on the RT/PC. */ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, - "Return t if file FILENAME can be written or created by you.") - (filename) + doc: /* Return t if file FILENAME can be written or created by you. */) + (filename) Lisp_Object filename; { Lisp_Object absname, dir, encoded; Lisp_Object handler; struct stat statbuf; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -2996,8 +3135,8 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, return call2 (handler, Qfile_writable_p, absname); encoded = ENCODE_FILE (absname); - if (stat (XSTRING (encoded)->data, &statbuf) >= 0) - return (check_writable (XSTRING (encoded)->data) + if (stat (SDATA (encoded), &statbuf) >= 0) + return (check_writable (SDATA (encoded)) ? Qt : Qnil); dir = Ffile_name_directory (absname); @@ -3015,59 +3154,56 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, /* 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) + if (stat (SDATA (dir), &statbuf) < 0) return Qnil; return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; #else - return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "") + return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "") ? Qt : Qnil); #endif } DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, - "Access file FILENAME, and get an error if that does not work.\n\ -The second argument STRING is used in the error message.\n\ -If there is no error, we return nil.") - (filename, string) + doc: /* Access file FILENAME, and get an error if that does not work. +The second argument STRING is used in the error message. +If there is no error, we return nil. */) + (filename, string) Lisp_Object filename, string; { - Lisp_Object handler, encoded_filename; + Lisp_Object handler, encoded_filename, absname; int fd; - CHECK_STRING (filename, 0); - CHECK_STRING (string, 1); + CHECK_STRING (filename); + absname = Fexpand_file_name (filename, Qnil); + + CHECK_STRING (string); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qaccess_file); + handler = Ffind_file_name_handler (absname, Qaccess_file); if (!NILP (handler)) - return call3 (handler, Qaccess_file, filename, string); + return call3 (handler, Qaccess_file, absname, string); - encoded_filename = ENCODE_FILE (filename); + encoded_filename = ENCODE_FILE (absname); - fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0); + fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0); if (fd < 0) - report_file_error (XSTRING (string)->data, Fcons (filename, Qnil)); + report_file_error (SDATA (string), Fcons (filename, Qnil)); emacs_close (fd); return Qnil; } DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, - "Return non-nil if file FILENAME is the name of a symbolic link.\n\ -The value is the name of the file to which it is linked.\n\ -Otherwise returns nil.") - (filename) + doc: /* Return non-nil if file FILENAME is the name of a symbolic link. +The value is the link target, as a string. +Otherwise returns nil. */) + (filename) Lisp_Object filename; { -#ifdef S_IFLNK - char *buf; - int bufsize; - int valsize; - Lisp_Object val; Lisp_Object handler; - CHECK_STRING (filename, 0); + CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -3076,40 +3212,58 @@ Otherwise returns nil.") if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); +#ifdef S_IFLNK + { + char *buf; + int bufsize; + int valsize; + Lisp_Object val; + filename = ENCODE_FILE (filename); - bufsize = 100; - while (1) + bufsize = 50; + buf = NULL; + do { - buf = (char *) xmalloc (bufsize); - bzero (buf, bufsize); - valsize = readlink (XSTRING (filename)->data, buf, bufsize); - if (valsize < bufsize) break; - /* Buffer was not long enough */ - xfree (buf); bufsize *= 2; + buf = (char *) xrealloc (buf, bufsize); + bzero (buf, bufsize); + + errno = 0; + valsize = readlink (SDATA (filename), buf, bufsize); + 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; + } + } } - if (valsize == -1) - { - 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; #endif /* not S_IFLNK */ } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, - "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) + doc: /* Return t if FILENAME names an existing directory. +Symbolic links to directories count as directories. +See `file-symlink-p' to distinguish symlinks. */) + (filename) Lisp_Object filename; { register Lisp_Object absname; @@ -3126,19 +3280,20 @@ See `file-symlink-p' to distinguish symlinks.") absname = ENCODE_FILE (absname); - if (stat (XSTRING (absname)->data, &st) < 0) + if (stat (SDATA (absname), &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; } DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, - "Return t if file FILENAME is the name of a directory as a file,\n\ -and files in that directory can be opened by you. In order to use a\n\ -directory as a buffer's current directory, this predicate must return true.\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 readable and\n\ -searchable directory.") - (filename) + doc: /* Return t if file FILENAME names a directory you can open. +For the value to be t, FILENAME must specify the name of a directory as a file, +and the directory must allow you to open files in it. In order to use a +directory as a buffer's current directory, this predicate must return true. +A directory name spec may be given instead; then the value is t +if the directory so specified exists and really is a readable and +searchable directory. */) + (filename) Lisp_Object filename; { Lisp_Object handler; @@ -3151,12 +3306,6 @@ searchable directory.") if (!NILP (handler)) return call2 (handler, Qfile_accessible_directory_p, filename); - /* It's an unlikely combination, but yes we really do need to gcpro: - Suppose that file-accessible-directory-p has no handler, but - file-directory-p does have a handler; this handler causes a GC which - relocates the string in `filename'; and finally file-directory-p - returns non-nil. Then we would end up passing a garbaged string - to file-executable-p. */ GCPRO1 (filename); tem = (NILP (Ffile_directory_p (filename)) || NILP (Ffile_executable_p (filename))); @@ -3165,9 +3314,9 @@ searchable directory.") } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, - "Return t if file FILENAME is the name of a regular file.\n\ -This is the sort of file that holds an ordinary stream of data bytes.") - (filename) + doc: /* Return t if file FILENAME is the name of a regular file. +This is the sort of file that holds an ordinary stream of data bytes. */) + (filename) Lisp_Object filename; { register Lisp_Object absname; @@ -3191,7 +3340,7 @@ This is the sort of file that holds an ordinary stream of data bytes.") /* Tell stat to use expensive method to get accurate info. */ Vw32_get_true_file_attributes = Qt; - result = stat (XSTRING (absname)->data, &st); + result = stat (SDATA (absname), &st); Vw32_get_true_file_attributes = tem; if (result < 0) @@ -3199,15 +3348,15 @@ This is the sort of file that holds an ordinary stream of data bytes.") return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; } #else - if (stat (XSTRING (absname)->data, &st) < 0) + if (stat (SDATA (absname), &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, - "Return mode bits of file named FILENAME, as an integer.") - (filename) + doc: /* Return mode bits of file named FILENAME, as an integer. */) + (filename) Lisp_Object filename; { Lisp_Object absname; @@ -3224,10 +3373,10 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, absname = ENCODE_FILE (absname); - if (stat (XSTRING (absname)->data, &st) < 0) + if (stat (SDATA (absname), &st) < 0) return Qnil; #if defined (MSDOS) && __DJGPP__ < 2 - if (check_executable (XSTRING (absname)->data)) + if (check_executable (SDATA (absname))) st.st_mode |= S_IEXEC; #endif /* MSDOS && __DJGPP__ < 2 */ @@ -3235,8 +3384,8 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, } DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, - "Set mode bits of file named FILENAME to MODE (an integer).\n\ -Only the 12 low bits of MODE are used.") + doc: /* Set mode bits of file named FILENAME to MODE (an integer). +Only the 12 low bits of MODE are used. */) (filename, mode) Lisp_Object filename, mode; { @@ -3244,7 +3393,7 @@ Only the 12 low bits of MODE are used.") Lisp_Object handler; absname = Fexpand_file_name (filename, current_buffer->directory); - CHECK_NUMBER (mode, 1); + CHECK_NUMBER (mode); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -3254,20 +3403,20 @@ Only the 12 low bits of MODE are used.") encoded_absname = ENCODE_FILE (absname); - if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0) + if (chmod (SDATA (encoded_absname), XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (absname, Qnil)); return Qnil; } DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, - "Set the file permission bits for newly created files.\n\ -The argument MODE should be an integer; only the low 9 bits are used.\n\ -This setting is inherited by subprocesses.") - (mode) + doc: /* Set the file permission bits for newly created files. +The argument MODE should be an integer; only the low 9 bits are used. +This setting is inherited by subprocesses. */) + (mode) Lisp_Object mode; { - CHECK_NUMBER (mode, 0); + CHECK_NUMBER (mode); umask ((~ XINT (mode)) & 0777); @@ -3275,9 +3424,9 @@ This setting is inherited by subprocesses.") } DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, - "Return the default file protection for created files.\n\ -The value is an integer.") - () + doc: /* Return the default file protection for created files. +The value is an integer. */) + () { int realmask; Lisp_Object value; @@ -3296,8 +3445,8 @@ The value is an integer.") #ifdef unix DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", - "Tell Unix to finish all pending disk updates.") - () + doc: /* Tell Unix to finish all pending disk updates. */) + () { sync (); return Qnil; @@ -3306,10 +3455,10 @@ DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", #endif /* unix */ DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, - "Return t if file FILE1 is newer than file FILE2.\n\ -If FILE1 does not exist, the answer is nil;\n\ -otherwise, if FILE2 does not exist, the answer is t.") - (file1, file2) + doc: /* Return t if file FILE1 is newer than file FILE2. +If FILE1 does not exist, the answer is nil; +otherwise, if FILE2 does not exist, the answer is t. */) + (file1, file2) Lisp_Object file1, file2; { Lisp_Object absname1, absname2; @@ -3318,8 +3467,8 @@ otherwise, if FILE2 does not exist, the answer is t.") Lisp_Object handler; struct gcpro gcpro1, gcpro2; - CHECK_STRING (file1, 0); - CHECK_STRING (file2, 0); + CHECK_STRING (file1); + CHECK_STRING (file2); absname1 = Qnil; GCPRO2 (absname1, file2); @@ -3340,12 +3489,12 @@ otherwise, if FILE2 does not exist, the answer is t.") absname2 = ENCODE_FILE (absname2); UNGCPRO; - if (stat (XSTRING (absname1)->data, &st) < 0) + if (stat (SDATA (absname1), &st) < 0) return Qnil; mtime1 = st.st_mtime; - if (stat (XSTRING (absname2)->data, &st) < 0) + if (stat (SDATA (absname2), &st) < 0) return Qt; return (mtime1 > st.st_mtime) ? Qt : Qnil; @@ -3401,32 +3550,70 @@ decide_coding_unwind (unwind_data) 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 - BEG_BYTE + non_regular_inserted, + non_regular_nbytes); + 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) + 1, 5, 0, + doc: /* Insert contents of file FILENAME after point. +Returns list of absolute file name and number of characters inserted. +If second argument VISIT is non-nil, the buffer's visited filename +and last save file modtime are set, and it is marked unmodified. +If visiting and the file does not exist, visiting is completed +before the error is signaled. +The optional third and fourth arguments BEG and END +specify what portion of the file to insert. +These arguments count bytes in the file, not characters in the buffer. +If VISIT is non-nil, BEG and END must be nil. + +If optional fifth argument REPLACE is non-nil, +it means replace the current buffer contents (in the accessible portion) +with the file contents. This is better than simply deleting and inserting +the whole thing because (1) it preserves some marker positions +and (2) it puts less data in the undo list. +When REPLACE is non-nil, the value is the number of characters actually read, +which is often less than the number of characters to be read. + +This does code conversion according to the value of +`coding-system-for-read' or `file-coding-system-alist', +and sets the variable `last-coding-system-used' to the coding system +actually used. */) + (filename, visit, beg, end, replace) Lisp_Object filename, visit, beg, end, replace; { struct stat st; @@ -3434,7 +3621,7 @@ actually used.") int inserted = 0; register int how_much; register int unprocessed; - int count = BINDING_STACK_SIZE (); + int count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object handler, val, insval, orig_filename; Lisp_Object p; @@ -3446,6 +3633,7 @@ actually used.") int replace_handled = 0; int set_coding_system = 0; int coding_system_decided = 0; + int read_quit = 0; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3459,7 +3647,7 @@ actually used.") GCPRO4 (filename, val, p, orig_filename); - CHECK_STRING (filename, 0); + CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -3485,15 +3673,15 @@ actually used.") /* Tell stat to use expensive method to get accurate info. */ Vw32_get_true_file_attributes = Qt; - total = stat (XSTRING (filename)->data, &st); + total = stat (SDATA (filename), &st); Vw32_get_true_file_attributes = tem; } if (total < 0) #else #ifndef APOLLO - if (stat (XSTRING (filename)->data, &st) < 0) + if (stat (SDATA (filename), &st) < 0) #else - if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0 + if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ #endif /* WINDOWSNT */ @@ -3528,7 +3716,7 @@ actually used.") #endif if (fd < 0) - if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0) + if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0) goto badopen; /* Replacement should preserve point as it preserves markers. */ @@ -3538,8 +3726,11 @@ actually used.") record_unwind_protect (close_file_unwind, make_number (fd)); /* Supposedly happens on VMS. */ + /* Can happen on any platform that uses long as type of off_t, but allows + file sizes to exceed 2Gb. VMS is no longer officially supported, so + give a message suitable for the latter case. */ if (! not_regular && st.st_size < 0) - error ("File size is negative"); + error ("Maximum buffer size exceeded"); /* Prevent redisplay optimizations. */ current_buffer->clip_changed = 1; @@ -3553,12 +3744,12 @@ actually used.") } if (!NILP (beg)) - CHECK_NUMBER (beg, 0); + CHECK_NUMBER (beg); else XSETFASTINT (beg, 0); if (!NILP (end)) - CHECK_NUMBER (end, 0); + CHECK_NUMBER (end); else { if (! not_regular) @@ -3572,10 +3763,29 @@ actually used.") 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) + if (EQ (Vcoding_system_for_read, Qauto_save_coding)) + { + /* We use emacs-mule for auto saving... */ + setup_coding_system (Qemacs_mule, &coding); + /* ... but with the special flag to indicate to read in a + multibyte sequence for eight-bit-control char as is. */ + coding.flags = 1; + coding.src_multibyte = 0; + coding.dst_multibyte + = !NILP (current_buffer->enable_multibyte_characters); + coding.eol_type = CODING_EOL_LF; + coding_system_decided = 1; + } + else if (BEG < Z) { /* Decide the coding system to use for reading the file now because we can't use an optimized method for handling @@ -3618,30 +3828,36 @@ actually used.") if (nread < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, emacs_strerror (errno)); + SDATA (orig_filename), emacs_strerror (errno)); else if (nread > 0) { struct buffer *prev = current_buffer; - int count1; + Lisp_Object buffer; + struct buffer *buf; 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; + buffer = Fget_buffer_create (build_string (" *code-converting-work*")); + buf = XBUFFER (buffer); + + delete_all_overlays (buf); + buf->directory = current_buffer->directory; + buf->read_only = Qnil; + buf->filename = Qnil; + buf->undo_list = Qt; + eassert (buf->overlays_before == NULL); + eassert (buf->overlays_after == NULL); + + set_buffer_internal (buf); + Ferase_buffer (); + buf->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--; @@ -3730,7 +3946,7 @@ actually used.") nread = emacs_read (fd, buffer, sizeof buffer); if (nread < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, emacs_strerror (errno)); + SDATA (orig_filename), emacs_strerror (errno)); else if (nread == 0) break; @@ -3795,18 +4011,22 @@ actually used.") report_file_error ("Setting file position", Fcons (orig_filename, Qnil)); - total_read = 0; + total_read = nread = 0; while (total_read < trial) { nread = emacs_read (fd, buffer + total_read, trial - total_read); - if (nread <= 0) + if (nread < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, emacs_strerror (errno)); + SDATA (orig_filename), 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 @@ -3826,6 +4046,9 @@ actually used.") giveup_match_end = 1; break; } + + if (nread == 0) + break; } immediate_quit = 0; @@ -3947,6 +4170,8 @@ actually used.") /* Convert this batch with results in CONVERSION_BUFFER. */ if (how_much >= total) /* This is the last block. */ 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); @@ -3975,7 +4200,7 @@ actually used.") if (how_much == -1) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, emacs_strerror (errno)); + SDATA (orig_filename), emacs_strerror (errno)); else if (how_much == -2) error ("maximum buffer size exceeded"); } @@ -4055,6 +4280,10 @@ actually used.") 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; @@ -4099,50 +4328,86 @@ actually used.") before exiting the loop, it is set to a negative value if I/O error occurs. */ how_much = 0; + /* Total bytes inserted. */ inserted = 0; + /* 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. */ - while (how_much < total) - { + { + 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); - int this; + int trytry = min (total - how_much, READ_BUF_SIZE); + int this; - /* For a special file, GAP_SIZE should be checked every time. */ - if (not_regular && GAP_SIZE < trytry) - make_gap (total - GAP_SIZE); + if (not_regular) + { + Lisp_Object val; - /* Allow quitting out of the actual I/O. */ - immediate_quit = 1; - QUIT; - this = emacs_read (fd, BYTE_POS_ADDR (PT_BYTE + inserted - 1) + 1, - trytry); - immediate_quit = 0; + /* Maybe make more room. */ + if (gap_size < trytry) + { + make_gap (total - gap_size); + gap_size = GAP_SIZE; + } - if (this <= 0) - { - how_much = this; - break; - } + /* 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; + } - GAP_SIZE -= this; - GPT_BYTE += this; - ZV_BYTE += this; - Z_BYTE += this; - GPT += this; - ZV += this; - Z += this; - - /* 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; - } + 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 - BEG_BYTE + inserted, trytry); + immediate_quit = 0; + } + + if (this <= 0) + { + how_much = this; + break; + } + + gap_size -= this; + + /* 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. */ @@ -4155,7 +4420,7 @@ actually used.") if (how_much < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, emacs_strerror (errno)); + SDATA (orig_filename), emacs_strerror (errno)); notfound: @@ -4180,7 +4445,7 @@ actually used.") this way, we can run Lisp program safely before decoding the inserted text. */ Lisp_Object unwind_data; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); unwind_data = Fcons (current_buffer->enable_multibyte_characters, Fcons (current_buffer->undo_list, @@ -4235,11 +4500,13 @@ actually used.") } 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)) { - /* Visiting a file with these coding system always make the buffer - unibyte. */ + /* Visiting a file with these coding system makes the buffer + unibyte. */ current_buffer->enable_multibyte_characters = Qnil; coding.dst_multibyte = 0; } @@ -4257,11 +4524,13 @@ actually used.") inserted); } + /* Now INSERTED is measured in characters. */ + #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 + if ((coding.eol_type == CODING_EOL_UNDECIDED || coding.eol_type == CODING_EOL_LF) && ! CODING_REQUIRE_DECODING (&coding)) current_buffer->buffer_file_type = Qt; @@ -4276,7 +4545,7 @@ actually used.") if (!EQ (current_buffer->undo_list, Qt)) current_buffer->undo_list = Qnil; #ifdef APOLLO - stat (XSTRING (filename)->data, &st); + stat (SDATA (filename), &st); #endif if (NILP (handler)) @@ -4302,11 +4571,24 @@ actually used.") Fcons (orig_filename, Qnil))); } + if (set_coding_system) + Vlast_coding_system_used = coding.symbol; + + if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) + { + insval = call1 (Qafter_insert_file_set_coding, make_number (inserted)); + if (! NILP (insval)) + { + CHECK_NUMBER (insval); + inserted = XFASTINT (insval); + } + } + /* 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. */ @@ -4315,19 +4597,16 @@ actually used.") 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); + CHECK_NUMBER (insval); 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. */ @@ -4339,16 +4618,16 @@ actually used.") } p = Vafter_insert_file_functions; - while (!NILP (p)) + while (CONSP (p)) { - insval = call1 (Fcar (p), make_number (inserted)); + insval = call1 (XCAR (p), make_number (inserted)); if (!NILP (insval)) { - CHECK_NUMBER (insval, 0); + CHECK_NUMBER (insval); inserted = XFASTINT (insval); } QUIT; - p = Fcdr (p); + p = XCDR (p); } if (!NILP (visit) @@ -4358,6 +4637,9 @@ actually used.") 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 (orig_filename, @@ -4367,8 +4649,9 @@ actually used.") RETURN_UNGCPRO (unbind_to (count, val)); } -static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object, - Lisp_Object)); +static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object build_annotations_2 P_ ((Lisp_Object, 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. @@ -4391,48 +4674,163 @@ build_annotations_unwind (buf) return Qnil; } +/* Decide the coding-system to encode the data with. */ + +void +choose_write_coding_system (start, end, filename, + append, visit, lockname, coding) + Lisp_Object start, end, filename, append, visit, lockname; + struct coding_system *coding; +{ + Lisp_Object val; + + if (auto_saving) + { + /* We use emacs-mule for auto saving... */ + setup_coding_system (Qemacs_mule, coding); + /* ... but with the special flag to indicate not to strip off + leading code of eight-bit-control chars. */ + coding->flags = 1; + goto done_setup_coding; + } + else if (!NILP (Vcoding_system_for_write)) + { + val = Vcoding_system_for_write; + if (coding_system_require_warning + && !NILP (Ffboundp (Vselect_safe_coding_system_function))) + /* Confirm that VAL can surely encode the current region. */ + val = call5 (Vselect_safe_coding_system_function, + start, end, Fcons (Qt, Fcons (val, Qnil)), + Qnil, filename); + } + 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 = call5 (Vselect_safe_coding_system_function, + start, end, val, Qnil, filename); + + 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; +} + 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). 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\ -If VISIT is a string, it is a second file name;\n\ - the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\ - VISIT is also the file name to lock and unlock for clash detection.\n\ -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', `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) + "r\nFWrite region to file: \ni\ni\ni\np", + doc: /* Write current region into specified file. +When called from a program, requires three arguments: +START, END and FILENAME. START and END are normally buffer positions +specifying the part of the buffer to write. +If START is nil, that means to use the entire buffer contents. +If START is a string, then output that string to the file +instead of any buffer contents; END is ignored. + +Optional fourth argument APPEND if non-nil means + append to existing file contents (if any). If it is an integer, + seek to that offset in the file before writing. +Optional fifth argument VISIT if t means + set the last-save-file-modtime of buffer to this file's modtime + and mark buffer not modified. +If VISIT is a string, it is a second file name; + the output goes to FILENAME, but the buffer is marked as visiting VISIT. + VISIT is also the file name to lock and unlock for clash detection. +If VISIT is neither t nor nil nor a string, + that means do not display the \"Wrote file\" message. +The optional sixth arg LOCKNAME, if non-nil, specifies the name to + use for locking and unlocking, overriding FILENAME and VISIT. +The optional seventh arg MUSTBENEW, if non-nil, insists on a check + for an existing file with the same name. If MUSTBENEW is `excl', + that means to get an error if the file already exists; never overwrite. + If MUSTBENEW is neither nil nor `excl', that means ask for + confirmation before overwriting, but do go ahead and overwrite the file + if the user confirms. + +This does code conversion according to the value of +`coding-system-for-write', `buffer-file-coding-system', or +`file-coding-system-alist', and sets the variable +`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 = 0; - unsigned char *fn; + const unsigned char *fn; struct stat st; int tem; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); int count1; #ifdef VMS unsigned char *fname = 0; /* If non-0, original filename (must rename) */ @@ -4456,118 +4854,22 @@ This does code conversion according to the value of\n\ 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; + GCPRO5 (start, filename, visit, visit_file, lockname); filename = Fexpand_file_name (filename, Qnil); - if (! NILP (mustbenew) && !EQ (mustbenew, Qexcl)) + 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; - - annotations = Qnil; if (NILP (lockname)) lockname = visit_file; - GCPRO5 (start, filename, annotations, visit_file, lockname); + annotations = Qnil; /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -4592,22 +4894,54 @@ This does code conversion according to the value of\n\ return val; } + record_unwind_protect (save_restriction_restore, save_restriction_save ()); + /* Special kludge to simplify auto-saving. */ if (NILP (start)) { XSETFASTINT (start, BEG); XSETFASTINT (end, Z); + Fwiden (); } record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); - count1 = specpdl_ptr - specpdl; + count1 = SPECPDL_INDEX (); + + given_buffer = current_buffer; + + if (!STRINGP (start)) + { + annotations = build_annotations (start, end); + + if (current_buffer != given_buffer) + { + XSETFASTINT (start, BEGV); + XSETFASTINT (end, ZV); + } + } + + UNGCPRO; + + GCPRO5 (start, filename, annotations, visit_file, lockname); + + /* Decide the coding-system to encode the data with. + We used to make this choice before calling build_annotations, but that + leads to problems when a write-annotate-function takes care of + unsavable chars (as was the case with X-Symbol). */ + choose_write_coding_system (start, end, filename, + append, visit, lockname, &coding); + Vlast_coding_system_used = coding.symbol; given_buffer = current_buffer; - annotations = build_annotations (start, end, coding.pre_write_conversion); - if (current_buffer != given_buffer) + if (! STRINGP (start)) { - XSETFASTINT (start, BEGV); - XSETFASTINT (end, ZV); + annotations = build_annotations_2 (start, end, + coding.pre_write_conversion, annotations); + if (current_buffer != given_buffer) + { + XSETFASTINT (start, BEGV); + XSETFASTINT (end, ZV); + } } #ifdef CLASH_DETECTION @@ -4626,7 +4960,7 @@ This does code conversion according to the value of\n\ encoded_filename = ENCODE_FILE (filename); - fn = XSTRING (encoded_filename)->data; + fn = SDATA (encoded_filename); desc = -1; if (!NILP (append)) #ifdef DOS_NT @@ -4643,7 +4977,7 @@ This does code conversion according to the value of\n\ desc = emacs_open (fn, O_RDWR, 0); if (desc < 0) desc = creat_copy_attrs (STRINGP (current_buffer->filename) - ? XSTRING (current_buffer->filename)->data : 0, + ? SDATA (current_buffer->filename) : 0, fn); } else /* Write to temporary name and rename if no errors */ @@ -4655,8 +4989,8 @@ This does code conversion according to the value of\n\ { temp_name = Fmake_temp_name (concat2 (temp_name, build_string ("$$SAVE$$"))); - fname = XSTRING (filename)->data; - fn = XSTRING (temp_name)->data; + fname = SDATA (filename); + fn = SDATA (temp_name); desc = creat_copy_attrs (fname, fn); if (desc < 0) { @@ -4710,7 +5044,7 @@ This does code conversion according to the value of\n\ if (!NILP (append) && !NILP (Ffile_regular_p (filename))) { long ret; - + if (NUMBERP (append)) ret = lseek (desc, XINT (append), 1); else @@ -4724,7 +5058,7 @@ This does code conversion according to the value of\n\ report_file_error ("Lseek error", Fcons (filename, Qnil)); } } - + UNGCPRO; #ifdef VMS @@ -4765,7 +5099,7 @@ This does code conversion according to the value of\n\ if (STRINGP (start)) { - failure = 0 > a_write (desc, start, 0, XSTRING (start)->size, + failure = 0 > a_write (desc, start, 0, SCHARS (start), &annotations, &coding); save_errno = errno; } @@ -4875,7 +5209,7 @@ This does code conversion according to the value of\n\ current_buffer->modtime = st.st_mtime; if (failure) - error ("IO error writing %s: %s", XSTRING (filename)->data, + error ("IO error writing %s: %s", SDATA (filename), emacs_strerror (save_errno)); if (visiting) @@ -4889,7 +5223,12 @@ This does code conversion according to the value of\n\ return Qnil; if (!auto_saving) - message_with_string ("Wrote %s", visit_file, 1); + message_with_string ((INTEGERP (append) + ? "Updated %s" + : ! NILP (append) + ? "Added to %s" + : "Wrote %s"), + visit_file, 1); return Qnil; } @@ -4897,8 +5236,8 @@ This does code conversion according to the value of\n\ Lisp_Object merge (); DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, - "Return t if (car A) is numerically less than (car B).") - (a, b) + doc: /* Return t if (car A) is numerically less than (car B). */) + (a, b) Lisp_Object a, b; { return Flss (Fcar (a), Fcar (b)); @@ -4913,25 +5252,34 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, as save-excursion would do. */ static Lisp_Object -build_annotations (start, end, pre_write_conversion) - Lisp_Object start, end, pre_write_conversion; +build_annotations (start, end) + Lisp_Object start, end; { Lisp_Object annotations; Lisp_Object p, res; struct gcpro gcpro1, gcpro2; Lisp_Object original_buffer; - int i; + int i, used_global = 0; XSETBUFFER (original_buffer, current_buffer); annotations = Qnil; p = Vwrite_region_annotate_functions; GCPRO2 (annotations, p); - while (!NILP (p)) + while (CONSP (p)) { struct buffer *given_buffer = current_buffer; + if (EQ (Qt, XCAR (p)) && !used_global) + { /* Use the global value of the hook. */ + Lisp_Object arg[2]; + used_global = 1; + arg[0] = Fdefault_value (Qwrite_region_annotate_functions); + arg[1] = XCDR (p); + p = Fappend (2, arg); + continue; + } Vwrite_region_annotations_so_far = annotations; - res = call2 (Fcar (p), start, end); + res = call2 (XCAR (p), start, end); /* If the function makes a different buffer current, assume that means this buffer contains altered text to be output. Reset START and END from the buffer bounds @@ -4945,7 +5293,7 @@ build_annotations (start, end, pre_write_conversion) } Flength (res); /* Check basic validity of return value */ annotations = merge (annotations, res, Qcar_less_than_car); - p = Fcdr (p); + p = XCDR (p); } /* Now do the same for annotation functions implied by the file-format */ @@ -4953,16 +5301,16 @@ build_annotations (start, end, pre_write_conversion) p = Vauto_save_file_format; else p = current_buffer->file_format; - for (i = 0; !NILP (p); p = Fcdr (p), ++i) + for (i = 0; CONSP (p); p = XCDR (p), ++i) { struct buffer *given_buffer = current_buffer; - + Vwrite_region_annotations_so_far = annotations; /* 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, + res = call5 (Qformat_annotate_function, XCAR (p), start, end, original_buffer, make_number (i)); if (current_buffer != given_buffer) { @@ -4970,11 +5318,23 @@ build_annotations (start, end, pre_write_conversion) XSETFASTINT (end, ZV); annotations = Qnil; } - + if (CONSP (res)) annotations = merge (annotations, res, Qcar_less_than_car); } + UNGCPRO; + return annotations; +} + +static Lisp_Object +build_annotations_2 (start, end, pre_write_conversion, annotations) + Lisp_Object start, end, pre_write_conversion, annotations; +{ + struct gcpro gcpro1; + Lisp_Object res; + + GCPRO1 (annotations); /* At last, do the same for the function PRE_WRITE_CONVERSION implied by the current coding-system. */ if (!NILP (pre_write_conversion)) @@ -5038,7 +5398,7 @@ a_write (desc, string, pos, nchars, annot, coding) tem = Fcdr (Fcar (*annot)); if (STRINGP (tem)) { - if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding)) + if (0 > e_write (desc, tem, 0, SCHARS (tem), coding)) return -1; } *annot = Fcdr (*annot); @@ -5074,8 +5434,8 @@ e_write (desc, string, start, end, coding) if (STRINGP (string)) { - addr = XSTRING (string)->data; - nbytes = STRING_BYTES (XSTRING (string)); + addr = SDATA (string); + nbytes = SBYTES (string); coding->src_multibyte = STRING_MULTIBYTE (string); } else if (start < end) @@ -5137,10 +5497,10 @@ e_write (desc, string, start, end, coding) } 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\ -This means that the file has not been changed since it was visited or saved.") - (buf) + Sverify_visited_file_modtime, 1, 1, 0, + doc: /* Return t if last mod time of BUF's visited file matches what BUF records. +This means that the file has not been changed since it was visited or saved. */) + (buf) Lisp_Object buf; { struct buffer *b; @@ -5148,7 +5508,7 @@ This means that the file has not been changed since it was visited or saved.") Lisp_Object handler; Lisp_Object filename; - CHECK_BUFFER (buf, 0); + CHECK_BUFFER (buf); b = XBUFFER (buf); if (!STRINGP (b->filename)) return Qt; @@ -5163,7 +5523,7 @@ This means that the file has not been changed since it was visited or saved.") filename = ENCODE_FILE (b->filename); - if (stat (XSTRING (filename)->data, &st) < 0) + if (stat (SDATA (filename), &st) < 0) { /* If the file doesn't exist now and didn't exist before, we say that it isn't modified, provided the error is a tame one. */ @@ -5182,34 +5542,34 @@ This means that the file has not been changed since it was visited or saved.") } DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, - Sclear_visited_file_modtime, 0, 0, 0, - "Clear out records of last mod time of visited file.\n\ -Next attempt to save will certainly not complain of a discrepancy.") - () + Sclear_visited_file_modtime, 0, 0, 0, + doc: /* Clear out records of last mod time of visited file. +Next attempt to save will certainly not complain of a discrepancy. */) + () { current_buffer->modtime = 0; return Qnil; } DEFUN ("visited-file-modtime", Fvisited_file_modtime, - Svisited_file_modtime, 0, 0, 0, - "Return the current buffer's recorded visited file modification time.\n\ -The value is a list of the form (HIGH . LOW), like the time values\n\ -that `file-attributes' returns.") - () + Svisited_file_modtime, 0, 0, 0, + doc: /* Return the current buffer's recorded visited file modification time. +The value is a list of the form (HIGH . LOW), like the time values +that `file-attributes' returns. */) + () { return long_to_cons ((unsigned long) current_buffer->modtime); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, - Sset_visited_file_modtime, 0, 1, 0, - "Update buffer's recorded modification time from the visited file's time.\n\ -Useful if the buffer was not read from the file normally\n\ -or if the file itself has been changed for some known benign reason.\n\ -An argument specifies the modification time value to use\n\ -\(instead of that of the visited file), in the form of a list\n\ -\(HIGH . LOW) or (HIGH LOW).") - (time_list) + Sset_visited_file_modtime, 0, 1, 0, + doc: /* Update buffer's recorded modification time from the visited file's time. +Useful if the buffer was not read from the file normally +or if the file itself has been changed for some known benign reason. +An argument specifies the modification time value to use +\(instead of that of the visited file), in the form of a list +\(HIGH . LOW) or (HIGH LOW). */) + (time_list) Lisp_Object time_list; { if (!NILP (time_list)) @@ -5231,7 +5591,7 @@ An argument specifies the modification time value to use\n\ filename = ENCODE_FILE (filename); - if (stat (XSTRING (filename)->data, &st) >= 0) + if (stat (SDATA (filename), &st) >= 0) current_buffer->modtime = st.st_mtime; } @@ -5245,22 +5605,22 @@ auto_save_error (error) Lisp_Object args[3], msg; int i, nbytes; struct gcpro gcpro1; - + ring_bell (); - + 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)); + nbytes = SBYTES (msg); for (i = 0; i < 3; ++i) { if (i == 0) - message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg)); + message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); else - message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg)); + message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); Fsleep_for (make_number (1), Qnil); } @@ -5275,7 +5635,7 @@ auto_save_1 () /* Get visited file's mode to become the auto save file's mode. */ if (! NILP (current_buffer->filename) - && stat (XSTRING (current_buffer->filename)->data, &st) >= 0) + && stat (SDATA (current_buffer->filename), &st) >= 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = st.st_mode | 0600; else @@ -5295,7 +5655,6 @@ do_auto_save_unwind (stream) /* used as unwind-protect function */ if (!NILP (stream)) fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 | XFASTINT (XCDR (stream)))); - pop_message (); return Qnil; } @@ -5307,17 +5666,32 @@ do_auto_save_unwind_1 (value) /* used as unwind-protect function */ return Qnil; } +static Lisp_Object +do_auto_save_make_dir (dir) + Lisp_Object dir; +{ + return call2 (Qmake_directory, dir, Qt); +} + +static Lisp_Object +do_auto_save_eh (ignore) + Lisp_Object ignore; +{ + return Qnil; +} + DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", - "Auto-save all buffers that need it.\n\ -This is all buffers that have auto-saving enabled\n\ -and are changed since last auto-saved.\n\ -Auto-saving writes the buffer into a file\n\ -so that your editing is not lost if the system crashes.\n\ -This file is not the file you visited; that changes only when you save.\n\ -Normally we run the normal hook `auto-save-hook' before saving.\n\n\ -A non-nil NO-MESSAGE argument means do not print any message if successful.\n\ -A non-nil CURRENT-ONLY argument means save only current buffer.") - (no_message, current_only) + doc: /* Auto-save all buffers that need it. +This is all buffers that have auto-saving enabled +and are changed since last auto-saved. +Auto-saving writes the buffer into a file +so that your editing is not lost if the system crashes. +This file is not the file you visited; that changes only when you save. +Normally we run the normal hook `auto-save-hook' before saving. + +A non-nil NO-MESSAGE argument means do not print any message if successful. +A non-nil CURRENT-ONLY argument means save only current buffer. */) + (no_message, current_only) Lisp_Object no_message, current_only; { struct buffer *old = current_buffer, *b; @@ -5327,10 +5701,23 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") Lisp_Object oquit; FILE *stream; Lisp_Object lispstream; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); int orig_minibuffer_auto_raise = minibuffer_auto_raise; - int message_p = push_message (); - + int old_message_p = 0; + struct gcpro gcpro1, gcpro2; + + if (max_specpdl_size < specpdl_size + 40) + max_specpdl_size = specpdl_size + 40; + + if (minibuf_level) + no_message = Qt; + + if (NILP (no_message)) + { + old_message_p = push_message (); + record_unwind_protect (pop_message_unwind, Qnil); + } + /* 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; @@ -5339,30 +5726,39 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") /* No GCPRO needed, because (when it matters) all Lisp_Object variables point to non-strings reached from Vbuffer_alist. */ - if (minibuf_level) - no_message = Qt; - if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("auto-save-hook")); if (STRINGP (Vauto_save_list_file_name)) { - Lisp_Object listfile, dir; - + Lisp_Object listfile; + listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); - - dir = Ffile_name_directory (listfile); - if (NILP (Ffile_directory_p (dir))) - call2 (Qmake_directory, dir, Qt); - - stream = fopen (XSTRING (listfile)->data, "w"); + + /* 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 = Qnil; + GCPRO2 (dir, listfile); + dir = Ffile_name_directory (listfile); + if (NILP (Ffile_directory_p (dir))) + internal_condition_case_1 (do_auto_save_make_dir, + dir, Fcons (Fcons (Qfile_error, Qnil), Qnil), + do_auto_save_eh); + UNGCPRO; + } + + stream = fopen (SDATA (listfile), "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); + XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); + XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); } else lispstream = Qnil; @@ -5398,12 +5794,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") { if (!NILP (b->filename)) { - fwrite (XSTRING (b->filename)->data, 1, - STRING_BYTES (XSTRING (b->filename)), stream); + fwrite (SDATA (b->filename), 1, + SBYTES (b->filename), stream); } putc ('\n', stream); - fwrite (XSTRING (b->auto_save_file_name)->data, 1, - STRING_BYTES (XSTRING (b->auto_save_file_name)), stream); + fwrite (SDATA (b->auto_save_file_name), 1, + SBYTES (b->auto_save_file_name), stream); putc ('\n', stream); } @@ -5448,7 +5844,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") { /* It has shrunk too much; turn off auto-saving here. */ minibuffer_auto_raise = orig_minibuffer_auto_raise; - message_with_string ("Buffer %s has shrunk a lot; auto save turned off there", + message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save", b->name, 1); minibuffer_auto_raise = 0; /* Turn off auto-saving until there's a real save, @@ -5480,26 +5876,31 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") if (auto_saved && NILP (no_message)) { - if (message_p) + if (old_message_p) { + /* If we are going to restore an old message, + give time to read ours. */ sit_for (1, 0, 0, 0, 0); restore_message (); } else + /* If we displayed a message and then restored a state + with no message, leave a "done" message on the screen. */ message1 ("Auto-saving...done"); } Vquit_flag = oquit; + /* This restores the message-stack status. */ unbind_to (count, Qnil); return Qnil; } DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, - Sset_buffer_auto_saved, 0, 0, 0, - "Mark current buffer as auto-saved with its current text.\n\ -No auto-save file will be written until the buffer changes again.") - () + Sset_buffer_auto_saved, 0, 0, 0, + doc: /* Mark current buffer as auto-saved with its current text. +No auto-save file will be written until the buffer changes again. */) + () { current_buffer->auto_save_modified = MODIFF; XSETFASTINT (current_buffer->save_length, Z - BEG); @@ -5508,18 +5909,18 @@ No auto-save file will be written until the buffer changes again.") } DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, - Sclear_buffer_auto_save_failure, 0, 0, 0, - "Clear any record of a recent auto-save failure in the current buffer.") - () + Sclear_buffer_auto_save_failure, 0, 0, 0, + doc: /* Clear any record of a recent auto-save failure in the current buffer. */) + () { current_buffer->auto_save_failure_time = -1; return Qnil; } DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, - 0, 0, 0, - "Return t if buffer has been auto-saved since last read in or saved.") - () + 0, 0, 0, + doc: /* Return t if buffer has been auto-saved since last read in or saved. */) + () { return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil; } @@ -5533,21 +5934,22 @@ static Lisp_Object double_dollars (val) Lisp_Object val; { - register unsigned char *old, *new; + register const unsigned char *old; + register unsigned char *new; register int n; int osize, count; - osize = STRING_BYTES (XSTRING (val)); + osize = SBYTES (val); /* Count the number of $ characters. */ - for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) + for (n = osize, count = 0, old = SDATA (val); n > 0; n--) if (*old++ == '$') count++; if (count > 0) { - old = XSTRING (val)->data; - val = make_uninit_multibyte_string (XSTRING (val)->size + count, + old = SDATA (val); + val = make_uninit_multibyte_string (SCHARS (val) + count, osize + count); - new = XSTRING (val)->data; + new = SDATA (val); for (n = osize; n > 0; n--) if (*old != '$') *new++ = *old++; @@ -5561,10 +5963,17 @@ double_dollars (val) return val; } +static Lisp_Object +read_file_name_cleanup (arg) + Lisp_Object arg; +{ + return (current_buffer->directory = arg); +} + DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, - 3, 3, 0, - "Internal subroutine for read-file-name. Do not call this.") - (string, dir, action) + 3, 3, 0, + doc: /* Internal subroutine for read-file-name. Do not call this. */) + (string, dir, action) Lisp_Object string, dir, action; /* action is nil for complete, t for return list of completions, lambda for verify final value */ @@ -5573,7 +5982,7 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte int changed; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - CHECK_STRING (string, 0); + CHECK_STRING (string); realdir = dir; name = string; @@ -5583,7 +5992,7 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte /* No need to protect ACTION--we only compare it with t and nil. */ GCPRO5 (string, realdir, name, specdir, orig_string); - if (XSTRING (string)->size == 0) + if (SCHARS (string) == 0) { if (EQ (action, Qlambda)) { @@ -5625,37 +6034,82 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte UNGCPRO; if (EQ (action, Qt)) - return Ffile_name_all_completions (name, realdir); + { + Lisp_Object all = Ffile_name_all_completions (name, realdir); + Lisp_Object comp; + int count; + + if (NILP (Vread_file_name_predicate) + || EQ (Vread_file_name_predicate, Qfile_exists_p)) + return all; + +#ifndef VMS + if (EQ (Vread_file_name_predicate, Qfile_directory_p)) + { + /* Brute-force speed up for directory checking: + Discard strings which don't end in a slash. */ + for (comp = Qnil; CONSP (all); all = XCDR (all)) + { + Lisp_Object tem = XCAR (all); + int len; + if (STRINGP (tem) && + (len = SCHARS (tem), len > 0) && + IS_DIRECTORY_SEP (SREF (tem, len-1))) + comp = Fcons (tem, comp); + } + } + else +#endif + { + /* Must do it the hard (and slow) way. */ + GCPRO3 (all, comp, specdir); + count = SPECPDL_INDEX (); + record_unwind_protect (read_file_name_cleanup, current_buffer->directory); + current_buffer->directory = realdir; + for (comp = Qnil; CONSP (all); all = XCDR (all)) + if (!NILP (call1 (Vread_file_name_predicate, XCAR (all)))) + comp = Fcons (XCAR (all), comp); + unbind_to (count, Qnil); + UNGCPRO; + } + return Fnreverse (comp); + } + /* Only other case actually used is ACTION = lambda */ #ifdef VMS /* Supposedly this helps commands such as `cd' that read directory names, but can someone explain how it helps them? -- RMS */ - if (XSTRING (name)->size == 0) + if (SCHARS (name) == 0) return Qt; #endif /* VMS */ + if (!NILP (Vread_file_name_predicate)) + return call1 (Vread_file_name_predicate, string); return Ffile_exists_p (string); } -DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, - "Read file name, prompting with PROMPT and completing in directory DIR.\n\ -Value is not expanded---you must call `expand-file-name' yourself.\n\ -Default name to DEFAULT-FILENAME if user enters a null string.\n\ - (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\ - except that if INITIAL is specified, that combined with DIR is used.)\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.\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; +DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, + doc: /* Read file name, prompting with PROMPT and completing in directory DIR. +Value is not expanded---you must call `expand-file-name' yourself. +Default name to DEFAULT-FILENAME if user enters a null string. + (If DEFAULT-FILENAME is omitted, the visited file name is used, + except that if INITIAL is specified, that combined with DIR is used.) +Fourth arg MUSTMATCH non-nil means require existing file's name. + Non-nil and non-t means also require confirmation after completion. +Fifth arg INITIAL specifies text to start with. +If optional sixth arg PREDICATE is non-nil, possible completions and the +resulting file name must satisfy (funcall PREDICATE NAME). +DIR defaults to current buffer's directory default. + +If this command was invoked with the mouse, use a file dialog box if +`use-dialog-box' is non-nil, and the window system or X toolkit in use +provides a file dialog box. */) + (prompt, dir, default_filename, mustmatch, initial, predicate) + Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate; { Lisp_Object val, insdef, tem; struct gcpro gcpro1, gcpro2; register char *homedir; + Lisp_Object decoded_homedir; int replace_in_history = 0; int add_to_history = 0; int count; @@ -5663,12 +6117,9 @@ provides a file dialog box..") if (NILP (dir)) dir = current_buffer->directory; if (NILP (default_filename)) - { - if (! NILP (initial)) - default_filename = Fexpand_file_name (initial, dir); - else - default_filename = current_buffer->filename; - } + default_filename = !NILP (initial) + ? Fexpand_file_name (initial, dir) + : current_buffer->filename; /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); @@ -5681,29 +6132,33 @@ provides a file dialog box..") CORRECT_DIR_SEPS (homedir); } #endif + if (homedir != 0) + decoded_homedir + = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir))); if (homedir != 0 && STRINGP (dir) - && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) - && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)])) + && !strncmp (SDATA (decoded_homedir), SDATA (dir), + SBYTES (decoded_homedir)) + && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir)))) { - dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, - STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1); - XSTRING (dir)->data[0] = '~'; + dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil); + dir = concat2 (build_string ("~"), dir); } /* 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)])) + && !strncmp (SDATA (decoded_homedir), SDATA (default_filename), + SBYTES (decoded_homedir)) + && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_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] = '~'; + = Fsubstring (default_filename, + make_number (SCHARS (decoded_homedir)), Qnil); + default_filename = concat2 (build_string ("~"), default_filename); } if (!NILP (default_filename)) { - CHECK_STRING (default_filename, 3); + CHECK_STRING (default_filename); default_filename = double_dollars (default_filename); } @@ -5717,7 +6172,7 @@ provides a file dialog box..") args[0] = insdef; args[1] = initial; insdef = Fconcat (2, args); - pos = make_number (XSTRING (double_dollars (dir))->size); + pos = make_number (SCHARS (double_dollars (dir))); insdef = Fcons (double_dollars (insdef), pos); } else @@ -5728,16 +6183,33 @@ provides a file dialog box..") else insdef = Qnil; - count = specpdl_ptr - specpdl; + if (!NILP (Vread_file_name_function)) + { + Lisp_Object args[7]; + + GCPRO2 (insdef, default_filename); + args[0] = Vread_file_name_function; + args[1] = prompt; + args[2] = dir; + args[3] = default_filename; + args[4] = mustmatch; + args[5] = initial; + args[6] = predicate; + RETURN_UNGCPRO (Ffuncall (7, args)); + } + + count = SPECPDL_INDEX (); #ifdef VMS specbind (intern ("completion-ignore-case"), Qt); #endif specbind (intern ("minibuffer-completing-file-name"), Qt); + specbind (intern ("read-file-name-predicate"), + (NILP (predicate) ? Qfile_exists_p : predicate)); GCPRO2 (insdef, default_filename); - -#if defined (USE_MOTIF) || defined (HAVE_NTGUI) + +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && use_dialog_box && have_menus_p ()) @@ -5745,7 +6217,7 @@ provides a file dialog box..") /* If DIR contains a file name, split it. */ Lisp_Object file; file = Ffile_name_nondirectory (dir); - if (XSTRING (file)->size && NILP (default_filename)) + if (SCHARS (file) && NILP (default_filename)) { default_filename = file; dir = Ffile_name_directory (dir); @@ -5777,7 +6249,7 @@ provides a file dialog box..") if (! replace_in_history) add_to_history = 1; - val = build_string (""); + val = empty_string; } unbind_to (count, Qnil); @@ -5789,7 +6261,7 @@ provides a file dialog box..") if (!NILP (tem) && !NILP (default_filename)) val = default_filename; - else if (XSTRING (val)->size == 0 && NILP (insdef)) + else if (SCHARS (val) == 0 && NILP (insdef)) { if (!NILP (default_filename)) val = default_filename; @@ -5801,7 +6273,7 @@ provides a file dialog box..") 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); + XSETCAR (Fsymbol_value (Qfile_name_history), double_dollars (val)); else if (add_to_history) { /* Add the value to the history--but not if it matches @@ -5812,7 +6284,7 @@ provides a file dialog box..") Fset (Qfile_name_history, Fcons (val1, tem)); } - + return val; } @@ -5859,6 +6331,7 @@ syms_of_fileio () Qwrite_region = intern ("write-region"); Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); Qset_visited_file_modtime = intern ("set-visited-file-modtime"); + Qauto_save_coding = intern ("auto-save-coding"); staticpro (&Qexpand_file_name); staticpro (&Qsubstitute_in_file_name); @@ -5891,6 +6364,7 @@ syms_of_fileio () staticpro (&Qwrite_region); staticpro (&Qverify_visited_file_modtime); staticpro (&Qset_visited_file_modtime); + staticpro (&Qauto_save_coding); Qfile_name_history = intern ("file-name-history"); Fset (Qfile_name_history, Qnil); @@ -5911,33 +6385,35 @@ syms_of_fileio () #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."); + doc: /* *Coding system for encoding file names. +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."); + doc: /* Default coding system for encoding file names. +This variable is used only when `file-name-coding-system' is nil. + +This variable is set/changed by the command `set-language-environment'. +User should not set this variable manually, +instead use `file-name-coding-system' to get a constant encoding +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\ -If it is t, which is the default, auto-save files are written in the\n\ -same format as a regular save would use."); + doc: /* *Format in which to write auto-save files. +Should be a list of symbols naming formats that are defined in `format-alist'. +If it is t, which is the default, auto-save files are written in the +same format as a regular save would use. */); Vauto_save_file_format = Qt; Qformat_decode = intern ("format-decode"); staticpro (&Qformat_decode); Qformat_annotate_function = intern ("format-annotate-function"); staticpro (&Qformat_annotate_function); - + Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding"); + staticpro (&Qafter_insert_file_set_coding); + Qcar_less_than_car = intern ("car-less-than-car"); staticpro (&Qcar_less_than_car); @@ -5958,94 +6434,103 @@ same format as a regular save would use."); Fput (Qfile_date_error, Qerror_message, build_string ("Cannot set file date")); + DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function, + doc: /* If this is non-nil, `read-file-name' does its work by calling this function. */); + Vread_file_name_function = Qnil; + + DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate, + doc: /* Current predicate used by `read-file-name-internal'. */); + Vread_file_name_predicate = Qnil; + DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, - "*Non-nil means when reading a filename start with default dir in minibuffer."); + doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. */); insert_default_directory = 1; DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm, - "*Non-nil means write new files with record format `stmlf'.\n\ -nil means use format `var'. This variable is meaningful only on VMS."); + doc: /* *Non-nil means write new files with record format `stmlf'. +nil means use format `var'. This variable is meaningful only on VMS. */); vms_stmlf_recfm = 0; DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char, - "Directory separator character for built-in functions that return file names.\n\ -The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\ -This variable affects the built-in functions only on Windows,\n\ -on other platforms, it is initialized so that Lisp code can find out\n\ -what the normal separator is.\n\ -\n\ -WARNING: This variable is deprecated and will be removed in the near\n\ -future. DO NOT USE IT."); + doc: /* Directory separator character for built-in functions that return file names. +The value is always ?/. Don't use this variable, just use `/'. */); DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, - "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ -If a file name matches REGEXP, then all I/O on that file is done by calling\n\ -HANDLER.\n\ -\n\ -The first argument given to HANDLER is the name of the I/O primitive\n\ -to be handled; the remaining arguments are the arguments that were\n\ -passed to that primitive. For example, if you do\n\ - (file-exists-p FILENAME)\n\ -and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ - (funcall HANDLER 'file-exists-p FILENAME)\n\ -The function `find-file-name-handler' checks this list for a handler\n\ -for its argument."); + doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially. +If a file name matches REGEXP, then all I/O on that file is done by calling +HANDLER. + +The first argument given to HANDLER is the name of the I/O primitive +to be handled; the remaining arguments are the arguments that were +passed to that primitive. For example, if you do + (file-exists-p FILENAME) +and FILENAME is handled by HANDLER, then HANDLER is called like this: + (funcall HANDLER 'file-exists-p FILENAME) +The function `find-file-name-handler' checks this list for a handler +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."); + doc: /* If non-nil, a function to call to decide a coding system of file. +Two arguments are passed to this function: the file name +and the length of a file contents following the point. +This function should return a coding system to decode the file contents. +It should check the file name against `auto-coding-alist'. +If no coding system is decided, it should check a coding system +specified in the heading lines with the format: + -*- ... coding: CODING-SYSTEM; ... -*- +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\ -the new byte count, and leave point the same. If `insert-file-contents' is\n\ -intercepted by a handler from `file-name-handler-alist', that handler is\n\ -responsible for calling the after-insert-file-functions if appropriate."); + doc: /* A list of functions to be called at the end of `insert-file-contents'. +Each is passed one argument, the number of characters inserted. +It should return the new character count, and leave point the same. +If `insert-file-contents' is intercepted by a handler from +`file-name-handler-alist', that handler is responsible for calling the +functions in `after-insert-file-functions' if appropriate. */); Vafter_insert_file_functions = Qnil; DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, - "A list of functions to be called at the start of `write-region'.\n\ -Each is passed two arguments, START and END as for `write-region'.\n\ -These are usually two numbers but not always; see the documentation\n\ -for `write-region'. The function should return a list of pairs\n\ -of the form (POSITION . STRING), consisting of strings to be effectively\n\ -inserted at the specified positions of the file being written (1 means to\n\ -insert before the first byte written). The POSITIONs must be sorted into\n\ -increasing order. If there are several functions in the list, the several\n\ -lists are merged destructively."); + doc: /* A list of functions to be called at the start of `write-region'. +Each is passed two arguments, START and END as for `write-region'. +These are usually two numbers but not always; see the documentation +for `write-region'. The function should return a list of pairs +of the form (POSITION . STRING), consisting of strings to be effectively +inserted at the specified positions of the file being written (1 means to +insert before the first byte written). The POSITIONs must be sorted into +increasing order. If there are several functions in the list, the several +lists are merged destructively. Alternatively, the function can return +with a different buffer current; in that case it should pay attention +to the annotations returned by previous functions and listed in +`write-region-annotations-so-far'.*/); Vwrite_region_annotate_functions = Qnil; + staticpro (&Qwrite_region_annotate_functions); + Qwrite_region_annotate_functions + = intern ("write-region-annotate-functions"); DEFVAR_LISP ("write-region-annotations-so-far", &Vwrite_region_annotations_so_far, - "When an annotation function is called, this holds the previous annotations.\n\ -These are the annotations made by other annotation functions\n\ -that were already called. See also `write-region-annotate-functions'."); + doc: /* When an annotation function is called, this holds the previous annotations. +These are the annotations made by other annotation functions +that were already called. See also `write-region-annotate-functions'. */); Vwrite_region_annotations_so_far = Qnil; DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, - "A list of file name handlers that temporarily should not be used.\n\ -This applies only to the operation `inhibit-file-name-operation'."); + doc: /* A list of file name handlers that temporarily should not be used. +This applies only to the operation `inhibit-file-name-operation'. */); Vinhibit_file_name_handlers = Qnil; DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation, - "The operation for which `inhibit-file-name-handlers' is applicable."); + doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */); Vinhibit_file_name_operation = Qnil; DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name, - "File name in which we write a list of all auto save file names.\n\ -This variable is initialized automatically from `auto-save-list-file-prefix'\n\ -shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\ -a non-nil value."); + doc: /* File name in which we write a list of all auto save file names. +This variable is initialized automatically from `auto-save-list-file-prefix' +shortly after Emacs reads your `.emacs' file, if you have not yet given it +a non-nil value. */); Vauto_save_list_file_name = Qnil; defsubr (&Sfind_file_name_handler); @@ -6106,4 +6591,3 @@ a non-nil value."); defsubr (&Sunix_sync); #endif } -