X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b016179b58efb59ba177cafdaea6bdee2d23e0e0..e0f24100c74828aadd926f0afa6e3440be8c89d0:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 898dc0705d..26723fa4f3 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,12 +1,13 @@ /* File IO for GNU Emacs. - Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, - 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, + 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006, 2007 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) +the Free Software Foundation; either version 3, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -16,8 +17,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License 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. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -76,6 +77,7 @@ extern int errno; #include "charset.h" #include "coding.h" #include "window.h" +#include "blockinput.h" #ifdef WINDOWSNT #define NOMINMAX 1 @@ -224,6 +226,11 @@ int vms_stmlf_recfm; expanding file names. This can be bound to / or \. */ Lisp_Object Vdirectory_sep_char; +#ifdef HAVE_FSYNC +/* Nonzero means skip the call to fsync in Fwrite-region. */ +int write_region_inhibit_fsync; +#endif + extern Lisp_Object Vuser_login_name; #ifdef WINDOWSNT @@ -273,7 +280,7 @@ report_file_error (string, data) switch (errorno) { case EEXIST: - Fsignal (Qfile_already_exists, Fcons (errstring, data)); + xsignal (Qfile_already_exists, Fcons (errstring, data)); break; default: /* System error messages are capitalized. Downcase the initial @@ -281,7 +288,7 @@ report_file_error (string, data) if (SREF (errstring, 1) != '/') SSET (errstring, 0, DOWNCASE (SREF (errstring, 0))); - Fsignal (Qfile_error, + xsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); } } @@ -1055,6 +1062,7 @@ See also the function `substitute-in-file-name'. */) #endif /* DOS_NT */ int length; Lisp_Object handler, result; + int multibyte; CHECK_STRING (name); @@ -1132,6 +1140,7 @@ See also the function `substitute-in-file-name'. */) name = FILE_SYSTEM_CASE (name); nm = SDATA (name); + multibyte = STRING_MULTIBYTE (name); #ifdef DOS_NT /* We will force directory separators to be either all \ or /, so make @@ -1239,9 +1248,9 @@ See also the function `substitute-in-file-name'. */) } else #endif /* NO_HYPHENS_IN_FILENAMES */ - if (lbrack > rbrack && - ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && - (p[1] == '.' || p[1] == ']' || p[1] == '>'))) + if (lbrack > rbrack + && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') + && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) lose = 1; #ifdef NO_HYPHENS_IN_FILENAMES else @@ -1297,8 +1306,7 @@ See also the function `substitute-in-file-name'. */) if (index (nm, '/')) { nm = sys_translate_unix (nm); - return make_specified_string (nm, -1, strlen (nm), - STRING_MULTIBYTE (name)); + return make_specified_string (nm, -1, strlen (nm), multibyte); } #endif /* VMS */ #ifdef DOS_NT @@ -1310,8 +1318,7 @@ See also the function `substitute-in-file-name'. */) if (IS_DIRECTORY_SEP (nm[1])) { if (strcmp (nm, SDATA (name)) != 0) - name = make_specified_string (nm, -1, strlen (nm), - STRING_MULTIBYTE (name)); + name = make_specified_string (nm, -1, strlen (nm), multibyte); } else #endif @@ -1320,8 +1327,7 @@ See also the function `substitute-in-file-name'. */) { char temp[] = " :"; - name = make_specified_string (nm, -1, p - nm, - STRING_MULTIBYTE (name)); + name = make_specified_string (nm, -1, p - nm, multibyte); temp[0] = DRIVE_LETTER (drive); name = concat2 (build_string (temp), name); } @@ -1329,8 +1335,7 @@ See also the function `substitute-in-file-name'. */) #else /* not DOS_NT */ if (nm == SDATA (name)) return name; - return make_specified_string (nm, -1, strlen (nm), - STRING_MULTIBYTE (name)); + return make_specified_string (nm, -1, strlen (nm), multibyte); #endif /* not DOS_NT */ } } @@ -1382,7 +1387,9 @@ See also the function `substitute-in-file-name'. */) bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; + BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); + UNBLOCK_INPUT; if (pw) { newdir = (unsigned char *) pw -> pw_dir; @@ -1442,6 +1449,7 @@ See also the function `substitute-in-file-name'. */) && !newdir) { newdir = SDATA (default_directory); + multibyte |= STRING_MULTIBYTE (default_directory); #ifdef DOS_NT /* Note if special escape prefix is present, but remove for now. */ if (newdir[0] == '/' && newdir[1] == ':') @@ -1611,8 +1619,8 @@ See also the function `substitute-in-file-name'. */) else if (*p == '-' && *o != '.') *--p = '.'; } - else if (p[0] == '-' && o[-1] == '.' && - (p[1] == '.' || p[1] == ']' || p[1] == '>')) + else if (p[0] == '-' && o[-1] == '.' + && (p[1] == '.' || p[1] == ']' || p[1] == '>')) /* flush .foo.- ; leave - if stopped by '[' or '<' */ { do @@ -1627,9 +1635,9 @@ See also the function `substitute-in-file-name'. */) else { #ifdef NO_HYPHENS_IN_FILENAMES - if (*p == '-' && - o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && - p[1] != ']' && p[1] != '>' && p[1] != '.') + if (*p == '-' + && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' + && p[1] != ']' && p[1] != '>' && p[1] != '.') *p = '_'; #endif /* NO_HYPHENS_IN_FILENAMES */ *o++ = *p++; @@ -1639,8 +1647,7 @@ See also the function `substitute-in-file-name'. */) { *o++ = *p++; } - else if (IS_DIRECTORY_SEP (p[0]) - && p[1] == '.' + else if (p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0)) { @@ -1650,7 +1657,7 @@ See also the function `substitute-in-file-name'. */) *o++ = *p; p += 2; } - else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' + else if (p[1] == '.' && p[2] == '.' /* `/../' is the "superroot" on certain file systems. Turned off on DOS_NT systems because they have no "superroot" and because this causes us to produce @@ -1670,14 +1677,9 @@ See also the function `substitute-in-file-name'. */) ++o; p += 3; } - else if (p > target - && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) - { - /* Collapse multiple `/' in a row. */ - *o++ = *p++; - while (IS_DIRECTORY_SEP (*p)) - ++p; - } + else if (p > target && IS_DIRECTORY_SEP (p[1])) + /* Collapse multiple `/' in a row. */ + p++; else { *o++ = *p++; @@ -1707,8 +1709,7 @@ See also the function `substitute-in-file-name'. */) CORRECT_DIR_SEPS (target); #endif /* DOS_NT */ - result = make_specified_string (target, -1, o - target, - STRING_MULTIBYTE (name)); + result = make_specified_string (target, -1, o - target, multibyte); /* Again look to see if the file name has special constructs in it and perhaps call the corresponding file handler. This is needed @@ -1819,9 +1820,9 @@ See also the function `substitute-in-file-name'.") } else #endif /* VMS4_4 */ - if (lbrack > rbrack && - ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && - (p[1] == '.' || p[1] == ']' || p[1] == '>'))) + if (lbrack > rbrack + && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') + && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) lose = 1; #ifndef VMS4_4 else @@ -1919,7 +1920,9 @@ See also the function `substitute-in-file-name'.") o[len] = 0; /* Look up the user name. */ + BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); + UNBLOCK_INPUT; if (!pw) error ("\"%s\" isn't a registered user", o + 1); @@ -1988,8 +1991,8 @@ See also the function `substitute-in-file-name'.") else if (*p == '-' && *o != '.') *--p = '.'; } - else if (p[0] == '-' && o[-1] == '.' && - (p[1] == '.' || p[1] == ']' || p[1] == '>')) + else if (p[0] == '-' && o[-1] == '.' + && (p[1] == '.' || p[1] == ']' || p[1] == '>')) /* flush .foo.- ; leave - if stopped by '[' or '<' */ { do @@ -2004,9 +2007,9 @@ See also the function `substitute-in-file-name'.") else { #ifndef VMS4_4 - if (*p == '-' && - o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && - p[1] != ']' && p[1] != '>' && p[1] != '.') + if (*p == '-' + && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' + && p[1] != ']' && p[1] != '>' && p[1] != '.') *p = '_'; #endif /* VMS4_4 */ *o++ = *p++; @@ -2026,8 +2029,8 @@ See also the function `substitute-in-file-name'.") o = target; p++; } - else if (p[0] == '/' && p[1] == '.' && - (p[2] == '/' || p[2] == 0)) + else if (p[0] == '/' && p[1] == '.' + && (p[2] == '/' || p[2] == 0)) p += 2; else if (!strncmp (p, "/..", 3) /* `/../' is the "superroot" on certain file systems. */ @@ -2113,10 +2116,11 @@ search_embedded_absfilename (nm, endp) /* If we have ~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 ((pw = getpwnam (o + 1))) + BLOCK_INPUT; + pw = getpwnam (o + 1); + UNBLOCK_INPUT; + if (pw) return p; - else - xfree (pw); } else return p; @@ -2380,9 +2384,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) if (lstat (SDATA (encoded_filename), &statbuf) >= 0) { if (! interactive) - Fsignal (Qfile_already_exists, - Fcons (build_string ("File already exists"), - Fcons (absname, Qnil))); + xsignal2 (Qfile_already_exists, + build_string ("File already exists"), absname); GCPRO1 (absname); tem = format2 ("File %s already exists; %s anyway? ", absname, build_string (querystring)); @@ -2392,9 +2395,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) tem = do_yes_or_no_p (tem); UNGCPRO; if (NILP (tem)) - Fsignal (Qfile_already_exists, - Fcons (build_string ("File already exists"), - Fcons (absname, Qnil))); + xsignal2 (Qfile_already_exists, + build_string ("File already exists"), absname); if (statptr) *statptr = statbuf; } @@ -2406,32 +2408,31 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) return; } -DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6, +DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5, "fCopy file: \nGCopy %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. -Always sets the file modes of the output file to match the input file. + +This function always sets the file modes of the output file to match +the input file. + +The optional third argument OK-IF-ALREADY-EXISTS specifies what to do +if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we +signal a `file-already-exists' error without overwriting. If +OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user +about overwriting; this is what happens in interactive use with M-x. +Any other value for OK-IF-ALREADY-EXISTS means to overwrite the +existing file. Fourth arg KEEP-TIME non-nil means give the output file the same last-modified time as the old one. (This works on only some systems.) A prefix arg makes KEEP-TIME non-nil. -The optional fifth 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. - If PRESERVE-UID-GID is non-nil, we try to transfer the uid and gid of FILE to NEWNAME. */) - (file, newname, ok_if_already_exists, keep_time, mustbenew, preserve_uid_gid) - Lisp_Object file, newname, ok_if_already_exists, keep_time, mustbenew; + (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid) + Lisp_Object file, newname, ok_if_already_exists, keep_time; Lisp_Object preserve_uid_gid; { int ifd, ofd, n; @@ -2448,9 +2449,6 @@ uid and gid of FILE to NEWNAME. */) CHECK_STRING (file); CHECK_STRING (newname); - if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl)) - barf_or_query_if_file_exists (newname, "overwrite", 1, 0, 1); - if (!NILP (Ffile_directory_p (newname))) newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); else @@ -2473,7 +2471,7 @@ uid and gid of FILE to NEWNAME. */) if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (encoded_newname, "copy to it", + barf_or_query_if_file_exists (newname, "copy to it", INTEGERP (ok_if_already_exists), &out_st, 0); else if (stat (SDATA (encoded_newname), &out_st) < 0) out_st.st_mode = 0; @@ -2500,9 +2498,8 @@ uid and gid of FILE to NEWNAME. */) { /* Restore original attributes. */ SetFileAttributes (filename, attributes); - Fsignal (Qfile_date_error, - Fcons (build_string ("Cannot set file date"), - Fcons (newname, Qnil))); + xsignal2 (Qfile_date_error, + build_string ("Cannot set file date"), newname); } /* Restore original attributes. */ SetFileAttributes (filename, attributes); @@ -2553,12 +2550,12 @@ uid and gid of FILE to NEWNAME. */) /* System's default file type was set to binary by _fmode in emacs.c. */ ofd = emacs_open (SDATA (encoded_newname), O_WRONLY | O_TRUNC | O_CREAT - | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + | (NILP (ok_if_already_exists) ? O_EXCL : 0), S_IREAD | S_IWRITE); #else /* not MSDOS */ ofd = emacs_open (SDATA (encoded_newname), O_WRONLY | O_TRUNC | O_CREAT - | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + | (NILP (ok_if_already_exists) ? O_EXCL : 0), 0666); #endif /* not MSDOS */ #endif /* VMS */ @@ -2598,9 +2595,8 @@ uid and gid of FILE to NEWNAME. */) EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); if (set_file_times (SDATA (encoded_newname), atime, mtime)) - Fsignal (Qfile_date_error, - Fcons (build_string ("Cannot set file date"), - Fcons (newname, Qnil))); + xsignal2 (Qfile_date_error, + build_string ("Cannot set file date"), newname); } } @@ -2652,7 +2648,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, #else if (mkdir (dir, 0777) != 0) #endif - report_file_error ("Creating directory", Flist (1, &directory)); + report_file_error ("Creating directory", list1 (directory)); return Qnil; } @@ -2678,7 +2674,7 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete dir = SDATA (encoded_dir); if (rmdir (dir) != 0) - report_file_error ("Removing directory", Flist (1, &directory)); + report_file_error ("Removing directory", list1 (directory)); return Qnil; } @@ -2696,9 +2692,9 @@ If file has multiple names, it continues to exist with the other names. */) 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))); + xsignal2 (Qfile_error, + build_string ("Removing old name: is a directory"), + filename); UNGCPRO; filename = Fexpand_file_name (filename, Qnil); @@ -2709,7 +2705,7 @@ If file has multiple names, it continues to exist with the other names. */) encoded_file = ENCODE_FILE (filename); if (0 > unlink (SDATA (encoded_file))) - report_file_error ("Removing old name", Flist (1, &filename)); + report_file_error ("Removing old name", list1 (filename)); return Qnil; } @@ -2726,8 +2722,10 @@ int internal_delete_file (filename) Lisp_Object filename; { - return NILP (internal_condition_case_1 (Fdelete_file, filename, - Qt, internal_delete_file_1)); + Lisp_Object tem; + tem = internal_condition_case_1 (Fdelete_file, filename, + Qt, internal_delete_file_1); + return NILP (tem); } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, @@ -2741,9 +2739,6 @@ 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 - Lisp_Object args[2]; -#endif Lisp_Object handler; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; Lisp_Object encoded_file, encoded_newname, symlink_target; @@ -2754,7 +2749,13 @@ This is what happens in interactive use with M-x. */) CHECK_STRING (newname); file = Fexpand_file_name (file, Qnil); - if (!NILP (Ffile_directory_p (newname))) + if ((!NILP (Ffile_directory_p (newname))) +#ifdef DOS_NT + /* If the file names are identical but for the case, + don't attempt to move directory to itself. */ + && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))) +#endif + ) newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); else newname = Fexpand_file_name (newname, Qnil); @@ -2779,7 +2780,7 @@ This is what happens in interactive use with M-x. */) #endif if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (encoded_newname, "rename to it", + barf_or_query_if_file_exists (newname, "rename to it", INTEGERP (ok_if_already_exists), 0, 0); #ifndef BSD4_1 if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname))) @@ -2801,20 +2802,12 @@ This is what happens in interactive use with M-x. */) /* We have already prompted if it was an integer, so don't have copy-file prompt again. */ NILP (ok_if_already_exists) ? Qnil : Qt, - Qt, Qnil, Qt); + Qt, Qt); Fdelete_file (file); } else -#ifdef NO_ARG_ARRAY - { - args[0] = file; - args[1] = newname; - report_file_error ("Renaming", Flist (2, args)); - } -#else - report_file_error ("Renaming", Flist (2, &file)); -#endif + report_file_error ("Renaming", list2 (file, newname)); } UNGCPRO; return Qnil; @@ -2830,9 +2823,6 @@ 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 - Lisp_Object args[2]; -#endif Lisp_Object handler; Lisp_Object encoded_file, encoded_newname; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -2867,20 +2857,12 @@ This is what happens in interactive use with M-x. */) if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (encoded_newname, "make it a new name", + barf_or_query_if_file_exists (newname, "make it a new name", INTEGERP (ok_if_already_exists), 0, 0); unlink (SDATA (newname)); if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))) - { -#ifdef NO_ARG_ARRAY - args[0] = file; - args[1] = newname; - report_file_error ("Adding new name", Flist (2, args)); -#else - report_file_error ("Adding new name", Flist (2, &file)); -#endif - } + report_file_error ("Adding new name", list2 (file, newname)); UNGCPRO; return Qnil; @@ -2898,9 +2880,6 @@ 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 - Lisp_Object args[2]; -#endif Lisp_Object handler; Lisp_Object encoded_filename, encoded_linkname; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -2939,7 +2918,7 @@ This happens for interactive use with M-x. */) if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (encoded_linkname, "make it a link", + barf_or_query_if_file_exists (linkname, "make it a link", INTEGERP (ok_if_already_exists), 0, 0); if (0 > symlink (SDATA (encoded_filename), SDATA (encoded_linkname))) @@ -2956,13 +2935,7 @@ This happens for interactive use with M-x. */) } } -#ifdef NO_ARG_ARRAY - args[0] = filename; - args[1] = linkname; - report_file_error ("Making symbolic link", Flist (2, args)); -#else - report_file_error ("Making symbolic link", Flist (2, &filename)); -#endif + report_file_error ("Making symbolic link", list2 (filename, linkname)); } UNGCPRO; return Qnil; @@ -3388,8 +3361,10 @@ searchable directory. */) } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, - 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. */) + doc: /* Return t if FILENAME names a regular file. +This is the sort of file that holds an ordinary stream of data bytes. +Symbolic links to regular files count as regular files. +See `file-symlink-p' to distinguish symlinks. */) (filename) Lisp_Object filename; { @@ -3566,11 +3541,7 @@ Use the current time if TIME is nil. TIME is in the format of return Qt; } -#ifdef __NetBSD__ -#define unix 42 -#endif - -#ifdef unix +#ifdef HAVE_SYNC DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", doc: /* Tell Unix to finish all pending disk updates. */) () @@ -3579,7 +3550,7 @@ DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", return Qnil; } -#endif /* unix */ +#endif /* HAVE_SYNC */ DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, doc: /* Return t if file FILE1 is newer than file FILE2. @@ -3838,9 +3809,8 @@ actually used. */) goto notfound; if (! NILP (replace) || ! NILP (beg) || ! NILP (end)) - Fsignal (Qfile_error, - Fcons (build_string ("not a regular file"), - Fcons (orig_filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("not a regular file"), orig_filename); } #endif @@ -4323,11 +4293,8 @@ actually used. */) { xfree (conversion_buffer); coding_free_composition_data (&coding); - if (how_much == -1) - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); - else if (how_much == -2) - error ("maximum buffer size exceeded"); + error ("IO error reading %s: %s", + SDATA (orig_filename), emacs_strerror (errno)); } /* Compare the beginning of the converted file @@ -4412,6 +4379,8 @@ actually used. */) /* Set `inserted' to the number of inserted characters. */ inserted = PT - temp; + /* Set point before the inserted characters. */ + SET_PT_BOTH (temp, same_at_start); xfree (conversion_buffer); emacs_close (fd); @@ -4546,6 +4515,8 @@ actually used. */) #endif Vdeactivate_mark = old_Vdeactivate_mark; } + else + Vdeactivate_mark = Qt; /* Make the text read part of the buffer. */ GAP_SIZE -= inserted; @@ -4712,9 +4683,8 @@ actually used. */) } #endif /* CLASH_DETECTION */ if (not_regular) - Fsignal (Qfile_error, - Fcons (build_string ("not a regular file"), - Fcons (orig_filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("not a regular file"), orig_filename); } if (set_coding_system) @@ -4840,6 +4810,8 @@ choose_write_coding_system (start, end, filename, /* ... but with the special flag to indicate not to strip off leading code of eight-bit-control chars. */ coding->flags = 1; + /* We force LF for end-of-line because that is faster. */ + coding->eol_type = CODING_EOL_LF; goto done_setup_coding; } else if (!NILP (Vcoding_system_for_write)) @@ -4932,6 +4904,8 @@ choose_write_coding_system (start, end, filename, setup_coding_system (Fcheck_coding_system (val), coding); done_setup_coding: + if (coding->eol_type == CODING_EOL_UNDECIDED) + coding->eol_type = system_eol_type; if (!STRINGP (start) && !NILP (current_buffer->selective_display)) coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; } @@ -5003,6 +4977,7 @@ This does code conversion according to the value of if (!NILP (start) && !STRINGP (start)) validate_region (&start, &end); + visit_file = Qnil; GCPRO5 (start, filename, visit, visit_file, lockname); filename = Fexpand_file_name (filename, Qnil); @@ -5216,7 +5191,7 @@ This does code conversion according to the value of * if we do writes that don't end with a carriage return. Furthermore * it cannot handle writes of more then 16K. The modified * version of "sys_write" in SYSDEP.C (see comment there) copes with - * this EXCEPT for the last record (iff it doesn't end with a carriage + * this EXCEPT for the last record (if it doesn't end with a carriage * return). This implies that if your buffer doesn't end with a carriage * return, you get one free... tough. However it also means that if * we make two calls to sys_write (a la the following code) you can @@ -5297,7 +5272,7 @@ This does code conversion according to the value of Disk full in NFS may be reported here. */ /* mib says that closing the file will try to write as fast as NFS can do it, and that means the fsync here is not crucial for autosave files. */ - if (!auto_saving && fsync (desc) < 0) + if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0) { /* If fsync fails with EINTR, don't treat that as serious. */ if (errno != EINTR) @@ -5717,11 +5692,9 @@ file modification time, this function returns 0. See Info node `(elisp)Modification Time' for more details. */) () { - Lisp_Object tcons; - tcons = long_to_cons ((unsigned long) current_buffer->modtime); - if (CONSP (tcons)) - return list2 (XCAR (tcons), XCDR (tcons)); - return tcons; + if (! current_buffer->modtime) + return make_number (0); + return make_time ((time_t) current_buffer->modtime); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, @@ -5768,6 +5741,8 @@ auto_save_error (error) Lisp_Object args[3], msg; int i, nbytes; struct gcpro gcpro1; + char *msgbuf; + USE_SAFE_ALLOCA; ring_bell (); @@ -5777,16 +5752,19 @@ auto_save_error (error) msg = Fformat (3, args); GCPRO1 (msg); nbytes = SBYTES (msg); + SAFE_ALLOCA (msgbuf, char *, nbytes); + bcopy (SDATA (msg), msgbuf, nbytes); for (i = 0; i < 3; ++i) { if (i == 0) - message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); + message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg)); else - message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); + message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg)); Fsleep_for (make_number (1), Qnil); } + SAFE_FREE (); UNGCPRO; return Qnil; } @@ -5818,13 +5796,17 @@ auto_save_1 () } static Lisp_Object -do_auto_save_unwind (stream) /* used as unwind-protect function */ - Lisp_Object stream; +do_auto_save_unwind (arg) /* used as unwind-protect function */ + Lisp_Object arg; { + FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; auto_saving = 0; - if (!NILP (stream)) - fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 - | XFASTINT (XCDR (stream)))); + if (stream != NULL) + { + BLOCK_INPUT; + fclose (stream); + UNBLOCK_INPUT; + } return Qnil; } @@ -5840,7 +5822,11 @@ static Lisp_Object do_auto_save_make_dir (dir) Lisp_Object dir; { - return call2 (Qmake_directory, dir, Qt); + Lisp_Object mode; + + call2 (Qmake_directory, dir, Qt); + XSETFASTINT (mode, 0700); + return Fset_file_modes (dir, mode); } static Lisp_Object @@ -5869,8 +5855,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) int auto_saved = 0; int do_handled_files; Lisp_Object oquit; - FILE *stream; - Lisp_Object lispstream; + FILE *stream = NULL; int count = SPECPDL_INDEX (); int orig_minibuffer_auto_raise = minibuffer_auto_raise; int old_message_p = 0; @@ -5922,24 +5907,10 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) } 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); - XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); - XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); - } - else - lispstream = Qnil; - } - else - { - stream = NULL; - lispstream = Qnil; } - record_unwind_protect (do_auto_save_unwind, lispstream); + record_unwind_protect (do_auto_save_unwind, + make_save_value (stream, 0)); record_unwind_protect (do_auto_save_unwind_1, make_number (minibuffer_auto_raise)); minibuffer_auto_raise = 0; @@ -5965,6 +5936,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) if (STRINGP (b->auto_save_file_name) && stream != NULL && do_handled_files == 0) { + BLOCK_INPUT; if (!NILP (b->filename)) { fwrite (SDATA (b->filename), 1, @@ -5974,6 +5946,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) fwrite (SDATA (b->auto_save_file_name), 1, SBYTES (b->auto_save_file_name), stream); putc ('\n', stream); + UNBLOCK_INPUT; } if (!NILP (current_only) @@ -6053,7 +6026,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) { /* If we are going to restore an old message, give time to read ours. */ - sit_for (1, 0, 0, 0, 0); + sit_for (make_number (1), 0, 0); restore_message (); } else @@ -6190,7 +6163,7 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte if (NILP (action)) { specdir = Ffile_name_directory (string); - val = Ffile_name_completion (name, realdir); + val = Ffile_name_completion (name, realdir, Vread_file_name_predicate); UNGCPRO; if (!STRINGP (val)) { @@ -6228,9 +6201,9 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte { Lisp_Object tem = XCAR (all); int len; - if (STRINGP (tem) && - (len = SCHARS (tem), len > 0) && - IS_DIRECTORY_SEP (SREF (tem, len-1))) + if (STRINGP (tem) + && (len = SBYTES (tem), len > 0) + && IS_DIRECTORY_SEP (SREF (tem, len-1))) comp = Fcons (tem, comp); } } @@ -6238,13 +6211,17 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte #endif { /* Must do it the hard (and slow) way. */ + Lisp_Object tem; 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); + { + tem = call1 (Vread_file_name_predicate, XCAR (all)); + if (!NILP (tem)) + comp = Fcons (XCAR (all), comp); + } unbind_to (count, Qnil); UNGCPRO; } @@ -6618,19 +6595,17 @@ of file names regardless of the current language environment. */); staticpro (&Qcar_less_than_car); Fput (Qfile_error, Qerror_conditions, - Fcons (Qfile_error, Fcons (Qerror, Qnil))); + list2 (Qfile_error, Qerror)); Fput (Qfile_error, Qerror_message, build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, - Fcons (Qfile_already_exists, - Fcons (Qfile_error, Fcons (Qerror, Qnil)))); + list3 (Qfile_already_exists, Qfile_error, Qerror)); Fput (Qfile_already_exists, Qerror_message, build_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, - Fcons (Qfile_date_error, - Fcons (Qfile_error, Fcons (Qerror, Qnil)))); + list3 (Qfile_date_error, Qfile_error, Qerror)); Fput (Qfile_date_error, Qerror_message, build_string ("Cannot set file date")); @@ -6754,6 +6729,14 @@ shortly after Emacs reads your `.emacs' file, if you have not yet given it a non-nil value. */); Vauto_save_list_file_name = Qnil; +#ifdef HAVE_FSYNC + DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync, + doc: /* *Non-nil means don't call fsync in `write-region'. +This variable affects calls to `write-region' as well as save commands. +A non-nil value may result in data loss! */); + write_region_inhibit_fsync = 0; +#endif + defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); defsubr (&Sfile_name_nondirectory); @@ -6810,7 +6793,7 @@ a non-nil value. */); defsubr (&Sread_file_name); defsubr (&Snext_read_file_uses_dialog_p); -#ifdef unix +#ifdef HAVE_SYNC defsubr (&Sunix_sync); #endif }