X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a3911e8c0ad15d6f571d7447474e31b35e7e670d..7147863a1cadafc27dcab1d3f28ccab2224a6316:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index c62ddd3676..fa7a2d0cd8 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,7 +1,7 @@ /* File IO for GNU Emacs. Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -77,6 +77,7 @@ extern int errno; #include "charset.h" #include "coding.h" #include "window.h" +#include "blockinput.h" #ifdef WINDOWSNT #define NOMINMAX 1 @@ -279,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 @@ -287,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))); } } @@ -1386,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; @@ -1644,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)) { @@ -1655,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 @@ -1675,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++; @@ -1923,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); @@ -2117,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; @@ -2384,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)); @@ -2396,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; } @@ -2410,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; @@ -2452,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 @@ -2504,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); @@ -2557,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 */ @@ -2602,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); } } @@ -2656,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; } @@ -2682,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; } @@ -2700,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); @@ -2713,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; } @@ -2747,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; @@ -2760,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); @@ -2807,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; @@ -2836,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; @@ -2878,15 +2862,7 @@ This is what happens in interactive use with M-x. */) 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; @@ -2904,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; @@ -2962,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; @@ -3846,9 +3813,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 @@ -4331,11 +4297,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 @@ -4420,6 +4383,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); @@ -4554,6 +4519,8 @@ actually used. */) #endif Vdeactivate_mark = old_Vdeactivate_mark; } + else + Vdeactivate_mark = Qt; /* Make the text read part of the buffer. */ GAP_SIZE -= inserted; @@ -4720,9 +4687,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) @@ -4848,6 +4814,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)) @@ -4940,6 +4908,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; } @@ -5011,6 +4981,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); @@ -5853,7 +5824,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 @@ -6051,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 @@ -6620,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"));