Fix bug with conditionals in expand-file-name on MS-Windows.
[bpt/emacs.git] / src / fileio.c
CommitLineData
570d7624 1/* File IO for GNU Emacs.
e9bffc61 2
ab422c4d 3Copyright (C) 1985-1988, 1993-2013 Free Software Foundation, Inc.
570d7624
JB
4
5This file is part of GNU Emacs.
6
9ec0b715 7GNU Emacs is free software: you can redistribute it and/or modify
570d7624 8it under the terms of the GNU General Public License as published by
9ec0b715
GM
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
570d7624
JB
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
9ec0b715 18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
570d7624 19
18160b98 20#include <config.h>
77a28bbf 21#include <limits.h>
bb369dc6 22#include <fcntl.h>
406af475 23#include "sysstdio.h"
570d7624
JB
24#include <sys/types.h>
25#include <sys/stat.h>
29beb080 26#include <unistd.h>
29beb080 27
5b9c0a1d 28#ifdef HAVE_PWD_H
570d7624 29#include <pwd.h>
bfb61299
JB
30#endif
31
570d7624
JB
32#include <errno.h>
33
574c05e2
KK
34#ifdef HAVE_LIBSELINUX
35#include <selinux/selinux.h>
36#include <selinux/context.h>
37#endif
38
ffdc270a 39#ifdef HAVE_ACL_SET_FILE
7c3d167f
RF
40#include <sys/acl.h>
41#endif
42
620f13b0
PE
43#include <c-ctype.h>
44
570d7624 45#include "lisp.h"
8d4e077b 46#include "intervals.h"
db327c7e 47#include "character.h"
e5560ff7 48#include "buffer.h"
6fdaa9a0 49#include "coding.h"
570d7624 50#include "window.h"
67c08d6c 51#include "blockinput.h"
addccbd0 52#include "region-cache.h"
385ed61f
KL
53#include "frame.h"
54#include "dispextern.h"
570d7624 55
5e570b75
RS
56#ifdef WINDOWSNT
57#define NOMINMAX 1
58#include <windows.h>
bb385a92 59#include <sys/file.h>
a68089e4 60#include "w32.h"
5e570b75
RS
61#endif /* not WINDOWSNT */
62
7990d02a
EZ
63#ifdef MSDOS
64#include "msdos.h"
65#include <sys/param.h>
7990d02a 66#endif
7990d02a 67
199607e4 68#ifdef DOS_NT
199607e4 69/* On Windows, drive letters must be alphabetic - on DOS, the Netware
a5bb9bd3 70 redirector allows the six letters between 'Z' and 'a' as well. */
199607e4
RS
71#ifdef MSDOS
72#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
73#endif
74#ifdef WINDOWSNT
620f13b0 75#define IS_DRIVE(x) c_isalpha (x)
199607e4 76#endif
f54b565c 77/* Need to lower-case the drive letter, or else expanded
53964682 78 filenames will sometimes compare unequal, because
f54b565c 79 `expand-file-name' doesn't always down-case the drive letter. */
620f13b0 80#define DRIVE_LETTER(x) c_tolower (x)
199607e4
RS
81#endif
82
de5bf5d3 83#include "systime.h"
ffdc270a 84#include <acl.h>
8654f9d7
PE
85#include <allocator.h>
86#include <careadlinkat.h>
d35af63c 87#include <stat-time.h>
570d7624
JB
88
89#ifdef HPUX
90#include <netio.h>
47e7b9e5 91#endif
570d7624 92
9c856db9 93#include "commands.h"
9c856db9 94
f75d7a91
PE
95/* True during writing of auto-save files. */
96static bool auto_saving;
570d7624 97
71873e2b 98/* Nonzero umask during creation of auto-save directories. */
f75d7a91 99static mode_t auto_saving_dir_umask;
09450bae 100
570d7624 101/* Set by auto_save_1 to mode of original file so Fwrite_region will create
71873e2b 102 a new file with the same mode as the original. */
f75d7a91 103static mode_t auto_save_mode_bits;
570d7624 104
71873e2b 105/* Set by auto_save_1 if an error occurred during the last auto-save. */
f75d7a91 106static bool auto_save_error_occurred;
ca730bf0 107
9fe43ff6
PE
108/* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
109 number of a file system where time stamps were observed to to work. */
110static bool valid_timestamp_file_system;
111static dev_t timestamp_file_system;
112
356a6224
KH
113/* The symbol bound to coding-system-for-read when
114 insert-file-contents is called for recovering a file. This is not
115 an actual coding system name, but just an indicator to tell
116 insert-file-contents to use `emacs-mule' with a special flag for
117 auto saving and recovering a file. */
955cbe7b 118static Lisp_Object Qauto_save_coding;
356a6224 119
f6c9b683
RS
120/* Property name of a file name handler,
121 which gives a list of operations it handles.. */
955cbe7b 122static Lisp_Object Qoperations;
f6c9b683 123
71873e2b 124/* Lisp functions for translating file formats. */
955cbe7b 125static Lisp_Object Qformat_decode, Qformat_annotate_function;
0d420e88 126
2080470e 127/* Lisp function for setting buffer-file-coding-system and the
b6426b03 128 multibyteness of the current buffer after inserting a file. */
955cbe7b 129static Lisp_Object Qafter_insert_file_set_coding;
b6426b03 130
955cbe7b 131static Lisp_Object Qwrite_region_annotate_functions;
67fbc0cb
CY
132/* Each time an annotation function changes the buffer, the new buffer
133 is added here. */
5045092b 134static Lisp_Object Vwrite_region_annotation_buffers;
67fbc0cb 135
955cbe7b 136static Lisp_Object Qdelete_by_moving_to_trash;
d2b66acf 137
6cf29fe8 138/* Lisp function for moving files to trash. */
955cbe7b 139static Lisp_Object Qmove_file_to_trash;
6cf29fe8 140
8719abec 141/* Lisp function for recursively copying directories. */
955cbe7b 142static Lisp_Object Qcopy_directory;
8719abec
CY
143
144/* Lisp function for recursively deleting directories. */
955cbe7b 145static Lisp_Object Qdelete_directory;
8719abec 146
ee041f2d
SM
147static Lisp_Object Qsubstitute_env_in_file_name;
148
86dfb7a8 149Lisp_Object Qfile_error, Qfile_notify_error;
955cbe7b
PE
150static Lisp_Object Qfile_already_exists, Qfile_date_error;
151static Lisp_Object Qexcl;
15c65264
RS
152Lisp_Object Qfile_name_history;
153
955cbe7b 154static Lisp_Object Qcar_less_than_car;
d6a3cc15 155
f75d7a91
PE
156static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
157 Lisp_Object *, struct coding_system *);
158static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
159 struct coding_system *);
ce51c54c 160
ec7adf26 161\f
3d798ba7
PE
162/* Return true if FILENAME exists. */
163
164static bool
165check_existing (const char *filename)
166{
167 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
168}
169
170/* Return true if file FILENAME exists and can be executed. */
171
172static bool
173check_executable (char *filename)
174{
175 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
176}
177
178/* Return true if file FILENAME exists and can be accessed
179 according to AMODE, which should include W_OK.
180 On failure, return false and set errno. */
181
182static bool
183check_writable (const char *filename, int amode)
184{
185#ifdef MSDOS
186 /* FIXME: an faccessat implementation should be added to the
187 DOS/Windows ports and this #ifdef branch should be removed. */
188 struct stat st;
189 if (stat (filename, &st) < 0)
190 return 0;
191 errno = EPERM;
192 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
193#else /* not MSDOS */
194 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
195#ifdef CYGWIN
196 /* faccessat may have returned failure because Cygwin couldn't
197 determine the file's UID or GID; if so, we return success. */
198 if (!res)
199 {
200 int faccessat_errno = errno;
201 struct stat st;
202 if (stat (filename, &st) < 0)
203 return 0;
204 res = (st.st_uid == -1 || st.st_gid == -1);
205 errno = faccessat_errno;
206 }
207#endif /* CYGWIN */
208 return res;
209#endif /* not MSDOS */
210}
211\f
a773ed9a 212/* Signal a file-access failure. STRING describes the failure,
a9757f6a
PE
213 NAME the file involved, and ERRORNO the errno value.
214
215 If NAME is neither null nor a pair, package it up as a singleton
216 list before reporting it; this saves report_file_errno's caller the
217 trouble of preserving errno before calling list1. */
a773ed9a 218
5d01d666 219void
a9757f6a 220report_file_errno (char const *string, Lisp_Object name, int errorno)
570d7624 221{
a9757f6a 222 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
570d7624 223 Lisp_Object errstring;
d7259fdb 224 char *str;
570d7624 225
ca9c0567 226 synchronize_system_messages_locale ();
d7259fdb 227 str = strerror (errorno);
d7ea76b4 228 errstring = code_convert_string_norecord (build_unibyte_string (str),
68c45bf0
PE
229 Vlocale_coding_system, 0);
230
570d7624 231 while (1)
505ab9bc
RS
232 switch (errorno)
233 {
234 case EEXIST:
24b1ddad 235 xsignal (Qfile_already_exists, Fcons (errstring, data));
505ab9bc
RS
236 break;
237 default:
238 /* System error messages are capitalized. Downcase the initial
39824137
EZ
239 unless it is followed by a slash. (The slash case caters to
240 error messages that begin with "I/O" or, in German, "E/A".) */
d5443ffd
KH
241 if (STRING_MULTIBYTE (errstring)
242 && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
6c0969ca
KH
243 {
244 int c;
245
51b59d79 246 str = SSDATA (errstring);
5976c3fe 247 c = STRING_CHAR ((unsigned char *) str);
5da9919f 248 Faset (errstring, make_number (0), make_number (downcase (c)));
6c0969ca 249 }
505ab9bc 250
24b1ddad 251 xsignal (Qfile_error,
505ab9bc
RS
252 Fcons (build_string (string), Fcons (errstring, data)));
253 }
570d7624 254}
b5148e85 255
a9757f6a 256/* Signal a file-access failure that set errno. STRING describes the
b648c163
PE
257 failure, NAME the file involved. When invoking this function, take
258 care to not use arguments such as build_string ("foo") that involve
259 side effects that may set errno. */
a9757f6a 260
a773ed9a 261void
a9757f6a 262report_file_error (char const *string, Lisp_Object name)
a773ed9a 263{
a9757f6a 264 report_file_errno (string, name, errno);
a773ed9a
PE
265}
266
27e498e6
PE
267void
268close_file_unwind (int fd)
b5148e85 269{
a0931322 270 emacs_close (fd);
b5148e85 271}
a1d2b64a 272
f4b1eb36
PE
273void
274fclose_unwind (void *arg)
275{
276 FILE *stream = arg;
277 fclose (stream);
278}
279
a1d2b64a
RS
280/* Restore point, having saved it as a marker. */
281
27e498e6 282void
971de7fb 283restore_point_unwind (Lisp_Object location)
a1d2b64a 284{
ec7adf26 285 Fgoto_char (location);
bc923770 286 unchain_marker (XMARKER (location));
a1d2b64a 287}
59c94f03 288
570d7624 289\f
955cbe7b
PE
290static Lisp_Object Qexpand_file_name;
291static Lisp_Object Qsubstitute_in_file_name;
292static Lisp_Object Qdirectory_file_name;
293static Lisp_Object Qfile_name_directory;
294static Lisp_Object Qfile_name_nondirectory;
295static Lisp_Object Qunhandled_file_name_directory;
296static Lisp_Object Qfile_name_as_directory;
297static Lisp_Object Qcopy_file;
298static Lisp_Object Qmake_directory_internal;
299static Lisp_Object Qmake_directory;
300static Lisp_Object Qdelete_directory_internal;
32f4334d 301Lisp_Object Qdelete_file;
955cbe7b
PE
302static Lisp_Object Qrename_file;
303static Lisp_Object Qadd_name_to_file;
304static Lisp_Object Qmake_symbolic_link;
32f4334d 305Lisp_Object Qfile_exists_p;
955cbe7b
PE
306static Lisp_Object Qfile_executable_p;
307static Lisp_Object Qfile_readable_p;
308static Lisp_Object Qfile_writable_p;
309static Lisp_Object Qfile_symlink_p;
310static Lisp_Object Qaccess_file;
32f4334d 311Lisp_Object Qfile_directory_p;
955cbe7b
PE
312static Lisp_Object Qfile_regular_p;
313static Lisp_Object Qfile_accessible_directory_p;
314static Lisp_Object Qfile_modes;
315static Lisp_Object Qset_file_modes;
316static Lisp_Object Qset_file_times;
317static Lisp_Object Qfile_selinux_context;
318static Lisp_Object Qset_file_selinux_context;
7c3d167f
RF
319static Lisp_Object Qfile_acl;
320static Lisp_Object Qset_file_acl;
955cbe7b 321static Lisp_Object Qfile_newer_than_file_p;
32f4334d 322Lisp_Object Qinsert_file_contents;
3f011c7f 323static Lisp_Object Qchoose_write_coding_system;
32f4334d 324Lisp_Object Qwrite_region;
955cbe7b
PE
325static Lisp_Object Qverify_visited_file_modtime;
326static Lisp_Object Qset_visited_file_modtime;
32f4334d 327
a7ca3326 328DEFUN ("find-file-name-handler", Ffind_file_name_handler,
16a97296 329 Sfind_file_name_handler, 2, 2, 0,
8c1a1077
PJ
330 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
331Otherwise, return nil.
332A file name is handled if one of the regular expressions in
333`file-name-handler-alist' matches it.
334
335If OPERATION equals `inhibit-file-name-operation', then we ignore
336any handlers that are members of `inhibit-file-name-handlers',
337but we still do run any other handlers. This lets handlers
338use the standard functions without calling themselves recursively. */)
5842a27b 339 (Lisp_Object filename, Lisp_Object operation)
32f4334d 340{
642ef245 341 /* This function must not munge the match data. */
204ee271 342 Lisp_Object chain, inhibited_handlers, result;
d311d28c 343 ptrdiff_t pos = -1;
642ef245 344
204ee271 345 result = Qnil;
b7826503 346 CHECK_STRING (filename);
e4432095 347
a65970a0
RS
348 if (EQ (operation, Vinhibit_file_name_operation))
349 inhibited_handlers = Vinhibit_file_name_handlers;
350 else
351 inhibited_handlers = Qnil;
82c2d839 352
93c30b5f 353 for (chain = Vfile_name_handler_alist; CONSP (chain);
03699b14 354 chain = XCDR (chain))
32f4334d
RS
355 {
356 Lisp_Object elt;
03699b14 357 elt = XCAR (chain);
93c30b5f 358 if (CONSP (elt))
32f4334d 359 {
f6c9b683 360 Lisp_Object string = XCAR (elt);
d311d28c 361 ptrdiff_t match_pos;
f6c9b683 362 Lisp_Object handler = XCDR (elt);
68780e2a
RS
363 Lisp_Object operations = Qnil;
364
365 if (SYMBOLP (handler))
366 operations = Fget (handler, Qoperations);
f6c9b683 367
8d2ced53 368 if (STRINGP (string)
f6c9b683
RS
369 && (match_pos = fast_string_match (string, filename)) > pos
370 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
a65970a0 371 {
f6c9b683 372 Lisp_Object tem;
a65970a0 373
03699b14 374 handler = XCDR (elt);
a65970a0
RS
375 tem = Fmemq (handler, inhibited_handlers);
376 if (NILP (tem))
8d2ced53
SM
377 {
378 result = handler;
379 pos = match_pos;
380 }
a65970a0 381 }
32f4334d 382 }
642ef245
JB
383
384 QUIT;
32f4334d 385 }
8d2ced53 386 return result;
32f4334d
RS
387}
388\f
a7ca3326 389DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
8c1a1077
PJ
390 1, 1, 0,
391 doc: /* Return the directory component in file name FILENAME.
392Return nil if FILENAME does not include a directory.
78379264 393Otherwise return a directory name.
7c2fb837 394Given a Unix syntax file name, returns a string ending in slash. */)
5842a27b 395 (Lisp_Object filename)
570d7624 396{
100c44b7 397#ifndef DOS_NT
5976c3fe 398 register const char *beg;
100c44b7 399#else
5976c3fe 400 register char *beg;
273ac8d1 401 Lisp_Object tem_fn;
100c44b7 402#endif
5976c3fe 403 register const char *p;
0bf2eed2 404 Lisp_Object handler;
570d7624 405
b7826503 406 CHECK_STRING (filename);
570d7624 407
0bf2eed2
RS
408 /* If the file name has special constructs in it,
409 call the corresponding file handler. */
3b7f6e60 410 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
0bf2eed2 411 if (!NILP (handler))
2375c96a
CY
412 {
413 Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
414 filename);
415 return STRINGP (handled_name) ? handled_name : Qnil;
416 }
0bf2eed2 417
199607e4 418#ifdef DOS_NT
5b71542d 419 beg = xlispstrdupa (filename);
0f3f018c 420#else
5976c3fe 421 beg = SSDATA (filename);
199607e4 422#endif
d5db4077 423 p = beg + SBYTES (filename);
570d7624 424
199607e4 425 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
199607e4 426#ifdef DOS_NT
e1dbe924 427 /* only recognize drive specifier at the beginning */
ba14e174
RS
428 && !(p[-1] == ':'
429 /* handle the "/:d:foo" and "/:foo" cases correctly */
430 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
431 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
199607e4 432#endif
570d7624
JB
433 ) p--;
434
435 if (p == beg)
436 return Qnil;
5e570b75 437#ifdef DOS_NT
4c3c22f3 438 /* Expansion of "c:" to drive and default directory. */
ba14e174 439 if (p[-1] == ':')
4c3c22f3 440 {
4c3c22f3 441 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
5976c3fe
PE
442 char *res = alloca (MAXPATHLEN + 1);
443 char *r = res;
ba14e174
RS
444
445 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
446 {
e99a530f 447 memcpy (res, beg, 2);
ba14e174
RS
448 beg += 2;
449 r += 2;
450 }
451
620f13b0 452 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
4c3c22f3 453 {
e7ac588e
EZ
454 size_t l = strlen (res);
455
456 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
4c3c22f3
RS
457 strcat (res, "/");
458 beg = res;
459 p = beg + strlen (beg);
1fd201bb 460 dostounix_filename (beg);
f5c81c80
EZ
461 tem_fn = make_specified_string (beg, -1, p - beg,
462 STRING_MULTIBYTE (filename));
4c3c22f3 463 }
f5c81c80
EZ
464 else
465 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
466 STRING_MULTIBYTE (filename));
467 }
468 else if (STRING_MULTIBYTE (filename))
469 {
e7ac588e 470 tem_fn = make_specified_string (beg, -1, p - beg, 1);
1fd201bb 471 dostounix_filename (SSDATA (tem_fn));
e7ac588e
EZ
472#ifdef WINDOWSNT
473 if (!NILP (Vw32_downcase_file_names))
474 tem_fn = Fdowncase (tem_fn);
475#endif
f5c81c80
EZ
476 }
477 else
478 {
1fd201bb 479 dostounix_filename (beg);
f5c81c80 480 tem_fn = make_specified_string (beg, -1, p - beg, 0);
4c3c22f3 481 }
f5c81c80 482 return tem_fn;
273ac8d1 483#else /* DOS_NT */
d7231f93 484 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
273ac8d1 485#endif /* DOS_NT */
570d7624
JB
486}
487
a7ca3326 488DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
60d67b83 489 Sfile_name_nondirectory, 1, 1, 0,
8c1a1077
PJ
490 doc: /* Return file name FILENAME sans its directory.
491For example, in a Unix-syntax file name,
492this is everything after the last slash,
493or the entire name if it contains no slash. */)
5842a27b 494 (Lisp_Object filename)
570d7624 495{
5976c3fe 496 register const char *beg, *p, *end;
0bf2eed2 497 Lisp_Object handler;
570d7624 498
b7826503 499 CHECK_STRING (filename);
570d7624 500
0bf2eed2
RS
501 /* If the file name has special constructs in it,
502 call the corresponding file handler. */
3b7f6e60 503 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
0bf2eed2 504 if (!NILP (handler))
2375c96a
CY
505 {
506 Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
507 filename);
508 if (STRINGP (handled_name))
509 return handled_name;
510 error ("Invalid handler in `file-name-handler-alist'");
511 }
0bf2eed2 512
5976c3fe 513 beg = SSDATA (filename);
d5db4077 514 end = p = beg + SBYTES (filename);
570d7624 515
199607e4 516 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
199607e4 517#ifdef DOS_NT
e1dbe924 518 /* only recognize drive specifier at beginning */
ba14e174
RS
519 && !(p[-1] == ':'
520 /* handle the "/:d:foo" case correctly */
521 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
199607e4 522#endif
60d67b83
RS
523 )
524 p--;
570d7624 525
d7231f93 526 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
570d7624 527}
642ef245 528
a7ca3326 529DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
60d67b83 530 Sunhandled_file_name_directory, 1, 1, 0,
8c1a1077
PJ
531 doc: /* Return a directly usable directory name somehow associated with FILENAME.
532A `directly usable' directory name is one that may be used without the
533intervention of any file handler.
534If FILENAME is a directly usable file itself, return
535\(file-name-directory FILENAME).
ca319910
SM
536If FILENAME refers to a file which is not accessible from a local process,
537then this should return nil.
8c1a1077
PJ
538The `call-process' and `start-process' functions use this function to
539get a current directory to run processes in. */)
5842a27b 540 (Lisp_Object filename)
642ef245
JB
541{
542 Lisp_Object handler;
543
544 /* If the file name has special constructs in it,
545 call the corresponding file handler. */
49307295 546 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
642ef245 547 if (!NILP (handler))
2375c96a
CY
548 {
549 Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
550 filename);
551 return STRINGP (handled_name) ? handled_name : Qnil;
552 }
642ef245
JB
553
554 return Ffile_name_directory (filename);
555}
556
c365c355
PE
557/* Maximum number of bytes that DST will be longer than SRC
558 in file_name_as_directory. This occurs when SRCLEN == 0. */
559enum { file_name_as_directory_slop = 2 };
560
f5c81c80
EZ
561/* Convert from file name SRC of length SRCLEN to directory name in
562 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
563 string. On UNIX, just make sure there is a terminating /. Return
564 the length of DST in bytes. */
570d7624 565
c293e30c 566static ptrdiff_t
f5c81c80
EZ
567file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
568 bool multibyte)
c293e30c
DA
569{
570 if (srclen == 0)
8aa3a244 571 {
c293e30c
DA
572 dst[0] = '.';
573 dst[1] = '/';
574 dst[2] = '\0';
575 return 2;
8aa3a244
RS
576 }
577
c365c355 578 memcpy (dst, src, srclen);
c293e30c 579 if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
c365c355
PE
580 dst[srclen++] = DIRECTORY_SEP;
581 dst[srclen] = 0;
199607e4 582#ifdef DOS_NT
1fd201bb 583 dostounix_filename (dst);
199607e4 584#endif
c293e30c 585 return srclen;
570d7624
JB
586}
587
a7ca3326 588DEFUN ("file-name-as-directory", Ffile_name_as_directory,
570d7624 589 Sfile_name_as_directory, 1, 1, 0,
0dac4f85 590 doc: /* Return a string representing the file name FILE interpreted as a directory.
8c1a1077
PJ
591This operation exists because a directory is also a file, but its name as
592a directory is different from its name as a file.
593The result can be used as the value of `default-directory'
594or passed as second argument to `expand-file-name'.
7c2fb837 595For a Unix-syntax file name, just appends a slash. */)
5842a27b 596 (Lisp_Object file)
570d7624
JB
597{
598 char *buf;
c293e30c 599 ptrdiff_t length;
c365c355
PE
600 Lisp_Object handler, val;
601 USE_SAFE_ALLOCA;
570d7624 602
b7826503 603 CHECK_STRING (file);
265a9e55 604 if (NILP (file))
570d7624 605 return Qnil;
0bf2eed2
RS
606
607 /* If the file name has special constructs in it,
608 call the corresponding file handler. */
49307295 609 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
0bf2eed2 610 if (!NILP (handler))
2375c96a
CY
611 {
612 Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
613 file);
614 if (STRINGP (handled_name))
615 return handled_name;
616 error ("Invalid handler in `file-name-handler-alist'");
617 }
0bf2eed2 618
e7ac588e
EZ
619#ifdef WINDOWSNT
620 if (!NILP (Vw32_downcase_file_names))
621 file = Fdowncase (file);
622#endif
c365c355 623 buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
f5c81c80
EZ
624 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
625 STRING_MULTIBYTE (file));
c365c355
PE
626 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
627 SAFE_FREE ();
628 return val;
570d7624
JB
629}
630\f
f5c81c80
EZ
631/* Convert from directory name SRC of length SRCLEN to file name in
632 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
633 string. On UNIX, just make sure there isn't a terminating /.
634 Return the length of DST in bytes. */
570d7624 635
c293e30c 636static ptrdiff_t
f5c81c80 637directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
570d7624 638{
570d7624 639 /* Process as Unix format: just remove any final slash.
c365c355
PE
640 But leave "/" and "//" unchanged. */
641 while (srclen > 1
4592782e 642#ifdef DOS_NT
c365c355 643 && !IS_ANY_SEP (src[srclen - 2])
4592782e 644#endif
c365c355
PE
645 && IS_DIRECTORY_SEP (src[srclen - 1])
646 && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
647 srclen--;
648
649 memcpy (dst, src, srclen);
650 dst[srclen] = 0;
199607e4 651#ifdef DOS_NT
1fd201bb 652 dostounix_filename (dst);
125feee8 653#endif
c293e30c 654 return srclen;
570d7624
JB
655}
656
a7ca3326 657DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
8c1a1077
PJ
658 1, 1, 0,
659 doc: /* Returns the file name of the directory named DIRECTORY.
660This is the name of the file that holds the data for the directory DIRECTORY.
661This operation exists because a directory is also a file, but its name as
662a directory is different from its name as a file.
7c2fb837 663In Unix-syntax, this function just removes the final slash. */)
5842a27b 664 (Lisp_Object directory)
570d7624
JB
665{
666 char *buf;
c293e30c 667 ptrdiff_t length;
c365c355
PE
668 Lisp_Object handler, val;
669 USE_SAFE_ALLOCA;
570d7624 670
b7826503 671 CHECK_STRING (directory);
570d7624 672
265a9e55 673 if (NILP (directory))
570d7624 674 return Qnil;
0bf2eed2
RS
675
676 /* If the file name has special constructs in it,
677 call the corresponding file handler. */
49307295 678 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
0bf2eed2 679 if (!NILP (handler))
2375c96a
CY
680 {
681 Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
682 directory);
683 if (STRINGP (handled_name))
684 return handled_name;
685 error ("Invalid handler in `file-name-handler-alist'");
686 }
0bf2eed2 687
e7ac588e
EZ
688#ifdef WINDOWSNT
689 if (!NILP (Vw32_downcase_file_names))
690 directory = Fdowncase (directory);
691#endif
c365c355 692 buf = SAFE_ALLOCA (SBYTES (directory) + 1);
f5c81c80
EZ
693 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
694 STRING_MULTIBYTE (directory));
c365c355
PE
695 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
696 SAFE_FREE ();
697 return val;
570d7624
JB
698}
699
91433552 700static const char make_temp_name_tbl[64] =
3ce839e4
RS
701{
702 'A','B','C','D','E','F','G','H',
703 'I','J','K','L','M','N','O','P',
704 'Q','R','S','T','U','V','W','X',
705 'Y','Z','a','b','c','d','e','f',
706 'g','h','i','j','k','l','m','n',
707 'o','p','q','r','s','t','u','v',
708 'w','x','y','z','0','1','2','3',
709 '4','5','6','7','8','9','-','_'
710};
cb613bb8 711
3ce839e4
RS
712static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
713
cb613bb8 714/* Value is a temporary file name starting with PREFIX, a string.
efdc16c9 715
cb613bb8
GM
716 The Emacs process number forms part of the result, so there is
717 no danger of generating a name being used by another process.
718 In addition, this function makes an attempt to choose a name
719 which has no existing file. To make this work, PREFIX should be
720 an absolute file name.
efdc16c9 721
f75d7a91 722 BASE64_P means add the pid as 3 characters in base64
cb613bb8
GM
723 encoding. In this case, 6 characters will be added to PREFIX to
724 form the file name. Otherwise, if Emacs is running on a system
725 with long file names, add the pid as a decimal number.
726
727 This function signals an error if no unique file name could be
728 generated. */
729
730Lisp_Object
f75d7a91 731make_temp_name (Lisp_Object prefix, bool base64_p)
570d7624 732{
d0065ff1
EZ
733 Lisp_Object val, encoded_prefix;
734 int len;
a81d11a3 735 printmax_t pid;
5976c3fe 736 char *p, *data;
a81d11a3 737 char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
3ce839e4 738 int pidlen;
efdc16c9 739
b7826503 740 CHECK_STRING (prefix);
3ce839e4
RS
741
742 /* VAL is created by adding 6 characters to PREFIX. The first
743 three are the PID of this process, in base 64, and the second
744 three are incremented if the file already exists. This ensures
745 262144 unique file names per PID per PREFIX. */
746
93f4cf88 747 pid = getpid ();
3ce839e4 748
cb613bb8
GM
749 if (base64_p)
750 {
751 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
752 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
753 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
754 pidlen = 3;
755 }
756 else
757 {
3ce839e4 758#ifdef HAVE_LONG_FILE_NAMES
a81d11a3 759 pidlen = sprintf (pidbuf, "%"pMd, pid);
3a3bfb18 760#else
cb613bb8
GM
761 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
762 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
763 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
764 pidlen = 3;
3ce839e4 765#endif
cb613bb8 766 }
efdc16c9 767
d0065ff1
EZ
768 encoded_prefix = ENCODE_FILE (prefix);
769 len = SBYTES (encoded_prefix);
770 val = make_uninit_string (len + 3 + pidlen);
5976c3fe 771 data = SSDATA (val);
d0065ff1 772 memcpy (data, SSDATA (encoded_prefix), len);
3ce839e4
RS
773 p = data + len;
774
72af86bd 775 memcpy (p, pidbuf, pidlen);
3ce839e4
RS
776 p += pidlen;
777
778 /* Here we try to minimize useless stat'ing when this function is
779 invoked many times successively with the same PREFIX. We achieve
780 this by initializing count to a random value, and incrementing it
f6a492a9
RS
781 afterwards.
782
783 We don't want make-temp-name to be called while dumping,
784 because then make_temp_name_count_initialized_p would get set
785 and then make_temp_name_count would not be set when Emacs starts. */
786
3ce839e4
RS
787 if (!make_temp_name_count_initialized_p)
788 {
327eeec8 789 make_temp_name_count = time (NULL);
3ce839e4
RS
790 make_temp_name_count_initialized_p = 1;
791 }
792
793 while (1)
794 {
8a7777fc 795 unsigned num = make_temp_name_count;
3ce839e4
RS
796
797 p[0] = make_temp_name_tbl[num & 63], num >>= 6;
798 p[1] = make_temp_name_tbl[num & 63], num >>= 6;
799 p[2] = make_temp_name_tbl[num & 63], num >>= 6;
800
8a7777fc
RS
801 /* Poor man's congruential RN generator. Replace with
802 ++make_temp_name_count for debugging. */
803 make_temp_name_count += 25229;
804 make_temp_name_count %= 225307;
805
bb385a92 806 if (!check_existing (data))
3ce839e4
RS
807 {
808 /* We want to return only if errno is ENOENT. */
809 if (errno == ENOENT)
d0065ff1 810 return DECODE_FILE (val);
3ce839e4
RS
811 else
812 /* The error here is dubious, but there is little else we
813 can do. The alternatives are to return nil, which is
814 as bad as (and in many cases worse than) throwing the
815 error, or to ignore the error, which will likely result
8a7777fc 816 in looping through 225307 stat's, which is not only
410ed5c3
PE
817 dog-slow, but also useless since eventually nil would
818 have to be returned anyway. */
9869bb0b 819 report_file_error ("Cannot create temporary name for prefix",
a9757f6a 820 prefix);
3ce839e4
RS
821 /* not reached */
822 }
823 }
570d7624 824}
3ce839e4 825
cb613bb8
GM
826
827DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
8c1a1077
PJ
828 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
829The Emacs process number forms part of the result,
830so there is no danger of generating a name being used by another process.
831
832In addition, this function makes an attempt to choose a name
833which has no existing file. To make this work,
834PREFIX should be an absolute file name.
835
836There is a race condition between calling `make-temp-name' and creating the
837file which opens all kinds of security holes. For that reason, you should
f9e6f049
RS
838probably use `make-temp-file' instead, except in three circumstances:
839
840* If you are creating the file in the user's home directory.
841* If you are creating a directory rather than an ordinary file.
842* If you are taking special precautions as `make-temp-file' does. */)
5842a27b 843 (Lisp_Object prefix)
cb613bb8
GM
844{
845 return make_temp_name (prefix, 0);
846}
847
848
570d7624 849\f
a7ca3326 850DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
8c1a1077
PJ
851 doc: /* Convert filename NAME to absolute, and canonicalize it.
852Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
d177e213
XF
853\(does not start with slash or tilde); both the directory name and
854a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
855missing, the current buffer's value of `default-directory' is used.
1b2a627f
EZ
856NAME should be a string that is a valid file name for the underlying
857filesystem.
8c1a1077
PJ
858File name components that are `.' are removed, and
859so are file name components followed by `..', along with the `..' itself;
860note that these simplifications are done without checking the resulting
861file names in the file system.
15579471
EZ
862Multiple consecutive slashes are collapsed into a single slash,
863except at the beginning of the file name when they are significant (e.g.,
864UNC file names on MS-Windows.)
8c1a1077
PJ
865An initial `~/' expands to your home directory.
866An initial `~USER/' expands to USER's home directory.
07114296
CY
867See also the function `substitute-in-file-name'.
868
869For technical reasons, this function can return correct but
870non-intuitive results for the root directory; for instance,
871\(expand-file-name ".." "/") returns "/..". For this reason, use
15579471 872\(directory-file-name (file-name-directory dirname)) to traverse a
07114296 873filesystem tree, not (expand-file-name ".." dirname). */)
5842a27b 874 (Lisp_Object name, Lisp_Object default_directory)
570d7624 875{
5b5a2ea1
SM
876 /* These point to SDATA and need to be careful with string-relocation
877 during GC (via DECODE_FILE). */
2893f146
PE
878 char *nm;
879 const char *newdir;
5b5a2ea1 880 /* This should only point to alloca'd data. */
5976c3fe 881 char *target;
199607e4 882
93f4cf88 883 ptrdiff_t tlen;
570d7624 884 struct passwd *pw;
5e570b75 885#ifdef DOS_NT
199607e4 886 int drive = 0;
f75d7a91
PE
887 bool collapse_newdir = 1;
888 bool is_escaped = 0;
5e570b75 889#endif /* DOS_NT */
93f4cf88 890 ptrdiff_t length;
2375c96a 891 Lisp_Object handler, result, handled_name;
fce31d69 892 bool multibyte;
9c06a1f3 893 Lisp_Object hdir;
c365c355 894 USE_SAFE_ALLOCA;
199607e4 895
b7826503 896 CHECK_STRING (name);
570d7624 897
0bf2eed2
RS
898 /* If the file name has special constructs in it,
899 call the corresponding file handler. */
49307295 900 handler = Ffind_file_name_handler (name, Qexpand_file_name);
0bf2eed2 901 if (!NILP (handler))
2375c96a
CY
902 {
903 handled_name = call3 (handler, Qexpand_file_name,
904 name, default_directory);
905 if (STRINGP (handled_name))
906 return handled_name;
907 error ("Invalid handler in `file-name-handler-alist'");
908 }
909
58fc9587 910
3b7f6e60
EN
911 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
912 if (NILP (default_directory))
4b4deea2 913 default_directory = BVAR (current_buffer, directory);
82330e7f 914 if (! STRINGP (default_directory))
dd693537
EZ
915 {
916#ifdef DOS_NT
917 /* "/" is not considered a root directory on DOS_NT, so using "/"
918 here causes an infinite recursion in, e.g., the following:
919
920 (let (default-directory)
921 (expand-file-name "a"))
922
923 To avoid this, we set default_directory to the root of the
924 current drive. */
dd693537
EZ
925 default_directory = build_string (emacs_root_dir ());
926#else
927 default_directory = build_string ("/");
928#endif
929 }
58fc9587 930
3b7f6e60 931 if (!NILP (default_directory))
273e0829 932 {
3b7f6e60 933 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
273e0829 934 if (!NILP (handler))
2375c96a
CY
935 {
936 handled_name = call3 (handler, Qexpand_file_name,
937 name, default_directory);
938 if (STRINGP (handled_name))
939 return handled_name;
940 error ("Invalid handler in `file-name-handler-alist'");
941 }
273e0829 942 }
0bf2eed2 943
5b5a2ea1 944 {
5976c3fe 945 char *o = SSDATA (default_directory);
5b5a2ea1
SM
946
947 /* Make sure DEFAULT_DIRECTORY is properly expanded.
948 It would be better to do this down below where we actually use
949 default_directory. Unfortunately, calling Fexpand_file_name recursively
950 could invoke GC, and the strings might be relocated. This would
951 be annoying because we have pointers into strings lying around
952 that would need adjusting, and people would add new pointers to
953 the code and forget to adjust them, resulting in intermittent bugs.
954 Putting this call here avoids all that crud.
955
956 The EQ test avoids infinite recursion. */
957 if (! NILP (default_directory) && !EQ (default_directory, name)
958 /* Save time in some common cases - as long as default_directory
959 is not relative, it can be canonicalized with name below (if it
960 is needed at all) without requiring it to be expanded now. */
01937013 961#ifdef DOS_NT
5b5a2ea1
SM
962 /* Detect MSDOS file names with drive specifiers. */
963 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
964 && IS_DIRECTORY_SEP (o[2]))
199607e4 965#ifdef WINDOWSNT
5b5a2ea1
SM
966 /* Detect Windows file names in UNC format. */
967 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
01937013 968#endif
199607e4
RS
969#else /* not DOS_NT */
970 /* Detect Unix absolute file names (/... alone is not absolute on
971 DOS or Windows). */
5b5a2ea1 972 && ! (IS_DIRECTORY_SEP (o[0]))
199607e4 973#endif /* not DOS_NT */
5b5a2ea1
SM
974 )
975 {
976 struct gcpro gcpro1;
f14b1c68 977
5b5a2ea1
SM
978 GCPRO1 (name);
979 default_directory = Fexpand_file_name (default_directory, Qnil);
980 UNGCPRO;
981 }
982 }
2b046a72 983 multibyte = STRING_MULTIBYTE (name);
6d060996
KH
984 if (multibyte != STRING_MULTIBYTE (default_directory))
985 {
986 if (multibyte)
d0065ff1
EZ
987 {
988 unsigned char *p = SDATA (name);
989
990 while (*p && ASCII_BYTE_P (*p))
991 p++;
992 if (*p == '\0')
993 {
994 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
995 unibyte. Do not convert DEFAULT_DIRECTORY to
996 multibyte; instead, convert NAME to a unibyte string,
997 so that the result of this function is also a unibyte
a67c4ae0 998 string. This is needed during bootstrapping and
d0065ff1
EZ
999 dumping, when Emacs cannot decode file names, because
1000 the locale environment is not set up. */
1001 name = make_unibyte_string (SSDATA (name), SBYTES (name));
1002 multibyte = 0;
1003 }
1004 else
1005 default_directory = string_to_multibyte (default_directory);
1006 }
6d060996
KH
1007 else
1008 {
1009 name = string_to_multibyte (name);
1010 multibyte = 1;
1011 }
1012 }
1013
e7ac588e
EZ
1014#ifdef WINDOWSNT
1015 if (!NILP (Vw32_downcase_file_names))
1016 default_directory = Fdowncase (default_directory);
1017#endif
1018
e8d32c7e 1019 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
5b71542d 1020 nm = xlispstrdupa (name);
199607e4 1021
565f0b98 1022#ifdef DOS_NT
f0f95d31
RS
1023 /* Note if special escape prefix is present, but remove for now. */
1024 if (nm[0] == '/' && nm[1] == ':')
1025 {
1026 is_escaped = 1;
1027 nm += 2;
1028 }
1029
199607e4 1030 /* Find and remove drive specifier if present; this makes nm absolute
f0f95d31
RS
1031 even if the rest of the name appears to be relative. Only look for
1032 drive specifier at the beginning. */
1033 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
1034 {
5976c3fe 1035 drive = (unsigned char) nm[0];
f0f95d31
RS
1036 nm += 2;
1037 }
bb1ff1f4
GV
1038
1039#ifdef WINDOWSNT
1040 /* If we see "c://somedir", we want to strip the first slash after the
1041 colon when stripping the drive letter. Otherwise, this expands to
1042 "//somedir". */
1043 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1044 nm++;
4c3c22f3 1045
e8d32c7e 1046 /* Discard any previous drive specifier if nm is now in UNC format. */
199607e4
RS
1047 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1048 {
1049 drive = 0;
1050 }
5b5a2ea1
SM
1051#endif /* WINDOWSNT */
1052#endif /* DOS_NT */
199607e4 1053
214378ec
GM
1054 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1055 none are found, we can probably return right away. We will avoid
1056 allocating a new string if name is already fully expanded. */
570d7624 1057 if (
5e570b75 1058 IS_DIRECTORY_SEP (nm[0])
199607e4 1059#ifdef MSDOS
f0f95d31 1060 && drive && !is_escaped
199607e4
RS
1061#endif
1062#ifdef WINDOWSNT
f0f95d31 1063 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
199607e4 1064#endif
570d7624
JB
1065 )
1066 {
f14b1c68
JB
1067 /* If it turns out that the filename we want to return is just a
1068 suffix of FILENAME, we don't need to go through and edit
1069 things; we just need to construct a new string using data
f75d7a91
PE
1070 starting at the middle of FILENAME. If we set LOSE, that
1071 means we've discovered that we can't do that cool trick. */
1072 bool lose = 0;
5976c3fe 1073 char *p = nm;
f14b1c68 1074
570d7624
JB
1075 while (*p)
1076 {
199607e4 1077 /* Since we know the name is absolute, we can assume that each
c77d647e
JB
1078 element starts with a "/". */
1079
c77d647e 1080 /* "." and ".." are hairy. */
5e570b75 1081 if (IS_DIRECTORY_SEP (p[0])
c77d647e 1082 && p[1] == '.'
5e570b75 1083 && (IS_DIRECTORY_SEP (p[2])
c77d647e 1084 || p[2] == 0
5e570b75 1085 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
c77d647e 1086 || p[3] == 0))))
570d7624 1087 lose = 1;
c365c355
PE
1088 /* Replace multiple slashes with a single one, except
1089 leave leading "//" alone. */
1090 else if (IS_DIRECTORY_SEP (p[0])
1091 && IS_DIRECTORY_SEP (p[1])
1092 && (p != nm || IS_DIRECTORY_SEP (p[2])))
214378ec 1093 lose = 1;
570d7624
JB
1094 p++;
1095 }
1096 if (!lose)
1097 {
199607e4 1098#ifdef DOS_NT
087fc47a
JB
1099 /* Make sure directories are all separated with /, but
1100 avoid allocation of a new string when not required. */
1fd201bb 1101 dostounix_filename (nm);
199607e4
RS
1102#ifdef WINDOWSNT
1103 if (IS_DIRECTORY_SEP (nm[1]))
1104 {
42a5b22f 1105 if (strcmp (nm, SSDATA (name)) != 0)
2b046a72 1106 name = make_specified_string (nm, -1, strlen (nm), multibyte);
199607e4
RS
1107 }
1108 else
1109#endif
e8d32c7e 1110 /* Drive must be set, so this is okay. */
5976c3fe 1111 if (strcmp (nm - 2, SSDATA (name)) != 0)
199607e4 1112 {
3f817c73
KH
1113 char temp[] = " :";
1114
2b046a72 1115 name = make_specified_string (nm, -1, p - nm, multibyte);
3f817c73
KH
1116 temp[0] = DRIVE_LETTER (drive);
1117 name = concat2 (build_string (temp), name);
199607e4 1118 }
e7ac588e
EZ
1119#ifdef WINDOWSNT
1120 if (!NILP (Vw32_downcase_file_names))
1121 name = Fdowncase (name);
1122#endif
199607e4
RS
1123 return name;
1124#else /* not DOS_NT */
42a5b22f 1125 if (strcmp (nm, SSDATA (name)) == 0)
570d7624 1126 return name;
2b046a72 1127 return make_specified_string (nm, -1, strlen (nm), multibyte);
5e570b75 1128#endif /* not DOS_NT */
570d7624
JB
1129 }
1130 }
1131
199607e4
RS
1132 /* At this point, nm might or might not be an absolute file name. We
1133 need to expand ~ or ~user if present, otherwise prefix nm with
1134 default_directory if nm is not absolute, and finally collapse /./
1135 and /foo/../ sequences.
1136
1137 We set newdir to be the appropriate prefix if one is needed:
1138 - the relevant user directory if nm starts with ~ or ~user
1139 - the specified drive's working dir (DOS/NT only) if nm does not
1140 start with /
1141 - the value of default_directory.
1142
1143 Note that these prefixes are not guaranteed to be absolute (except
1144 for the working dir of a drive). Therefore, to ensure we always
1145 return an absolute name, if the final prefix is not absolute we
1146 append it to the current working directory. */
570d7624
JB
1147
1148 newdir = 0;
1149
1150 if (nm[0] == '~') /* prefix ~ */
c77d647e 1151 {
5e570b75 1152 if (IS_DIRECTORY_SEP (nm[1])
c77d647e
JB
1153 || nm[1] == 0) /* ~ by itself */
1154 {
6d557778
EZ
1155 Lisp_Object tem;
1156
5976c3fe
PE
1157 if (!(newdir = egetenv ("HOME")))
1158 newdir = "";
199607e4 1159 nm++;
e8d32c7e 1160 /* `egetenv' may return a unibyte string, which will bite us since
6d557778 1161 we expect the directory to be multibyte. */
857fd372
EZ
1162#ifdef WINDOWSNT
1163 if (newdir[0])
1164 {
1165 char newdir_utf8[MAX_UTF8_PATH];
1166
1167 filename_from_ansi (newdir, newdir_utf8);
1168 tem = build_string (newdir_utf8);
1169 }
1170 else
857fd372 1171#endif
db50ad5f 1172 tem = build_string (newdir);
f5c81c80 1173 if (multibyte && !STRING_MULTIBYTE (tem))
9c06a1f3
EZ
1174 {
1175 hdir = DECODE_FILE (tem);
5976c3fe 1176 newdir = SSDATA (hdir);
9c06a1f3 1177 }
5e570b75 1178#ifdef DOS_NT
9a1dc3be 1179 collapse_newdir = 0;
4c3c22f3 1180#endif
c77d647e
JB
1181 }
1182 else /* ~user/filename */
1183 {
5976c3fe 1184 char *o, *p;
c365c355
PE
1185 for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
1186 continue;
1187 o = SAFE_ALLOCA (p - nm + 1);
72af86bd 1188 memcpy (o, nm, p - nm);
c365c355 1189 o[p - nm] = 0;
c77d647e 1190
4d7e6e51 1191 block_input ();
350e0088 1192 pw = getpwnam (o + 1);
4d7e6e51 1193 unblock_input ();
c77d647e
JB
1194 if (pw)
1195 {
f5c81c80
EZ
1196 Lisp_Object tem;
1197
5976c3fe 1198 newdir = pw->pw_dir;
f5c81c80
EZ
1199 /* `getpwnam' may return a unibyte string, which will
1200 bite us since we expect the directory to be
1201 multibyte. */
1202 tem = build_string (newdir);
1203 if (multibyte && !STRING_MULTIBYTE (tem))
1204 {
1205 hdir = DECODE_FILE (tem);
1206 newdir = SSDATA (hdir);
1207 }
c77d647e 1208 nm = p;
199607e4 1209#ifdef DOS_NT
9a1dc3be 1210 collapse_newdir = 0;
199607e4 1211#endif
c77d647e 1212 }
e5d77022 1213
c77d647e
JB
1214 /* If we don't find a user of that name, leave the name
1215 unchanged; don't move nm forward to p. */
1216 }
1217 }
570d7624 1218
5e570b75 1219#ifdef DOS_NT
199607e4
RS
1220 /* On DOS and Windows, nm is absolute if a drive name was specified;
1221 use the drive's current directory as the prefix if needed. */
1222 if (!newdir && drive)
1223 {
e8d32c7e 1224 /* Get default directory if needed to make nm absolute. */
2893f146 1225 char *adir = NULL;
199607e4
RS
1226 if (!IS_DIRECTORY_SEP (nm[0]))
1227 {
2893f146 1228 adir = alloca (MAXPATHLEN + 1);
620f13b0 1229 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
2893f146 1230 adir = NULL;
f5c81c80
EZ
1231 else if (multibyte)
1232 {
1233 Lisp_Object tem = build_string (adir);
1234
1235 tem = DECODE_FILE (tem);
1236 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1237 }
199607e4 1238 }
2893f146 1239 if (!adir)
199607e4 1240 {
e8d32c7e 1241 /* Either nm starts with /, or drive isn't mounted. */
2893f146
PE
1242 adir = alloca (4);
1243 adir[0] = DRIVE_LETTER (drive);
1244 adir[1] = ':';
1245 adir[2] = '/';
1246 adir[3] = 0;
199607e4 1247 }
2893f146 1248 newdir = adir;
199607e4 1249 }
5e570b75 1250#endif /* DOS_NT */
199607e4
RS
1251
1252 /* Finally, if no prefix has been specified and nm is not absolute,
e8d32c7e 1253 then it must be expanded relative to default_directory. */
199607e4 1254
34097368 1255 if (1
199607e4 1256#ifndef DOS_NT
e8d32c7e 1257 /* /... alone is not absolute on DOS and Windows. */
34097368 1258 && !IS_DIRECTORY_SEP (nm[0])
199607e4
RS
1259#endif
1260#ifdef WINDOWSNT
34097368 1261 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
199607e4 1262#endif
570d7624
JB
1263 && !newdir)
1264 {
5976c3fe 1265 newdir = SSDATA (default_directory);
f0f95d31
RS
1266#ifdef DOS_NT
1267 /* Note if special escape prefix is present, but remove for now. */
1268 if (newdir[0] == '/' && newdir[1] == ':')
1269 {
1270 is_escaped = 1;
1271 newdir += 2;
1272 }
1273#endif
570d7624
JB
1274 }
1275
5e570b75 1276#ifdef DOS_NT
199607e4
RS
1277 if (newdir)
1278 {
e8d32c7e 1279 /* First ensure newdir is an absolute name. */
199607e4
RS
1280 if (
1281 /* Detect MSDOS file names with drive specifiers. */
1282 ! (IS_DRIVE (newdir[0])
1283 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1284#ifdef WINDOWSNT
1285 /* Detect Windows file names in UNC format. */
1286 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1287#endif
1288 )
1289 {
1290 /* Effectively, let newdir be (expand-file-name newdir cwd).
1291 Because of the admonition against calling expand-file-name
1292 when we have pointers into lisp strings, we accomplish this
1293 indirectly by prepending newdir to nm if necessary, and using
e8d32c7e 1294 cwd (or the wd of newdir's drive) as the new newdir. */
2893f146 1295 char *adir;
5c4a19a9
EZ
1296#ifdef WINDOWSNT
1297 const int adir_size = MAX_UTF8_PATH;
1298#else
1299 const int adir_size = MAXPATHLEN + 1;
1300#endif
f5c81c80 1301
c70a4df6 1302 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
199607e4 1303 {
5976c3fe 1304 drive = (unsigned char) newdir[0];
199607e4
RS
1305 newdir += 2;
1306 }
1307 if (!IS_DIRECTORY_SEP (nm[0]))
1308 {
c293e30c 1309 ptrdiff_t newlen = strlen (newdir);
c365c355
PE
1310 char *tmp = alloca (newlen + file_name_as_directory_slop
1311 + strlen (nm) + 1);
f5c81c80 1312 file_name_as_directory (tmp, newdir, newlen, multibyte);
199607e4
RS
1313 strcat (tmp, nm);
1314 nm = tmp;
1315 }
5c4a19a9 1316 adir = alloca (adir_size);
199607e4
RS
1317 if (drive)
1318 {
620f13b0 1319 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
f5c81c80 1320 strcpy (adir, "/");
199607e4
RS
1321 }
1322 else
5c4a19a9 1323 getcwd (adir, adir_size);
f5c81c80
EZ
1324 if (multibyte)
1325 {
1326 Lisp_Object tem = build_string (adir);
1327
1328 tem = DECODE_FILE (tem);
1329 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1330 }
2893f146 1331 newdir = adir;
199607e4
RS
1332 }
1333
e8d32c7e 1334 /* Strip off drive name from prefix, if present. */
c70a4df6 1335 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
199607e4
RS
1336 {
1337 drive = newdir[0];
1338 newdir += 2;
1339 }
1340
1341 /* Keep only a prefix from newdir if nm starts with slash
82330e7f 1342 (//server/share for UNC, nothing otherwise). */
9a1dc3be 1343 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
199607e4
RS
1344 {
1345#ifdef WINDOWSNT
1346 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1347 {
2893f146
PE
1348 char *adir = strcpy (alloca (strlen (newdir) + 1), newdir);
1349 char *p = adir + 2;
199607e4
RS
1350 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1351 p++;
1352 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1353 *p = 0;
2893f146 1354 newdir = adir;
199607e4
RS
1355 }
1356 else
1357#endif
1358 newdir = "";
1359 }
1360 }
5e570b75 1361#endif /* DOS_NT */
199607e4
RS
1362
1363 if (newdir)
bfb61299 1364 {
c365c355
PE
1365 /* Ignore any slash at the end of newdir, unless newdir is
1366 just "/" or "//". */
199607e4 1367 length = strlen (newdir);
c365c355
PE
1368 while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1369 && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
1370 length--;
bfb61299
JB
1371 }
1372 else
c365c355 1373 length = 0;
570d7624 1374
e8d32c7e 1375 /* Now concatenate the directory and name to new space in the stack frame. */
c365c355 1376 tlen = length + file_name_as_directory_slop + strlen (nm) + 1;
5e570b75 1377#ifdef DOS_NT
f0f95d31
RS
1378 /* Reserve space for drive specifier and escape prefix, since either
1379 or both may need to be inserted. (The Microsoft x86 compiler
5e570b75 1380 produces incorrect code if the following two lines are combined.) */
38182d90 1381 target = alloca (tlen + 4);
f0f95d31 1382 target += 4;
5e570b75 1383#else /* not DOS_NT */
c365c355 1384 target = SAFE_ALLOCA (tlen);
5e570b75 1385#endif /* not DOS_NT */
570d7624
JB
1386 *target = 0;
1387
1388 if (newdir)
1389 {
5e570b75 1390 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
f5321b5c 1391 {
3ea2d8b2 1392#ifdef DOS_NT
f5321b5c
RS
1393 /* If newdir is effectively "C:/", then the drive letter will have
1394 been stripped and newdir will be "/". Concatenating with an
1395 absolute directory in nm produces "//", which will then be
1396 incorrectly treated as a network share. Ignore newdir in
1397 this case (keeping the drive letter). */
efdc16c9 1398 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
f5321b5c
RS
1399 && newdir[1] == '\0'))
1400#endif
c365c355
PE
1401 {
1402 memcpy (target, newdir, length);
1403 target[length] = 0;
1404 }
f5321b5c 1405 }
570d7624 1406 else
f5c81c80 1407 file_name_as_directory (target, newdir, length, multibyte);
570d7624
JB
1408 }
1409
1410 strcat (target, nm);
199607e4 1411
214378ec
GM
1412 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1413 appear. */
5b5a2ea1 1414 {
5976c3fe
PE
1415 char *p = target;
1416 char *o = target;
570d7624 1417
5b5a2ea1
SM
1418 while (*p)
1419 {
5b5a2ea1
SM
1420 if (!IS_DIRECTORY_SEP (*p))
1421 {
1422 *o++ = *p++;
1423 }
1424 else if (p[1] == '.'
1425 && (IS_DIRECTORY_SEP (p[2])
1426 || p[2] == 0))
1427 {
1428 /* If "/." is the entire filename, keep the "/". Otherwise,
1429 just delete the whole "/.". */
1430 if (o == target && p[2] == '\0')
1431 *o++ = *p;
1432 p += 2;
1433 }
1434 else if (p[1] == '.' && p[2] == '.'
1435 /* `/../' is the "superroot" on certain file systems.
1436 Turned off on DOS_NT systems because they have no
1437 "superroot" and because this causes us to produce
1438 file names like "d:/../foo" which fail file-related
1439 functions of the underlying OS. (To reproduce, try a
1440 long series of "../../" in default_directory, longer
1441 than the number of levels from the root.) */
aa4060b9 1442#ifndef DOS_NT
5b5a2ea1 1443 && o != target
aa4060b9 1444#endif
5b5a2ea1
SM
1445 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1446 {
972ed246 1447#ifdef WINDOWSNT
5976c3fe 1448 char *prev_o = o;
972ed246 1449#endif
7ba11bee
PE
1450 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1451 continue;
972ed246
JR
1452#ifdef WINDOWSNT
1453 /* Don't go below server level in UNC filenames. */
1454 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1455 && IS_DIRECTORY_SEP (*target))
1456 o = prev_o;
1457 else
1458#endif
5b5a2ea1
SM
1459 /* Keep initial / only if this is the whole name. */
1460 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1461 ++o;
1462 p += 3;
1463 }
c365c355
PE
1464 else if (IS_DIRECTORY_SEP (p[1])
1465 && (p != target || IS_DIRECTORY_SEP (p[2])))
1466 /* Collapse multiple "/", except leave leading "//" alone. */
5b5a2ea1
SM
1467 p++;
1468 else
1469 {
1470 *o++ = *p++;
1471 }
5b5a2ea1 1472 }
570d7624 1473
5e570b75 1474#ifdef DOS_NT
e8d32c7e 1475 /* At last, set drive name. */
5e570b75 1476#ifdef WINDOWSNT
5b5a2ea1
SM
1477 /* Except for network file name. */
1478 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
5e570b75 1479#endif /* WINDOWSNT */
5b5a2ea1 1480 {
1088b922 1481 if (!drive) emacs_abort ();
5b5a2ea1
SM
1482 target -= 2;
1483 target[0] = DRIVE_LETTER (drive);
1484 target[1] = ':';
1485 }
1486 /* Reinsert the escape prefix if required. */
1487 if (is_escaped)
1488 {
1489 target -= 2;
1490 target[0] = '/';
1491 target[1] = ':';
1492 }
5b5a2ea1 1493 result = make_specified_string (target, -1, o - target, multibyte);
1fd201bb 1494 dostounix_filename (SSDATA (result));
e7ac588e
EZ
1495#ifdef WINDOWSNT
1496 if (!NILP (Vw32_downcase_file_names))
1497 result = Fdowncase (result);
1498#endif
273ac8d1
EZ
1499#else /* !DOS_NT */
1500 result = make_specified_string (target, -1, o - target, multibyte);
1501#endif /* !DOS_NT */
5b5a2ea1 1502 }
beb402de
KG
1503
1504 /* Again look to see if the file name has special constructs in it
1505 and perhaps call the corresponding file handler. This is needed
1506 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1507 the ".." component gives us "/user@host:/bar/../baz" which needs
e8d32c7e 1508 to be expanded again. */
beb402de
KG
1509 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1510 if (!NILP (handler))
2375c96a
CY
1511 {
1512 handled_name = call3 (handler, Qexpand_file_name,
1513 result, default_directory);
c365c355
PE
1514 if (! STRINGP (handled_name))
1515 error ("Invalid handler in `file-name-handler-alist'");
1516 result = handled_name;
2375c96a 1517 }
beb402de 1518
c365c355 1519 SAFE_FREE ();
beb402de 1520 return result;
570d7624 1521}
5e570b75 1522
4887597a
EZ
1523#if 0
1524/* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1525 This is the old version of expand-file-name, before it was thoroughly
1526 rewritten for Emacs 10.31. We leave this version here commented-out,
1527 because the code is very complex and likely to have subtle bugs. If
1528 bugs _are_ found, it might be of interest to look at the old code and
1529 see what did it do in the relevant situation.
1530
30f50381
GM
1531 Don't remove this code: it's true that it will be accessible
1532 from the repository, but a few years from deletion, people will
1533 forget it is there. */
4887597a
EZ
1534
1535/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1536DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1537 "Convert FILENAME to absolute, and canonicalize it.\n\
1538Second arg DEFAULT is directory to start with if FILENAME is relative\n\
c70a4df6 1539\(does not start with slash); if DEFAULT is nil or missing,\n\
4887597a
EZ
1540the current buffer's value of default-directory is used.\n\
1541Filenames containing `.' or `..' as components are simplified;\n\
1542initial `~/' expands to your home directory.\n\
1543See also the function `substitute-in-file-name'.")
1544 (name, defalt)
1545 Lisp_Object name, defalt;
1546{
1547 unsigned char *nm;
1548
1549 register unsigned char *newdir, *p, *o;
93f4cf88 1550 ptrdiff_t tlen;
4887597a
EZ
1551 unsigned char *target;
1552 struct passwd *pw;
4887597a 1553
b7826503 1554 CHECK_STRING (name);
d5db4077 1555 nm = SDATA (name);
4887597a
EZ
1556
1557 /* If nm is absolute, flush ...// and detect /./ and /../.
1558 If no /./ or /../ we can return right away. */
7c2fb837 1559 if (nm[0] == '/')
4887597a 1560 {
f75d7a91 1561 bool lose = 0;
4887597a 1562 p = nm;
4887597a
EZ
1563 while (*p)
1564 {
ce2fe65a 1565 if (p[0] == '/' && p[1] == '/')
4887597a
EZ
1566 nm = p + 1;
1567 if (p[0] == '/' && p[1] == '~')
1568 nm = p + 1, lose = 1;
1569 if (p[0] == '/' && p[1] == '.'
1570 && (p[2] == '/' || p[2] == 0
1571 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1572 lose = 1;
4887597a
EZ
1573 p++;
1574 }
1575 if (!lose)
1576 {
d5db4077 1577 if (nm == SDATA (name))
4887597a
EZ
1578 return name;
1579 return build_string (nm);
1580 }
1581 }
1582
e8d32c7e 1583 /* Now determine directory to start with and put it in NEWDIR. */
4887597a
EZ
1584
1585 newdir = 0;
1586
1587 if (nm[0] == '~') /* prefix ~ */
7c2fb837 1588 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
4887597a
EZ
1589 {
1590 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1591 newdir = (unsigned char *) "";
1592 nm++;
4887597a
EZ
1593 }
1594 else /* ~user/filename */
1595 {
e8d32c7e 1596 /* Get past ~ to user. */
4887597a 1597 unsigned char *user = nm + 1;
e8d32c7e 1598 /* Find end of name. */
8966b757 1599 unsigned char *ptr = (unsigned char *) strchr (user, '/');
93f4cf88 1600 ptrdiff_t len = ptr ? ptr - user : strlen (user);
e8d32c7e 1601 /* Copy the user name into temp storage. */
38182d90 1602 o = alloca (len + 1);
72af86bd 1603 memcpy (o, user, len);
4887597a
EZ
1604 o[len] = 0;
1605
e8d32c7e 1606 /* Look up the user name. */
4d7e6e51 1607 block_input ();
4887597a 1608 pw = (struct passwd *) getpwnam (o + 1);
4d7e6e51 1609 unblock_input ();
4887597a
EZ
1610 if (!pw)
1611 error ("\"%s\" isn't a registered user", o + 1);
1612
1613 newdir = (unsigned char *) pw->pw_dir;
1614
1615 /* Discard the user name from NM. */
1616 nm += len;
1617 }
1618
7c2fb837 1619 if (nm[0] != '/' && !newdir)
4887597a
EZ
1620 {
1621 if (NILP (defalt))
1622 defalt = current_buffer->directory;
b7826503 1623 CHECK_STRING (defalt);
d5db4077 1624 newdir = SDATA (defalt);
4887597a
EZ
1625 }
1626
e8d32c7e 1627 /* Now concatenate the directory and name to new space in the stack frame. */
4887597a
EZ
1628
1629 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
38182d90 1630 target = alloca (tlen);
4887597a
EZ
1631 *target = 0;
1632
1633 if (newdir)
1634 {
4887597a
EZ
1635 if (nm[0] == 0 || nm[0] == '/')
1636 strcpy (target, newdir);
1637 else
4887597a
EZ
1638 file_name_as_directory (target, newdir);
1639 }
1640
1641 strcat (target, nm);
4887597a 1642
e8d32c7e 1643 /* Now canonicalize by removing /. and /foo/.. if they appear. */
4887597a
EZ
1644
1645 p = target;
1646 o = target;
1647
1648 while (*p)
1649 {
4887597a
EZ
1650 if (*p != '/')
1651 {
1652 *o++ = *p++;
1653 }
1654 else if (!strncmp (p, "//", 2)
4887597a
EZ
1655 )
1656 {
1657 o = target;
1658 p++;
1659 }
994a7262
RS
1660 else if (p[0] == '/' && p[1] == '.'
1661 && (p[2] == '/' || p[2] == 0))
4887597a
EZ
1662 p += 2;
1663 else if (!strncmp (p, "/..", 3)
1664 /* `/../' is the "superroot" on certain file systems. */
1665 && o != target
1666 && (p[3] == '/' || p[3] == 0))
1667 {
1668 while (o != target && *--o != '/')
1669 ;
4887597a
EZ
1670 if (o == target && *o == '/')
1671 ++o;
1672 p += 3;
1673 }
1674 else
1675 {
1676 *o++ = *p++;
1677 }
4887597a
EZ
1678 }
1679
1680 return make_string (target, o - target);
1681}
1682#endif
570d7624 1683\f
c70a4df6 1684/* If /~ or // appears, discard everything through first slash. */
f75d7a91 1685static bool
5976c3fe 1686file_name_absolute_p (const char *filename)
c70a4df6
SM
1687{
1688 return
1689 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
c70a4df6
SM
1690#ifdef DOS_NT
1691 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1692 && IS_DIRECTORY_SEP (filename[2]))
1693#endif
1694 );
1695}
1696
5976c3fe
PE
1697static char *
1698search_embedded_absfilename (char *nm, char *endp)
c70a4df6 1699{
5976c3fe 1700 char *p, *s;
c70a4df6
SM
1701
1702 for (p = nm + 1; p < endp; p++)
1703 {
ce2fe65a 1704 if (IS_DIRECTORY_SEP (p[-1])
c70a4df6 1705 && file_name_absolute_p (p)
5e617bc2 1706#if defined (WINDOWSNT) || defined (CYGWIN)
c70a4df6
SM
1707 /* // at start of file name is meaningful in Apollo,
1708 WindowsNT and Cygwin systems. */
f34574c6 1709 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
e39a993c 1710#endif /* not (WINDOWSNT || CYGWIN) */
ce2fe65a 1711 )
c70a4df6 1712 {
ce2fe65a 1713 for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
e8d32c7e 1714 if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
c70a4df6 1715 {
5976c3fe 1716 char *o = alloca (s - p + 1);
c70a4df6 1717 struct passwd *pw;
72af86bd 1718 memcpy (o, p, s - p);
c70a4df6
SM
1719 o [s - p] = 0;
1720
1721 /* If we have ~user and `user' exists, discard
1722 everything up to ~. But if `user' does not exist, leave
1723 ~user alone, it might be a literal file name. */
4d7e6e51 1724 block_input ();
67c08d6c 1725 pw = getpwnam (o + 1);
4d7e6e51 1726 unblock_input ();
67c08d6c 1727 if (pw)
c70a4df6 1728 return p;
c70a4df6
SM
1729 }
1730 else
1731 return p;
1732 }
1733 }
1734 return NULL;
1735}
1736
a7ca3326 1737DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
8c1a1077
PJ
1738 Ssubstitute_in_file_name, 1, 1, 0,
1739 doc: /* Substitute environment variables referred to in FILENAME.
1740`$FOO' where FOO is an environment variable name means to substitute
1741the value of that variable. The variable name should be terminated
1742with a character not a letter, digit or underscore; otherwise, enclose
1743the entire variable name in braces.
c68845e0
GM
1744
1745If `/~' appears, all of FILENAME through that `/' is discarded.
1746If `//' appears, everything up to and including the first of
1747those `/' is discarded. */)
5842a27b 1748 (Lisp_Object filename)
570d7624 1749{
ee041f2d
SM
1750 char *nm, *p, *x, *endp;
1751 bool substituted = false;
fce31d69 1752 bool multibyte;
5976c3fe 1753 char *xnm;
8ce069f5 1754 Lisp_Object handler;
570d7624 1755
b7826503 1756 CHECK_STRING (filename);
570d7624 1757
58aec0d6
JR
1758 multibyte = STRING_MULTIBYTE (filename);
1759
8ce069f5
RS
1760 /* If the file name has special constructs in it,
1761 call the corresponding file handler. */
3b7f6e60 1762 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
8ce069f5 1763 if (!NILP (handler))
2375c96a
CY
1764 {
1765 Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
1766 filename);
1767 if (STRINGP (handled_name))
1768 return handled_name;
1769 error ("Invalid handler in `file-name-handler-alist'");
1770 }
8ce069f5 1771
58aec0d6
JR
1772 /* Always work on a copy of the string, in case GC happens during
1773 decode of environment variables, causing the original Lisp_String
1774 data to be relocated. */
5b71542d 1775 nm = xlispstrdupa (filename);
0f3f018c 1776
58aec0d6 1777#ifdef DOS_NT
1fd201bb 1778 dostounix_filename (nm);
e7ac588e 1779 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
a5a1cc06 1780#endif
d5db4077 1781 endp = nm + SBYTES (filename);
570d7624 1782
82330e7f 1783 /* If /~ or // appears, discard everything through first slash. */
c70a4df6
SM
1784 p = search_embedded_absfilename (nm, endp);
1785 if (p)
1786 /* Start over with the new string, so we check the file-name-handler
1787 again. Important with filenames like "/home/foo//:/hello///there"
ee7683eb 1788 which would substitute to "/:/hello///there" rather than "/there". */
c70a4df6 1789 return Fsubstitute_in_file_name
58aec0d6 1790 (make_specified_string (p, -1, endp - p, multibyte));
570d7624 1791
ee041f2d 1792 /* See if any variables are substituted into the string. */
570d7624 1793
ee041f2d
SM
1794 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
1795 {
1796 Lisp_Object name
1797 = (!substituted ? filename
1798 : make_specified_string (nm, -1, endp - nm, multibyte));
1799 Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
1800 CHECK_STRING (tmp);
1801 if (!EQ (tmp, name))
1802 substituted = true;
1803 filename = tmp;
1804 }
570d7624
JB
1805
1806 if (!substituted)
e7ac588e
EZ
1807 {
1808#ifdef WINDOWSNT
1809 if (!NILP (Vw32_downcase_file_names))
1810 filename = Fdowncase (filename);
1811#endif
1812 return filename;
1813 }
570d7624 1814
ee041f2d
SM
1815 xnm = SSDATA (filename);
1816 x = xnm + SBYTES (filename);
3d798ba7 1817
82330e7f 1818 /* If /~ or // appears, discard everything through first slash. */
ce2fe65a 1819 while ((p = search_embedded_absfilename (xnm, x)) != NULL)
c70a4df6
SM
1820 /* This time we do not start over because we've already expanded envvars
1821 and replaced $$ with $. Maybe we should start over as well, but we'd
1822 need to quote some $ to $$ first. */
1823 xnm = p;
570d7624 1824
e7ac588e
EZ
1825#ifdef WINDOWSNT
1826 if (!NILP (Vw32_downcase_file_names))
1827 {
1828 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1829
1830 xname = Fdowncase (xname);
1831 return xname;
1832 }
1833 else
1834#endif
ee041f2d
SM
1835 return (xnm == SSDATA (filename)
1836 ? filename
1837 : make_specified_string (xnm, -1, x - xnm, multibyte));
570d7624
JB
1838}
1839\f
067ffa38 1840/* A slightly faster and more convenient way to get
298b760e 1841 (directory-file-name (expand-file-name FOO)). */
067ffa38 1842
570d7624 1843Lisp_Object
971de7fb 1844expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
570d7624 1845{
199607e4 1846 register Lisp_Object absname;
570d7624 1847
199607e4 1848 absname = Fexpand_file_name (filename, defdir);
7c2fb837 1849
199607e4 1850 /* Remove final slash, if any (unless this is the root dir).
570d7624 1851 stat behaves differently depending! */
d5db4077
KR
1852 if (SCHARS (absname) > 1
1853 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
e8d32c7e 1854 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
ddc61f46 1855 /* We cannot take shortcuts; they might be wrong for magic file names. */
199607e4 1856 absname = Fdirectory_file_name (absname);
199607e4 1857 return absname;
570d7624
JB
1858}
1859\f
3ed15d97 1860/* Signal an error if the file ABSNAME already exists.
f75d7a91 1861 If INTERACTIVE, ask the user whether to proceed,
3ed15d97
RS
1862 and bypass the error if the user says to go ahead.
1863 QUERYSTRING is a name for the action that is being considered
1864 to alter the file.
de1d0127 1865
3ed15d97 1866 *STATPTR is used to store the stat information if the file exists.
de1d0127 1867 If the file does not exist, STATPTR->st_mode is set to 0.
b8b29dc9
RS
1868 If STATPTR is null, we don't store into it.
1869
f75d7a91 1870 If QUICK, ask for y or n, not yes or no. */
3ed15d97 1871
f14b7e14 1872static void
5976c3fe 1873barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
f75d7a91
PE
1874 bool interactive, struct stat *statptr,
1875 bool quick)
570d7624 1876{
f75d7a91 1877 Lisp_Object tem, encoded_filename;
4018b5ef 1878 struct stat statbuf;
570d7624
JB
1879 struct gcpro gcpro1;
1880
643c73b9
RS
1881 encoded_filename = ENCODE_FILE (absname);
1882
e8d32c7e 1883 /* `stat' is a good way to tell whether the file exists,
4018b5ef 1884 regardless of what access permissions it has. */
42a5b22f 1885 if (lstat (SSDATA (encoded_filename), &statbuf) >= 0)
570d7624 1886 {
6e9b2be9 1887 if (S_ISDIR (statbuf.st_mode))
c4f2d8d4 1888 xsignal2 (Qfile_error,
ad637907 1889 build_string ("File is a directory"), absname);
c4f2d8d4 1890
570d7624 1891 if (! interactive)
24b1ddad
KS
1892 xsignal2 (Qfile_already_exists,
1893 build_string ("File already exists"), absname);
570d7624 1894 GCPRO1 (absname);
67e8e2b8
RS
1895 tem = format2 ("File %s already exists; %s anyway? ",
1896 absname, build_string (querystring));
b8b29dc9 1897 if (quick)
5616cc54 1898 tem = call1 (intern ("y-or-n-p"), tem);
b8b29dc9
RS
1899 else
1900 tem = do_yes_or_no_p (tem);
570d7624 1901 UNGCPRO;
265a9e55 1902 if (NILP (tem))
24b1ddad
KS
1903 xsignal2 (Qfile_already_exists,
1904 build_string ("File already exists"), absname);
3ed15d97
RS
1905 if (statptr)
1906 *statptr = statbuf;
1907 }
1908 else
1909 {
1910 if (statptr)
1911 statptr->st_mode = 0;
570d7624
JB
1912 }
1913 return;
1914}
1915
574c05e2 1916DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
7c0f6118 1917 "fCopy file: \nGCopy %s to file: \np\nP",
8c1a1077
PJ
1918 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1919If NEWNAME names a directory, copy FILE there.
795c20df
CY
1920
1921This function always sets the file modes of the output file to match
1922the input file.
1923
1924The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1925if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1926signal a `file-already-exists' error without overwriting. If
1927OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1928about overwriting; this is what happens in interactive use with M-x.
1929Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1930existing file.
c50f15d0 1931
7f08b80e 1932Fourth arg KEEP-TIME non-nil means give the output file the same
8c1a1077 1933last-modified time as the old one. (This works on only some systems.)
c50f15d0 1934
7fce7dfe
EZ
1935A prefix arg makes KEEP-TIME non-nil.
1936
586702ce 1937If PRESERVE-UID-GID is non-nil, we try to transfer the
574c05e2
KK
1938uid and gid of FILE to NEWNAME.
1939
7c3d167f
RF
1940If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
1941attributes of FILE to NEWNAME, such as its SELinux context and ACL
1942entries (depending on how Emacs was built). */)
1943 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_extended_attributes)
570d7624 1944{
8a2cbd72 1945 int ifd, ofd;
d311d28c 1946 int n;
570d7624 1947 char buf[16 * 1024];
3ed15d97 1948 struct stat st, out_st;
32f4334d 1949 Lisp_Object handler;
b1d1b865 1950 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d311d28c 1951 ptrdiff_t count = SPECPDL_INDEX ();
b1d1b865 1952 Lisp_Object encoded_file, encoded_newname;
574c05e2
KK
1953#if HAVE_LIBSELINUX
1954 security_context_t con;
f75d7a91 1955 int conlength = 0;
574c05e2 1956#endif
ffdc270a 1957#ifdef WINDOWSNT
ec4440cf 1958 int result;
7c3d167f 1959#endif
570d7624 1960
b1d1b865
RS
1961 encoded_file = encoded_newname = Qnil;
1962 GCPRO4 (file, newname, encoded_file, encoded_newname);
b7826503
PJ
1963 CHECK_STRING (file);
1964 CHECK_STRING (newname);
b1d1b865 1965
a9d14e54 1966 if (!NILP (Ffile_directory_p (newname)))
6b61353c 1967 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
a9d14e54
GM
1968 else
1969 newname = Fexpand_file_name (newname, Qnil);
1970
3b7f6e60 1971 file = Fexpand_file_name (file, Qnil);
32f4334d 1972
0bf2eed2 1973 /* If the input file name has special constructs in it,
32f4334d 1974 call the corresponding file handler. */
3b7f6e60 1975 handler = Ffind_file_name_handler (file, Qcopy_file);
0bf2eed2 1976 /* Likewise for output file name. */
51cf6d37 1977 if (NILP (handler))
49307295 1978 handler = Ffind_file_name_handler (newname, Qcopy_file);
32f4334d 1979 if (!NILP (handler))
574c05e2
KK
1980 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
1981 ok_if_already_exists, keep_time, preserve_uid_gid,
7c3d167f 1982 preserve_extended_attributes));
32f4334d 1983
b1d1b865
RS
1984 encoded_file = ENCODE_FILE (file);
1985 encoded_newname = ENCODE_FILE (newname);
1986
265a9e55 1987 if (NILP (ok_if_already_exists)
93c30b5f 1988 || INTEGERP (ok_if_already_exists))
2f868094 1989 barf_or_query_if_file_exists (newname, "copy to it",
b8b29dc9 1990 INTEGERP (ok_if_already_exists), &out_st, 0);
42a5b22f 1991 else if (stat (SSDATA (encoded_newname), &out_st) < 0)
3ed15d97 1992 out_st.st_mode = 0;
570d7624 1993
e8691c59 1994#ifdef WINDOWSNT
ec4440cf
EZ
1995 result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
1996 !NILP (keep_time), !NILP (preserve_uid_gid),
1997 !NILP (preserve_extended_attributes));
1998 switch (result)
66447e07 1999 {
ec4440cf
EZ
2000 case -1:
2001 report_file_error ("Copying file", list2 (file, newname));
2002 case -2:
2003 report_file_error ("Copying permissions from", file);
2004 case -3:
2005 xsignal2 (Qfile_date_error,
2006 build_string ("Resetting file times"), newname);
2007 case -4:
2008 report_file_error ("Copying permissions to", newname);
66447e07 2009 }
e8691c59 2010#else /* not WINDOWSNT */
13336908 2011 immediate_quit = 1;
42a5b22f 2012 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
13336908
RS
2013 immediate_quit = 0;
2014
570d7624 2015 if (ifd < 0)
a9757f6a 2016 report_file_error ("Opening input file", file);
570d7624 2017
27e498e6 2018 record_unwind_protect_int (close_file_unwind, ifd);
b5148e85 2019
d20704ef 2020 if (fstat (ifd, &st) != 0)
a9757f6a 2021 report_file_error ("Input file status", file);
f73b0ada 2022
7c3d167f 2023 if (!NILP (preserve_extended_attributes))
574c05e2 2024 {
7c3d167f
RF
2025#if HAVE_LIBSELINUX
2026 if (is_selinux_enabled ())
2027 {
2028 conlength = fgetfilecon (ifd, &con);
2029 if (conlength == -1)
a9757f6a 2030 report_file_error ("Doing fgetfilecon", file);
7c3d167f
RF
2031 }
2032#endif
7c3d167f 2033 }
574c05e2 2034
3ed15d97
RS
2035 if (out_st.st_mode != 0
2036 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
a773ed9a 2037 report_file_errno ("Input and output files are the same",
6c6f1994 2038 list2 (file, newname), 0);
3ed15d97 2039
d20704ef
PE
2040 /* We can copy only regular files. */
2041 if (!S_ISREG (st.st_mode))
a9757f6a 2042 report_file_errno ("Non-regular file", file,
a773ed9a 2043 S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
f73b0ada 2044
15e3a074 2045 {
a773ed9a
PE
2046#ifndef MSDOS
2047 int new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0600 : 0666);
2048#else
2049 int new_mask = S_IREAD | S_IWRITE;
2050#endif
15e3a074
PE
2051 ofd = emacs_open (SSDATA (encoded_newname),
2052 (O_WRONLY | O_TRUNC | O_CREAT
2053 | (NILP (ok_if_already_exists) ? O_EXCL : 0)),
2054 new_mask);
2055 }
570d7624 2056 if (ofd < 0)
a9757f6a 2057 report_file_error ("Opening output file", newname);
b5148e85 2058
27e498e6 2059 record_unwind_protect_int (close_file_unwind, ofd);
570d7624 2060
b5148e85
RS
2061 immediate_quit = 1;
2062 QUIT;
68c45bf0 2063 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
4ebbdd67 2064 if (emacs_write_sig (ofd, buf, n) != n)
4e604a5d 2065 report_file_error ("Write error", newname);
b5148e85 2066 immediate_quit = 0;
570d7624 2067
b016179b 2068#ifndef MSDOS
ffdc270a 2069 /* Preserve the original file permissions, and if requested, also its
b016179b 2070 owner and group. */
d20704ef
PE
2071 {
2072 mode_t mode_mask = 07777;
2073 if (!NILP (preserve_uid_gid))
2074 {
2075 /* Attempt to change owner and group. If that doesn't work
2076 attempt to change just the group, as that is sometimes allowed.
2077 Adjust the mode mask to eliminate setuid or setgid bits
2078 that are inappropriate if the owner and group are wrong. */
2079 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2080 {
2081 mode_mask &= ~06000;
2082 if (fchown (ofd, -1, st.st_gid) == 0)
2083 mode_mask |= 02000;
2084 }
2085 }
ffdc270a
PE
2086
2087 switch (!NILP (preserve_extended_attributes)
2088 ? qcopy_acl (SSDATA (encoded_file), ifd,
2089 SSDATA (encoded_newname), ofd,
2090 st.st_mode & mode_mask)
2091 : fchmod (ofd, st.st_mode & mode_mask))
2092 {
a9757f6a
PE
2093 case -2: report_file_error ("Copying permissions from", file);
2094 case -1: report_file_error ("Copying permissions to", newname);
ffdc270a 2095 }
d20704ef 2096 }
b016179b 2097#endif /* not MSDOS */
586702ce 2098
574c05e2
KK
2099#if HAVE_LIBSELINUX
2100 if (conlength > 0)
2101 {
24c51a09 2102 /* Set the modified context back to the file. */
f75d7a91 2103 bool fail = fsetfilecon (ofd, con) != 0;
24c51a09
GM
2104 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2105 if (fail && errno != ENOTSUP)
a9757f6a 2106 report_file_error ("Doing fsetfilecon", newname);
574c05e2
KK
2107
2108 freecon (con);
2109 }
2110#endif
2111
d20704ef 2112 if (!NILP (keep_time))
570d7624 2113 {
43aac990
PE
2114 struct timespec atime = get_stat_atime (&st);
2115 struct timespec mtime = get_stat_mtime (&st);
96c06863 2116 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
d20704ef
PE
2117 xsignal2 (Qfile_date_error,
2118 build_string ("Cannot set file date"), newname);
570d7624
JB
2119 }
2120
d35af63c 2121 if (emacs_close (ofd) < 0)
4e604a5d 2122 report_file_error ("Write error", newname);
d35af63c 2123
68c45bf0 2124 emacs_close (ifd);
b016179b 2125
ed68db4d 2126#ifdef MSDOS
d20704ef
PE
2127 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2128 and if it can't, it tells so. Otherwise, under MSDOS we usually
2129 get only the READ bit, which will make the copied file read-only,
2130 so it's better not to chmod at all. */
2131 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2132 chmod (SDATA (encoded_newname), st.st_mode & 07777);
ed68db4d 2133#endif /* MSDOS */
b016179b 2134#endif /* not WINDOWSNT */
5acac34e 2135
b5148e85
RS
2136 /* Discard the unwind protects. */
2137 specpdl_ptr = specpdl + count;
2138
570d7624
JB
2139 UNGCPRO;
2140 return Qnil;
2141}
385b6cc7 2142\f
9bbe01fb 2143DEFUN ("make-directory-internal", Fmake_directory_internal,
353cfc19 2144 Smake_directory_internal, 1, 1, 0,
8c1a1077 2145 doc: /* Create a new directory named DIRECTORY. */)
5842a27b 2146 (Lisp_Object directory)
570d7624 2147{
5976c3fe 2148 const char *dir;
32f4334d 2149 Lisp_Object handler;
b1d1b865 2150 Lisp_Object encoded_dir;
570d7624 2151
b7826503 2152 CHECK_STRING (directory);
3b7f6e60 2153 directory = Fexpand_file_name (directory, Qnil);
32f4334d 2154
3b7f6e60 2155 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
32f4334d 2156 if (!NILP (handler))
3b7f6e60 2157 return call2 (handler, Qmake_directory_internal, directory);
9bbe01fb 2158
b1d1b865
RS
2159 encoded_dir = ENCODE_FILE (directory);
2160
5976c3fe 2161 dir = SSDATA (encoded_dir);
570d7624 2162
5e570b75
RS
2163#ifdef WINDOWSNT
2164 if (mkdir (dir) != 0)
2165#else
09450bae 2166 if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
5e570b75 2167#endif
a9757f6a 2168 report_file_error ("Creating directory", directory);
570d7624 2169
32f4334d 2170 return Qnil;
570d7624
JB
2171}
2172
9d8f3bd9
MA
2173DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2174 Sdelete_directory_internal, 1, 1, 0,
efdc16c9 2175 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
5842a27b 2176 (Lisp_Object directory)
570d7624 2177{
5976c3fe 2178 const char *dir;
b1d1b865 2179 Lisp_Object encoded_dir;
570d7624 2180
b7826503 2181 CHECK_STRING (directory);
3b7f6e60 2182 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
b1d1b865 2183 encoded_dir = ENCODE_FILE (directory);
5976c3fe 2184 dir = SSDATA (encoded_dir);
b1d1b865 2185
570d7624 2186 if (rmdir (dir) != 0)
a9757f6a 2187 report_file_error ("Removing directory", directory);
570d7624
JB
2188
2189 return Qnil;
2190}
2191
2e2bbddb 2192DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
f1a5d776
CY
2193 "(list (read-file-name \
2194 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2195 \"Move file to trash: \" \"Delete file: \") \
2196 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2197 (null current-prefix-arg))",
efdc16c9 2198 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
53967e09 2199If file has multiple names, it continues to exist with the other names.
f1a5d776
CY
2200TRASH non-nil means to trash the file instead of deleting, provided
2201`delete-by-moving-to-trash' is non-nil.
53967e09 2202
f1a5d776
CY
2203When called interactively, TRASH is t if no prefix argument is given.
2204With a prefix argument, TRASH is nil. */)
5842a27b 2205 (Lisp_Object filename, Lisp_Object trash)
570d7624 2206{
32f4334d 2207 Lisp_Object handler;
b1d1b865 2208 Lisp_Object encoded_file;
efdc16c9 2209 struct gcpro gcpro1;
b1d1b865 2210
efdc16c9 2211 GCPRO1 (filename);
b4bd27c5
RS
2212 if (!NILP (Ffile_directory_p (filename))
2213 && NILP (Ffile_symlink_p (filename)))
24b1ddad
KS
2214 xsignal2 (Qfile_error,
2215 build_string ("Removing old name: is a directory"),
2216 filename);
efdc16c9 2217 UNGCPRO;
570d7624 2218 filename = Fexpand_file_name (filename, Qnil);
32f4334d 2219
49307295 2220 handler = Ffind_file_name_handler (filename, Qdelete_file);
32f4334d 2221 if (!NILP (handler))
f5783df3 2222 return call3 (handler, Qdelete_file, filename, trash);
32f4334d 2223
f1a5d776 2224 if (delete_by_moving_to_trash && !NILP (trash))
6cf29fe8
JR
2225 return call1 (Qmove_file_to_trash, filename);
2226
b1d1b865
RS
2227 encoded_file = ENCODE_FILE (filename);
2228
ce2fe65a 2229 if (unlink (SSDATA (encoded_file)) < 0)
a9757f6a 2230 report_file_error ("Removing old name", filename);
8a9b0da9 2231 return Qnil;
570d7624
JB
2232}
2233
385b6cc7 2234static Lisp_Object
971de7fb 2235internal_delete_file_1 (Lisp_Object ignore)
385b6cc7
RS
2236{
2237 return Qt;
2238}
2239
7d80ea23 2240/* Delete file FILENAME, returning true if successful.
f1a5d776 2241 This ignores `delete-by-moving-to-trash'. */
385b6cc7 2242
7d80ea23 2243bool
f1a5d776 2244internal_delete_file (Lisp_Object filename)
385b6cc7 2245{
b0728617
EZ
2246 Lisp_Object tem;
2247
2248 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2249 Qt, internal_delete_file_1);
2250 return NILP (tem);
385b6cc7
RS
2251}
2252\f
570d7624 2253DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
7c0f6118 2254 "fRename file: \nGRename %s to file: \np",
a4e03fe5 2255 doc: /* Rename FILE as NEWNAME. Both args must be strings.
8c1a1077
PJ
2256If file has names other than FILE, it continues to have those names.
2257Signals a `file-already-exists' error if a file NEWNAME already exists
2258unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2259A number as third arg means request confirmation if NEWNAME already exists.
2260This is what happens in interactive use with M-x. */)
5842a27b 2261 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
570d7624 2262{
32f4334d 2263 Lisp_Object handler;
f72b5416
JD
2264 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2265 Lisp_Object encoded_file, encoded_newname, symlink_target;
570d7624 2266
f72b5416
JD
2267 symlink_target = encoded_file = encoded_newname = Qnil;
2268 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
b7826503
PJ
2269 CHECK_STRING (file);
2270 CHECK_STRING (newname);
3b7f6e60 2271 file = Fexpand_file_name (file, Qnil);
1ffc5c90 2272
f83caf70
EZ
2273 if ((!NILP (Ffile_directory_p (newname)))
2274#ifdef DOS_NT
2275 /* If the file names are identical but for the case,
2276 don't attempt to move directory to itself. */
2277 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2278#endif
2279 )
8719abec 2280 {
ce2fe65a
AS
2281 Lisp_Object fname = (NILP (Ffile_directory_p (file))
2282 ? file : Fdirectory_file_name (file));
8719abec
CY
2283 newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
2284 }
1ffc5c90
RS
2285 else
2286 newname = Fexpand_file_name (newname, Qnil);
32f4334d
RS
2287
2288 /* If the file name has special constructs in it,
2289 call the corresponding file handler. */
3b7f6e60 2290 handler = Ffind_file_name_handler (file, Qrename_file);
51cf6d37 2291 if (NILP (handler))
49307295 2292 handler = Ffind_file_name_handler (newname, Qrename_file);
32f4334d 2293 if (!NILP (handler))
36712b0a 2294 RETURN_UNGCPRO (call4 (handler, Qrename_file,
3b7f6e60 2295 file, newname, ok_if_already_exists));
32f4334d 2296
b1d1b865
RS
2297 encoded_file = ENCODE_FILE (file);
2298 encoded_newname = ENCODE_FILE (newname);
2299
bc77278f
EZ
2300#ifdef DOS_NT
2301 /* If the file names are identical but for the case, don't ask for
2302 confirmation: they simply want to change the letter-case of the
2303 file name. */
2304 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2305#endif
265a9e55 2306 if (NILP (ok_if_already_exists)
93c30b5f 2307 || INTEGERP (ok_if_already_exists))
2f868094 2308 barf_or_query_if_file_exists (newname, "rename to it",
b8b29dc9 2309 INTEGERP (ok_if_already_exists), 0, 0);
ce2fe65a 2310 if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
570d7624 2311 {
b648c163
PE
2312 int rename_errno = errno;
2313 if (rename_errno == EXDEV)
570d7624 2314 {
d311d28c 2315 ptrdiff_t count;
f72b5416 2316 symlink_target = Ffile_symlink_p (file);
440c7d00
JD
2317 if (! NILP (symlink_target))
2318 Fmake_symbolic_link (symlink_target, newname,
f59abab9 2319 NILP (ok_if_already_exists) ? Qnil : Qt);
ae0d7250 2320 else if (!NILP (Ffile_directory_p (file)))
8719abec
CY
2321 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2322 else
2323 /* We have already prompted if it was an integer, so don't
2324 have copy-file prompt again. */
586702ce 2325 Fcopy_file (file, newname,
586702ce 2326 NILP (ok_if_already_exists) ? Qnil : Qt,
574c05e2 2327 Qt, Qt, Qt);
d550c425 2328
6bddfc97 2329 count = SPECPDL_INDEX ();
d2b66acf 2330 specbind (Qdelete_by_moving_to_trash, Qnil);
8fab2362 2331
ae0d7250 2332 if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
8719abec
CY
2333 call2 (Qdelete_directory, file, Qt);
2334 else
f1a5d776 2335 Fdelete_file (file, Qnil);
6bddfc97 2336 unbind_to (count, Qnil);
570d7624
JB
2337 }
2338 else
b648c163 2339 report_file_errno ("Renaming", list2 (file, newname), rename_errno);
570d7624
JB
2340 }
2341 UNGCPRO;
2342 return Qnil;
2343}
2344
2345DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
7c0f6118 2346 "fAdd name to file: \nGName to add to %s: \np",
a4e03fe5 2347 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
8c1a1077
PJ
2348Signals a `file-already-exists' error if a file NEWNAME already exists
2349unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2350A number as third arg means request confirmation if NEWNAME already exists.
2351This is what happens in interactive use with M-x. */)
5842a27b 2352 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
570d7624 2353{
32f4334d 2354 Lisp_Object handler;
b1d1b865
RS
2355 Lisp_Object encoded_file, encoded_newname;
2356 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
570d7624 2357
b1d1b865
RS
2358 GCPRO4 (file, newname, encoded_file, encoded_newname);
2359 encoded_file = encoded_newname = Qnil;
b7826503
PJ
2360 CHECK_STRING (file);
2361 CHECK_STRING (newname);
3b7f6e60 2362 file = Fexpand_file_name (file, Qnil);
1ffc5c90
RS
2363
2364 if (!NILP (Ffile_directory_p (newname)))
2365 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
2366 else
2367 newname = Fexpand_file_name (newname, Qnil);
32f4334d
RS
2368
2369 /* If the file name has special constructs in it,
2370 call the corresponding file handler. */
3b7f6e60 2371 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
32f4334d 2372 if (!NILP (handler))
3b7f6e60 2373 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
36712b0a 2374 newname, ok_if_already_exists));
32f4334d 2375
adc6741c
RS
2376 /* If the new name has special constructs in it,
2377 call the corresponding file handler. */
2378 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2379 if (!NILP (handler))
3b7f6e60 2380 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
adc6741c
RS
2381 newname, ok_if_already_exists));
2382
b1d1b865
RS
2383 encoded_file = ENCODE_FILE (file);
2384 encoded_newname = ENCODE_FILE (newname);
2385
265a9e55 2386 if (NILP (ok_if_already_exists)
93c30b5f 2387 || INTEGERP (ok_if_already_exists))
2f868094 2388 barf_or_query_if_file_exists (newname, "make it a new name",
b8b29dc9 2389 INTEGERP (ok_if_already_exists), 0, 0);
5e570b75 2390
42a5b22f 2391 unlink (SSDATA (newname));
ce2fe65a 2392 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
b648c163
PE
2393 {
2394 int link_errno = errno;
2395 report_file_errno ("Adding new name", list2 (file, newname), link_errno);
2396 }
570d7624
JB
2397
2398 UNGCPRO;
2399 return Qnil;
2400}
2401
570d7624 2402DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
7c0f6118 2403 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
68780e2a
RS
2404 doc: /* Make a symbolic link to FILENAME, named LINKNAME.
2405Both args must be strings.
8c1a1077
PJ
2406Signals a `file-already-exists' error if a file LINKNAME already exists
2407unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2408A number as third arg means request confirmation if LINKNAME already exists.
2409This happens for interactive use with M-x. */)
5842a27b 2410 (Lisp_Object filename, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
570d7624 2411{
32f4334d 2412 Lisp_Object handler;
b1d1b865
RS
2413 Lisp_Object encoded_filename, encoded_linkname;
2414 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
570d7624 2415
b1d1b865
RS
2416 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
2417 encoded_filename = encoded_linkname = Qnil;
b7826503
PJ
2418 CHECK_STRING (filename);
2419 CHECK_STRING (linkname);
d9bc1c99
RS
2420 /* If the link target has a ~, we must expand it to get
2421 a truly valid file name. Otherwise, do not expand;
2422 we want to permit links to relative file names. */
d5db4077 2423 if (SREF (filename, 0) == '~')
d9bc1c99 2424 filename = Fexpand_file_name (filename, Qnil);
1ffc5c90
RS
2425
2426 if (!NILP (Ffile_directory_p (linkname)))
dac24db4 2427 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
1ffc5c90
RS
2428 else
2429 linkname = Fexpand_file_name (linkname, Qnil);
32f4334d
RS
2430
2431 /* If the file name has special constructs in it,
2432 call the corresponding file handler. */
49307295 2433 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
32f4334d 2434 if (!NILP (handler))
36712b0a
KH
2435 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2436 linkname, ok_if_already_exists));
32f4334d 2437
adc6741c
RS
2438 /* If the new link name has special constructs in it,
2439 call the corresponding file handler. */
2440 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2441 if (!NILP (handler))
2442 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2443 linkname, ok_if_already_exists));
2444
b1d1b865
RS
2445 encoded_filename = ENCODE_FILE (filename);
2446 encoded_linkname = ENCODE_FILE (linkname);
2447
265a9e55 2448 if (NILP (ok_if_already_exists)
93c30b5f 2449 || INTEGERP (ok_if_already_exists))
2f868094 2450 barf_or_query_if_file_exists (linkname, "make it a link",
b8b29dc9 2451 INTEGERP (ok_if_already_exists), 0, 0);
ce2fe65a 2452 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
570d7624
JB
2453 {
2454 /* If we didn't complain already, silently delete existing file. */
b648c163 2455 int symlink_errno;
570d7624
JB
2456 if (errno == EEXIST)
2457 {
42a5b22f 2458 unlink (SSDATA (encoded_linkname));
ce2fe65a
AS
2459 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname))
2460 >= 0)
1a04498e
KH
2461 {
2462 UNGCPRO;
2463 return Qnil;
2464 }
570d7624 2465 }
d9d0d182
PE
2466 if (errno == ENOSYS)
2467 {
2468 UNGCPRO;
2469 xsignal1 (Qfile_error,
2470 build_string ("Symbolic links are not supported"));
2471 }
570d7624 2472
b648c163
PE
2473 symlink_errno = errno;
2474 report_file_errno ("Making symbolic link", list2 (filename, linkname),
2475 symlink_errno);
570d7624
JB
2476 }
2477 UNGCPRO;
2478 return Qnil;
e89b536d 2479}
570d7624 2480
570d7624 2481\f
a7ca3326 2482DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
570d7624 2483 1, 1, 0,
8c1a1077
PJ
2484 doc: /* Return t if file FILENAME specifies an absolute file name.
2485On Unix, this is a name starting with a `/' or a `~'. */)
5842a27b 2486 (Lisp_Object filename)
570d7624 2487{
b7826503 2488 CHECK_STRING (filename);
5976c3fe 2489 return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
570d7624 2490}
3beeedfe 2491\f
a7ca3326 2492DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
68780e2a
RS
2493 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2494See also `file-readable-p' and `file-attributes'.
2495This returns nil for a symlink to a nonexistent file.
2496Use `file-symlink-p' to test for such links. */)
5842a27b 2497 (Lisp_Object filename)
570d7624 2498{
199607e4 2499 Lisp_Object absname;
32f4334d 2500 Lisp_Object handler;
570d7624 2501
b7826503 2502 CHECK_STRING (filename);
199607e4 2503 absname = Fexpand_file_name (filename, Qnil);
32f4334d
RS
2504
2505 /* If the file name has special constructs in it,
2506 call the corresponding file handler. */
199607e4 2507 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
32f4334d 2508 if (!NILP (handler))
a773ed9a
PE
2509 {
2510 Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
2511 errno = 0;
2512 return result;
2513 }
32f4334d 2514
b1d1b865
RS
2515 absname = ENCODE_FILE (absname);
2516
3d798ba7 2517 return check_existing (SSDATA (absname)) ? Qt : Qnil;
570d7624
JB
2518}
2519
2520DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
8c1a1077
PJ
2521 doc: /* Return t if FILENAME can be executed by you.
2522For a directory, this means you can access files in that directory. */)
5842a27b 2523 (Lisp_Object filename)
570d7624 2524{
199607e4 2525 Lisp_Object absname;
32f4334d 2526 Lisp_Object handler;
570d7624 2527
b7826503 2528 CHECK_STRING (filename);
199607e4 2529 absname = Fexpand_file_name (filename, Qnil);
32f4334d
RS
2530
2531 /* If the file name has special constructs in it,
2532 call the corresponding file handler. */
199607e4 2533 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
32f4334d 2534 if (!NILP (handler))
199607e4 2535 return call2 (handler, Qfile_executable_p, absname);
32f4334d 2536
b1d1b865
RS
2537 absname = ENCODE_FILE (absname);
2538
42a5b22f 2539 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
570d7624
JB
2540}
2541
a7ca3326 2542DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
8c1a1077
PJ
2543 doc: /* Return t if file FILENAME exists and you can read it.
2544See also `file-exists-p' and `file-attributes'. */)
5842a27b 2545 (Lisp_Object filename)
570d7624 2546{
199607e4 2547 Lisp_Object absname;
32f4334d 2548 Lisp_Object handler;
570d7624 2549
b7826503 2550 CHECK_STRING (filename);
199607e4 2551 absname = Fexpand_file_name (filename, Qnil);
32f4334d
RS
2552
2553 /* If the file name has special constructs in it,
2554 call the corresponding file handler. */
199607e4 2555 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
32f4334d 2556 if (!NILP (handler))
199607e4 2557 return call2 (handler, Qfile_readable_p, absname);
32f4334d 2558
b1d1b865 2559 absname = ENCODE_FILE (absname);
73dcdb9f
PE
2560 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2561 ? Qt : Qnil);
570d7624
JB
2562}
2563
f793dc6c 2564DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
8c1a1077 2565 doc: /* Return t if file FILENAME can be written or created by you. */)
5842a27b 2566 (Lisp_Object filename)
f793dc6c 2567{
b1d1b865 2568 Lisp_Object absname, dir, encoded;
f793dc6c 2569 Lisp_Object handler;
f793dc6c 2570
b7826503 2571 CHECK_STRING (filename);
199607e4 2572 absname = Fexpand_file_name (filename, Qnil);
f793dc6c
RS
2573
2574 /* If the file name has special constructs in it,
2575 call the corresponding file handler. */
199607e4 2576 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
f793dc6c 2577 if (!NILP (handler))
199607e4 2578 return call2 (handler, Qfile_writable_p, absname);
f793dc6c 2579
b1d1b865 2580 encoded = ENCODE_FILE (absname);
73dcdb9f
PE
2581 if (check_writable (SSDATA (encoded), W_OK))
2582 return Qt;
2583 if (errno != ENOENT)
2584 return Qnil;
b1d1b865 2585
199607e4 2586 dir = Ffile_name_directory (absname);
73dcdb9f 2587 eassert (!NILP (dir));
f793dc6c 2588#ifdef MSDOS
73dcdb9f 2589 dir = Fdirectory_file_name (dir);
f793dc6c 2590#endif /* MSDOS */
b1d1b865
RS
2591
2592 dir = ENCODE_FILE (dir);
e3e8a75a
GM
2593#ifdef WINDOWSNT
2594 /* The read-only attribute of the parent directory doesn't affect
2595 whether a file or directory can be created within it. Some day we
2596 should check ACLs though, which do affect this. */
73dcdb9f 2597 return file_directory_p (SDATA (dir)) ? Qt : Qnil;
e3e8a75a 2598#else
73dcdb9f 2599 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
e3e8a75a 2600#endif
f793dc6c
RS
2601}
2602\f
1f8653eb 2603DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
8c1a1077
PJ
2604 doc: /* Access file FILENAME, and get an error if that does not work.
2605The second argument STRING is used in the error message.
a4e03fe5 2606If there is no error, returns nil. */)
5842a27b 2607 (Lisp_Object filename, Lisp_Object string)
1f8653eb 2608{
49475635 2609 Lisp_Object handler, encoded_filename, absname;
1f8653eb 2610
b7826503 2611 CHECK_STRING (filename);
49475635
EZ
2612 absname = Fexpand_file_name (filename, Qnil);
2613
b7826503 2614 CHECK_STRING (string);
1f8653eb
RS
2615
2616 /* If the file name has special constructs in it,
2617 call the corresponding file handler. */
49475635 2618 handler = Ffind_file_name_handler (absname, Qaccess_file);
1f8653eb 2619 if (!NILP (handler))
49475635 2620 return call3 (handler, Qaccess_file, absname, string);
1f8653eb 2621
49475635 2622 encoded_filename = ENCODE_FILE (absname);
b1d1b865 2623
a773ed9a 2624 if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
a9757f6a 2625 report_file_error (SSDATA (string), filename);
1f8653eb
RS
2626
2627 return Qnil;
2628}
2629\f
8654f9d7
PE
2630/* Relative to directory FD, return the symbolic link value of FILENAME.
2631 On failure, return nil. */
2632Lisp_Object
2633emacs_readlinkat (int fd, char const *filename)
2634{
2635 static struct allocator const emacs_norealloc_allocator =
2636 { xmalloc, NULL, xfree, memory_full };
2637 Lisp_Object val;
2638 char readlink_buf[1024];
2639 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2640 &emacs_norealloc_allocator, readlinkat);
2641 if (!buf)
2642 return Qnil;
2643
eeccd06f 2644 val = build_unibyte_string (buf);
8654f9d7 2645 if (buf[0] == '/' && strchr (buf, ':'))
eeccd06f 2646 val = concat2 (build_unibyte_string ("/:"), val);
8654f9d7
PE
2647 if (buf != readlink_buf)
2648 xfree (buf);
2649 val = DECODE_FILE (val);
2650 return val;
2651}
2652
a7ca3326 2653DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
8c1a1077 2654 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
1c353c74 2655The value is the link target, as a string.
68780e2a
RS
2656Otherwise it returns nil.
2657
2658This function returns t when given the name of a symlink that
2659points to a nonexistent file. */)
5842a27b 2660 (Lisp_Object filename)
570d7624 2661{
32f4334d 2662 Lisp_Object handler;
570d7624 2663
b7826503 2664 CHECK_STRING (filename);
570d7624
JB
2665 filename = Fexpand_file_name (filename, Qnil);
2666
32f4334d
RS
2667 /* If the file name has special constructs in it,
2668 call the corresponding file handler. */
49307295 2669 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
32f4334d
RS
2670 if (!NILP (handler))
2671 return call2 (handler, Qfile_symlink_p, filename);
2672
b1d1b865
RS
2673 filename = ENCODE_FILE (filename);
2674
8654f9d7 2675 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
570d7624
JB
2676}
2677
a7ca3326 2678DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
8c1a1077
PJ
2679 doc: /* Return t if FILENAME names an existing directory.
2680Symbolic links to directories count as directories.
2681See `file-symlink-p' to distinguish symlinks. */)
5842a27b 2682 (Lisp_Object filename)
570d7624 2683{
73dcdb9f 2684 Lisp_Object absname;
32f4334d 2685 Lisp_Object handler;
570d7624 2686
4b4deea2 2687 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
570d7624 2688
32f4334d
RS
2689 /* If the file name has special constructs in it,
2690 call the corresponding file handler. */
199607e4 2691 handler = Ffind_file_name_handler (absname, Qfile_directory_p);
32f4334d 2692 if (!NILP (handler))
199607e4 2693 return call2 (handler, Qfile_directory_p, absname);
32f4334d 2694
b1d1b865
RS
2695 absname = ENCODE_FILE (absname);
2696
73dcdb9f
PE
2697 return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
2698}
2699
2700/* Return true if FILE is a directory or a symlink to a directory. */
2701bool
2702file_directory_p (char const *file)
2703{
2704#ifdef WINDOWSNT
2705 /* This is cheaper than 'stat'. */
2706 return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
2707#else
2708 struct stat st;
2709 return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
2710#endif
570d7624
JB
2711}
2712
a7ca3326 2713DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
16a97296 2714 Sfile_accessible_directory_p, 1, 1, 0,
e385ec41
RS
2715 doc: /* Return t if file FILENAME names a directory you can open.
2716For the value to be t, FILENAME must specify the name of a directory as a file,
2717and the directory must allow you to open files in it. In order to use a
8c1a1077
PJ
2718directory as a buffer's current directory, this predicate must return true.
2719A directory name spec may be given instead; then the value is t
2720if the directory so specified exists and really is a readable and
2721searchable directory. */)
5842a27b 2722 (Lisp_Object filename)
b72dea2a 2723{
73dcdb9f 2724 Lisp_Object absname;
32f4334d 2725 Lisp_Object handler;
73dcdb9f
PE
2726
2727 CHECK_STRING (filename);
2728 absname = Fexpand_file_name (filename, Qnil);
32f4334d
RS
2729
2730 /* If the file name has special constructs in it,
2731 call the corresponding file handler. */
73dcdb9f 2732 handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
32f4334d 2733 if (!NILP (handler))
a773ed9a
PE
2734 {
2735 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2736 errno = 0;
2737 return r;
2738 }
32f4334d 2739
73dcdb9f
PE
2740 absname = ENCODE_FILE (absname);
2741 return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil;
2742}
2743
2744/* If FILE is a searchable directory or a symlink to a
2745 searchable directory, return true. Otherwise return
2746 false and set errno to an error number. */
2747bool
2748file_accessible_directory_p (char const *file)
2749{
2750#ifdef DOS_NT
2751 /* There's no need to test whether FILE is searchable, as the
2752 searchable/executable bit is invented on DOS_NT platforms. */
2753 return file_directory_p (file);
2754#else
2755 /* On POSIXish platforms, use just one system call; this avoids a
2756 race and is typically faster. */
2757 ptrdiff_t len = strlen (file);
2758 char const *dir;
2759 bool ok;
2760 int saved_errno;
2761 USE_SAFE_ALLOCA;
2762
2763 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2764 There are three exceptions: "", "/", and "//". Leave "" alone,
2765 as it's invalid. Append only "." to the other two exceptions as
2766 "/" and "//" are distinct on some platforms, whereas "/", "///",
2767 "////", etc. are all equivalent. */
2768 if (! len)
2769 dir = file;
2770 else
2771 {
2772 /* Just check for trailing '/' when deciding whether to append '/'.
2773 That's simpler than testing the two special cases "/" and "//",
2774 and it's a safe optimization here. */
2775 char *buf = SAFE_ALLOCA (len + 3);
2776 memcpy (buf, file, len);
31ff141c 2777 strcpy (buf + len, &"/."[file[len - 1] == '/']);
73dcdb9f
PE
2778 dir = buf;
2779 }
2780
2781 ok = check_existing (dir);
2782 saved_errno = errno;
2783 SAFE_FREE ();
2784 errno = saved_errno;
2785 return ok;
2786#endif
b72dea2a
JB
2787}
2788
f793dc6c 2789DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
19a9c3b7
LH
2790 doc: /* Return t if FILENAME names a regular file.
2791This is the sort of file that holds an ordinary stream of data bytes.
2792Symbolic links to regular files count as regular files.
2793See `file-symlink-p' to distinguish symlinks. */)
5842a27b 2794 (Lisp_Object filename)
f793dc6c 2795{
199607e4 2796 register Lisp_Object absname;
f793dc6c
RS
2797 struct stat st;
2798 Lisp_Object handler;
2799
4b4deea2 2800 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
f793dc6c
RS
2801
2802 /* If the file name has special constructs in it,
2803 call the corresponding file handler. */
199607e4 2804 handler = Ffind_file_name_handler (absname, Qfile_regular_p);
f793dc6c 2805 if (!NILP (handler))
199607e4 2806 return call2 (handler, Qfile_regular_p, absname);
f793dc6c 2807
b1d1b865
RS
2808 absname = ENCODE_FILE (absname);
2809
c1c4693e
RS
2810#ifdef WINDOWSNT
2811 {
2812 int result;
2813 Lisp_Object tem = Vw32_get_true_file_attributes;
2814
2815 /* Tell stat to use expensive method to get accurate info. */
2816 Vw32_get_true_file_attributes = Qt;
d5db4077 2817 result = stat (SDATA (absname), &st);
c1c4693e
RS
2818 Vw32_get_true_file_attributes = tem;
2819
2820 if (result < 0)
2821 return Qnil;
f68c809d 2822 return S_ISREG (st.st_mode) ? Qt : Qnil;
c1c4693e
RS
2823 }
2824#else
42a5b22f 2825 if (stat (SSDATA (absname), &st) < 0)
f793dc6c 2826 return Qnil;
f68c809d 2827 return S_ISREG (st.st_mode) ? Qt : Qnil;
c1c4693e 2828#endif
f793dc6c
RS
2829}
2830\f
574c05e2
KK
2831DEFUN ("file-selinux-context", Ffile_selinux_context,
2832 Sfile_selinux_context, 1, 1, 0,
fa74b241
CY
2833 doc: /* Return SELinux context of file named FILENAME.
2834The return value is a list (USER ROLE TYPE RANGE), where the list
2835elements are strings naming the user, role, type, and range of the
2836file's SELinux security context.
2837
2838Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2839or if SELinux is disabled, or if Emacs lacks SELinux support. */)
5842a27b 2840 (Lisp_Object filename)
574c05e2
KK
2841{
2842 Lisp_Object absname;
2843 Lisp_Object values[4];
2844 Lisp_Object handler;
2845#if HAVE_LIBSELINUX
2846 security_context_t con;
2847 int conlength;
2848 context_t context;
2849#endif
2850
4b4deea2 2851 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
574c05e2
KK
2852
2853 /* If the file name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
2856 if (!NILP (handler))
2857 return call2 (handler, Qfile_selinux_context, absname);
2858
2859 absname = ENCODE_FILE (absname);
2860
2861 values[0] = Qnil;
2862 values[1] = Qnil;
2863 values[2] = Qnil;
2864 values[3] = Qnil;
2865#if HAVE_LIBSELINUX
2866 if (is_selinux_enabled ())
2867 {
b14aac08 2868 conlength = lgetfilecon (SSDATA (absname), &con);
574c05e2
KK
2869 if (conlength > 0)
2870 {
2871 context = context_new (con);
45841e65
KK
2872 if (context_user_get (context))
2873 values[0] = build_string (context_user_get (context));
2874 if (context_role_get (context))
2875 values[1] = build_string (context_role_get (context));
2876 if (context_type_get (context))
2877 values[2] = build_string (context_type_get (context));
2878 if (context_range_get (context))
2879 values[3] = build_string (context_range_get (context));
574c05e2 2880 context_free (context);
c6ba4138 2881 freecon (con);
574c05e2 2882 }
574c05e2
KK
2883 }
2884#endif
2885
5e617bc2 2886 return Flist (sizeof (values) / sizeof (values[0]), values);
574c05e2
KK
2887}
2888\f
2889DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2890 Sset_file_selinux_context, 2, 2, 0,
fa74b241
CY
2891 doc: /* Set SELinux context of file named FILENAME to CONTEXT.
2892CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2893elements are strings naming the components of a SELinux context.
2894
ccad023b
EZ
2895Value is t if setting of SELinux context was successful, nil otherwise.
2896
2897This function does nothing and returns nil if SELinux is disabled,
2898or if Emacs was not compiled with SELinux support. */)
5842a27b 2899 (Lisp_Object filename, Lisp_Object context)
574c05e2 2900{
0f4a96b5 2901 Lisp_Object absname;
574c05e2 2902 Lisp_Object handler;
0f4a96b5
JB
2903#if HAVE_LIBSELINUX
2904 Lisp_Object encoded_absname;
574c05e2
KK
2905 Lisp_Object user = CAR_SAFE (context);
2906 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2907 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2908 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
574c05e2 2909 security_context_t con;
f75d7a91
PE
2910 bool fail;
2911 int conlength;
574c05e2
KK
2912 context_t parsed_con;
2913#endif
2914
4b4deea2 2915 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
574c05e2
KK
2916
2917 /* If the file name has special constructs in it,
2918 call the corresponding file handler. */
2919 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2920 if (!NILP (handler))
2921 return call3 (handler, Qset_file_selinux_context, absname, context);
2922
0f4a96b5 2923#if HAVE_LIBSELINUX
574c05e2
KK
2924 if (is_selinux_enabled ())
2925 {
2926 /* Get current file context. */
a9b53ad3 2927 encoded_absname = ENCODE_FILE (absname);
b14aac08 2928 conlength = lgetfilecon (SSDATA (encoded_absname), &con);
574c05e2
KK
2929 if (conlength > 0)
2930 {
2931 parsed_con = context_new (con);
2932 /* Change the parts defined in the parameter.*/
2933 if (STRINGP (user))
2934 {
b14aac08 2935 if (context_user_set (parsed_con, SSDATA (user)))
574c05e2
KK
2936 error ("Doing context_user_set");
2937 }
2938 if (STRINGP (role))
2939 {
b14aac08 2940 if (context_role_set (parsed_con, SSDATA (role)))
574c05e2
KK
2941 error ("Doing context_role_set");
2942 }
2943 if (STRINGP (type))
2944 {
b14aac08 2945 if (context_type_set (parsed_con, SSDATA (type)))
574c05e2
KK
2946 error ("Doing context_type_set");
2947 }
2948 if (STRINGP (range))
2949 {
b14aac08 2950 if (context_range_set (parsed_con, SSDATA (range)))
574c05e2
KK
2951 error ("Doing context_range_set");
2952 }
2953
24c51a09 2954 /* Set the modified context back to the file. */
f75d7a91
PE
2955 fail = (lsetfilecon (SSDATA (encoded_absname),
2956 context_str (parsed_con))
2957 != 0);
24c51a09
GM
2958 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2959 if (fail && errno != ENOTSUP)
a9757f6a 2960 report_file_error ("Doing lsetfilecon", absname);
574c05e2
KK
2961
2962 context_free (parsed_con);
c6ba4138 2963 freecon (con);
c1fea2c0 2964 return fail ? Qnil : Qt;
574c05e2
KK
2965 }
2966 else
a9757f6a 2967 report_file_error ("Doing lgetfilecon", absname);
574c05e2
KK
2968 }
2969#endif
2970
2971 return Qnil;
2972}
2973\f
7c3d167f 2974DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
553081a5
SM
2975 doc: /* Return ACL entries of file named FILENAME.
2976The entries are returned in a format suitable for use in `set-file-acl'
2977but is otherwise undocumented and subject to change.
7c3d167f 2978Return nil if file does not exist or is not accessible, or if Emacs
553081a5 2979was unable to determine the ACL entries. */)
7c3d167f
RF
2980 (Lisp_Object filename)
2981{
2982 Lisp_Object absname;
2983 Lisp_Object handler;
ffdc270a 2984#ifdef HAVE_ACL_SET_FILE
7c3d167f
RF
2985 acl_t acl;
2986 Lisp_Object acl_string;
2987 char *str;
2988#endif
2989
2990 absname = expand_and_dir_to_file (filename,
2991 BVAR (current_buffer, directory));
2992
2993 /* If the file name has special constructs in it,
2994 call the corresponding file handler. */
2995 handler = Ffind_file_name_handler (absname, Qfile_acl);
2996 if (!NILP (handler))
2997 return call2 (handler, Qfile_acl, absname);
2998
ffdc270a 2999#ifdef HAVE_ACL_SET_FILE
7c3d167f
RF
3000 absname = ENCODE_FILE (absname);
3001
3002 acl = acl_get_file (SSDATA (absname), ACL_TYPE_ACCESS);
3003 if (acl == NULL)
3004 return Qnil;
3005
3006 str = acl_to_text (acl, NULL);
3007 if (str == NULL)
3008 {
3009 acl_free (acl);
3010 return Qnil;
3011 }
3012
3013 acl_string = build_string (str);
3014 acl_free (str);
3015 acl_free (acl);
3016
3017 return acl_string;
3018#endif
3019
3020 return Qnil;
3021}
3022
3023DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
3024 2, 2, 0,
3025 doc: /* Set ACL of file named FILENAME to ACL-STRING.
3026ACL-STRING should contain the textual representation of the ACL
3027entries in a format suitable for the platform.
3028
ccad023b
EZ
3029Value is t if setting of ACL was successful, nil otherwise.
3030
7c3d167f
RF
3031Setting ACL for local files requires Emacs to be built with ACL
3032support. */)
3033 (Lisp_Object filename, Lisp_Object acl_string)
3034{
3035 Lisp_Object absname;
3036 Lisp_Object handler;
ffdc270a 3037#ifdef HAVE_ACL_SET_FILE
7c3d167f
RF
3038 Lisp_Object encoded_absname;
3039 acl_t acl;
3040 bool fail;
3041#endif
3042
3043 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3044
3045 /* If the file name has special constructs in it,
3046 call the corresponding file handler. */
3047 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3048 if (!NILP (handler))
3049 return call3 (handler, Qset_file_acl, absname, acl_string);
3050
ffdc270a 3051#ifdef HAVE_ACL_SET_FILE
7c3d167f
RF
3052 if (STRINGP (acl_string))
3053 {
3054 acl = acl_from_text (SSDATA (acl_string));
3055 if (acl == NULL)
3056 {
a9757f6a 3057 report_file_error ("Converting ACL", absname);
7c3d167f
RF
3058 return Qnil;
3059 }
3060
3061 encoded_absname = ENCODE_FILE (absname);
3062
3063 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3064 acl)
3065 != 0);
ffdc270a 3066 if (fail && acl_errno_valid (errno))
a9757f6a 3067 report_file_error ("Setting ACL", absname);
7c3d167f
RF
3068
3069 acl_free (acl);
c1fea2c0 3070 return fail ? Qnil : Qt;
7c3d167f
RF
3071 }
3072#endif
3073
3074 return Qnil;
3075}
3076\f
570d7624 3077DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
d4a42098
KS
3078 doc: /* Return mode bits of file named FILENAME, as an integer.
3079Return nil, if file does not exist or is not accessible. */)
5842a27b 3080 (Lisp_Object filename)
570d7624 3081{
199607e4 3082 Lisp_Object absname;
570d7624 3083 struct stat st;
32f4334d 3084 Lisp_Object handler;
570d7624 3085
4b4deea2 3086 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
570d7624 3087
32f4334d
RS
3088 /* If the file name has special constructs in it,
3089 call the corresponding file handler. */
199607e4 3090 handler = Ffind_file_name_handler (absname, Qfile_modes);
32f4334d 3091 if (!NILP (handler))
199607e4 3092 return call2 (handler, Qfile_modes, absname);
32f4334d 3093
b1d1b865
RS
3094 absname = ENCODE_FILE (absname);
3095
42a5b22f 3096 if (stat (SSDATA (absname), &st) < 0)
570d7624 3097 return Qnil;
3ace87e3 3098
570d7624
JB
3099 return make_number (st.st_mode & 07777);
3100}
3101
09fbdf6c
MC
3102DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
3103 "(let ((file (read-file-name \"File: \"))) \
3104 (list file (read-file-modes nil file)))",
8c1a1077 3105 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
ea429250
EZ
3106Only the 12 low bits of MODE are used.
3107
3108Interactively, mode bits are read by `read-file-modes', which accepts
712adc82 3109symbolic notation, like the `chmod' command from GNU Coreutils. */)
5842a27b 3110 (Lisp_Object filename, Lisp_Object mode)
570d7624 3111{
b1d1b865 3112 Lisp_Object absname, encoded_absname;
32f4334d 3113 Lisp_Object handler;
570d7624 3114
4b4deea2 3115 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
b7826503 3116 CHECK_NUMBER (mode);
570d7624 3117
32f4334d
RS
3118 /* If the file name has special constructs in it,
3119 call the corresponding file handler. */
199607e4 3120 handler = Ffind_file_name_handler (absname, Qset_file_modes);
32f4334d 3121 if (!NILP (handler))
199607e4 3122 return call3 (handler, Qset_file_modes, absname, mode);
32f4334d 3123
b1d1b865
RS
3124 encoded_absname = ENCODE_FILE (absname);
3125
18c52557 3126 if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
a9757f6a 3127 report_file_error ("Doing chmod", absname);
570d7624
JB
3128
3129 return Qnil;
3130}
3131
c24e9a53 3132DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
8c1a1077
PJ
3133 doc: /* Set the file permission bits for newly created files.
3134The argument MODE should be an integer; only the low 9 bits are used.
3135This setting is inherited by subprocesses. */)
5842a27b 3136 (Lisp_Object mode)
36a8c287 3137{
b7826503 3138 CHECK_NUMBER (mode);
199607e4 3139
5f85ea58 3140 umask ((~ XINT (mode)) & 0777);
36a8c287
JB
3141
3142 return Qnil;
3143}
3144
c24e9a53 3145DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
8c1a1077
PJ
3146 doc: /* Return the default file protection for created files.
3147The value is an integer. */)
5842a27b 3148 (void)
36a8c287 3149{
f75d7a91 3150 mode_t realmask;
5f85ea58 3151 Lisp_Object value;
36a8c287 3152
4d7e6e51 3153 block_input ();
5f85ea58
RS
3154 realmask = umask (0);
3155 umask (realmask);
4d7e6e51 3156 unblock_input ();
36a8c287 3157
46283abe 3158 XSETINT (value, (~ realmask) & 0777);
5f85ea58 3159 return value;
36a8c287 3160}
819da85b 3161\f
819da85b
EZ
3162
3163DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
f839df0c 3164 doc: /* Set times of file FILENAME to TIMESTAMP.
819da85b
EZ
3165Set both access and modification times.
3166Return t on success, else nil.
f839df0c 3167Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
819da85b 3168`current-time'. */)
f839df0c 3169 (Lisp_Object filename, Lisp_Object timestamp)
819da85b
EZ
3170{
3171 Lisp_Object absname, encoded_absname;
3172 Lisp_Object handler;
43aac990 3173 struct timespec t = lisp_time_argument (timestamp);
819da85b 3174
4b4deea2 3175 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
819da85b
EZ
3176
3177 /* If the file name has special constructs in it,
3178 call the corresponding file handler. */
3179 handler = Ffind_file_name_handler (absname, Qset_file_times);
3180 if (!NILP (handler))
f839df0c 3181 return call3 (handler, Qset_file_times, absname, timestamp);
819da85b
EZ
3182
3183 encoded_absname = ENCODE_FILE (absname);
5df5e07c 3184
819da85b 3185 {
96c06863 3186 if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
819da85b 3187 {
0d9f584b 3188#ifdef MSDOS
819da85b 3189 /* Setting times on a directory always fails. */
73dcdb9f 3190 if (file_directory_p (SSDATA (encoded_absname)))
819da85b
EZ
3191 return Qnil;
3192#endif
a9757f6a 3193 report_file_error ("Setting file times", absname);
819da85b
EZ
3194 }
3195 }
5df5e07c 3196
819da85b
EZ
3197 return Qt;
3198}
f793dc6c 3199\f
697c17a2 3200#ifdef HAVE_SYNC
85ffea93 3201DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
8c1a1077 3202 doc: /* Tell Unix to finish all pending disk updates. */)
5842a27b 3203 (void)
85ffea93
RS
3204{
3205 sync ();
3206 return Qnil;
3207}
3208
697c17a2 3209#endif /* HAVE_SYNC */
85ffea93 3210
570d7624 3211DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
8c1a1077
PJ
3212 doc: /* Return t if file FILE1 is newer than file FILE2.
3213If FILE1 does not exist, the answer is nil;
3214otherwise, if FILE2 does not exist, the answer is t. */)
5842a27b 3215 (Lisp_Object file1, Lisp_Object file2)
570d7624 3216{
199607e4 3217 Lisp_Object absname1, absname2;
39adff0d 3218 struct stat st1, st2;
32f4334d 3219 Lisp_Object handler;
09121adc 3220 struct gcpro gcpro1, gcpro2;
570d7624 3221
b7826503
PJ
3222 CHECK_STRING (file1);
3223 CHECK_STRING (file2);
570d7624 3224
199607e4
RS
3225 absname1 = Qnil;
3226 GCPRO2 (absname1, file2);
4b4deea2
TT
3227 absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
3228 absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
09121adc 3229 UNGCPRO;
570d7624 3230
32f4334d
RS
3231 /* If the file name has special constructs in it,
3232 call the corresponding file handler. */
199607e4 3233 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
51cf6d37 3234 if (NILP (handler))
199607e4 3235 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
32f4334d 3236 if (!NILP (handler))
199607e4 3237 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
32f4334d 3238
b1d1b865
RS
3239 GCPRO2 (absname1, absname2);
3240 absname1 = ENCODE_FILE (absname1);
3241 absname2 = ENCODE_FILE (absname2);
3242 UNGCPRO;
3243
39adff0d 3244 if (stat (SSDATA (absname1), &st1) < 0)
570d7624
JB
3245 return Qnil;
3246
39adff0d 3247 if (stat (SSDATA (absname2), &st2) < 0)
570d7624
JB
3248 return Qt;
3249
43aac990 3250 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
39adff0d 3251 ? Qt : Qnil);
570d7624
JB
3252}
3253\f
6fdaa9a0
KH
3254#ifndef READ_BUF_SIZE
3255#define READ_BUF_SIZE (64 << 10)
3256#endif
d311d28c
PE
3257/* Some buffer offsets are stored in 'int' variables. */
3258verify (READ_BUF_SIZE <= INT_MAX);
6fdaa9a0 3259
98a7d268
KH
3260/* This function is called after Lisp functions to decide a coding
3261 system are called, or when they cause an error. Before they are
3262 called, the current buffer is set unibyte and it contains only a
3263 newly inserted text (thus the buffer was empty before the
3264 insertion).
3265
3266 The functions may set markers, overlays, text properties, or even
3267 alter the buffer contents, change the current buffer.
3268
3269 Here, we reset all those changes by:
3270 o set back the current buffer.
3271 o move all markers and overlays to BEG.
3272 o remove all text properties.
3273 o set back the buffer multibyteness. */
f736ffbf 3274
27e498e6 3275static void
971de7fb 3276decide_coding_unwind (Lisp_Object unwind_data)
f736ffbf 3277{
98a7d268 3278 Lisp_Object multibyte, undo_list, buffer;
f736ffbf 3279
98a7d268
KH
3280 multibyte = XCAR (unwind_data);
3281 unwind_data = XCDR (unwind_data);
3282 undo_list = XCAR (unwind_data);
3283 buffer = XCDR (unwind_data);
3284
a3d794a1 3285 set_buffer_internal (XBUFFER (buffer));
98a7d268
KH
3286 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3287 adjust_overlays_for_delete (BEG, Z - BEG);
0c94c8d6 3288 set_buffer_intervals (current_buffer, NULL);
98a7d268
KH
3289 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3290
3291 /* Now we are safe to change the buffer's multibyteness directly. */
39eb03f1
PE
3292 bset_enable_multibyte_characters (current_buffer, multibyte);
3293 bset_undo_list (current_buffer, undo_list);
f736ffbf
KH
3294}
3295
2ef88fd4 3296/* Read from a non-regular file. STATE is a Lisp_Save_Value
3346c1d0
DA
3297 object where slot 0 is the file descriptor, slot 1 specifies
3298 an offset to put the read bytes, and slot 2 is the maximum
3299 amount of bytes to read. Value is the number of bytes read. */
55587f8a
GM
3300
3301static Lisp_Object
2ef88fd4 3302read_non_regular (Lisp_Object state)
55587f8a 3303{
d311d28c 3304 int nbytes;
efdc16c9 3305
1b978129
GM
3306 immediate_quit = 1;
3307 QUIT;
3346c1d0 3308 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
5976c3fe 3309 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3346c1d0
DA
3310 + XSAVE_INTEGER (state, 1)),
3311 XSAVE_INTEGER (state, 2));
1b978129 3312 immediate_quit = 0;
e07469fa
DA
3313 /* Fast recycle this object for the likely next call. */
3314 free_misc (state);
1b978129
GM
3315 return make_number (nbytes);
3316}
55587f8a 3317
2ef88fd4
DA
3318
3319/* Condition-case handler used when reading from non-regular files
3320 in insert-file-contents. */
1b978129
GM
3321
3322static Lisp_Object
2ef88fd4 3323read_non_regular_quit (Lisp_Object ignore)
1b978129 3324{
55587f8a
GM
3325 return Qnil;
3326}
3327
b3fbb395
PE
3328/* Return the file offset that VAL represents, checking for type
3329 errors and overflow. */
e69dafad 3330static off_t
b3fbb395 3331file_offset (Lisp_Object val)
e69dafad 3332{
b3fbb395
PE
3333 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3334 return XINT (val);
3335
3336 if (FLOATP (val))
e69dafad 3337 {
b3fbb395 3338 double v = XFLOAT_DATA (val);
7216e43b 3339 if (0 <= v
b3fbb395
PE
3340 && (sizeof (off_t) < sizeof v
3341 ? v <= TYPE_MAXIMUM (off_t)
3342 : v < TYPE_MAXIMUM (off_t)))
3343 return v;
e69dafad 3344 }
b3fbb395
PE
3345
3346 wrong_type_argument (intern ("file-offset"), val);
e69dafad
PE
3347}
3348
f0941253 3349/* Return a special time value indicating the error number ERRNUM. */
43aac990 3350static struct timespec
f0941253 3351time_error_value (int errnum)
dbeed9a6 3352{
0497dc44 3353 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
dbeed9a6
PE
3354 ? NONEXISTENT_MODTIME_NSECS
3355 : UNKNOWN_MODTIME_NSECS);
43aac990 3356 return make_timespec (0, ns);
dbeed9a6 3357}
55587f8a 3358
570d7624 3359DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
8c1a1077
PJ
3360 1, 5, 0,
3361 doc: /* Insert contents of file FILENAME after point.
cf6d2357 3362Returns list of absolute file name and number of characters inserted.
6f2528d8
MR
3363If second argument VISIT is non-nil, the buffer's visited filename and
3364last save file modtime are set, and it is marked unmodified. If
3365visiting and the file does not exist, visiting is completed before the
3366error is signaled.
3367
3368The optional third and fourth arguments BEG and END specify what portion
3369of the file to insert. These arguments count bytes in the file, not
3370characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3371
3372If optional fifth argument REPLACE is non-nil, replace the current
3373buffer contents (in the accessible portion) with the file contents.
3374This is better than simply deleting and inserting the whole thing
3375because (1) it preserves some marker positions and (2) it puts less data
3376in the undo list. When REPLACE is non-nil, the second return value is
3377the number of characters that replace previous buffer contents.
3378
3379This function does code conversion according to the value of
3380`coding-system-for-read' or `file-coding-system-alist', and sets the
bb085aed
EZ
3381variable `last-coding-system-used' to the coding system actually used.
3382
3383In addition, this function decodes the inserted text from known formats
3384by calling `format-decode', which see. */)
5842a27b 3385 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
570d7624
JB
3386{
3387 struct stat st;
43aac990 3388 struct timespec mtime;
f75d7a91 3389 int fd;
d311d28c 3390 ptrdiff_t inserted = 0;
f75d7a91 3391 ptrdiff_t how_much;
728f8f0a 3392 off_t beg_offset, end_offset;
f75d7a91 3393 int unprocessed;
d311d28c 3394 ptrdiff_t count = SPECPDL_INDEX ();
6f2528d8
MR
3395 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3396 Lisp_Object handler, val, insval, orig_filename, old_undo;
d6a3cc15 3397 Lisp_Object p;
d311d28c 3398 ptrdiff_t total = 0;
f75d7a91 3399 bool not_regular = 0;
2ef88fd4 3400 int save_errno = 0;
5976c3fe 3401 char read_buf[READ_BUF_SIZE];
6fdaa9a0 3402 struct coding_system coding;
f75d7a91
PE
3403 bool replace_handled = 0;
3404 bool set_coding_system = 0;
db327c7e 3405 Lisp_Object coding_system;
f75d7a91 3406 bool read_quit = 0;
22513e52
SM
3407 /* If the undo log only contains the insertion, there's no point
3408 keeping it. It's typically when we first fill a file-buffer. */
3409 bool empty_undo_list_p
3410 = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
3411 && BEG == Z);
490ee853 3412 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
f75d7a91 3413 bool we_locked_file = 0;
41d48a42 3414 ptrdiff_t fd_index;
32f4334d 3415
95385625
RS
3416 if (current_buffer->base_buffer && ! NILP (visit))
3417 error ("Cannot do file visiting in an indirect buffer");
3418
4b4deea2 3419 if (!NILP (BVAR (current_buffer, read_only)))
95385625
RS
3420 Fbarf_if_buffer_read_only ();
3421
32f4334d 3422 val = Qnil;
d6a3cc15 3423 p = Qnil;
b1d1b865 3424 orig_filename = Qnil;
6f2528d8 3425 old_undo = Qnil;
32f4334d 3426
6f2528d8 3427 GCPRO5 (filename, val, p, orig_filename, old_undo);
570d7624 3428
b7826503 3429 CHECK_STRING (filename);
570d7624
JB
3430 filename = Fexpand_file_name (filename, Qnil);
3431
1c157f8d
KH
3432 /* The value Qnil means that the coding system is not yet
3433 decided. */
3434 coding_system = Qnil;
3435
32f4334d
RS
3436 /* If the file name has special constructs in it,
3437 call the corresponding file handler. */
49307295 3438 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
32f4334d
RS
3439 if (!NILP (handler))
3440 {
3d0387c0
RS
3441 val = call6 (handler, Qinsert_file_contents, filename,
3442 visit, beg, end, replace);
d311d28c
PE
3443 if (CONSP (val) && CONSP (XCDR (val))
3444 && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
03699b14 3445 inserted = XINT (XCAR (XCDR (val)));
32f4334d
RS
3446 goto handled;
3447 }
3448
b1d1b865
RS
3449 orig_filename = filename;
3450 filename = ENCODE_FILE (filename);
3451
67722112
PE
3452 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3453 if (fd < 0)
570d7624 3454 {
e5e9d610 3455 save_errno = errno;
265a9e55 3456 if (NILP (visit))
a9757f6a 3457 report_file_error ("Opening input file", orig_filename);
f0941253 3458 mtime = time_error_value (save_errno);
b885bf36 3459 st.st_size = -1;
0de6b8f4 3460 if (!NILP (Vcoding_system_for_read))
22d92d6b 3461 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
570d7624
JB
3462 goto notfound;
3463 }
3464
41d48a42
PE
3465 fd_index = SPECPDL_INDEX ();
3466 record_unwind_protect_int (close_file_unwind, fd);
3467
67722112
PE
3468 /* Replacement should preserve point as it preserves markers. */
3469 if (!NILP (replace))
3470 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
3471
67722112 3472 if (fstat (fd, &st) != 0)
a9757f6a 3473 report_file_error ("Input file status", orig_filename);
67722112
PE
3474 mtime = get_stat_mtime (&st);
3475
be53b411
JB
3476 /* This code will need to be changed in order to work on named
3477 pipes, and it's probably just not worth it. So we should at
3478 least signal an error. */
99bc28f4 3479 if (!S_ISREG (st.st_mode))
330bfe57 3480 {
d4b8687b
RS
3481 not_regular = 1;
3482
3483 if (! NILP (visit))
3484 goto notfound;
3485
3486 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
24b1ddad
KS
3487 xsignal2 (Qfile_error,
3488 build_string ("not a regular file"), orig_filename);
330bfe57 3489 }
be53b411 3490
9f57b6b4
KH
3491 if (!NILP (visit))
3492 {
3493 if (!NILP (beg) || !NILP (end))
3494 error ("Attempt to visit less than an entire file");
3495 if (BEG < Z && NILP (replace))
3496 error ("Cannot do file visiting in a non-empty buffer");
3497 }
7fded690
JB
3498
3499 if (!NILP (beg))
b3fbb395 3500 beg_offset = file_offset (beg);
7fded690 3501 else
728f8f0a 3502 beg_offset = 0;
7fded690
JB
3503
3504 if (!NILP (end))
b3fbb395 3505 end_offset = file_offset (end);
7fded690
JB
3506 else
3507 {
728f8f0a
PE
3508 if (not_regular)
3509 end_offset = TYPE_MAXIMUM (off_t);
3510 else
d4b8687b 3511 {
728f8f0a
PE
3512 end_offset = st.st_size;
3513
3514 /* A negative size can happen on a platform that allows file
3515 sizes greater than the maximum off_t value. */
3516 if (end_offset < 0)
3517 buffer_overflow ();
68c45bf0 3518
d21dd12d
GM
3519 /* The file size returned from stat may be zero, but data
3520 may be readable nonetheless, for example when this is a
3521 file in the /proc filesystem. */
728f8f0a
PE
3522 if (end_offset == 0)
3523 end_offset = READ_BUF_SIZE;
d4b8687b 3524 }
7fded690
JB
3525 }
3526
728f8f0a
PE
3527 /* Check now whether the buffer will become too large,
3528 in the likely case where the file's length is not changing.
3529 This saves a lot of needless work before a buffer overflow. */
3530 if (! not_regular)
3531 {
3532 /* The likely offset where we will stop reading. We could read
3533 more (or less), if the file grows (or shrinks) as we read it. */
3534 off_t likely_end = min (end_offset, st.st_size);
3535
3536 if (beg_offset < likely_end)
3537 {
ce2fe65a
AS
3538 ptrdiff_t buf_bytes
3539 = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
728f8f0a
PE
3540 ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
3541 off_t likely_growth = likely_end - beg_offset;
3542 if (buf_growth_max < likely_growth)
3543 buffer_overflow ();
3544 }
3545 }
3546
3547 /* Prevent redisplay optimizations. */
3548 current_buffer->clip_changed = 1;
3549
356a6224 3550 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
5560aecd 3551 {
75421805 3552 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
5560aecd
KH
3553 setup_coding_system (coding_system, &coding);
3554 /* Ensure we set Vlast_coding_system_used. */
3555 set_coding_system = 1;
3556 }
356a6224 3557 else if (BEG < Z)
f736ffbf
KH
3558 {
3559 /* Decide the coding system to use for reading the file now
3560 because we can't use an optimized method for handling
3561 `coding:' tag if the current buffer is not empty. */
f736ffbf 3562 if (!NILP (Vcoding_system_for_read))
db327c7e 3563 coding_system = Vcoding_system_for_read;
f736ffbf
KH
3564 else
3565 {
3566 /* Don't try looking inside a file for a coding system
3567 specification if it is not seekable. */
3568 if (! not_regular && ! NILP (Vset_auto_coding_function))
3569 {
3570 /* Find a coding system specified in the heading two
3571 lines or in the tailing several lines of the file.
3572 We assume that the 1K-byte and 3K-byte for heading
003a7eaa 3573 and tailing respectively are sufficient for this
f736ffbf 3574 purpose. */
d311d28c 3575 int nread;
f736ffbf
KH
3576
3577 if (st.st_size <= (1024 * 4))
68c45bf0 3578 nread = emacs_read (fd, read_buf, 1024 * 4);
f736ffbf
KH
3579 else
3580 {
68c45bf0 3581 nread = emacs_read (fd, read_buf, 1024);
4c95c9a5 3582 if (nread == 1024)
f736ffbf 3583 {
4c95c9a5
PE
3584 int ntail;
3585 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
f736ffbf 3586 report_file_error ("Setting file position",
a9757f6a 3587 orig_filename);
4c95c9a5
PE
3588 ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
3589 nread = ntail < 0 ? ntail : nread + ntail;
f736ffbf
KH
3590 }
3591 }
feb9dc27 3592
f736ffbf 3593 if (nread < 0)
4e604a5d 3594 report_file_error ("Read error", orig_filename);
f736ffbf
KH
3595 else if (nread > 0)
3596 {
f736ffbf 3597 struct buffer *prev = current_buffer;
f839df0c 3598 Lisp_Object workbuf;
685fc579 3599 struct buffer *buf;
f736ffbf 3600
66322887 3601 record_unwind_current_buffer ();
1d92afcd 3602
f839df0c
PE
3603 workbuf = Fget_buffer_create (build_string (" *code-converting-work*"));
3604 buf = XBUFFER (workbuf);
685fc579 3605
29ea8ae9 3606 delete_all_overlays (buf);
39eb03f1
PE
3607 bset_directory (buf, BVAR (current_buffer, directory));
3608 bset_read_only (buf, Qnil);
3609 bset_filename (buf, Qnil);
3610 bset_undo_list (buf, Qt);
fd318b54
DA
3611 eassert (buf->overlays_before == NULL);
3612 eassert (buf->overlays_after == NULL);
efdc16c9 3613
685fc579
RS
3614 set_buffer_internal (buf);
3615 Ferase_buffer ();
39eb03f1 3616 bset_enable_multibyte_characters (buf, Qnil);
685fc579 3617
b68864e5 3618 insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
f736ffbf 3619 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
db327c7e 3620 coding_system = call2 (Vset_auto_coding_function,
8f924df7 3621 filename, make_number (nread));
f736ffbf 3622 set_buffer_internal (prev);
efdc16c9 3623
f736ffbf
KH
3624 /* Discard the unwind protect for recovering the
3625 current buffer. */
3626 specpdl_ptr--;
3627
3628 /* Rewind the file for the actual read done later. */
e69dafad 3629 if (lseek (fd, 0, SEEK_SET) < 0)
a9757f6a 3630 report_file_error ("Setting file position", orig_filename);
f736ffbf
KH
3631 }
3632 }
feb9dc27 3633
db327c7e 3634 if (NILP (coding_system))
f736ffbf
KH
3635 {
3636 /* If we have not yet decided a coding system, check
3637 file-coding-system-alist. */
8f924df7 3638 Lisp_Object args[6];
f736ffbf
KH
3639
3640 args[0] = Qinsert_file_contents, args[1] = orig_filename;
3641 args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
8f924df7
KH
3642 coding_system = Ffind_operation_coding_system (6, args);
3643 if (CONSP (coding_system))
3644 coding_system = XCAR (coding_system);
f736ffbf
KH
3645 }
3646 }
c9e82392 3647
db327c7e
KH
3648 if (NILP (coding_system))
3649 coding_system = Qundecided;
3650 else
3651 CHECK_CODING_SYSTEM (coding_system);
c8a6d68a 3652
4b4deea2 3653 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
237a6fd2
RS
3654 /* We must suppress all character code conversion except for
3655 end-of-line conversion. */
db327c7e 3656 coding_system = raw_text_coding_system (coding_system);
54369368 3657
db327c7e
KH
3658 setup_coding_system (coding_system, &coding);
3659 /* Ensure we set Vlast_coding_system_used. */
3660 set_coding_system = 1;
f736ffbf 3661 }
6cf71bf1 3662
3d0387c0
RS
3663 /* If requested, replace the accessible part of the buffer
3664 with the file contents. Avoid replacing text at the
3665 beginning or end of the buffer that matches the file contents;
3dbcf3f6
RS
3666 that preserves markers pointing to the unchanged parts.
3667
3668 Here we implement this feature in an optimized way
3669 for the case where code conversion is NOT needed.
3670 The following if-statement handles the case of conversion
727a0b4a
RS
3671 in a less optimal way.
3672
3673 If the code conversion is "automatic" then we try using this
3674 method and hope for the best.
3675 But if we discover the need for conversion, we give up on this method
3676 and let the following if-statement handle the replace job. */
3dbcf3f6 3677 if (!NILP (replace)
f736ffbf 3678 && BEGV < ZV
db327c7e
KH
3679 && (NILP (coding_system)
3680 || ! CODING_REQUIRE_DECODING (&coding)))
3d0387c0 3681 {
ec7adf26
RS
3682 /* same_at_start and same_at_end count bytes,
3683 because file access counts bytes
3684 and BEG and END count bytes. */
d311d28c
PE
3685 ptrdiff_t same_at_start = BEGV_BYTE;
3686 ptrdiff_t same_at_end = ZV_BYTE;
3687 ptrdiff_t overlap;
6fdaa9a0 3688 /* There is still a possibility we will find the need to do code
f75d7a91 3689 conversion. If that happens, set this variable to
727a0b4a 3690 give up on handling REPLACE in the optimized way. */
f75d7a91 3691 bool giveup_match_end = 0;
9c28748f 3692
728f8f0a 3693 if (beg_offset != 0)
4d2a0879 3694 {
728f8f0a 3695 if (lseek (fd, beg_offset, SEEK_SET) < 0)
a9757f6a 3696 report_file_error ("Setting file position", orig_filename);
4d2a0879
RS
3697 }
3698
3d0387c0
RS
3699 immediate_quit = 1;
3700 QUIT;
3701 /* Count how many chars at the start of the file
3702 match the text at the beginning of the buffer. */
3703 while (1)
3704 {
d311d28c 3705 int nread, bufpos;
3d0387c0 3706
2ef88fd4 3707 nread = emacs_read (fd, read_buf, sizeof read_buf);
3d0387c0 3708 if (nread < 0)
4e604a5d 3709 report_file_error ("Read error", orig_filename);
3d0387c0
RS
3710 else if (nread == 0)
3711 break;
6fdaa9a0 3712
db327c7e 3713 if (CODING_REQUIRE_DETECTION (&coding))
727a0b4a 3714 {
2ef88fd4 3715 coding_system = detect_coding_system ((unsigned char *) read_buf,
5976c3fe 3716 nread, nread, 1, 0,
db327c7e
KH
3717 coding_system);
3718 setup_coding_system (coding_system, &coding);
727a0b4a
RS
3719 }
3720
db327c7e
KH
3721 if (CODING_REQUIRE_DECODING (&coding))
3722 /* We found that the file should be decoded somehow.
727a0b4a
RS
3723 Let's give up here. */
3724 {
3725 giveup_match_end = 1;
3726 break;
3727 }
3728
3d0387c0 3729 bufpos = 0;
ec7adf26 3730 while (bufpos < nread && same_at_start < ZV_BYTE
2ef88fd4 3731 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3d0387c0
RS
3732 same_at_start++, bufpos++;
3733 /* If we found a discrepancy, stop the scan.
8e6208c5 3734 Otherwise loop around and scan the next bufferful. */
3d0387c0
RS
3735 if (bufpos != nread)
3736 break;
3737 }
3738 immediate_quit = 0;
3739 /* If the file matches the buffer completely,
3740 there's no need to replace anything. */
2ba8e008 3741 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
3d0387c0 3742 {
68c45bf0 3743 emacs_close (fd);
b6806029 3744 clear_unwind_protect (fd_index);
9d611ffe 3745
1051b3b3 3746 /* Truncate the buffer to the size of the file. */
7dae4502 3747 del_range_1 (same_at_start, same_at_end, 0, 0);
3d0387c0
RS
3748 goto handled;
3749 }
3750 immediate_quit = 1;
3751 QUIT;
3752 /* Count how many chars at the end of the file
6fdaa9a0
KH
3753 match the text at the end of the buffer. But, if we have
3754 already found that decoding is necessary, don't waste time. */
3755 while (!giveup_match_end)
3d0387c0 3756 {
728f8f0a
PE
3757 int total_read, nread, bufpos, trial;
3758 off_t curpos;
3d0387c0
RS
3759
3760 /* At what file position are we now scanning? */
728f8f0a 3761 curpos = end_offset - (ZV_BYTE - same_at_end);
fc81fa9e
KH
3762 /* If the entire file matches the buffer tail, stop the scan. */
3763 if (curpos == 0)
3764 break;
3d0387c0 3765 /* How much can we scan in the next step? */
2ef88fd4 3766 trial = min (curpos, sizeof read_buf);
728f8f0a 3767 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
a9757f6a 3768 report_file_error ("Setting file position", orig_filename);
3d0387c0 3769
b02439c8 3770 total_read = nread = 0;
3d0387c0
RS
3771 while (total_read < trial)
3772 {
2ef88fd4 3773 nread = emacs_read (fd, read_buf + total_read, trial - total_read);
2bd2273e 3774 if (nread < 0)
4e604a5d 3775 report_file_error ("Read error", orig_filename);
2bd2273e
GM
3776 else if (nread == 0)
3777 break;
3d0387c0
RS
3778 total_read += nread;
3779 }
efdc16c9 3780
8e6208c5 3781 /* Scan this bufferful from the end, comparing with
3d0387c0
RS
3782 the Emacs buffer. */
3783 bufpos = total_read;
efdc16c9 3784
3d0387c0
RS
3785 /* Compare with same_at_start to avoid counting some buffer text
3786 as matching both at the file's beginning and at the end. */
3787 while (bufpos > 0 && same_at_end > same_at_start
2ef88fd4 3788 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3d0387c0 3789 same_at_end--, bufpos--;
727a0b4a 3790
3d0387c0 3791 /* If we found a discrepancy, stop the scan.
8e6208c5 3792 Otherwise loop around and scan the preceding bufferful. */
3d0387c0 3793 if (bufpos != 0)
727a0b4a
RS
3794 {
3795 /* If this discrepancy is because of code conversion,
3796 we cannot use this method; giveup and try the other. */
3797 if (same_at_end > same_at_start
3798 && FETCH_BYTE (same_at_end - 1) >= 0200
4b4deea2 3799 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
c8a6d68a 3800 && (CODING_MAY_REQUIRE_DECODING (&coding)))
727a0b4a
RS
3801 giveup_match_end = 1;
3802 break;
3803 }
b02439c8
GM
3804
3805 if (nread == 0)
3806 break;
3d0387c0
RS
3807 }
3808 immediate_quit = 0;
9c28748f 3809
727a0b4a
RS
3810 if (! giveup_match_end)
3811 {
d311d28c 3812 ptrdiff_t temp;
ec7adf26 3813
727a0b4a 3814 /* We win! We can handle REPLACE the optimized way. */
9c28748f 3815
20f6783d
RS
3816 /* Extend the start of non-matching text area to multibyte
3817 character boundary. */
4b4deea2 3818 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
20f6783d
RS
3819 while (same_at_start > BEGV_BYTE
3820 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3821 same_at_start--;
3822
3823 /* Extend the end of non-matching text area to multibyte
71312b68 3824 character boundary. */
4b4deea2 3825 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
ec7adf26
RS
3826 while (same_at_end < ZV_BYTE
3827 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
71312b68
RS
3828 same_at_end++;
3829
727a0b4a 3830 /* Don't try to reuse the same piece of text twice. */
ec7adf26 3831 overlap = (same_at_start - BEGV_BYTE
728f8f0a
PE
3832 - (same_at_end
3833 + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
727a0b4a
RS
3834 if (overlap > 0)
3835 same_at_end += overlap;
9c28748f 3836
727a0b4a 3837 /* Arrange to read only the nonmatching middle part of the file. */
728f8f0a
PE
3838 beg_offset += same_at_start - BEGV_BYTE;
3839 end_offset -= ZV_BYTE - same_at_end;
3dbcf3f6 3840
de1e0d91
EZ
3841 invalidate_buffer_caches (current_buffer,
3842 BYTE_TO_CHAR (same_at_start),
3843 BYTE_TO_CHAR (same_at_end));
ec7adf26 3844 del_range_byte (same_at_start, same_at_end, 0);
727a0b4a 3845 /* Insert from the file at the proper position. */
ec7adf26
RS
3846 temp = BYTE_TO_CHAR (same_at_start);
3847 SET_PT_BOTH (temp, same_at_start);
727a0b4a
RS
3848
3849 /* If display currently starts at beginning of line,
3850 keep it that way. */
e74aeda8 3851 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
c98ff5dd 3852 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
727a0b4a
RS
3853
3854 replace_handled = 1;
3855 }
3dbcf3f6
RS
3856 }
3857
3858 /* If requested, replace the accessible part of the buffer
3859 with the file contents. Avoid replacing text at the
3860 beginning or end of the buffer that matches the file contents;
3861 that preserves markers pointing to the unchanged parts.
3862
3863 Here we implement this feature for the case where code conversion
3864 is needed, in a simple way that needs a lot of memory.
3865 The preceding if-statement handles the case of no conversion
3866 in a more optimized way. */
f736ffbf 3867 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3dbcf3f6 3868 {
d311d28c
PE
3869 ptrdiff_t same_at_start = BEGV_BYTE;
3870 ptrdiff_t same_at_end = ZV_BYTE;
3871 ptrdiff_t same_at_start_charpos;
3872 ptrdiff_t inserted_chars;
3873 ptrdiff_t overlap;
3874 ptrdiff_t bufpos;
db327c7e 3875 unsigned char *decoded;
d311d28c
PE
3876 ptrdiff_t temp;
3877 ptrdiff_t this = 0;
3878 ptrdiff_t this_count = SPECPDL_INDEX ();
f10fe38f
PE
3879 bool multibyte
3880 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
5b359650 3881 Lisp_Object conversion_buffer;
83aca1cb 3882 struct gcpro gcpro1;
db327c7e 3883
5b359650 3884 conversion_buffer = code_conversion_save (1, multibyte);
3dbcf3f6
RS
3885
3886 /* First read the whole file, performing code conversion into
3887 CONVERSION_BUFFER. */
3888
728f8f0a 3889 if (lseek (fd, beg_offset, SEEK_SET) < 0)
a9757f6a 3890 report_file_error ("Setting file position", orig_filename);
727a0b4a 3891
3dbcf3f6
RS
3892 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3893 unprocessed = 0; /* Bytes not processed in previous loop. */
3894
2ba48777 3895 GCPRO1 (conversion_buffer);
b41b8a7e 3896 while (1)
3dbcf3f6 3897 {
b41b8a7e
PE
3898 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3899 quitting while reading a huge file. */
3dbcf3f6
RS
3900
3901 /* Allow quitting out of the actual I/O. */
3902 immediate_quit = 1;
3903 QUIT;
b41b8a7e
PE
3904 this = emacs_read (fd, read_buf + unprocessed,
3905 READ_BUF_SIZE - unprocessed);
3dbcf3f6
RS
3906 immediate_quit = 0;
3907
db327c7e 3908 if (this <= 0)
43aae36e 3909 break;
3dbcf3f6 3910
bf1c0f27
SM
3911 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3912 BUF_Z (XBUFFER (conversion_buffer)));
5976c3fe
PE
3913 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3914 unprocessed + this, conversion_buffer);
db327c7e
KH
3915 unprocessed = coding.carryover_bytes;
3916 if (coding.carryover_bytes > 0)
72af86bd 3917 memcpy (read_buf, coding.carryover, unprocessed);
3dbcf3f6 3918 }
2ba48777 3919 UNGCPRO;
43aae36e 3920 if (this < 0)
4e604a5d 3921 report_file_error ("Read error", orig_filename);
41d48a42 3922 emacs_close (fd);
a0931322 3923 clear_unwind_protect (fd_index);
3dbcf3f6 3924
db327c7e
KH
3925 if (unprocessed > 0)
3926 {
3927 coding.mode |= CODING_MODE_LAST_BLOCK;
5976c3fe
PE
3928 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3929 unprocessed, conversion_buffer);
db327c7e
KH
3930 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3931 }
3932
50b06221 3933 coding_system = CODING_ID_NAME (coding.id);
f6a07420 3934 set_coding_system = 1;
db327c7e 3935 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
50342b35
KH
3936 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3937 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
db327c7e
KH
3938
3939 /* Compare the beginning of the converted string with the buffer
3940 text. */
3dbcf3f6
RS
3941
3942 bufpos = 0;
3943 while (bufpos < inserted && same_at_start < same_at_end
db327c7e 3944 && FETCH_BYTE (same_at_start) == decoded[bufpos])
3dbcf3f6
RS
3945 same_at_start++, bufpos++;
3946
db327c7e 3947 /* If the file matches the head of buffer completely,
3dbcf3f6
RS
3948 there's no need to replace anything. */
3949
3950 if (bufpos == inserted)
3951 {
3dbcf3f6 3952 /* Truncate the buffer to the size of the file. */
0e64479a 3953 if (same_at_start != same_at_end)
de1e0d91
EZ
3954 {
3955 invalidate_buffer_caches (current_buffer,
3956 BYTE_TO_CHAR (same_at_start),
3957 BYTE_TO_CHAR (same_at_end));
3958 del_range_byte (same_at_start, same_at_end, 0);
3959 }
427f5aab 3960 inserted = 0;
e8553dd1
KH
3961
3962 unbind_to (this_count, Qnil);
3dbcf3f6
RS
3963 goto handled;
3964 }
3965
db327c7e
KH
3966 /* Extend the start of non-matching text area to the previous
3967 multibyte character boundary. */
4b4deea2 3968 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
20f6783d
RS
3969 while (same_at_start > BEGV_BYTE
3970 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3971 same_at_start--;
3972
3dbcf3f6
RS
3973 /* Scan this bufferful from the end, comparing with
3974 the Emacs buffer. */
3975 bufpos = inserted;
3976
3977 /* Compare with same_at_start to avoid counting some buffer text
3978 as matching both at the file's beginning and at the end. */
3979 while (bufpos > 0 && same_at_end > same_at_start
db327c7e 3980 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
3dbcf3f6
RS
3981 same_at_end--, bufpos--;
3982
db327c7e
KH
3983 /* Extend the end of non-matching text area to the next
3984 multibyte character boundary. */
4b4deea2 3985 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
20f6783d
RS
3986 while (same_at_end < ZV_BYTE
3987 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3988 same_at_end++;
3989
3dbcf3f6 3990 /* Don't try to reuse the same piece of text twice. */
ec7adf26 3991 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
3dbcf3f6
RS
3992 if (overlap > 0)
3993 same_at_end += overlap;
3994
727a0b4a
RS
3995 /* If display currently starts at beginning of line,
3996 keep it that way. */
e74aeda8 3997 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
c98ff5dd 3998 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
727a0b4a 3999
3dbcf3f6
RS
4000 /* Replace the chars that we need to replace,
4001 and update INSERTED to equal the number of bytes
db327c7e 4002 we are taking from the decoded string. */
4b70e2c9 4003 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
427f5aab 4004
643c73b9 4005 if (same_at_end != same_at_start)
427f5aab 4006 {
de1e0d91
EZ
4007 invalidate_buffer_caches (current_buffer,
4008 BYTE_TO_CHAR (same_at_start),
4009 BYTE_TO_CHAR (same_at_end));
427f5aab
KH
4010 del_range_byte (same_at_start, same_at_end, 0);
4011 temp = GPT;
22513e52 4012 eassert (same_at_start == GPT_BYTE);
427f5aab
KH
4013 same_at_start = GPT_BYTE;
4014 }
643c73b9
RS
4015 else
4016 {
643c73b9 4017 temp = BYTE_TO_CHAR (same_at_start);
643c73b9 4018 }
427f5aab
KH
4019 /* Insert from the file at the proper position. */
4020 SET_PT_BOTH (temp, same_at_start);
50342b35
KH
4021 same_at_start_charpos
4022 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
7f5d2c72
SM
4023 same_at_start - BEGV_BYTE
4024 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
22513e52 4025 eassert (same_at_start_charpos == temp - (BEGV - BEG));
50342b35
KH
4026 inserted_chars
4027 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
7f5d2c72
SM
4028 same_at_start + inserted - BEGV_BYTE
4029 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
50342b35 4030 - same_at_start_charpos);
d07af40d
KH
4031 /* This binding is to avoid ask-user-about-supersession-threat
4032 being called in insert_from_buffer (via in
4033 prepare_to_modify_buffer). */
4034 specbind (intern ("buffer-file-name"), Qnil);
db327c7e 4035 insert_from_buffer (XBUFFER (conversion_buffer),
50342b35 4036 same_at_start_charpos, inserted_chars, 0);
427f5aab
KH
4037 /* Set `inserted' to the number of inserted characters. */
4038 inserted = PT - temp;
77343e1d
KH
4039 /* Set point before the inserted characters. */
4040 SET_PT_BOTH (temp, same_at_start);
3dbcf3f6 4041
db327c7e 4042 unbind_to (this_count, Qnil);
3dbcf3f6 4043
3dbcf3f6 4044 goto handled;
3d0387c0
RS
4045 }
4046
d4b8687b 4047 if (! not_regular)
728f8f0a 4048 total = end_offset - beg_offset;
d4b8687b
RS
4049 else
4050 /* For a special file, all we can do is guess. */
4051 total = READ_BUF_SIZE;
570d7624 4052
8b913b57 4053 if (NILP (visit) && total > 0)
68780e2a
RS
4054 {
4055#ifdef CLASH_DETECTION
4b4deea2 4056 if (!NILP (BVAR (current_buffer, file_truename))
68780e2a 4057 /* Make binding buffer-file-name to nil effective. */
4b4deea2 4058 && !NILP (BVAR (current_buffer, filename))
68780e2a
RS
4059 && SAVE_MODIFF >= MODIFF)
4060 we_locked_file = 1;
4061#endif /* CLASH_DETECTION */
4062 prepare_to_modify_buffer (GPT, GPT, NULL);
4063 }
570d7624 4064
13002885 4065 move_gap_both (PT, PT_BYTE);
7fded690
JB
4066 if (GAP_SIZE < total)
4067 make_gap (total - GAP_SIZE);
4068
728f8f0a 4069 if (beg_offset != 0 || !NILP (replace))
7fded690 4070 {
728f8f0a 4071 if (lseek (fd, beg_offset, SEEK_SET) < 0)
a9757f6a 4072 report_file_error ("Setting file position", orig_filename);
7fded690
JB
4073 }
4074
2ef88fd4
DA
4075 /* In the following loop, HOW_MUCH contains the total bytes read so
4076 far for a regular file, and not changed for a special file. But,
4077 before exiting the loop, it is set to a negative value if I/O
4078 error occurs. */
a1d2b64a 4079 how_much = 0;
efdc16c9 4080
6fdaa9a0
KH
4081 /* Total bytes inserted. */
4082 inserted = 0;
efdc16c9 4083
2ef88fd4
DA
4084 /* Here, we don't do code conversion in the loop. It is done by
4085 decode_coding_gap after all data are read into the buffer. */
4086 {
4087 ptrdiff_t gap_size = GAP_SIZE;
1b978129 4088
2ef88fd4
DA
4089 while (how_much < total)
4090 {
4091 /* try is reserved in some compilers (Microsoft C) */
4092 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4093 ptrdiff_t this;
1b978129 4094
2ef88fd4
DA
4095 if (not_regular)
4096 {
4097 Lisp_Object nbytes;
4098
4099 /* Maybe make more room. */
4100 if (gap_size < trytry)
4101 {
4102 make_gap (trytry - gap_size);
4103 gap_size = GAP_SIZE - inserted;
4104 }
4105
4106 /* Read from the file, capturing `quit'. When an
4107 error occurs, end the loop, and arrange for a quit
4108 to be signaled after decoding the text we read. */
4109 nbytes = internal_condition_case_1
4110 (read_non_regular,
1396ac86 4111 make_save_int_int_int (fd, inserted, trytry),
2ef88fd4
DA
4112 Qerror, read_non_regular_quit);
4113
4114 if (NILP (nbytes))
4115 {
4116 read_quit = 1;
4117 break;
4118 }
4119
4120 this = XINT (nbytes);
4121 }
4122 else
4123 {
4124 /* Allow quitting out of the actual I/O. We don't make text
4125 part of the buffer until all the reading is done, so a C-g
4126 here doesn't do any harm. */
4127 immediate_quit = 1;
4128 QUIT;
4129 this = emacs_read (fd,
4130 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4131 + inserted),
4132 trytry);
4133 immediate_quit = 0;
4134 }
4135
4136 if (this <= 0)
4137 {
4138 how_much = this;
4139 break;
4140 }
4141
4142 gap_size -= this;
4143
4144 /* For a regular file, where TOTAL is the real size,
4145 count HOW_MUCH to compare with it.
4146 For a special file, where TOTAL is just a buffer size,
4147 so don't bother counting in HOW_MUCH.
4148 (INSERTED is where we count the number of characters inserted.) */
4149 if (! not_regular)
4150 how_much += this;
4151 inserted += this;
4152 }
4153 }
1b978129 4154
e07469fa
DA
4155 /* Now we have either read all the file data into the gap,
4156 or stop reading on I/O error or quit. If nothing was
4157 read, undo marking the buffer modified. */
68780e2a
RS
4158
4159 if (inserted == 0)
4160 {
6840d350 4161#ifdef CLASH_DETECTION
68780e2a 4162 if (we_locked_file)
4b4deea2 4163 unlock_file (BVAR (current_buffer, file_truename));
6840d350 4164#endif
68780e2a
RS
4165 Vdeactivate_mark = old_Vdeactivate_mark;
4166 }
83c1cf6d
RS
4167 else
4168 Vdeactivate_mark = Qt;
68780e2a 4169
68c45bf0 4170 emacs_close (fd);
a0931322 4171 clear_unwind_protect (fd_index);
6fdaa9a0 4172
2ef88fd4 4173 if (how_much < 0)
4e604a5d 4174 report_file_error ("Read error", orig_filename);
2ef88fd4
DA
4175
4176 /* Make the text read part of the buffer. */
4177 GAP_SIZE -= inserted;
4178 GPT += inserted;
4179 GPT_BYTE += inserted;
4180 ZV += inserted;
4181 ZV_BYTE += inserted;
4182 Z += inserted;
4183 Z_BYTE += inserted;
4184
4185 if (GAP_SIZE > 0)
4186 /* Put an anchor to ensure multi-byte form ends at gap. */
4187 *GPT_ADDR = 0;
4188
f8569325
DL
4189 notfound:
4190
db327c7e 4191 if (NILP (coding_system))
c8a6d68a 4192 {
2df42e09 4193 /* The coding system is not yet decided. Decide it by an
dfe35e7b
RS
4194 optimized method for handling `coding:' tag.
4195
4196 Note that we can get here only if the buffer was empty
4197 before the insertion. */
f736ffbf 4198
2df42e09 4199 if (!NILP (Vcoding_system_for_read))
db327c7e 4200 coding_system = Vcoding_system_for_read;
2df42e09
KH
4201 else
4202 {
98a7d268
KH
4203 /* Since we are sure that the current buffer was empty
4204 before the insertion, we can toggle
4205 enable-multibyte-characters directly here without taking
9a7f80aa
KH
4206 care of marker adjustment. By this way, we can run Lisp
4207 program safely before decoding the inserted text. */
98a7d268 4208 Lisp_Object unwind_data;
d311d28c 4209 ptrdiff_t count1 = SPECPDL_INDEX ();
2df42e09 4210
4b4deea2
TT
4211 unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
4212 Fcons (BVAR (current_buffer, undo_list),
98a7d268 4213 Fcurrent_buffer ()));
39eb03f1
PE
4214 bset_enable_multibyte_characters (current_buffer, Qnil);
4215 bset_undo_list (current_buffer, Qt);
98a7d268
KH
4216 record_unwind_protect (decide_coding_unwind, unwind_data);
4217
4218 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4219 {
db327c7e 4220 coding_system = call2 (Vset_auto_coding_function,
8f924df7 4221 filename, make_number (inserted));
2df42e09 4222 }
f736ffbf 4223
db327c7e 4224 if (NILP (coding_system))
2df42e09
KH
4225 {
4226 /* If the coding system is not yet decided, check
4227 file-coding-system-alist. */
8f924df7 4228 Lisp_Object args[6];
f736ffbf 4229
2df42e09
KH
4230 args[0] = Qinsert_file_contents, args[1] = orig_filename;
4231 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
8f924df7
KH
4232 coding_system = Ffind_operation_coding_system (6, args);
4233 if (CONSP (coding_system))
4234 coding_system = XCAR (coding_system);
f736ffbf 4235 }
f839df0c 4236 unbind_to (count1, Qnil);
98a7d268 4237 inserted = Z_BYTE - BEG_BYTE;
2df42e09 4238 }
f736ffbf 4239
db327c7e
KH
4240 if (NILP (coding_system))
4241 coding_system = Qundecided;
4242 else
4243 CHECK_CODING_SYSTEM (coding_system);
f736ffbf 4244
4b4deea2 4245 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
237a6fd2 4246 /* We must suppress all character code conversion except for
2df42e09 4247 end-of-line conversion. */
db327c7e 4248 coding_system = raw_text_coding_system (coding_system);
db327c7e
KH
4249 setup_coding_system (coding_system, &coding);
4250 /* Ensure we set Vlast_coding_system_used. */
4251 set_coding_system = 1;
2df42e09 4252 }
f736ffbf 4253
db327c7e 4254 if (!NILP (visit))
8c3b9441 4255 {
db327c7e 4256 /* When we visit a file by raw-text, we change the buffer to
9a7f80aa 4257 unibyte. */
db327c7e
KH
4258 if (CODING_FOR_UNIBYTE (&coding)
4259 /* Can't do this if part of the buffer might be preserved. */
4260 && NILP (replace))
4261 /* Visiting a file with these coding system makes the buffer
4262 unibyte. */
39eb03f1 4263 bset_enable_multibyte_characters (current_buffer, Qnil);
8c3b9441
KH
4264 }
4265
4b4deea2 4266 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
5b359650 4267 if (CODING_MAY_REQUIRE_DECODING (&coding)
1c157f8d 4268 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
2df42e09 4269 {
db327c7e
KH
4270 move_gap_both (PT, PT_BYTE);
4271 GAP_SIZE += inserted;
4272 ZV_BYTE -= inserted;
4273 Z_BYTE -= inserted;
4274 ZV -= inserted;
4275 Z -= inserted;
4276 decode_coding_gap (&coding, inserted, inserted);
4277 inserted = coding.produced_char;
5b359650 4278 coding_system = CODING_ID_NAME (coding.id);
2df42e09 4279 }
db327c7e
KH
4280 else if (inserted > 0)
4281 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4282 inserted);
570d7624 4283
0068070e
SM
4284 /* Call after-change hooks for the inserted text, aside from the case
4285 of normal visiting (not with REPLACE), which is done in a new buffer
4286 "before" the buffer is changed. */
4287 if (inserted > 0 && total > 0
4288 && (NILP (visit) || !NILP (replace)))
4289 {
4290 signal_after_change (PT, 0, inserted);
4291 update_compositions (PT, PT, CHECK_BORDER);
4292 }
4293
cf6d2357
RS
4294 /* Now INSERTED is measured in characters. */
4295
32f4334d 4296 handled:
570d7624 4297
265a9e55 4298 if (!NILP (visit))
570d7624 4299 {
22513e52 4300 if (empty_undo_list_p)
39eb03f1 4301 bset_undo_list (current_buffer, Qnil);
62bcf009 4302
a7e82472
RS
4303 if (NILP (handler))
4304 {
dbeed9a6 4305 current_buffer->modtime = mtime;
58b963f7 4306 current_buffer->modtime_size = st.st_size;
39eb03f1 4307 bset_filename (current_buffer, orig_filename);
a7e82472 4308 }
62bcf009 4309
95385625 4310 SAVE_MODIFF = MODIFF;
0b5397c2 4311 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4b4deea2 4312 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
570d7624 4313#ifdef CLASH_DETECTION
32f4334d
RS
4314 if (NILP (handler))
4315 {
4b4deea2
TT
4316 if (!NILP (BVAR (current_buffer, file_truename)))
4317 unlock_file (BVAR (current_buffer, file_truename));
32f4334d
RS
4318 unlock_file (filename);
4319 }
570d7624 4320#endif /* CLASH_DETECTION */
330bfe57 4321 if (not_regular)
24b1ddad
KS
4322 xsignal2 (Qfile_error,
4323 build_string ("not a regular file"), orig_filename);
570d7624
JB
4324 }
4325
b6426b03 4326 if (set_coding_system)
8f924df7 4327 Vlast_coding_system_used = coding_system;
b6426b03 4328
2080470e 4329 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
b6426b03 4330 {
37a3c774
KH
4331 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4332 visit);
b6426b03
KH
4333 if (! NILP (insval))
4334 {
d311d28c
PE
4335 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4336 wrong_type_argument (intern ("inserted-chars"), insval);
b6426b03
KH
4337 inserted = XFASTINT (insval);
4338 }
4339 }
4340
6420e80c 4341 /* Decode file format. */
c8a6d68a 4342 if (inserted > 0)
0d420e88 4343 {
6420e80c 4344 /* Don't run point motion or modification hooks when decoding. */
d311d28c
PE
4345 ptrdiff_t count1 = SPECPDL_INDEX ();
4346 ptrdiff_t old_inserted = inserted;
6f2528d8
MR
4347 specbind (Qinhibit_point_motion_hooks, Qt);
4348 specbind (Qinhibit_modification_hooks, Qt);
4349
6420e80c 4350 /* Save old undo list and don't record undo for decoding. */
4b4deea2 4351 old_undo = BVAR (current_buffer, undo_list);
39eb03f1 4352 bset_undo_list (current_buffer, Qt);
efdc16c9 4353
6f2528d8 4354 if (NILP (replace))
ed8e506f 4355 {
6f2528d8
MR
4356 insval = call3 (Qformat_decode,
4357 Qnil, make_number (inserted), visit);
d311d28c
PE
4358 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4359 wrong_type_argument (intern ("inserted-chars"), insval);
6f2528d8
MR
4360 inserted = XFASTINT (insval);
4361 }
4362 else
4363 {
4364 /* If REPLACE is non-nil and we succeeded in not replacing the
6420e80c
AS
4365 beginning or end of the buffer text with the file's contents,
4366 call format-decode with `point' positioned at the beginning
fa463103 4367 of the buffer and `inserted' equaling the number of
6420e80c
AS
4368 characters in the buffer. Otherwise, format-decode might
4369 fail to correctly analyze the beginning or end of the buffer.
4370 Hence we temporarily save `point' and `inserted' here and
4371 restore `point' iff format-decode did not insert or delete
4372 any text. Otherwise we leave `point' at point-min. */
d311d28c
PE
4373 ptrdiff_t opoint = PT;
4374 ptrdiff_t opoint_byte = PT_BYTE;
4375 ptrdiff_t oinserted = ZV - BEGV;
4376 EMACS_INT ochars_modiff = CHARS_MODIFF;
1f163f28
MA
4377
4378 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
6f2528d8
MR
4379 insval = call3 (Qformat_decode,
4380 Qnil, make_number (oinserted), visit);
d311d28c
PE
4381 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4382 wrong_type_argument (intern ("inserted-chars"), insval);
cac4219c
MR
4383 if (ochars_modiff == CHARS_MODIFF)
4384 /* format_decode didn't modify buffer's characters => move
4385 point back to position before inserted text and leave
6420e80c 4386 value of inserted alone. */
6f2528d8 4387 SET_PT_BOTH (opoint, opoint_byte);
cac4219c
MR
4388 else
4389 /* format_decode modified buffer's characters => consider
6420e80c 4390 entire buffer changed and leave point at point-min. */
cac4219c 4391 inserted = XFASTINT (insval);
ed8e506f 4392 }
efdc16c9 4393
6f2528d8 4394 /* For consistency with format-decode call these now iff inserted > 0
6420e80c 4395 (martin 2007-06-28). */
6f2528d8
MR
4396 p = Vafter_insert_file_functions;
4397 while (CONSP (p))
4398 {
4399 if (NILP (replace))
4400 {
4401 insval = call1 (XCAR (p), make_number (inserted));
4402 if (!NILP (insval))
4403 {
d311d28c
PE
4404 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4405 wrong_type_argument (intern ("inserted-chars"), insval);
6f2528d8
MR
4406 inserted = XFASTINT (insval);
4407 }
4408 }
4409 else
4410 {
6420e80c
AS
4411 /* For the rationale of this see the comment on
4412 format-decode above. */
d311d28c
PE
4413 ptrdiff_t opoint = PT;
4414 ptrdiff_t opoint_byte = PT_BYTE;
4415 ptrdiff_t oinserted = ZV - BEGV;
4416 EMACS_INT ochars_modiff = CHARS_MODIFF;
1f163f28 4417
6f2528d8
MR
4418 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4419 insval = call1 (XCAR (p), make_number (oinserted));
4420 if (!NILP (insval))
4421 {
d311d28c
PE
4422 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4423 wrong_type_argument (intern ("inserted-chars"), insval);
cac4219c
MR
4424 if (ochars_modiff == CHARS_MODIFF)
4425 /* after_insert_file_functions didn't modify
4426 buffer's characters => move point back to
4427 position before inserted text and leave value of
6420e80c 4428 inserted alone. */
6f2528d8 4429 SET_PT_BOTH (opoint, opoint_byte);
cac4219c
MR
4430 else
4431 /* after_insert_file_functions did modify buffer's
4432 characters => consider entire buffer changed and
6420e80c 4433 leave point at point-min. */
cac4219c 4434 inserted = XFASTINT (insval);
6f2528d8
MR
4435 }
4436 }
4437
4438 QUIT;
4439 p = XCDR (p);
ed8e506f 4440 }
efdc16c9 4441
22513e52 4442 if (!empty_undo_list_p)
6f2528d8 4443 {
39eb03f1 4444 bset_undo_list (current_buffer, old_undo);
6420e80c 4445 if (CONSP (old_undo) && inserted != old_inserted)
6f2528d8 4446 {
6420e80c
AS
4447 /* Adjust the last undo record for the size change during
4448 the format conversion. */
6f2528d8 4449 Lisp_Object tem = XCAR (old_undo);
6420e80c
AS
4450 if (CONSP (tem) && INTEGERP (XCAR (tem))
4451 && INTEGERP (XCDR (tem))
4452 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4453 XSETCDR (tem, make_number (PT + inserted));
6f2528d8
MR
4454 }
4455 }
6f2528d8 4456 else
1bc99c9c 4457 /* If undo_list was Qt before, keep it that way.
6420e80c 4458 Otherwise start with an empty undo_list. */
39eb03f1 4459 bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
efdc16c9 4460
f839df0c 4461 unbind_to (count1, Qnil);
0d420e88
BG
4462 }
4463
f8569325 4464 if (!NILP (visit)
43aac990 4465 && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
f8569325
DL
4466 {
4467 /* If visiting nonexistent file, return nil. */
a9757f6a 4468 report_file_errno ("Opening input file", orig_filename, save_errno);
d6a3cc15
RS
4469 }
4470
addccbd0
EZ
4471 /* We made a lot of deletions and insertions above, so invalidate
4472 the newline cache for the entire region of the inserted
4473 characters. */
4474 if (current_buffer->newline_cache)
4475 invalidate_region_cache (current_buffer,
4476 current_buffer->newline_cache,
4477 PT - BEG, Z - PT - inserted);
4478
1b978129
GM
4479 if (read_quit)
4480 Fsignal (Qquit, Qnil);
4481
2ef88fd4 4482 /* Retval needs to be dealt with in all cases consistently. */
a1d2b64a 4483 if (NILP (val))
e07469fa 4484 val = list2 (orig_filename, make_number (inserted));
a1d2b64a
RS
4485
4486 RETURN_UNGCPRO (unbind_to (count, val));
570d7624 4487}
7fded690 4488\f
f57e2426 4489static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
d6a3cc15 4490
27e498e6 4491static void
971de7fb 4492build_annotations_unwind (Lisp_Object arg)
6fc6f94b 4493{
67fbc0cb 4494 Vwrite_region_annotation_buffers = arg;
6fc6f94b
RS
4495}
4496
7c82a4a9
SM
4497/* Decide the coding-system to encode the data with. */
4498
9dbda100
GM
4499DEFUN ("choose-write-coding-system", Fchoose_write_coding_system,
4500 Schoose_write_coding_system, 3, 6, 0,
4501 doc: /* Choose the coding system for writing a file.
4502Arguments are as for `write-region'.
4503This function is for internal use only. It may prompt the user. */ )
4504 (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4505 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname)
7c82a4a9
SM
4506{
4507 Lisp_Object val;
75421805 4508 Lisp_Object eol_parent = Qnil;
7c82a4a9 4509
9dbda100
GM
4510 /* Mimic write-region behavior. */
4511 if (NILP (start))
4512 {
4513 XSETFASTINT (start, BEGV);
4514 XSETFASTINT (end, ZV);
4515 }
4516
6b61353c 4517 if (auto_saving
4b4deea2
TT
4518 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4519 BVAR (current_buffer, auto_save_file_name))))
75421805
KH
4520 {
4521 val = Qutf_8_emacs;
4522 eol_parent = Qunix;
4523 }
7c82a4a9 4524 else if (!NILP (Vcoding_system_for_write))
42b01e1e
KH
4525 {
4526 val = Vcoding_system_for_write;
4527 if (coding_system_require_warning
4528 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4529 /* Confirm that VAL can surely encode the current region. */
4530 val = call5 (Vselect_safe_coding_system_function,
6c6f1994 4531 start, end, list2 (Qt, val),
42b01e1e
KH
4532 Qnil, filename);
4533 }
7c82a4a9
SM
4534 else
4535 {
4536 /* If the variable `buffer-file-coding-system' is set locally,
4537 it means that the file was read with some kind of code
4538 conversion or the variable is explicitly set by users. We
4539 had better write it out with the same coding system even if
4540 `enable-multibyte-characters' is nil.
4541
4542 If it is not set locally, we anyway have to convert EOL
4543 format if the default value of `buffer-file-coding-system'
4544 tells that it is not Unix-like (LF only) format. */
f75d7a91
PE
4545 bool using_default_coding = 0;
4546 bool force_raw_text = 0;
7c82a4a9 4547
4b4deea2 4548 val = BVAR (current_buffer, buffer_file_coding_system);
7c82a4a9
SM
4549 if (NILP (val)
4550 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4551 {
4552 val = Qnil;
4b4deea2 4553 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
7c82a4a9
SM
4554 force_raw_text = 1;
4555 }
efdc16c9 4556
7c82a4a9
SM
4557 if (NILP (val))
4558 {
4559 /* Check file-coding-system-alist. */
4560 Lisp_Object args[7], coding_systems;
4561
4562 args[0] = Qwrite_region; args[1] = start; args[2] = end;
4563 args[3] = filename; args[4] = append; args[5] = visit;
4564 args[6] = lockname;
4565 coding_systems = Ffind_operation_coding_system (7, args);
4566 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4567 val = XCDR (coding_systems);
4568 }
4569
c934586d 4570 if (NILP (val))
7c82a4a9
SM
4571 {
4572 /* If we still have not decided a coding system, use the
4573 default value of buffer-file-coding-system. */
4b4deea2 4574 val = BVAR (current_buffer, buffer_file_coding_system);
7c82a4a9
SM
4575 using_default_coding = 1;
4576 }
efdc16c9 4577
db327c7e
KH
4578 if (! NILP (val) && ! force_raw_text)
4579 {
4580 Lisp_Object spec, attrs;
4581
4582 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4583 attrs = AREF (spec, 0);
4584 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4585 force_raw_text = 1;
4586 }
4587
7c82a4a9
SM
4588 if (!force_raw_text
4589 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4590 /* Confirm that VAL can surely encode the current region. */
905a4276
PJ
4591 val = call5 (Vselect_safe_coding_system_function,
4592 start, end, val, Qnil, filename);
7c82a4a9 4593
db327c7e
KH
4594 /* If the decided coding-system doesn't specify end-of-line
4595 format, we use that of
4596 `default-buffer-file-coding-system'. */
c934586d 4597 if (! using_default_coding
4b4deea2 4598 && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system)))
db327c7e 4599 val = (coding_inherit_eol_type
4b4deea2 4600 (val, BVAR (&buffer_defaults, buffer_file_coding_system)));
7c82a4a9 4601
db327c7e
KH
4602 /* If we decide not to encode text, use `raw-text' or one of its
4603 subsidiaries. */
7c82a4a9 4604 if (force_raw_text)
db327c7e 4605 val = raw_text_coding_system (val);
7c82a4a9
SM
4606 }
4607
75421805 4608 val = coding_inherit_eol_type (val, eol_parent);
c934586d 4609 return val;
7c82a4a9
SM
4610}
4611
a7ca3326 4612DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
8c1a1077
PJ
4613 "r\nFWrite region to file: \ni\ni\ni\np",
4614 doc: /* Write current region into specified file.
c2efea25
RS
4615When called from a program, requires three arguments:
4616START, END and FILENAME. START and END are normally buffer positions
4617specifying the part of the buffer to write.
4618If START is nil, that means to use the entire buffer contents.
4619If START is a string, then output that string to the file
4620instead of any buffer contents; END is ignored.
4621
8c1a1077 4622Optional fourth argument APPEND if non-nil means
b3fbb395 4623 append to existing file contents (if any). If it is a number,
8c1a1077 4624 seek to that offset in the file before writing.
36e50520 4625Optional fifth argument VISIT, if t or a string, means
8c1a1077
PJ
4626 set the last-save-file-modtime of buffer to this file's modtime
4627 and mark buffer not modified.
4628If VISIT is a string, it is a second file name;
4629 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4630 VISIT is also the file name to lock and unlock for clash detection.
4631If VISIT is neither t nor nil nor a string,
5f4e6aa9 4632 that means do not display the \"Wrote file\" message.
8c1a1077
PJ
4633The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4634 use for locking and unlocking, overriding FILENAME and VISIT.
4635The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4636 for an existing file with the same name. If MUSTBENEW is `excl',
4637 that means to get an error if the file already exists; never overwrite.
4638 If MUSTBENEW is neither nil nor `excl', that means ask for
4639 confirmation before overwriting, but do go ahead and overwrite the file
4640 if the user confirms.
8c1a1077
PJ
4641
4642This does code conversion according to the value of
4643`coding-system-for-write', `buffer-file-coding-system', or
4644`file-coding-system-alist', and sets the variable
aacd8ba1
GM
4645`last-coding-system-used' to the coding system actually used.
4646
4647This calls `write-region-annotate-functions' at the start, and
4648`write-region-post-annotation-function' at the end. */)
94fcd171
PE
4649 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
4650 Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4651{
4652 return write_region (start, end, filename, append, visit, lockname, mustbenew,
4653 -1);
4654}
4655
4656/* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4657 descriptor for FILENAME, so do not open or close FILENAME. */
4658
4659Lisp_Object
4660write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4661 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4662 Lisp_Object mustbenew, int desc)
570d7624 4663{
3a955a1f
PE
4664 int open_flags;
4665 int mode;
4666 off_t offset IF_LINT (= 0);
94fcd171 4667 bool open_and_close_file = desc < 0;
f75d7a91 4668 bool ok;
6bbd7a29 4669 int save_errno = 0;
5976c3fe 4670 const char *fn;
570d7624 4671 struct stat st;
43aac990 4672 struct timespec modtime;
d311d28c 4673 ptrdiff_t count = SPECPDL_INDEX ();
94fcd171 4674 ptrdiff_t count1 IF_LINT (= 0);
3eac9910 4675 Lisp_Object handler;
4ad827c5 4676 Lisp_Object visit_file;
65b7d3e7 4677 Lisp_Object annotations;
b1d1b865 4678 Lisp_Object encoded_filename;
f75d7a91
PE
4679 bool visiting = (EQ (visit, Qt) || STRINGP (visit));
4680 bool quietly = !NILP (visit);
94fcd171 4681 bool file_locked = 0;
7204a979 4682 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
6fc6f94b 4683 struct buffer *given_buffer;
6fdaa9a0 4684 struct coding_system coding;
570d7624 4685
d3a67486 4686 if (current_buffer->base_buffer && visiting)
95385625
RS
4687 error ("Cannot do file visiting in an indirect buffer");
4688
561cb8e1 4689 if (!NILP (start) && !STRINGP (start))
570d7624
JB
4690 validate_region (&start, &end);
4691
95c1c901 4692 visit_file = Qnil;
59fac292 4693 GCPRO5 (start, filename, visit, visit_file, lockname);
b56567b5 4694
570d7624 4695 filename = Fexpand_file_name (filename, Qnil);
de1d0127 4696
236a12f2 4697 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
b8b29dc9 4698 barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
de1d0127 4699
561cb8e1 4700 if (STRINGP (visit))
e5176bae 4701 visit_file = Fexpand_file_name (visit, Qnil);
4ad827c5
RS
4702 else
4703 visit_file = filename;
4704
7204a979
RS
4705 if (NILP (lockname))
4706 lockname = visit_file;
4707
65b7d3e7
RS
4708 annotations = Qnil;
4709
32f4334d
RS
4710 /* If the file name has special constructs in it,
4711 call the corresponding file handler. */
49307295 4712 handler = Ffind_file_name_handler (filename, Qwrite_region);
b56ad927 4713 /* If FILENAME has no handler, see if VISIT has one. */
93c30b5f 4714 if (NILP (handler) && STRINGP (visit))
199607e4 4715 handler = Ffind_file_name_handler (visit, Qwrite_region);
3eac9910 4716
32f4334d
RS
4717 if (!NILP (handler))
4718 {
32f4334d 4719 Lisp_Object val;
51cf6d37
RS
4720 val = call6 (handler, Qwrite_region, start, end,
4721 filename, append, visit);
32f4334d 4722
d6a3cc15 4723 if (visiting)
32f4334d 4724 {
95385625 4725 SAVE_MODIFF = MODIFF;
4b4deea2 4726 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
39eb03f1 4727 bset_filename (current_buffer, visit_file);
32f4334d 4728 }
09121adc 4729 UNGCPRO;
32f4334d
RS
4730 return val;
4731 }
4732
4a38de71
KH
4733 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4734
561cb8e1
RS
4735 /* Special kludge to simplify auto-saving. */
4736 if (NILP (start))
4737 {
6b3d752c
SM
4738 /* Do it later, so write-region-annotate-function can work differently
4739 if we save "the buffer" vs "a region".
4740 This is useful in tar-mode. --Stef
2acfd7ae 4741 XSETFASTINT (start, BEG);
6b3d752c 4742 XSETFASTINT (end, Z); */
4a38de71 4743 Fwiden ();
561cb8e1
RS
4744 }
4745
67fbc0cb
CY
4746 record_unwind_protect (build_annotations_unwind,
4747 Vwrite_region_annotation_buffers);
6c6f1994 4748 Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
6fc6f94b
RS
4749
4750 given_buffer = current_buffer;
bf3428a1
RS
4751
4752 if (!STRINGP (start))
236a12f2 4753 {
bf3428a1
RS
4754 annotations = build_annotations (start, end);
4755
4756 if (current_buffer != given_buffer)
4757 {
4758 XSETFASTINT (start, BEGV);
4759 XSETFASTINT (end, ZV);
4760 }
236a12f2
SM
4761 }
4762
6b3d752c
SM
4763 if (NILP (start))
4764 {
4765 XSETFASTINT (start, BEGV);
4766 XSETFASTINT (end, ZV);
4767 }
4768
236a12f2
SM
4769 UNGCPRO;
4770
4771 GCPRO5 (start, filename, annotations, visit_file, lockname);
4772
59fac292
SM
4773 /* Decide the coding-system to encode the data with.
4774 We used to make this choice before calling build_annotations, but that
4775 leads to problems when a write-annotate-function takes care of
4776 unsavable chars (as was the case with X-Symbol). */
538f3845 4777 Vlast_coding_system_used =
9dbda100 4778 Fchoose_write_coding_system (start, end, filename,
538f3845 4779 append, visit, lockname);
9dbda100
GM
4780
4781 setup_coding_system (Vlast_coding_system_used, &coding);
4782
4783 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4784 coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
d6a3cc15 4785
570d7624 4786#ifdef CLASH_DETECTION
94fcd171
PE
4787 if (open_and_close_file && !auto_saving)
4788 {
4789 lock_file (lockname);
4790 file_locked = 1;
4791 }
570d7624
JB
4792#endif /* CLASH_DETECTION */
4793
b1d1b865 4794 encoded_filename = ENCODE_FILE (filename);
5976c3fe 4795 fn = SSDATA (encoded_filename);
3a955a1f
PE
4796 open_flags = O_WRONLY | O_BINARY | O_CREAT;
4797 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4798 if (NUMBERP (append))
4799 offset = file_offset (append);
4800 else if (!NILP (append))
4801 open_flags |= O_APPEND;
5e570b75 4802#ifdef DOS_NT
3a955a1f
PE
4803 mode = S_IREAD | S_IWRITE;
4804#else
4805 mode = auto_saving ? auto_save_mode_bits : 0666;
4806#endif
4807
94fcd171 4808 if (open_and_close_file)
570d7624 4809 {
94fcd171
PE
4810 desc = emacs_open (fn, open_flags, mode);
4811 if (desc < 0)
4812 {
4813 int open_errno = errno;
570d7624 4814#ifdef CLASH_DETECTION
94fcd171
PE
4815 if (file_locked)
4816 unlock_file (lockname);
570d7624 4817#endif /* CLASH_DETECTION */
94fcd171
PE
4818 UNGCPRO;
4819 report_file_errno ("Opening output file", filename, open_errno);
4820 }
570d7624 4821
94fcd171
PE
4822 count1 = SPECPDL_INDEX ();
4823 record_unwind_protect_int (close_file_unwind, desc);
4824 }
570d7624 4825
3a955a1f 4826 if (NUMBERP (append))
43fb7d9a 4827 {
3a955a1f 4828 off_t ret = lseek (desc, offset, SEEK_SET);
43fb7d9a
DL
4829 if (ret < 0)
4830 {
a773ed9a 4831 int lseek_errno = errno;
570d7624 4832#ifdef CLASH_DETECTION
94fcd171
PE
4833 if (file_locked)
4834 unlock_file (lockname);
570d7624 4835#endif /* CLASH_DETECTION */
43fb7d9a 4836 UNGCPRO;
a9757f6a 4837 report_file_errno ("Lseek error", filename, lseek_errno);
43fb7d9a
DL
4838 }
4839 }
efdc16c9 4840
43fb7d9a 4841 UNGCPRO;
570d7624 4842
570d7624
JB
4843 immediate_quit = 1;
4844
561cb8e1 4845 if (STRINGP (start))
f75d7a91 4846 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
570d7624 4847 else if (XINT (start) != XINT (end))
f75d7a91
PE
4848 ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
4849 &annotations, &coding);
69f6e679
RS
4850 else
4851 {
f75d7a91 4852 /* If file was empty, still need to write the annotations. */
c8a6d68a 4853 coding.mode |= CODING_MODE_LAST_BLOCK;
f75d7a91 4854 ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
6fdaa9a0 4855 }
f75d7a91 4856 save_errno = errno;
6fdaa9a0 4857
f75d7a91
PE
4858 if (ok && CODING_REQUIRE_FLUSHING (&coding)
4859 && !(coding.mode & CODING_MODE_LAST_BLOCK))
6fdaa9a0
KH
4860 {
4861 /* We have to flush out a data. */
c8a6d68a 4862 coding.mode |= CODING_MODE_LAST_BLOCK;
f75d7a91 4863 ok = e_write (desc, Qnil, 1, 1, &coding);
69f6e679 4864 save_errno = errno;
570d7624
JB
4865 }
4866
4867 immediate_quit = 0;
4868
94fcd171
PE
4869 /* fsync is not crucial for temporary files. Nor for auto-save
4870 files, since they might lose some work anyway. */
4871 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
cb33c142 4872 {
cbee2131
PE
4873 /* Transfer data and metadata to disk, retrying if interrupted.
4874 fsync can report a write failure here, e.g., due to disk full
4875 under NFS. But ignore EINVAL, which means fsync is not
4876 supported on this file. */
47d7532e
PE
4877 while (fsync (desc) != 0)
4878 if (errno != EINTR)
4879 {
4880 if (errno != EINVAL)
4881 ok = 0, save_errno = errno;
4882 break;
4883 }
cb33c142 4884 }
570d7624 4885
43aac990 4886 modtime = invalid_timespec ();
d6453ce4
PE
4887 if (visiting)
4888 {
4889 if (fstat (desc, &st) == 0)
4890 modtime = get_stat_mtime (&st);
4891 else
4892 ok = 0, save_errno = errno;
4893 }
4894
94fcd171
PE
4895 if (open_and_close_file)
4896 {
4897 /* NFS can report a write failure now. */
4898 if (emacs_close (desc) < 0)
4899 ok = 0, save_errno = errno;
570d7624 4900
94fcd171
PE
4901 /* Discard the unwind protect for close_file_unwind. */
4902 specpdl_ptr = specpdl + count1;
4903 }
67fbc0cb 4904
9fe43ff6
PE
4905 /* Some file systems have a bug where st_mtime is not updated
4906 properly after a write. For example, CIFS might not see the
4907 st_mtime change until after the file is opened again.
4908
4909 Attempt to detect this file system bug, and update MODTIME to the
4910 newer st_mtime if the bug appears to be present. This introduces
4911 a race condition, so to avoid most instances of the race condition
4912 on non-buggy file systems, skip this check if the most recently
4913 encountered non-buggy file system was the current file system.
4914
4915 A race condition can occur if some other process modifies the
4916 file between the fstat above and the fstat below, but the race is
4917 unlikely and a similar race between the last write and the fstat
4918 above cannot possibly be closed anyway. */
4919
43aac990 4920 if (timespec_valid_p (modtime)
9fe43ff6
PE
4921 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
4922 {
21cd50b8 4923 int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
908589fd 4924 if (desc1 >= 0)
9fe43ff6
PE
4925 {
4926 struct stat st1;
4927 if (fstat (desc1, &st1) == 0
4928 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
4929 {
8ea41ea9
PE
4930 /* Use the heuristic if it appears to be valid. With neither
4931 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4932 file, the time stamp won't change. Also, some non-POSIX
4933 systems don't update an empty file's time stamp when
4934 truncating it. Finally, file systems with 100 ns or worse
4935 resolution sometimes seem to have bugs: on a system with ns
4936 resolution, checking ns % 100 incorrectly avoids the heuristic
4937 1% of the time, but the problem should be temporary as we will
4938 try again on the next time stamp. */
4939 bool use_heuristic
4940 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
4941 && st.st_size != 0
43aac990 4942 && modtime.tv_nsec % 100 != 0);
8ea41ea9 4943
43aac990 4944 struct timespec modtime1 = get_stat_mtime (&st1);
8ea41ea9 4945 if (use_heuristic
43aac990 4946 && timespec_cmp (modtime, modtime1) == 0
9fe43ff6
PE
4947 && st.st_size == st1.st_size)
4948 {
4949 timestamp_file_system = st.st_dev;
4950 valid_timestamp_file_system = 1;
4951 }
4952 else
4953 {
4954 st.st_size = st1.st_size;
4955 modtime = modtime1;
4956 }
4957 }
4958 emacs_close (desc1);
4959 }
4960 }
4961
67fbc0cb 4962 /* Call write-region-post-annotation-function. */
294fa707 4963 while (CONSP (Vwrite_region_annotation_buffers))
67fbc0cb
CY
4964 {
4965 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
4966 if (!NILP (Fbuffer_live_p (buf)))
4967 {
4968 Fset_buffer (buf);
4969 if (FUNCTIONP (Vwrite_region_post_annotation_function))
4970 call0 (Vwrite_region_post_annotation_function);
4971 }
4972 Vwrite_region_annotation_buffers
4973 = XCDR (Vwrite_region_annotation_buffers);
4974 }
4975
4976 unbind_to (count, Qnil);
570d7624
JB
4977
4978#ifdef CLASH_DETECTION
94fcd171 4979 if (file_locked)
7204a979 4980 unlock_file (lockname);
570d7624
JB
4981#endif /* CLASH_DETECTION */
4982
4983 /* Do this before reporting IO error
4984 to avoid a "file has changed on disk" warning on
4985 next attempt to save. */
43aac990 4986 if (timespec_valid_p (modtime))
58b963f7 4987 {
d6453ce4 4988 current_buffer->modtime = modtime;
58b963f7
SM
4989 current_buffer->modtime_size = st.st_size;
4990 }
570d7624 4991
f75d7a91 4992 if (! ok)
4e604a5d 4993 report_file_errno ("Write error", filename, save_errno);
570d7624 4994
d6a3cc15 4995 if (visiting)
570d7624 4996 {
95385625 4997 SAVE_MODIFF = MODIFF;
4b4deea2 4998 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
39eb03f1 4999 bset_filename (current_buffer, visit_file);
2ec9db5d 5000 update_mode_lines = 14;
570d7624 5001 }
d6a3cc15 5002 else if (quietly)
6b61353c
KH
5003 {
5004 if (auto_saving
4b4deea2
TT
5005 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5006 BVAR (current_buffer, auto_save_file_name))))
6b61353c
KH
5007 SAVE_MODIFF = MODIFF;
5008
5009 return Qnil;
5010 }
570d7624
JB
5011
5012 if (!auto_saving)
3908c576 5013 message_with_string ((NUMBERP (append)
0c328a0e
RS
5014 ? "Updated %s"
5015 : ! NILP (append)
5016 ? "Added to %s"
5017 : "Wrote %s"),
5018 visit_file, 1);
570d7624
JB
5019
5020 return Qnil;
5021}
ec7adf26 5022\f
d6a3cc15 5023DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
8c1a1077 5024 doc: /* Return t if (car A) is numerically less than (car B). */)
5842a27b 5025 (Lisp_Object a, Lisp_Object b)
d6a3cc15 5026{
ebb99847
BR
5027 Lisp_Object args[2] = { Fcar (a), Fcar (b), };
5028 return Flss (2, args);
d6a3cc15
RS
5029}
5030
5031/* Build the complete list of annotations appropriate for writing out
5032 the text between START and END, by calling all the functions in
6fc6f94b
RS
5033 write-region-annotate-functions and merging the lists they return.
5034 If one of these functions switches to a different buffer, we assume
5035 that buffer contains altered text. Therefore, the caller must
5036 make sure to restore the current buffer in all cases,
5037 as save-excursion would do. */
d6a3cc15
RS
5038
5039static Lisp_Object
971de7fb 5040build_annotations (Lisp_Object start, Lisp_Object end)
d6a3cc15
RS
5041{
5042 Lisp_Object annotations;
5043 Lisp_Object p, res;
5044 struct gcpro gcpro1, gcpro2;
0a20b684 5045 Lisp_Object original_buffer;
f75d7a91
PE
5046 int i;
5047 bool used_global = 0;
0a20b684
RS
5048
5049 XSETBUFFER (original_buffer, current_buffer);
d6a3cc15
RS
5050
5051 annotations = Qnil;
5052 p = Vwrite_region_annotate_functions;
5053 GCPRO2 (annotations, p);
28c3eb5a 5054 while (CONSP (p))
d6a3cc15 5055 {
6fc6f94b 5056 struct buffer *given_buffer = current_buffer;
bd235610
SM
5057 if (EQ (Qt, XCAR (p)) && !used_global)
5058 { /* Use the global value of the hook. */
5059 Lisp_Object arg[2];
5060 used_global = 1;
5061 arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
5062 arg[1] = XCDR (p);
5063 p = Fappend (2, arg);
5064 continue;
5065 }
6fc6f94b 5066 Vwrite_region_annotations_so_far = annotations;
28c3eb5a 5067 res = call2 (XCAR (p), start, end);
6fc6f94b
RS
5068 /* If the function makes a different buffer current,
5069 assume that means this buffer contains altered text to be output.
5070 Reset START and END from the buffer bounds
5071 and discard all previous annotations because they should have
5072 been dealt with by this function. */
5073 if (current_buffer != given_buffer)
5074 {
67fbc0cb
CY
5075 Vwrite_region_annotation_buffers
5076 = Fcons (Fcurrent_buffer (),
5077 Vwrite_region_annotation_buffers);
3cf29f61
RS
5078 XSETFASTINT (start, BEGV);
5079 XSETFASTINT (end, ZV);
6fc6f94b
RS
5080 annotations = Qnil;
5081 }
d6a3cc15
RS
5082 Flength (res); /* Check basic validity of return value */
5083 annotations = merge (annotations, res, Qcar_less_than_car);
28c3eb5a 5084 p = XCDR (p);
d6a3cc15 5085 }
0d420e88
BG
5086
5087 /* Now do the same for annotation functions implied by the file-format */
4b4deea2
TT
5088 if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
5089 p = BVAR (current_buffer, auto_save_file_format);
0d420e88 5090 else
4b4deea2 5091 p = BVAR (current_buffer, file_format);
28c3eb5a 5092 for (i = 0; CONSP (p); p = XCDR (p), ++i)
0d420e88
BG
5093 {
5094 struct buffer *given_buffer = current_buffer;
efdc16c9 5095
0d420e88 5096 Vwrite_region_annotations_so_far = annotations;
532ed661
GM
5097
5098 /* Value is either a list of annotations or nil if the function
5099 has written annotations to a temporary buffer, which is now
5100 current. */
28c3eb5a 5101 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
532ed661 5102 original_buffer, make_number (i));
0d420e88
BG
5103 if (current_buffer != given_buffer)
5104 {
3cf29f61
RS
5105 XSETFASTINT (start, BEGV);
5106 XSETFASTINT (end, ZV);
0d420e88
BG
5107 annotations = Qnil;
5108 }
efdc16c9 5109
532ed661
GM
5110 if (CONSP (res))
5111 annotations = merge (annotations, res, Qcar_less_than_car);
0d420e88 5112 }
6fdaa9a0 5113
236a12f2
SM
5114 UNGCPRO;
5115 return annotations;
5116}
5117
ec7adf26 5118\f
ce51c54c
KH
5119/* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5120 If STRING is nil, POS is the character position in the current buffer.
d6a3cc15 5121 Intersperse with them the annotations from *ANNOT
ce51c54c 5122 which fall within the range of POS to POS + NCHARS,
d6a3cc15
RS
5123 each at its appropriate position.
5124
ec7adf26
RS
5125 We modify *ANNOT by discarding elements as we use them up.
5126
f75d7a91 5127 Return true if successful. */
d6a3cc15 5128
f75d7a91 5129static bool
d311d28c 5130a_write (int desc, Lisp_Object string, ptrdiff_t pos,
f75d7a91 5131 ptrdiff_t nchars, Lisp_Object *annot,
8a2cbd72 5132 struct coding_system *coding)
d6a3cc15
RS
5133{
5134 Lisp_Object tem;
d311d28c
PE
5135 ptrdiff_t nextpos;
5136 ptrdiff_t lastpos = pos + nchars;
d6a3cc15 5137
eb15aa18 5138 while (NILP (*annot) || CONSP (*annot))
d6a3cc15
RS
5139 {
5140 tem = Fcar_safe (Fcar (*annot));
ce51c54c 5141 nextpos = pos - 1;
ec7adf26 5142 if (INTEGERP (tem))
ce51c54c 5143 nextpos = XFASTINT (tem);
ec7adf26
RS
5144
5145 /* If there are no more annotations in this range,
5146 output the rest of the range all at once. */
ce51c54c
KH
5147 if (! (nextpos >= pos && nextpos <= lastpos))
5148 return e_write (desc, string, pos, lastpos, coding);
ec7adf26
RS
5149
5150 /* Output buffer text up to the next annotation's position. */
ce51c54c 5151 if (nextpos > pos)
d6a3cc15 5152 {
f75d7a91
PE
5153 if (!e_write (desc, string, pos, nextpos, coding))
5154 return 0;
ce51c54c 5155 pos = nextpos;
d6a3cc15 5156 }
ec7adf26 5157 /* Output the annotation. */
d6a3cc15
RS
5158 tem = Fcdr (Fcar (*annot));
5159 if (STRINGP (tem))
5160 {
f75d7a91
PE
5161 if (!e_write (desc, tem, 0, SCHARS (tem), coding))
5162 return 0;
d6a3cc15
RS
5163 }
5164 *annot = Fcdr (*annot);
5165 }
f75d7a91 5166 return 1;
d6a3cc15
RS
5167}
5168
f8498081
DA
5169/* Maximum number of characters that the next
5170 function encodes per one loop iteration. */
5171
5172enum { E_WRITE_MAX = 8 * 1024 * 1024 };
6fdaa9a0 5173
ce51c54c
KH
5174/* Write text in the range START and END into descriptor DESC,
5175 encoding them with coding system CODING. If STRING is nil, START
5176 and END are character positions of the current buffer, else they
f75d7a91 5177 are indexes to the string STRING. Return true if successful. */
ec7adf26 5178
f75d7a91 5179static bool
d311d28c 5180e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
8a2cbd72 5181 struct coding_system *coding)
570d7624 5182{
ce51c54c
KH
5183 if (STRINGP (string))
5184 {
db327c7e 5185 start = 0;
8f924df7 5186 end = SCHARS (string);
ce51c54c 5187 }
570d7624 5188
6fdaa9a0
KH
5189 /* We used to have a code for handling selective display here. But,
5190 now it is handled within encode_coding. */
01ca97a2
KH
5191
5192 while (start < end)
570d7624 5193 {
01ca97a2 5194 if (STRINGP (string))
6ad568dd 5195 {
01ca97a2
KH
5196 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5197 if (CODING_REQUIRE_ENCODING (coding))
5198 {
f8498081
DA
5199 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5200
5201 /* Avoid creating huge Lisp string in encode_coding_object. */
5202 if (nchars == E_WRITE_MAX)
5203 coding->raw_destination = 1;
5204
5205 encode_coding_object
5206 (coding, string, start, string_char_to_byte (string, start),
5207 start + nchars, string_char_to_byte (string, start + nchars),
5208 Qt);
01ca97a2
KH
5209 }
5210 else
5211 {
5212 coding->dst_object = string;
5213 coding->consumed_char = SCHARS (string);
5214 coding->produced = SBYTES (string);
5215 }
6ad568dd 5216 }
db327c7e 5217 else
6ad568dd 5218 {
d311d28c
PE
5219 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
5220 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
b4132433 5221
01ca97a2
KH
5222 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5223 if (CODING_REQUIRE_ENCODING (coding))
5224 {
f8498081
DA
5225 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5226
5227 /* Likewise. */
5228 if (nchars == E_WRITE_MAX)
5229 coding->raw_destination = 1;
5230
5231 encode_coding_object
5232 (coding, Fcurrent_buffer (), start, start_byte,
5233 start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
01ca97a2
KH
5234 }
5235 else
5236 {
5237 coding->dst_object = Qnil;
5238 coding->dst_pos_byte = start_byte;
5239 if (start >= GPT || end <= GPT)
5240 {
5241 coding->consumed_char = end - start;
5242 coding->produced = end_byte - start_byte;
5243 }
5244 else
5245 {
5246 coding->consumed_char = GPT - start;
5247 coding->produced = GPT_BYTE - start_byte;
5248 }
5249 }
c185d744 5250 }
01ca97a2
KH
5251
5252 if (coding->produced > 0)
c185d744 5253 {
f8498081
DA
5254 char *buf = (coding->raw_destination ? (char *) coding->destination
5255 : (STRINGP (coding->dst_object)
5256 ? SSDATA (coding->dst_object)
5257 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
4ebbdd67 5258 coding->produced -= emacs_write_sig (desc, buf, coding->produced);
01ca97a2 5259
f8498081
DA
5260 if (coding->raw_destination)
5261 {
5262 /* We're responsible for freeing this, see
5263 encode_coding_object to check why. */
5264 xfree (coding->destination);
5265 coding->raw_destination = 0;
5266 }
01ca97a2 5267 if (coding->produced)
f75d7a91 5268 return 0;
570d7624 5269 }
01ca97a2 5270 start += coding->consumed_char;
c185d744
KH
5271 }
5272
f75d7a91 5273 return 1;
570d7624 5274}
ec7adf26 5275\f
a7ca3326 5276DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
ec1b9b17 5277 Sverify_visited_file_modtime, 0, 1, 0,
8c1a1077 5278 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
6b61353c 5279This means that the file has not been changed since it was visited or saved.
ec1b9b17 5280If BUF is omitted or nil, it defaults to the current buffer.
6b61353c 5281See Info node `(elisp)Modification Time' for more details. */)
5842a27b 5282 (Lisp_Object buf)
570d7624
JB
5283{
5284 struct buffer *b;
5285 struct stat st;
32f4334d 5286 Lisp_Object handler;
b1d1b865 5287 Lisp_Object filename;
43aac990 5288 struct timespec mtime;
570d7624 5289
ec1b9b17
GM
5290 if (NILP (buf))
5291 b = current_buffer;
5292 else
5293 {
5294 CHECK_BUFFER (buf);
5295 b = XBUFFER (buf);
5296 }
570d7624 5297
4b4deea2 5298 if (!STRINGP (BVAR (b, filename))) return Qt;
43aac990 5299 if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
570d7624 5300
32f4334d
RS
5301 /* If the file name has special constructs in it,
5302 call the corresponding file handler. */
4b4deea2 5303 handler = Ffind_file_name_handler (BVAR (b, filename),
49307295 5304 Qverify_visited_file_modtime);
32f4334d 5305 if (!NILP (handler))
09121adc 5306 return call2 (handler, Qverify_visited_file_modtime, buf);
32f4334d 5307
4b4deea2 5308 filename = ENCODE_FILE (BVAR (b, filename));
b1d1b865 5309
dbeed9a6
PE
5310 mtime = (stat (SSDATA (filename), &st) == 0
5311 ? get_stat_mtime (&st)
f0941253 5312 : time_error_value (errno));
43aac990 5313 if (timespec_cmp (mtime, b->modtime) == 0
645c6a30
PE
5314 && (b->modtime_size < 0
5315 || st.st_size == b->modtime_size))
570d7624
JB
5316 return Qt;
5317 return Qnil;
5318}
5319
f5d5eccf 5320DEFUN ("visited-file-modtime", Fvisited_file_modtime,
8c1a1077
PJ
5321 Svisited_file_modtime, 0, 0, 0,
5322 doc: /* Return the current buffer's recorded visited file modification time.
d35af63c 5323The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
1c4d7f3d
LMI
5324`file-attributes' returns. If the current buffer has no recorded file
5325modification time, this function returns 0. If the visited file
954b166e 5326doesn't exist, return -1.
6b61353c 5327See Info node `(elisp)Modification Time' for more details. */)
5842a27b 5328 (void)
f5d5eccf 5329{
43aac990 5330 int ns = current_buffer->modtime.tv_nsec;
954b166e
PE
5331 if (ns < 0)
5332 return make_number (UNKNOWN_MODTIME_NSECS - ns);
d35af63c 5333 return make_lisp_time (current_buffer->modtime);
f5d5eccf
RS
5334}
5335
570d7624 5336DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
8c1a1077
PJ
5337 Sset_visited_file_modtime, 0, 1, 0,
5338 doc: /* Update buffer's recorded modification time from the visited file's time.
5339Useful if the buffer was not read from the file normally
5340or if the file itself has been changed for some known benign reason.
5341An argument specifies the modification time value to use
5342\(instead of that of the visited file), in the form of a list
954b166e
PE
5343\(HIGH LOW USEC PSEC) or an integer flag as returned by
5344`visited-file-modtime'. */)
5345 (Lisp_Object time_flag)
570d7624 5346{
954b166e 5347 if (!NILP (time_flag))
58b963f7 5348 {
43aac990 5349 struct timespec mtime;
954b166e
PE
5350 if (INTEGERP (time_flag))
5351 {
5352 CHECK_RANGED_INTEGER (time_flag, -1, 0);
43aac990 5353 mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
954b166e
PE
5354 }
5355 else
5356 mtime = lisp_time_argument (time_flag);
5357
5358 current_buffer->modtime = mtime;
58b963f7
SM
5359 current_buffer->modtime_size = -1;
5360 }
f5d5eccf
RS
5361 else
5362 {
5363 register Lisp_Object filename;
5364 struct stat st;
5365 Lisp_Object handler;
570d7624 5366
4b4deea2 5367 filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
32f4334d 5368
f5d5eccf
RS
5369 /* If the file name has special constructs in it,
5370 call the corresponding file handler. */
49307295 5371 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
f5d5eccf 5372 if (!NILP (handler))
caf3c431 5373 /* The handler can find the file name the same way we did. */
76c881b0 5374 return call2 (handler, Qset_visited_file_modtime, Qnil);
b1d1b865
RS
5375
5376 filename = ENCODE_FILE (filename);
5377
42a5b22f 5378 if (stat (SSDATA (filename), &st) >= 0)
58b963f7 5379 {
d35af63c 5380 current_buffer->modtime = get_stat_mtime (&st);
58b963f7
SM
5381 current_buffer->modtime_size = st.st_size;
5382 }
f5d5eccf 5383 }
570d7624
JB
5384
5385 return Qnil;
5386}
5387\f
f14b7e14 5388static Lisp_Object
f839df0c 5389auto_save_error (Lisp_Object error_val)
570d7624 5390{
d7f31e22 5391 Lisp_Object args[3], msg;
b09cca6a 5392 int i;
d7f31e22 5393 struct gcpro gcpro1;
efdc16c9 5394
ca730bf0
CY
5395 auto_save_error_occurred = 1;
5396
385ed61f 5397 ring_bell (XFRAME (selected_frame));
efdc16c9 5398
d7f31e22 5399 args[0] = build_string ("Auto-saving %s: %s");
4b4deea2 5400 args[1] = BVAR (current_buffer, name);
f839df0c 5401 args[2] = Ferror_message_string (error_val);
d7f31e22
GM
5402 msg = Fformat (3, args);
5403 GCPRO1 (msg);
d7f31e22
GM
5404
5405 for (i = 0; i < 3; ++i)
5406 {
5407 if (i == 0)
b09cca6a 5408 message3 (msg);
d7f31e22 5409 else
b09cca6a 5410 message3_nolog (msg);
d7f31e22
GM
5411 Fsleep_for (make_number (1), Qnil);
5412 }
5413
5414 UNGCPRO;
570d7624
JB
5415 return Qnil;
5416}
5417
f14b7e14 5418static Lisp_Object
971de7fb 5419auto_save_1 (void)
570d7624 5420{
570d7624 5421 struct stat st;
d4a42098
KS
5422 Lisp_Object modes;
5423
5424 auto_save_mode_bits = 0666;
570d7624
JB
5425
5426 /* Get visited file's mode to become the auto save file's mode. */
4b4deea2 5427 if (! NILP (BVAR (current_buffer, filename)))
d4a42098 5428 {
4b4deea2 5429 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
d4a42098 5430 /* But make sure we can overwrite it later! */
18c52557 5431 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
ce2fe65a
AS
5432 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5433 INTEGERP (modes))
d4a42098 5434 /* Remote files don't cooperate with stat. */
18c52557 5435 auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
d4a42098 5436 }
570d7624
JB
5437
5438 return
4b4deea2 5439 Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
699b53bc
CY
5440 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5441 Qnil, Qnil);
570d7624
JB
5442}
5443
27e498e6
PE
5444struct auto_save_unwind
5445{
5446 FILE *stream;
5447 bool auto_raise;
5448};
410ed5c3 5449
27e498e6
PE
5450static void
5451do_auto_save_unwind (void *arg)
e54d3b5d 5452{
27e498e6
PE
5453 struct auto_save_unwind *p = arg;
5454 FILE *stream = p->stream;
5455 minibuffer_auto_raise = p->auto_raise;
3be3c08e 5456 auto_saving = 0;
fff7e982 5457 if (stream != NULL)
aab12958 5458 {
4d7e6e51 5459 block_input ();
aab12958 5460 fclose (stream);
4d7e6e51 5461 unblock_input ();
aab12958 5462 }
a8c828be
RS
5463}
5464
5794dd61 5465static Lisp_Object
971de7fb 5466do_auto_save_make_dir (Lisp_Object dir)
5794dd61 5467{
09450bae 5468 Lisp_Object result;
26816cbf 5469
09450bae
PE
5470 auto_saving_dir_umask = 077;
5471 result = call2 (Qmake_directory, dir, Qt);
5472 auto_saving_dir_umask = 0;
5473 return result;
5794dd61
RS
5474}
5475
5476static Lisp_Object
971de7fb 5477do_auto_save_eh (Lisp_Object ignore)
5794dd61 5478{
09450bae 5479 auto_saving_dir_umask = 0;
5794dd61
RS
5480 return Qnil;
5481}
5482
a7ca3326 5483DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
8c1a1077
PJ
5484 doc: /* Auto-save all buffers that need it.
5485This is all buffers that have auto-saving enabled
5486and are changed since last auto-saved.
5487Auto-saving writes the buffer into a file
5488so that your editing is not lost if the system crashes.
5489This file is not the file you visited; that changes only when you save.
5490Normally we run the normal hook `auto-save-hook' before saving.
5491
5492A non-nil NO-MESSAGE argument means do not print any message if successful.
5493A non-nil CURRENT-ONLY argument means save only current buffer. */)
5842a27b 5494 (Lisp_Object no_message, Lisp_Object current_only)
570d7624
JB
5495{
5496 struct buffer *old = current_buffer, *b;
dee091a3 5497 Lisp_Object tail, buf, hook;
f75d7a91 5498 bool auto_saved = 0;
f14b1c68 5499 int do_handled_files;
ff4c9993 5500 Lisp_Object oquit;
fff7e982 5501 FILE *stream = NULL;
d311d28c 5502 ptrdiff_t count = SPECPDL_INDEX ();
f75d7a91 5503 bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
fce31d69 5504 bool old_message_p = 0;
27e498e6 5505 struct auto_save_unwind auto_save_unwind;
d57563b6 5506 struct gcpro gcpro1, gcpro2;
38da540d
RS
5507
5508 if (max_specpdl_size < specpdl_size + 40)
5509 max_specpdl_size = specpdl_size + 40;
5510
5511 if (minibuf_level)
5512 no_message = Qt;
5513
5794dd61
RS
5514 if (NILP (no_message))
5515 {
5516 old_message_p = push_message ();
27e498e6 5517 record_unwind_protect_void (pop_message_unwind);
5794dd61 5518 }
efdc16c9 5519
ff4c9993
RS
5520 /* Ordinarily don't quit within this function,
5521 but don't make it impossible to quit (in case we get hung in I/O). */
5522 oquit = Vquit_flag;
5523 Vquit_flag = Qnil;
570d7624
JB
5524
5525 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5526 point to non-strings reached from Vbuffer_alist. */
5527
dee091a3 5528 hook = intern ("auto-save-hook");
afbfe143 5529 safe_run_hooks (hook);
570d7624 5530
e54d3b5d
RS
5531 if (STRINGP (Vauto_save_list_file_name))
5532 {
0894672f 5533 Lisp_Object listfile;
efdc16c9 5534
258fd2cb 5535 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
0894672f
GM
5536
5537 /* Don't try to create the directory when shutting down Emacs,
5538 because creating the directory might signal an error, and
5539 that would leave Emacs in a strange state. */
5540 if (!NILP (Vrun_hooks))
5541 {
5542 Lisp_Object dir;
d57563b6
RS
5543 dir = Qnil;
5544 GCPRO2 (dir, listfile);
0894672f
GM
5545 dir = Ffile_name_directory (listfile);
5546 if (NILP (Ffile_directory_p (dir)))
5794dd61 5547 internal_condition_case_1 (do_auto_save_make_dir,
09450bae 5548 dir, Qt,
5794dd61 5549 do_auto_save_eh);
d57563b6 5550 UNGCPRO;
0894672f 5551 }
efdc16c9 5552
406af475 5553 stream = emacs_fopen (SSDATA (listfile), "w");
1b335d29 5554 }
199607e4 5555
27e498e6
PE
5556 auto_save_unwind.stream = stream;
5557 auto_save_unwind.auto_raise = minibuffer_auto_raise;
5558 record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
a8c828be 5559 minibuffer_auto_raise = 0;
3be3c08e 5560 auto_saving = 1;
ca730bf0 5561 auto_save_error_occurred = 0;
3be3c08e 5562
6b61353c
KH
5563 /* On first pass, save all files that don't have handlers.
5564 On second pass, save all files that do have handlers.
5565
5566 If Emacs is crashing, the handlers may tweak what is causing
5567 Emacs to crash in the first place, and it would be a shame if
5568 Emacs failed to autosave perfectly ordinary files because it
5569 couldn't handle some ange-ftp'd file. */
5570
f14b1c68 5571 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
8f3a2c26 5572 FOR_EACH_LIVE_BUFFER (tail, buf)
f14b1c68 5573 {
f14b1c68 5574 b = XBUFFER (buf);
199607e4 5575
e54d3b5d 5576 /* Record all the buffers that have auto save mode
258fd2cb
RS
5577 in the special file that lists them. For each of these buffers,
5578 Record visited name (if any) and auto save name. */
4b4deea2 5579 if (STRINGP (BVAR (b, auto_save_file_name))
1b335d29 5580 && stream != NULL && do_handled_files == 0)
e54d3b5d 5581 {
4d7e6e51 5582 block_input ();
4b4deea2 5583 if (!NILP (BVAR (b, filename)))
258fd2cb 5584 {
4b4deea2
TT
5585 fwrite (SDATA (BVAR (b, filename)), 1,
5586 SBYTES (BVAR (b, filename)), stream);
258fd2cb 5587 }
1b335d29 5588 putc ('\n', stream);
4b4deea2
TT
5589 fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
5590 SBYTES (BVAR (b, auto_save_file_name)), stream);
1b335d29 5591 putc ('\n', stream);
4d7e6e51 5592 unblock_input ();
e54d3b5d 5593 }
17857782 5594
f14b1c68
JB
5595 if (!NILP (current_only)
5596 && b != current_buffer)
5597 continue;
e54d3b5d 5598
95385625
RS
5599 /* Don't auto-save indirect buffers.
5600 The base buffer takes care of it. */
5601 if (b->base_buffer)
5602 continue;
5603
f14b1c68
JB
5604 /* Check for auto save enabled
5605 and file changed since last auto save
5606 and file changed since last real save. */
4b4deea2 5607 if (STRINGP (BVAR (b, auto_save_file_name))
95385625 5608 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
0b5397c2 5609 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
82c2d839 5610 /* -1 means we've turned off autosaving for a while--see below. */
4b4deea2 5611 && XINT (BVAR (b, save_length)) >= 0
f14b1c68 5612 && (do_handled_files
4b4deea2 5613 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
49307295 5614 Qwrite_region))))
f14b1c68 5615 {
43aac990
PE
5616 struct timespec before_time = current_timespec ();
5617 struct timespec after_time;
b60247d9
RS
5618
5619 /* If we had a failure, don't try again for 20 minutes. */
d311d28c 5620 if (b->auto_save_failure_time > 0
43aac990 5621 && before_time.tv_sec - b->auto_save_failure_time < 1200)
b60247d9
RS
5622 continue;
5623
090101cf
CY
5624 set_buffer_internal (b);
5625 if (NILP (Vauto_save_include_big_deletions)
4b4deea2 5626 && (XFASTINT (BVAR (b, save_length)) * 10
4be941e3 5627 > (BUF_Z (b) - BUF_BEG (b)) * 13)
f14b1c68
JB
5628 /* A short file is likely to change a large fraction;
5629 spare the user annoying messages. */
4b4deea2 5630 && XFASTINT (BVAR (b, save_length)) > 5000
f14b1c68 5631 /* These messages are frequent and annoying for `*mail*'. */
4b4deea2 5632 && !EQ (BVAR (b, filename), Qnil)
f14b1c68
JB
5633 && NILP (no_message))
5634 {
5635 /* It has shrunk too much; turn off auto-saving here. */
a8c828be 5636 minibuffer_auto_raise = orig_minibuffer_auto_raise;
fd91d0d4 5637 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
4b4deea2 5638 BVAR (b, name), 1);
a8c828be 5639 minibuffer_auto_raise = 0;
82c2d839
RS
5640 /* Turn off auto-saving until there's a real save,
5641 and prevent any more warnings. */
4b4deea2 5642 XSETINT (BVAR (b, save_length), -1);
f14b1c68
JB
5643 Fsleep_for (make_number (1), Qnil);
5644 continue;
5645 }
f14b1c68
JB
5646 if (!auto_saved && NILP (no_message))
5647 message1 ("Auto-saving...");
5648 internal_condition_case (auto_save_1, Qt, auto_save_error);
f75d7a91 5649 auto_saved = 1;
0b5397c2 5650 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
4b4deea2 5651 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
f14b1c68 5652 set_buffer_internal (old);
b60247d9 5653
43aac990 5654 after_time = current_timespec ();
b60247d9
RS
5655
5656 /* If auto-save took more than 60 seconds,
5657 assume it was an NFS failure that got a timeout. */
43aac990
PE
5658 if (after_time.tv_sec - before_time.tv_sec > 60)
5659 b->auto_save_failure_time = after_time.tv_sec;
f14b1c68
JB
5660 }
5661 }
570d7624 5662
b67f2ca5
RS
5663 /* Prevent another auto save till enough input events come in. */
5664 record_auto_save ();
570d7624 5665
17857782 5666 if (auto_saved && NILP (no_message))
f05b275b 5667 {
5794dd61 5668 if (old_message_p)
31f3d831 5669 {
5794dd61
RS
5670 /* If we are going to restore an old message,
5671 give time to read ours. */
83f8d903 5672 sit_for (make_number (1), 0, 0);
c71106e5 5673 restore_message ();
31f3d831 5674 }
ca730bf0 5675 else if (!auto_save_error_occurred)
31e31a15
CY
5676 /* Don't overwrite the error message if an error occurred.
5677 If we displayed a message and then restored a state
5794dd61 5678 with no message, leave a "done" message on the screen. */
f05b275b
KH
5679 message1 ("Auto-saving...done");
5680 }
570d7624 5681
ff4c9993
RS
5682 Vquit_flag = oquit;
5683
5794dd61 5684 /* This restores the message-stack status. */
e54d3b5d 5685 unbind_to (count, Qnil);
570d7624
JB
5686 return Qnil;
5687}
5688
5689DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
8c1a1077
PJ
5690 Sset_buffer_auto_saved, 0, 0, 0,
5691 doc: /* Mark current buffer as auto-saved with its current text.
5692No auto-save file will be written until the buffer changes again. */)
5842a27b 5693 (void)
570d7624 5694{
0b5397c2
SM
5695 /* FIXME: This should not be called in indirect buffers, since
5696 they're not autosaved. */
5697 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4b4deea2 5698 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
d311d28c 5699 current_buffer->auto_save_failure_time = 0;
b60247d9
RS
5700 return Qnil;
5701}
5702
5703DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
8c1a1077
PJ
5704 Sclear_buffer_auto_save_failure, 0, 0, 0,
5705 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5842a27b 5706 (void)
b60247d9 5707{
d311d28c 5708 current_buffer->auto_save_failure_time = 0;
570d7624
JB
5709 return Qnil;
5710}
5711
5712DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
8c1a1077 5713 0, 0, 0,
68780e2a
RS
5714 doc: /* Return t if current buffer has been auto-saved recently.
5715More precisely, if it has been auto-saved since last read from or saved
5716in the visited file. If the buffer has no visited file,
5717then any auto-save counts as "recent". */)
5842a27b 5718 (void)
570d7624 5719{
0b5397c2
SM
5720 /* FIXME: maybe we should return nil for indirect buffers since
5721 they're never autosaved. */
5722 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
570d7624
JB
5723}
5724\f
5725/* Reading and completing file names */
6e710ae5 5726
88208bb8
JD
5727DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5728 Snext_read_file_uses_dialog_p, 0, 0, 0,
5729 doc: /* Return t if a call to `read-file-name' will use a dialog.
5730The return value is only relevant for a call to `read-file-name' that happens
1a0de25c 5731before any other event (mouse or keypress) is handled. */)
5842a27b 5732 (void)
88208bb8 5733{
d7e642cc
JD
5734#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5735 || defined (HAVE_NS)
88208bb8
JD
5736 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5737 && use_dialog_box
5738 && use_file_dialog
7452b7bd 5739 && window_system_available (SELECTED_FRAME ()))
88208bb8
JD
5740 return Qt;
5741#endif
5742 return Qnil;
5743}
d4a42098 5744
dbd50d4b 5745Lisp_Object
971de7fb 5746Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object initial, Lisp_Object predicate)
570d7624 5747{
fd4ead52 5748 struct gcpro gcpro1;
dbd50d4b 5749 Lisp_Object args[7];
a79485af 5750
71e1f69d 5751 GCPRO1 (default_filename);
dbd50d4b
SM
5752 args[0] = intern ("read-file-name");
5753 args[1] = prompt;
5754 args[2] = dir;
5755 args[3] = default_filename;
5756 args[4] = mustmatch;
5757 args[5] = initial;
5758 args[6] = predicate;
5759 RETURN_UNGCPRO (Ffuncall (7, args));
570d7624 5760}
9c856db9 5761
570d7624 5762\f
9fe43ff6
PE
5763void
5764init_fileio (void)
5765{
5766 valid_timestamp_file_system = 0;
1db72ad3
RF
5767
5768 /* fsync can be a significant performance hit. Often it doesn't
5769 suffice to make the file-save operation survive a crash. For
5770 batch scripts, which are typically part of larger shell commands
5771 that don't fsync other files, its effect on performance can be
5772 significant so its utility is particularly questionable.
5773 Hence, for now by default fsync is used only when interactive.
5774
5775 For more on why fsync often fails to work on today's hardware, see:
5776 Zheng M et al. Understanding the robustness of SSDs under power fault.
5777 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5778 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5779
5780 For more on why fsync does not suffice even if it works properly, see:
5781 Roche X. Necessary step(s) to synchronize filename operations on disk.
5782 Austin Group Defect 672, 2013-03-19
5783 http://austingroupbugs.net/view.php?id=672 */
5784 write_region_inhibit_fsync = noninteractive;
9fe43ff6
PE
5785}
5786
dfcf069d 5787void
971de7fb 5788syms_of_fileio (void)
570d7624 5789{
cd3520a4
JB
5790 DEFSYM (Qoperations, "operations");
5791 DEFSYM (Qexpand_file_name, "expand-file-name");
5792 DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
5793 DEFSYM (Qdirectory_file_name, "directory-file-name");
5794 DEFSYM (Qfile_name_directory, "file-name-directory");
5795 DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
5796 DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
5797 DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
5798 DEFSYM (Qcopy_file, "copy-file");
5799 DEFSYM (Qmake_directory_internal, "make-directory-internal");
5800 DEFSYM (Qmake_directory, "make-directory");
5801 DEFSYM (Qdelete_directory_internal, "delete-directory-internal");
5802 DEFSYM (Qdelete_file, "delete-file");
5803 DEFSYM (Qrename_file, "rename-file");
5804 DEFSYM (Qadd_name_to_file, "add-name-to-file");
5805 DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
5806 DEFSYM (Qfile_exists_p, "file-exists-p");
5807 DEFSYM (Qfile_executable_p, "file-executable-p");
5808 DEFSYM (Qfile_readable_p, "file-readable-p");
5809 DEFSYM (Qfile_writable_p, "file-writable-p");
5810 DEFSYM (Qfile_symlink_p, "file-symlink-p");
5811 DEFSYM (Qaccess_file, "access-file");
5812 DEFSYM (Qfile_directory_p, "file-directory-p");
5813 DEFSYM (Qfile_regular_p, "file-regular-p");
5814 DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
5815 DEFSYM (Qfile_modes, "file-modes");
5816 DEFSYM (Qset_file_modes, "set-file-modes");
5817 DEFSYM (Qset_file_times, "set-file-times");
5818 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5819 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
7c3d167f
RF
5820 DEFSYM (Qfile_acl, "file-acl");
5821 DEFSYM (Qset_file_acl, "set-file-acl");
cd3520a4
JB
5822 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5823 DEFSYM (Qinsert_file_contents, "insert-file-contents");
9dbda100 5824 DEFSYM (Qchoose_write_coding_system, "choose-write-coding-system");
cd3520a4
JB
5825 DEFSYM (Qwrite_region, "write-region");
5826 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5827 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
5828 DEFSYM (Qauto_save_coding, "auto-save-coding");
5829
5830 DEFSYM (Qfile_name_history, "file-name-history");
642ef245 5831 Fset (Qfile_name_history, Qnil);
15c65264 5832
cd3520a4
JB
5833 DEFSYM (Qfile_error, "file-error");
5834 DEFSYM (Qfile_already_exists, "file-already-exists");
5835 DEFSYM (Qfile_date_error, "file-date-error");
86dfb7a8 5836 DEFSYM (Qfile_notify_error, "file-notify-error");
cd3520a4 5837 DEFSYM (Qexcl, "excl");
570d7624 5838
29208e82 5839 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
fb7ada5f 5840 doc: /* Coding system for encoding file names.
7df14908
EZ
5841If it is nil, `default-file-name-coding-system' (which see) is used.
5842
5843On MS-Windows, the value of this variable is largely ignored if
6630df25
EZ
5844\`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5845behaves as if file names were encoded in `utf-8'. */);
b1d1b865
RS
5846 Vfile_name_coding_system = Qnil;
5847
cd913586 5848 DEFVAR_LISP ("default-file-name-coding-system",
29208e82 5849 Vdefault_file_name_coding_system,
8c1a1077 5850 doc: /* Default coding system for encoding file names.
346ebf53 5851This variable is used only when `file-name-coding-system' is nil.
8c1a1077 5852
346ebf53 5853This variable is set/changed by the command `set-language-environment'.
8c1a1077 5854User should not set this variable manually,
346ebf53 5855instead use `file-name-coding-system' to get a constant encoding
7df14908
EZ
5856of file names regardless of the current language environment.
5857
5858On MS-Windows, the value of this variable is largely ignored if
6630df25
EZ
5859\`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5860behaves as if file names were encoded in `utf-8'. */);
cd913586
KH
5861 Vdefault_file_name_coding_system = Qnil;
5862
cd3520a4
JB
5863 DEFSYM (Qformat_decode, "format-decode");
5864 DEFSYM (Qformat_annotate_function, "format-annotate-function");
5865 DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
5866 DEFSYM (Qcar_less_than_car, "car-less-than-car");
d6a3cc15 5867
570d7624 5868 Fput (Qfile_error, Qerror_conditions,
d67b4f80 5869 Fpurecopy (list2 (Qfile_error, Qerror)));
570d7624 5870 Fput (Qfile_error, Qerror_message,
2a0213a6 5871 build_pure_c_string ("File error"));
570d7624
JB
5872
5873 Fput (Qfile_already_exists, Qerror_conditions,
d67b4f80 5874 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
570d7624 5875 Fput (Qfile_already_exists, Qerror_message,
2a0213a6 5876 build_pure_c_string ("File already exists"));
570d7624 5877
c0b7b21c 5878 Fput (Qfile_date_error, Qerror_conditions,
d67b4f80 5879 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
c0b7b21c 5880 Fput (Qfile_date_error, Qerror_message,
2a0213a6 5881 build_pure_c_string ("Cannot set file date"));
c0b7b21c 5882
86dfb7a8
MA
5883 Fput (Qfile_notify_error, Qerror_conditions,
5884 Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
5885 Fput (Qfile_notify_error, Qerror_message,
5886 build_pure_c_string ("File notification error"));
5887
29208e82 5888 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
a59225b1
CY
5889 doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5890If a file name matches REGEXP, all I/O on that file is done by calling
5891HANDLER. If a file name matches more than one handler, the handler
5892whose match starts last in the file name gets precedence. The
5893function `find-file-name-handler' checks this list for a handler for
5894its argument.
5895
5896HANDLER should be a function. The first argument given to it is the
5897name of the I/O primitive to be handled; the remaining arguments are
5898the arguments that were passed to that primitive. For example, if you
5899do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5900HANDLER is called like this:
5901
5902 (funcall HANDLER 'file-exists-p FILENAME)
5903
5904Note that HANDLER must be able to handle all I/O primitives; if it has
5905nothing special to do for a primitive, it should reinvoke the
5906primitive to handle the operation \"the usual way\".
5907See Info node `(elisp)Magic File Names' for more details. */);
09121adc
RS
5908 Vfile_name_handler_alist = Qnil;
5909
0414b394 5910 DEFVAR_LISP ("set-auto-coding-function",
29208e82 5911 Vset_auto_coding_function,
8c1a1077
PJ
5912 doc: /* If non-nil, a function to call to decide a coding system of file.
5913Two arguments are passed to this function: the file name
5914and the length of a file contents following the point.
5915This function should return a coding system to decode the file contents.
5916It should check the file name against `auto-coding-alist'.
5917If no coding system is decided, it should check a coding system
5918specified in the heading lines with the format:
5919 -*- ... coding: CODING-SYSTEM; ... -*-
5920or local variable spec of the tailing lines with `coding:' tag. */);
0414b394 5921 Vset_auto_coding_function = Qnil;
c9e82392 5922
29208e82 5923 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
8c1a1077 5924 doc: /* A list of functions to be called at the end of `insert-file-contents'.
0cf9f5b5
RS
5925Each is passed one argument, the number of characters inserted,
5926with point at the start of the inserted text. Each function
5927should leave point the same, and return the new character count.
cf6d2357
RS
5928If `insert-file-contents' is intercepted by a handler from
5929`file-name-handler-alist', that handler is responsible for calling the
5930functions in `after-insert-file-functions' if appropriate. */);
d6a3cc15
RS
5931 Vafter_insert_file_functions = Qnil;
5932
29208e82 5933 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
8c1a1077
PJ
5934 doc: /* A list of functions to be called at the start of `write-region'.
5935Each is passed two arguments, START and END as for `write-region'.
5936These are usually two numbers but not always; see the documentation
5937for `write-region'. The function should return a list of pairs
5938of the form (POSITION . STRING), consisting of strings to be effectively
5939inserted at the specified positions of the file being written (1 means to
5940insert before the first byte written). The POSITIONs must be sorted into
67fbc0cb
CY
5941increasing order.
5942
5943If there are several annotation functions, the lists returned by these
5944functions are merged destructively. As each annotation function runs,
5945the variable `write-region-annotations-so-far' contains a list of all
5946annotations returned by previous annotation functions.
5947
5948An annotation function can return with a different buffer current.
5949Doing so removes the annotations returned by previous functions, and
5950resets START and END to `point-min' and `point-max' of the new buffer.
5951
5952After `write-region' completes, Emacs calls the function stored in
5953`write-region-post-annotation-function', once for each buffer that was
5954current when building the annotations (i.e., at least once), with that
5955buffer current. */);
d6a3cc15 5956 Vwrite_region_annotate_functions = Qnil;
cd3520a4 5957 DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
d6a3cc15 5958
67fbc0cb 5959 DEFVAR_LISP ("write-region-post-annotation-function",
29208e82 5960 Vwrite_region_post_annotation_function,
67fbc0cb
CY
5961 doc: /* Function to call after `write-region' completes.
5962The function is called with no arguments. If one or more of the
5963annotation functions in `write-region-annotate-functions' changed the
5964current buffer, the function stored in this variable is called for
5965each of those additional buffers as well, in addition to the original
5966buffer. The relevant buffer is current during each function call. */);
5967 Vwrite_region_post_annotation_function = Qnil;
5968 staticpro (&Vwrite_region_annotation_buffers);
5969
6fc6f94b 5970 DEFVAR_LISP ("write-region-annotations-so-far",
29208e82 5971 Vwrite_region_annotations_so_far,
8c1a1077
PJ
5972 doc: /* When an annotation function is called, this holds the previous annotations.
5973These are the annotations made by other annotation functions
5974that were already called. See also `write-region-annotate-functions'. */);
6fc6f94b
RS
5975 Vwrite_region_annotations_so_far = Qnil;
5976
29208e82 5977 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
8c1a1077
PJ
5978 doc: /* A list of file name handlers that temporarily should not be used.
5979This applies only to the operation `inhibit-file-name-operation'. */);
82c2d839
RS
5980 Vinhibit_file_name_handlers = Qnil;
5981
29208e82 5982 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
8c1a1077 5983 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
a65970a0
RS
5984 Vinhibit_file_name_operation = Qnil;
5985
29208e82 5986 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
8c1a1077
PJ
5987 doc: /* File name in which we write a list of all auto save file names.
5988This variable is initialized automatically from `auto-save-list-file-prefix'
a2458031 5989shortly after Emacs reads your init file, if you have not yet given it
8c1a1077 5990a non-nil value. */);
e54d3b5d
RS
5991 Vauto_save_list_file_name = Qnil;
5992
29208e82 5993 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
699b53bc
CY
5994 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5995Normally auto-save files are written under other names. */);
5996 Vauto_save_visited_file_name = Qnil;
5997
29208e82 5998 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
090101cf
CY
5999 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
6000If nil, deleting a substantial portion of the text disables auto-save
6001in the buffer; this is the default behavior, because the auto-save
6002file is usually more useful if it contains the deleted text. */);
6003 Vauto_save_include_big_deletions = Qnil;
6004
29208e82 6005 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
fb7ada5f 6006 doc: /* Non-nil means don't call fsync in `write-region'.
e3f509dd 6007This variable affects calls to `write-region' as well as save commands.
cbee2131
PE
6008Setting this to nil may avoid data loss if the system loses power or
6009the operating system crashes. */);
1db72ad3 6010 write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */
ccf61795 6011
29208e82 6012 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
6cf29fe8 6013 doc: /* Specifies whether to use the system's trash can.
f1a5d776
CY
6014When non-nil, certain file deletion commands use the function
6015`move-file-to-trash' instead of deleting files outright.
6016This includes interactive calls to `delete-file' and
6017`delete-directory' and the Dired deletion commands. */);
6cf29fe8 6018 delete_by_moving_to_trash = 0;
d67b4f80 6019 Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
cd3520a4
JB
6020
6021 DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
6022 DEFSYM (Qcopy_directory, "copy-directory");
6023 DEFSYM (Qdelete_directory, "delete-directory");
ee041f2d 6024 DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
6cf29fe8 6025
642ef245 6026 defsubr (&Sfind_file_name_handler);
570d7624
JB
6027 defsubr (&Sfile_name_directory);
6028 defsubr (&Sfile_name_nondirectory);
642ef245 6029 defsubr (&Sunhandled_file_name_directory);
570d7624
JB
6030 defsubr (&Sfile_name_as_directory);
6031 defsubr (&Sdirectory_file_name);
6032 defsubr (&Smake_temp_name);
6033 defsubr (&Sexpand_file_name);
6034 defsubr (&Ssubstitute_in_file_name);
6035 defsubr (&Scopy_file);
9bbe01fb 6036 defsubr (&Smake_directory_internal);
9d8f3bd9 6037 defsubr (&Sdelete_directory_internal);
570d7624
JB
6038 defsubr (&Sdelete_file);
6039 defsubr (&Srename_file);
6040 defsubr (&Sadd_name_to_file);
570d7624 6041 defsubr (&Smake_symbolic_link);
570d7624
JB
6042 defsubr (&Sfile_name_absolute_p);
6043 defsubr (&Sfile_exists_p);
6044 defsubr (&Sfile_executable_p);
6045 defsubr (&Sfile_readable_p);
6046 defsubr (&Sfile_writable_p);
1f8653eb 6047 defsubr (&Saccess_file);
570d7624
JB
6048 defsubr (&Sfile_symlink_p);
6049 defsubr (&Sfile_directory_p);
b72dea2a 6050 defsubr (&Sfile_accessible_directory_p);
f793dc6c 6051 defsubr (&Sfile_regular_p);
570d7624
JB
6052 defsubr (&Sfile_modes);
6053 defsubr (&Sset_file_modes);
819da85b 6054 defsubr (&Sset_file_times);
574c05e2 6055 defsubr (&Sfile_selinux_context);
7c3d167f
RF
6056 defsubr (&Sfile_acl);
6057 defsubr (&Sset_file_acl);
574c05e2 6058 defsubr (&Sset_file_selinux_context);
c24e9a53
RS
6059 defsubr (&Sset_default_file_modes);
6060 defsubr (&Sdefault_file_modes);
570d7624
JB
6061 defsubr (&Sfile_newer_than_file_p);
6062 defsubr (&Sinsert_file_contents);
9dbda100 6063 defsubr (&Schoose_write_coding_system);
570d7624 6064 defsubr (&Swrite_region);
d6a3cc15 6065 defsubr (&Scar_less_than_car);
570d7624 6066 defsubr (&Sverify_visited_file_modtime);
f5d5eccf 6067 defsubr (&Svisited_file_modtime);
570d7624
JB
6068 defsubr (&Sset_visited_file_modtime);
6069 defsubr (&Sdo_auto_save);
6070 defsubr (&Sset_buffer_auto_saved);
b60247d9 6071 defsubr (&Sclear_buffer_auto_save_failure);
570d7624
JB
6072 defsubr (&Srecent_auto_save_p);
6073
88208bb8 6074 defsubr (&Snext_read_file_uses_dialog_p);
85ffea93 6075
697c17a2 6076#ifdef HAVE_SYNC
85ffea93 6077 defsubr (&Sunix_sync);
483a2e10 6078#endif
570d7624 6079}