X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ef38927ffd51a32f8142493f0e3abc547a2ad5d2..0087ade67a7c8e31b32579a353381fb00b53a112:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 79984d9baa..7b3084c7aa 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,1998 Free Software Foundation, Inc. + Copyright (C) 1985,86,87,88,93,94,95,96,97,98,1999 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -65,8 +65,6 @@ Boston, MA 02111-1307, USA. */ extern int errno; #endif -extern char *strerror (); - #ifdef APOLLO #include #endif @@ -141,6 +139,9 @@ extern char *strerror (); #endif #endif +#include "commands.h" +extern int use_dialog_box; + #ifndef O_WRONLY #define O_WRONLY 1 #endif @@ -149,6 +150,10 @@ extern char *strerror (); #define O_RDONLY 0 #endif +#ifndef S_ISLNK +# define lstat stat +#endif + #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) @@ -225,7 +230,7 @@ static Lisp_Object Vinhibit_file_name_handlers; static Lisp_Object Vinhibit_file_name_operation; Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error; - +Lisp_Object Qexcl; Lisp_Object Qfile_name_history; Lisp_Object Qcar_less_than_car; @@ -240,24 +245,34 @@ report_file_error (string, data) Lisp_Object data; { Lisp_Object errstring; + int errorno = errno; - errstring = build_string (strerror (errno)); - - /* System error messages are capitalized. Downcase the initial - unless it is followed by a slash. */ - if (XSTRING (errstring)->data[1] != '/') - XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); + synchronize_system_messages_locale (); + errstring = code_convert_string_norecord (build_string (strerror (errorno)), + Vlocale_coding_system, 0); while (1) - Fsignal (Qfile_error, - Fcons (build_string (string), Fcons (errstring, data))); + switch (errorno) + { + case EEXIST: + Fsignal (Qfile_already_exists, Fcons (errstring, data)); + break; + default: + /* System error messages are capitalized. Downcase the initial + unless it is followed by a slash. */ + if (XSTRING (errstring)->data[1] != '/') + XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); + + Fsignal (Qfile_error, + Fcons (build_string (string), Fcons (errstring, data))); + } } Lisp_Object close_file_unwind (fd) Lisp_Object fd; { - close (XFASTINT (fd)); + emacs_close (XFASTINT (fd)); return Qnil; } @@ -326,19 +341,19 @@ use the standard functions without calling themselves recursively.") inhibited_handlers = Qnil; for (chain = Vfile_name_handler_alist; CONSP (chain); - chain = XCONS (chain)->cdr) + chain = XCDR (chain)) { Lisp_Object elt; - elt = XCONS (chain)->car; + elt = XCAR (chain); if (CONSP (elt)) { Lisp_Object string; - string = XCONS (elt)->car; + string = XCAR (elt); if (STRINGP (string) && fast_string_match (string, filename) >= 0) { Lisp_Object handler, tem; - handler = XCONS (elt)->cdr; + handler = XCDR (elt); tem = Fmemq (handler, inhibited_handlers); if (NILP (tem)) return handler; @@ -828,7 +843,11 @@ 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.") +PREFIX should be an absolute file name.\n\ +\n\ +There is a race condition between calling `make-temp-name' and creating the\n\ +file which opens all kinds of security holes. For that reason, you should\n\ +probably use `make-temp-file' instead.") (prefix) Lisp_Object prefix; { @@ -2111,7 +2130,7 @@ duplicates what `expand-file-name' does.") xnm = p; #ifdef DOS_NT else if (IS_DRIVE (p[0]) && p[1] == ':' - && p > nm && IS_DIRECTORY_SEP (p[-1])) + && p > xnm && IS_DIRECTORY_SEP (p[-1])) xnm = p; #endif @@ -2265,7 +2284,7 @@ A prefix arg makes KEEP-TIME non-nil.") else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0) out_st.st_mode = 0; - ifd = open (XSTRING (encoded_file)->data, O_RDONLY); + ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0); if (ifd < 0) report_file_error ("Opening input file", Fcons (file, Qnil)); @@ -2317,13 +2336,13 @@ A prefix arg makes KEEP-TIME non-nil.") immediate_quit = 1; QUIT; - while ((n = read (ifd, buf, sizeof buf)) > 0) - if (write (ofd, buf, n) != n) + while ((n = emacs_read (ifd, buf, sizeof buf)) > 0) + if (emacs_write (ofd, buf, n) != n) report_file_error ("I/O error", Fcons (newname, Qnil)); immediate_quit = 0; /* Closing the output clobbers the file times on some systems. */ - if (close (ofd) < 0) + if (emacs_close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); if (input_file_statable_p) @@ -2353,7 +2372,7 @@ A prefix arg makes KEEP-TIME non-nil.") #endif /* MSDOS */ } - close (ifd); + emacs_close (ifd); /* Discard the unwind protects. */ specpdl_ptr = specpdl + count; @@ -2892,10 +2911,10 @@ See also `file-exists-p' and `file-attributes'.") if (S_ISFIFO (statbuf.st_mode)) flags |= O_NONBLOCK; #endif - desc = open (XSTRING (absname)->data, flags); + desc = emacs_open (XSTRING (absname)->data, flags, 0); if (desc < 0) return Qnil; - close (desc); + emacs_close (desc); return Qt; #endif /* not DOS_NT */ } @@ -2961,10 +2980,10 @@ If there is no error, we return nil.") encoded_filename = ENCODE_FILE (filename); - fd = open (XSTRING (encoded_filename)->data, O_RDONLY); + fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0); if (fd < 0) report_file_error (XSTRING (string)->data, Fcons (filename, Qnil)); - close (fd); + emacs_close (fd); return Qnil; } @@ -3020,7 +3039,9 @@ Otherwise returns nil.") } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, - "Return t if FILENAME names an existing directory.") + "Return t if FILENAME names an existing directory.\n\ +Symbolic links to directories count as directories.\n\ +See `file-symlink-p' to distinguish symlinks.") (filename) Lisp_Object filename; { @@ -3355,8 +3376,8 @@ actually used.") { val = call6 (handler, Qinsert_file_contents, filename, visit, beg, end, replace); - if (CONSP (val) && CONSP (XCONS (val)->cdr)) - inserted = XINT (XCONS (XCONS (val)->cdr)->car); + if (CONSP (val) && CONSP (XCDR (val))) + inserted = XINT (XCAR (XCDR (val))); goto handled; } @@ -3379,19 +3400,19 @@ actually used.") #ifndef APOLLO if (stat (XSTRING (filename)->data, &st) < 0) #else - if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0 + if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ #endif /* WINDOWSNT */ { - if (fd >= 0) close (fd); + if (fd >= 0) emacs_close (fd); badopen: if (NILP (visit)) report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); st.st_mtime = -1; how_much = 0; if (!NILP (Vcoding_system_for_read)) - current_buffer->buffer_file_coding_system = Vcoding_system_for_read; + Fset (Qbuffer_file_coding_system, Vcoding_system_for_read); goto notfound; } @@ -3414,7 +3435,7 @@ actually used.") #endif if (fd < 0) - if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0) + if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0) goto badopen; /* Replacement should preserve point as it preserves markers. */ @@ -3427,6 +3448,9 @@ actually used.") if (! not_regular && st.st_size < 0) error ("File size is negative"); + /* Prevent redisplay optimizations. */ + current_buffer->clip_changed = 1; + if (!NILP (beg) || !NILP (end)) if (!NILP (visit)) error ("Attempt to visit less than an entire file"); @@ -3443,7 +3467,13 @@ actually used.") if (! not_regular) { XSETINT (end, st.st_size); - if (XINT (end) != st.st_size) + + /* Arithmetic overflow can occur if an Emacs integer cannot + represent the file size, or if the calculations below + overflow. The calculations below double the file size + twice, so check that it can be multiplied by 4 safely. */ + if (XINT (end) != st.st_size + || ((int) st.st_size * 4) / 4 != st.st_size) error ("Maximum buffer size exceeded"); } } @@ -3471,27 +3501,27 @@ actually used.") /* Find a coding system specified in the heading two lines or in the tailing several lines of the file. We assume that the 1K-byte and 3K-byte for heading - and tailing respectively are sufficient fot this + and tailing respectively are sufficient for this purpose. */ int how_many, nread; if (st.st_size <= (1024 * 4)) - nread = read (fd, read_buf, 1024 * 4); + nread = emacs_read (fd, read_buf, 1024 * 4); else { - nread = read (fd, read_buf, 1024); + nread = emacs_read (fd, read_buf, 1024); if (nread >= 0) { if (lseek (fd, st.st_size - (1024 * 3), 0) < 0) report_file_error ("Setting file position", Fcons (orig_filename, Qnil)); - nread += read (fd, read_buf + nread, 1024 * 3); + nread += emacs_read (fd, read_buf + nread, 1024 * 3); } } if (nread < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); else if (nread > 0) { int count = specpdl_ptr - specpdl; @@ -3527,16 +3557,16 @@ actually used.") args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace; coding_systems = Ffind_operation_coding_system (6, args); if (CONSP (coding_systems)) - val = XCONS (coding_systems)->car; + val = XCAR (coding_systems); } } setup_coding_system (Fcheck_coding_system (val), &coding); - if (NILP (Vcoding_system_for_read) - && NILP (current_buffer->enable_multibyte_characters)) - /* We must suppress all text conversion except for end-of-line - conversion. */ + if (NILP (current_buffer->enable_multibyte_characters) + && ! NILP (val)) + /* We must suppress all character code conversion except for + end-of-line conversion. */ setup_raw_text_coding_system (&coding); coding_system_decided = 1; @@ -3591,10 +3621,10 @@ actually used.") { int nread, bufpos; - nread = read (fd, buffer, sizeof buffer); + nread = emacs_read (fd, buffer, sizeof buffer); if (nread < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); else if (nread == 0) break; @@ -3633,7 +3663,7 @@ actually used.") there's no need to replace anything. */ if (same_at_start - BEGV_BYTE == XINT (end)) { - close (fd); + emacs_close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ del_range_1 (same_at_start, same_at_end, 0); @@ -3662,10 +3692,10 @@ actually used.") total_read = 0; while (total_read < trial) { - nread = read (fd, buffer + total_read, trial - total_read); + nread = emacs_read (fd, buffer + total_read, trial - total_read); if (nread <= 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); total_read += nread; } /* Scan this bufferful from the end, comparing with @@ -3762,7 +3792,7 @@ actually used.") if (lseek (fd, XINT (beg), 0) < 0) { - free (conversion_buffer); + xfree (conversion_buffer); report_file_error ("Setting file position", Fcons (orig_filename, Qnil)); } @@ -3782,7 +3812,7 @@ actually used.") /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; - this = read (fd, destination, trytry); + this = emacs_read (fd, destination, trytry); immediate_quit = 0; if (this < 0 || this + unprocessed == 0) @@ -3831,11 +3861,11 @@ actually used.") if (how_much < 0) { - free (conversion_buffer); + xfree (conversion_buffer); if (how_much == -1) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); else if (how_much == -2) error ("maximum buffer size exceeded"); } @@ -3853,11 +3883,12 @@ actually used.") if (bufpos == inserted) { - free (conversion_buffer); - close (fd); + xfree (conversion_buffer); + emacs_close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ - del_range_1 (same_at_start, same_at_end, 0); + del_range_byte (same_at_start, same_at_end, 0); + inserted = 0; goto handled; } @@ -3899,21 +3930,26 @@ actually used.") and update INSERTED to equal the number of bytes we are taking from the file. */ inserted -= (Z_BYTE - same_at_end) + (same_at_start - BEG_BYTE); - del_range_byte (same_at_start, same_at_end, 0); + if (same_at_end != same_at_start) - SET_PT_BOTH (GPT, GPT_BYTE); + { + del_range_byte (same_at_start, same_at_end, 0); + temp = GPT; + same_at_start = GPT_BYTE; + } else { - /* Insert from the file at the proper position. */ temp = BYTE_TO_CHAR (same_at_start); - SET_PT_BOTH (temp, same_at_start); } - + /* Insert from the file at the proper position. */ + SET_PT_BOTH (temp, same_at_start); insert_1 (conversion_buffer + same_at_start - BEG_BYTE, inserted, 0, 0, 0); + /* Set `inserted' to the number of inserted characters. */ + inserted = PT - temp; free (conversion_buffer); - close (fd); + emacs_close (fd); specpdl_ptr--; goto handled; @@ -3970,7 +4006,8 @@ actually used.") /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; - this = read (fd, BYTE_POS_ADDR (PT_BYTE + inserted - 1) + 1, trytry); + this = emacs_read (fd, BYTE_POS_ADDR (PT_BYTE + inserted - 1) + 1, + trytry); immediate_quit = 0; if (this <= 0) @@ -4001,14 +4038,14 @@ actually used.") /* Put an anchor to ensure multi-byte form ends at gap. */ *GPT_ADDR = 0; - close (fd); + emacs_close (fd); /* Discard the unwind protect for closing the file. */ specpdl_ptr--; if (how_much < 0) error ("IO error reading %s: %s", - XSTRING (orig_filename)->data, strerror (errno)); + XSTRING (orig_filename)->data, emacs_strerror (errno)); if (! coding_system_decided) { @@ -4054,7 +4091,7 @@ actually used.") args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil; coding_systems = Ffind_operation_coding_system (6, args); if (CONSP (coding_systems)) - val = XCONS (coding_systems)->car; + val = XCAR (coding_systems); } } @@ -4068,14 +4105,14 @@ actually used.") bcopy (&temp_coding, &coding, sizeof coding); } - if (NILP (Vcoding_system_for_read) - && NILP (current_buffer->enable_multibyte_characters)) - /* We must suppress all text conversion except for + if (NILP (current_buffer->enable_multibyte_characters) + && ! NILP (val)) + /* We must suppress all character code conversion except for end-of-line conversion. */ setup_raw_text_coding_system (&coding); } - if (inserted > 0) + if (inserted > 0 || coding.type == coding_type_ccl) { if (CODING_MAY_REQUIRE_DECODING (&coding)) { @@ -4240,8 +4277,12 @@ 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 CONFIRM, if non-nil, says ask for confirmation\n\ - before overwriting an existing file.\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\ @@ -4250,8 +4291,8 @@ This does code conversion according to the value of\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, confirm) - Lisp_Object start, end, filename, append, visit, lockname, confirm; + (start, end, filename, append, visit, lockname, mustbenew) + Lisp_Object start, end, filename, append, visit, lockname, mustbenew; { register int desc; int failure; @@ -4324,8 +4365,8 @@ This does code conversion according to the value of\n\ 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 (XCONS (coding_systems)->cdr)) - val = XCONS (coding_systems)->cdr; + if (CONSP (coding_systems) && !NILP (XCDR (coding_systems))) + val = XCDR (coding_systems); } if (NILP (val) @@ -4379,7 +4420,7 @@ This does code conversion according to the value of\n\ filename = Fexpand_file_name (filename, Qnil); - if (! NILP (confirm)) + if (! NILP (mustbenew) && mustbenew != Qexcl) barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1); if (STRINGP (visit)) @@ -4459,9 +4500,9 @@ This does code conversion according to the value of\n\ desc = -1; if (!NILP (append)) #ifdef DOS_NT - desc = open (fn, O_WRONLY | buffer_file_type); + desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0); #else /* not DOS_NT */ - desc = open (fn, O_WRONLY); + desc = emacs_open (fn, O_WRONLY, 0); #endif /* not DOS_NT */ if (desc < 0 && (NILP (append) || errno == ENOENT)) @@ -4469,7 +4510,7 @@ This does code conversion according to the value of\n\ if (auto_saving) /* Overwrite any previous version of autosave file */ { vms_truncate (fn); /* if fn exists, truncate to zero length */ - desc = open (fn, O_RDWR); + desc = emacs_open (fn, O_RDWR, 0); if (desc < 0) desc = creat_copy_attrs (STRINGP (current_buffer->filename) ? XSTRING (current_buffer->filename)->data : 0, @@ -4502,7 +4543,7 @@ This does code conversion according to the value of\n\ /* We can't make a new version; try to truncate and rewrite existing version if any. */ vms_truncate (fn); - desc = open (fn, O_RDWR); + desc = emacs_open (fn, O_RDWR, 0); } #endif } @@ -4512,11 +4553,14 @@ This does code conversion according to the value of\n\ } #else /* not VMS */ #ifdef DOS_NT - desc = open (fn, - O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, - S_IREAD | S_IWRITE); + desc = emacs_open (fn, + O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type + | (mustbenew == Qexcl ? O_EXCL : 0), + S_IREAD | S_IWRITE); #else /* not DOS_NT */ - desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); + desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT + | (mustbenew == Qexcl ? O_EXCL : 0), + auto_saving ? auto_save_mode_bits : 0666); #endif /* not DOS_NT */ #endif /* not VMS */ @@ -4661,7 +4705,7 @@ This does code conversion according to the value of\n\ #endif /* NFS can report a write failure now. */ - if (close (desc) < 0) + if (emacs_close (desc) < 0) failure = 1, save_errno = errno; #ifdef VMS @@ -4695,7 +4739,7 @@ This does code conversion according to the value of\n\ if (failure) error ("IO error writing %s: %s", XSTRING (filename)->data, - strerror (save_errno)); + emacs_strerror (save_errno)); if (visiting) { @@ -4887,14 +4931,14 @@ e_write (desc, addr, nbytes, coding) nbytes -= coding->consumed, addr += coding->consumed; if (coding->produced > 0) { - coding->produced -= write (desc, buf, coding->produced); + coding->produced -= emacs_write (desc, buf, coding->produced); if (coding->produced) return -1; } if (result == CODING_FINISH_INSUFFICIENT_SRC) { /* The source text ends by an incomplete multibyte form. There's no way other than write it out as is. */ - nbytes -= write (desc, addr, nbytes); + nbytes -= emacs_write (desc, addr, nbytes); if (nbytes) return -1; } if (nbytes <= 0) @@ -5043,8 +5087,8 @@ do_auto_save_unwind (stream) /* used as unwind-protect function */ { auto_saving = 0; if (!NILP (stream)) - fclose ((FILE *) (XFASTINT (XCONS (stream)->car) << 16 - | XFASTINT (XCONS (stream)->cdr))); + fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 + | XFASTINT (XCDR (stream)))); return Qnil; } @@ -5072,9 +5116,6 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") struct buffer *old = current_buffer, *b; Lisp_Object tail, buf; int auto_saved = 0; - char *omessage = echo_area_glyphs; - int omessage_length = echo_area_glyphs_length; - int oldmultibyte = message_enable_multibyte; int do_handled_files; Lisp_Object oquit; FILE *stream; @@ -5082,7 +5123,8 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") int count = specpdl_ptr - specpdl; int *ptr; int orig_minibuffer_auto_raise = minibuffer_auto_raise; - + int message_p = push_message (); + /* Ordinarily don't quit within this function, but don't make it impossible to quit (in case we get hung in I/O). */ oquit = Vquit_flag; @@ -5107,8 +5149,8 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") /* Arrange to close that file whether or not we get an error. Also reset auto_saving to 0. */ lispstream = Fcons (Qnil, Qnil); - XSETFASTINT (XCONS (lispstream)->car, (EMACS_UINT)stream >> 16); - XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff); + XSETFASTINT (XCAR (lispstream), (EMACS_UINT)stream >> 16); + XSETFASTINT (XCDR (lispstream), (EMACS_UINT)stream & 0xffff); } else lispstream = Qnil; @@ -5131,9 +5173,9 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") autosave perfectly ordinary files because it couldn't handle some ange-ftp'd file. */ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) - for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) { - buf = XCONS (XCONS (tail)->car)->cdr; + buf = XCDR (XCAR (tail)); b = XBUFFER (buf); /* Record all the buffers that have auto save mode @@ -5226,10 +5268,10 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") if (auto_saved && NILP (no_message)) { - if (omessage) + if (message_p) { sit_for (1, 0, 0, 0, 0); - message2 (omessage, omessage_length, oldmultibyte); + restore_message (); } else message1 ("Auto-saving...done"); @@ -5237,6 +5279,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer.") Vquit_flag = oquit; + pop_message (); unbind_to (count, Qnil); return Qnil; } @@ -5395,7 +5438,7 @@ DIR defaults to current buffer's directory default.") (prompt, dir, default_filename, mustmatch, initial) Lisp_Object prompt, dir, default_filename, mustmatch, initial; { - Lisp_Object val, insdef, insdef1, tem; + Lisp_Object val, insdef, tem; struct gcpro gcpro1, gcpro2; register char *homedir; int replace_in_history = 0; @@ -5427,6 +5470,22 @@ DIR defaults to current buffer's directory default.") STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1); XSTRING (dir)->data[0] = '~'; } + /* Likewise for default_filename. */ + if (homedir != 0 + && STRINGP (default_filename) + && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir)) + && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)])) + { + default_filename + = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1, + STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1); + XSTRING (default_filename)->data[0] = '~'; + } + if (!NILP (default_filename)) + { + CHECK_STRING (default_filename, 3); + default_filename = double_dollars (default_filename); + } if (insert_default_directory && STRINGP (dir)) { @@ -5439,18 +5498,15 @@ DIR defaults to current buffer's directory default.") args[1] = initial; insdef = Fconcat (2, args); pos = make_number (XSTRING (double_dollars (dir))->size); - insdef1 = Fcons (double_dollars (insdef), pos); + insdef = Fcons (double_dollars (insdef), pos); } else - insdef1 = double_dollars (insdef); + insdef = double_dollars (insdef); } else if (STRINGP (initial)) - { - insdef = initial; - insdef1 = Fcons (double_dollars (insdef), make_number (0)); - } + insdef = Fcons (double_dollars (initial), make_number (0)); else - insdef = Qnil, insdef1 = Qnil; + insdef = Qnil; count = specpdl_ptr - specpdl; #ifdef VMS @@ -5460,12 +5516,23 @@ DIR defaults to current buffer's directory default.") specbind (intern ("minibuffer-completing-file-name"), Qt); GCPRO2 (insdef, default_filename); - val = Fcompleting_read (prompt, intern ("read-file-name-internal"), - dir, mustmatch, insdef1, - Qfile_name_history, default_filename, Qnil); + +#ifdef USE_MOTIF + if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) + && use_dialog_box + && have_menus_p ()) + { + val = Fx_file_dialog (prompt, dir, default_filename, mustmatch); + add_to_history = 1; + } + else +#endif + val = Fcompleting_read (prompt, intern ("read-file-name-internal"), + dir, mustmatch, insdef, + Qfile_name_history, default_filename, Qnil); tem = Fsymbol_value (Qfile_name_history); - if (CONSP (tem) && EQ (XCONS (tem)->car, val)) + if (CONSP (tem) && EQ (XCAR (tem), val)) replace_in_history = 1; /* If Fcompleting_read returned the inserted default string itself @@ -5488,7 +5555,7 @@ DIR defaults to current buffer's directory default.") if (NILP (val)) error ("No file name specified"); - tem = Fstring_equal (val, insdef); + tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef); if (!NILP (tem) && !NILP (default_filename)) val = default_filename; @@ -5504,18 +5571,29 @@ DIR defaults to current buffer's directory default.") if (replace_in_history) /* Replace what Fcompleting_read added to the history with what we will actually return. */ - XCONS (Fsymbol_value (Qfile_name_history))->car = val; + XCAR (Fsymbol_value (Qfile_name_history)) = double_dollars (val); else if (add_to_history) { /* Add the value to the history--but not if it matches the last value already there. */ + Lisp_Object val1 = double_dollars (val); tem = Fsymbol_value (Qfile_name_history); - if (! CONSP (tem) || NILP (Fequal (XCONS (tem)->car, val))) + if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1))) Fset (Qfile_name_history, - Fcons (val, tem)); + Fcons (val1, tem)); } + return val; } + + +void +init_fileio_once () +{ + /* Must be set before any path manipulation is performed. */ + XSETFASTINT (Vdirectory_sep_char, '/'); +} + void syms_of_fileio () @@ -5592,6 +5670,8 @@ syms_of_fileio () staticpro (&Qfile_already_exists); Qfile_date_error = intern ("file-date-error"); staticpro (&Qfile_date_error); + Qexcl = intern ("excl"); + staticpro (&Qexcl); #ifdef DOS_NT Qfind_buffer_file_type = intern ("find-buffer-file-type"); @@ -5661,7 +5741,6 @@ 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."); - XSETFASTINT (Vdirectory_sep_char, '/'); DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\