* lisp/mail/footnote.el (footnote-align-to-fn-text): New config var
[emacs.git] / src / fileio.c
blob77ff7d8b6e7e472c4ef1302afd39ead3ac6df91e
1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2017 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <limits.h>
22 #include <fcntl.h>
23 #include "sysstdio.h"
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <unistd.h>
28 #ifdef DARWIN_OS
29 #include <sys/attr.h>
30 #endif
32 #ifdef HAVE_PWD_H
33 #include <pwd.h>
34 #endif
36 #include <errno.h>
38 #ifdef HAVE_LIBSELINUX
39 #include <selinux/selinux.h>
40 #include <selinux/context.h>
41 #endif
43 #if USE_ACL && defined HAVE_ACL_SET_FILE
44 #include <sys/acl.h>
45 #endif
47 #include <c-ctype.h>
49 #include "lisp.h"
50 #include "composite.h"
51 #include "character.h"
52 #include "buffer.h"
53 #include "coding.h"
54 #include "window.h"
55 #include "blockinput.h"
56 #include "region-cache.h"
57 #include "frame.h"
59 #ifdef HAVE_LINUX_FS_H
60 # include <sys/ioctl.h>
61 # include <linux/fs.h>
62 #endif
64 #ifdef WINDOWSNT
65 #define NOMINMAX 1
66 #include <windows.h>
67 /* The redundant #ifdef is to avoid compiler warning about unused macro. */
68 #ifdef NOMINMAX
69 #undef NOMINMAX
70 #endif
71 #include <sys/file.h>
72 #include "w32.h"
73 #endif /* not WINDOWSNT */
75 #ifdef MSDOS
76 #include "msdos.h"
77 #include <sys/param.h>
78 #endif
80 #ifdef DOS_NT
81 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
82 redirector allows the six letters between 'Z' and 'a' as well. */
83 #ifdef MSDOS
84 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
85 #endif
86 #ifdef WINDOWSNT
87 #define IS_DRIVE(x) c_isalpha (x)
88 #endif
89 /* Need to lower-case the drive letter, or else expanded
90 filenames will sometimes compare unequal, because
91 `expand-file-name' doesn't always down-case the drive letter. */
92 #define DRIVE_LETTER(x) c_tolower (x)
93 #endif
95 #include "systime.h"
96 #include <acl.h>
97 #include <allocator.h>
98 #include <careadlinkat.h>
99 #include <fsusage.h>
100 #include <stat-time.h>
101 #include <tempname.h>
103 #include <binary-io.h>
105 #ifdef HPUX
106 #include <netio.h>
107 #endif
109 #include "commands.h"
111 /* True during writing of auto-save files. */
112 static bool auto_saving;
114 /* Emacs's real umask. */
115 static mode_t realmask;
117 /* Nonzero umask during creation of auto-save directories. */
118 static mode_t auto_saving_dir_umask;
120 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
121 a new file with the same mode as the original. */
122 static mode_t auto_save_mode_bits;
124 /* Set by auto_save_1 if an error occurred during the last auto-save. */
125 static bool auto_save_error_occurred;
127 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
128 number of a file system where time stamps were observed to work. */
129 static bool valid_timestamp_file_system;
130 static dev_t timestamp_file_system;
132 /* Each time an annotation function changes the buffer, the new buffer
133 is added here. */
134 static Lisp_Object Vwrite_region_annotation_buffers;
136 static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
137 Lisp_Object *, struct coding_system *);
138 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
139 struct coding_system *);
142 /* Return true if FILENAME exists. */
144 static bool
145 check_existing (const char *filename)
147 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
150 /* Return true if file FILENAME exists and can be executed. */
152 static bool
153 check_executable (char *filename)
155 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
158 /* Return true if file FILENAME exists and can be accessed
159 according to AMODE, which should include W_OK.
160 On failure, return false and set errno. */
162 static bool
163 check_writable (const char *filename, int amode)
165 #ifdef MSDOS
166 /* FIXME: an faccessat implementation should be added to the
167 DOS/Windows ports and this #ifdef branch should be removed. */
168 struct stat st;
169 if (stat (filename, &st) < 0)
170 return 0;
171 errno = EPERM;
172 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
173 #else /* not MSDOS */
174 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
175 #ifdef CYGWIN
176 /* faccessat may have returned failure because Cygwin couldn't
177 determine the file's UID or GID; if so, we return success. */
178 if (!res)
180 int faccessat_errno = errno;
181 struct stat st;
182 if (stat (filename, &st) < 0)
183 return 0;
184 res = (st.st_uid == -1 || st.st_gid == -1);
185 errno = faccessat_errno;
187 #endif /* CYGWIN */
188 return res;
189 #endif /* not MSDOS */
192 /* Signal a file-access failure. STRING describes the failure,
193 NAME the file involved, and ERRORNO the errno value.
195 If NAME is neither null nor a pair, package it up as a singleton
196 list before reporting it; this saves report_file_errno's caller the
197 trouble of preserving errno before calling list1. */
199 void
200 report_file_errno (char const *string, Lisp_Object name, int errorno)
202 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
203 char *str = emacs_strerror (errorno);
204 AUTO_STRING (unibyte_str, str);
205 Lisp_Object errstring
206 = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
207 Lisp_Object errdata = Fcons (errstring, data);
209 if (errorno == EEXIST)
210 xsignal (Qfile_already_exists, errdata);
211 else
212 xsignal (errorno == ENOENT ? Qfile_missing : Qfile_error,
213 Fcons (build_string (string), errdata));
216 /* Signal a file-access failure that set errno. STRING describes the
217 failure, NAME the file involved. When invoking this function, take
218 care to not use arguments such as build_string ("foo") that involve
219 side effects that may set errno. */
221 void
222 report_file_error (char const *string, Lisp_Object name)
224 report_file_errno (string, name, errno);
227 /* Like report_file_error, but reports a file-notify-error instead. */
229 void
230 report_file_notify_error (const char *string, Lisp_Object name)
232 char *str = emacs_strerror (errno);
233 AUTO_STRING (unibyte_str, str);
234 Lisp_Object errstring
235 = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
236 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
237 Lisp_Object errdata = Fcons (errstring, data);
239 xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
242 void
243 close_file_unwind (int fd)
245 emacs_close (fd);
248 void
249 fclose_unwind (void *arg)
251 FILE *stream = arg;
252 fclose (stream);
255 /* Restore point, having saved it as a marker. */
257 void
258 restore_point_unwind (Lisp_Object location)
260 Fgoto_char (location);
261 unchain_marker (XMARKER (location));
265 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
266 Sfind_file_name_handler, 2, 2, 0,
267 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
268 Otherwise, return nil.
269 A file name is handled if one of the regular expressions in
270 `file-name-handler-alist' matches it.
272 If OPERATION equals `inhibit-file-name-operation', then ignore
273 any handlers that are members of `inhibit-file-name-handlers',
274 but still do run any other handlers. This lets handlers
275 use the standard functions without calling themselves recursively. */)
276 (Lisp_Object filename, Lisp_Object operation)
278 /* This function must not munge the match data. */
279 Lisp_Object chain, inhibited_handlers, result;
280 ptrdiff_t pos = -1;
282 result = Qnil;
283 CHECK_STRING (filename);
285 if (EQ (operation, Vinhibit_file_name_operation))
286 inhibited_handlers = Vinhibit_file_name_handlers;
287 else
288 inhibited_handlers = Qnil;
290 for (chain = Vfile_name_handler_alist; CONSP (chain);
291 chain = XCDR (chain))
293 Lisp_Object elt;
294 elt = XCAR (chain);
295 if (CONSP (elt))
297 Lisp_Object string = XCAR (elt);
298 ptrdiff_t match_pos;
299 Lisp_Object handler = XCDR (elt);
300 Lisp_Object operations = Qnil;
302 if (SYMBOLP (handler))
303 operations = Fget (handler, Qoperations);
305 if (STRINGP (string)
306 && (match_pos = fast_string_match (string, filename)) > pos
307 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
309 Lisp_Object tem;
311 handler = XCDR (elt);
312 tem = Fmemq (handler, inhibited_handlers);
313 if (NILP (tem))
315 result = handler;
316 pos = match_pos;
321 maybe_quit ();
323 return result;
326 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
327 1, 1, 0,
328 doc: /* Return the directory component in file name FILENAME.
329 Return nil if FILENAME does not include a directory.
330 Otherwise return a directory name.
331 Given a Unix syntax file name, returns a string ending in slash. */)
332 (Lisp_Object filename)
334 Lisp_Object handler;
336 CHECK_STRING (filename);
338 /* If the file name has special constructs in it,
339 call the corresponding file handler. */
340 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
341 if (!NILP (handler))
343 Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
344 filename);
345 return STRINGP (handled_name) ? handled_name : Qnil;
348 char *beg = SSDATA (filename);
349 char const *p = beg + SBYTES (filename);
351 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
352 #ifdef DOS_NT
353 /* only recognize drive specifier at the beginning */
354 && !(p[-1] == ':'
355 /* handle the "/:d:foo" and "/:foo" cases correctly */
356 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
357 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
358 #endif
359 ) p--;
361 if (p == beg)
362 return Qnil;
363 #ifdef DOS_NT
364 /* Expansion of "c:" to drive and default directory. */
365 Lisp_Object tem_fn;
366 USE_SAFE_ALLOCA;
367 SAFE_ALLOCA_STRING (beg, filename);
368 p = beg + (p - SSDATA (filename));
370 if (p[-1] == ':')
372 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
373 char *res = alloca (MAXPATHLEN + 1);
374 char *r = res;
376 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
378 memcpy (res, beg, 2);
379 beg += 2;
380 r += 2;
383 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
385 size_t l = strlen (res);
387 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
388 strcat (res, "/");
389 beg = res;
390 p = beg + strlen (beg);
391 dostounix_filename (beg);
392 tem_fn = make_specified_string (beg, -1, p - beg,
393 STRING_MULTIBYTE (filename));
395 else
396 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
397 STRING_MULTIBYTE (filename));
399 else if (STRING_MULTIBYTE (filename))
401 tem_fn = make_specified_string (beg, -1, p - beg, 1);
402 dostounix_filename (SSDATA (tem_fn));
403 #ifdef WINDOWSNT
404 if (!NILP (Vw32_downcase_file_names))
405 tem_fn = Fdowncase (tem_fn);
406 #endif
408 else
410 dostounix_filename (beg);
411 tem_fn = make_specified_string (beg, -1, p - beg, 0);
413 SAFE_FREE ();
414 return tem_fn;
415 #else /* DOS_NT */
416 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
417 #endif /* DOS_NT */
420 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
421 Sfile_name_nondirectory, 1, 1, 0,
422 doc: /* Return file name FILENAME sans its directory.
423 For example, in a Unix-syntax file name,
424 this is everything after the last slash,
425 or the entire name if it contains no slash. */)
426 (Lisp_Object filename)
428 register const char *beg, *p, *end;
429 Lisp_Object handler;
431 CHECK_STRING (filename);
433 /* If the file name has special constructs in it,
434 call the corresponding file handler. */
435 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
436 if (!NILP (handler))
438 Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
439 filename);
440 if (STRINGP (handled_name))
441 return handled_name;
442 error ("Invalid handler in `file-name-handler-alist'");
445 beg = SSDATA (filename);
446 end = p = beg + SBYTES (filename);
448 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
449 #ifdef DOS_NT
450 /* only recognize drive specifier at beginning */
451 && !(p[-1] == ':'
452 /* handle the "/:d:foo" case correctly */
453 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
454 #endif
456 p--;
458 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
461 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
462 Sunhandled_file_name_directory, 1, 1, 0,
463 doc: /* Return a directly usable directory name somehow associated with FILENAME.
464 A `directly usable' directory name is one that may be used without the
465 intervention of any file handler.
466 If FILENAME is a directly usable file itself, return
467 \(file-name-as-directory FILENAME).
468 If FILENAME refers to a file which is not accessible from a local process,
469 then this should return nil.
470 The `call-process' and `start-process' functions use this function to
471 get a current directory to run processes in. */)
472 (Lisp_Object filename)
474 Lisp_Object handler;
476 /* If the file name has special constructs in it,
477 call the corresponding file handler. */
478 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
479 if (!NILP (handler))
481 Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
482 filename);
483 return STRINGP (handled_name) ? handled_name : Qnil;
486 return Ffile_name_as_directory (filename);
489 /* Maximum number of bytes that DST will be longer than SRC
490 in file_name_as_directory. This occurs when SRCLEN == 0. */
491 enum { file_name_as_directory_slop = 2 };
493 /* Convert from file name SRC of length SRCLEN to directory name in
494 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
495 string. On UNIX, just make sure there is a terminating /. Return
496 the length of DST in bytes. */
498 static ptrdiff_t
499 file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
500 bool multibyte)
502 if (srclen == 0)
504 dst[0] = '.';
505 dst[1] = '/';
506 dst[2] = '\0';
507 return 2;
510 memcpy (dst, src, srclen);
511 if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
512 dst[srclen++] = DIRECTORY_SEP;
513 dst[srclen] = 0;
514 #ifdef DOS_NT
515 dostounix_filename (dst);
516 #endif
517 return srclen;
520 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
521 Sfile_name_as_directory, 1, 1, 0,
522 doc: /* Return a string representing the file name FILE interpreted as a directory.
523 This operation exists because a directory is also a file, but its name as
524 a directory is different from its name as a file.
525 The result can be used as the value of `default-directory'
526 or passed as second argument to `expand-file-name'.
527 For a Unix-syntax file name, just appends a slash unless a trailing slash
528 is already present. */)
529 (Lisp_Object file)
531 char *buf;
532 ptrdiff_t length;
533 Lisp_Object handler, val;
534 USE_SAFE_ALLOCA;
536 CHECK_STRING (file);
538 /* If the file name has special constructs in it,
539 call the corresponding file handler. */
540 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
541 if (!NILP (handler))
543 Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
544 file);
545 if (STRINGP (handled_name))
546 return handled_name;
547 error ("Invalid handler in `file-name-handler-alist'");
550 #ifdef WINDOWSNT
551 if (!NILP (Vw32_downcase_file_names))
552 file = Fdowncase (file);
553 #endif
554 buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
555 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
556 STRING_MULTIBYTE (file));
557 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
558 SAFE_FREE ();
559 return val;
562 /* Convert from directory name SRC of length SRCLEN to file name in
563 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
564 string. On UNIX, just make sure there isn't a terminating /.
565 Return the length of DST in bytes. */
567 static ptrdiff_t
568 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
570 /* In Unix-like systems, just remove any final slashes. However, if
571 they are all slashes, leave "/" and "//" alone, and treat "///"
572 and longer as if they were "/". */
573 if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
574 while (srclen > 1
575 #ifdef DOS_NT
576 && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2]))
577 #endif
578 && IS_DIRECTORY_SEP (src[srclen - 1]))
579 srclen--;
581 memcpy (dst, src, srclen);
582 dst[srclen] = 0;
583 #ifdef DOS_NT
584 dostounix_filename (dst);
585 #endif
586 return srclen;
589 DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0,
590 doc: /* Return non-nil if NAME ends with a directory separator character. */)
591 (Lisp_Object name)
593 CHECK_STRING (name);
594 ptrdiff_t namelen = SBYTES (name);
595 unsigned char c = namelen ? SREF (name, namelen - 1) : 0;
596 return IS_DIRECTORY_SEP (c) ? Qt : Qnil;
599 /* Return the expansion of NEWNAME, except that if NEWNAME is a
600 directory name then return the expansion of FILE's basename under
601 NEWNAME. This resembles how 'cp FILE NEWNAME' works, except that
602 it requires NEWNAME to be a directory name (typically, by ending in
603 "/"). */
605 static Lisp_Object
606 expand_cp_target (Lisp_Object file, Lisp_Object newname)
608 return (!NILP (Fdirectory_name_p (newname))
609 ? Fexpand_file_name (Ffile_name_nondirectory (file), newname)
610 : Fexpand_file_name (newname, Qnil));
613 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
614 1, 1, 0,
615 doc: /* Returns the file name of the directory named DIRECTORY.
616 This is the name of the file that holds the data for the directory DIRECTORY.
617 This operation exists because a directory is also a file, but its name as
618 a directory is different from its name as a file.
619 In Unix-syntax, this function just removes the final slash. */)
620 (Lisp_Object directory)
622 char *buf;
623 ptrdiff_t length;
624 Lisp_Object handler, val;
625 USE_SAFE_ALLOCA;
627 CHECK_STRING (directory);
629 /* If the file name has special constructs in it,
630 call the corresponding file handler. */
631 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
632 if (!NILP (handler))
634 Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
635 directory);
636 if (STRINGP (handled_name))
637 return handled_name;
638 error ("Invalid handler in `file-name-handler-alist'");
641 #ifdef WINDOWSNT
642 if (!NILP (Vw32_downcase_file_names))
643 directory = Fdowncase (directory);
644 #endif
645 buf = SAFE_ALLOCA (SBYTES (directory) + 1);
646 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
647 STRING_MULTIBYTE (directory));
648 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
649 SAFE_FREE ();
650 return val;
653 DEFUN ("make-temp-file-internal", Fmake_temp_file_internal,
654 Smake_temp_file_internal, 4, 4, 0,
655 doc: /* Generate a new file whose name starts with PREFIX, a string.
656 Return the name of the generated file. If DIR-FLAG is zero, do not
657 create the file, just its name. Otherwise, if DIR-FLAG is non-nil,
658 create an empty directory. The file name should end in SUFFIX.
659 Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
660 working directory. If TEXT is a string, insert it into the newly
661 created file.
663 Signal an error if the file could not be created.
665 This function does not grok magic file names. */)
666 (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix,
667 Lisp_Object text)
669 CHECK_STRING (prefix);
670 CHECK_STRING (suffix);
671 Lisp_Object encoded_prefix = ENCODE_FILE (prefix);
672 Lisp_Object encoded_suffix = ENCODE_FILE (suffix);
673 ptrdiff_t prefix_len = SBYTES (encoded_prefix);
674 ptrdiff_t suffix_len = SBYTES (encoded_suffix);
675 if (INT_MAX < suffix_len)
676 args_out_of_range (prefix, suffix);
677 int nX = 6;
678 Lisp_Object val = make_uninit_string (prefix_len + nX + suffix_len);
679 char *data = SSDATA (val);
680 memcpy (data, SSDATA (encoded_prefix), prefix_len);
681 memset (data + prefix_len, 'X', nX);
682 memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
683 int kind = (NILP (dir_flag) ? GT_FILE
684 : EQ (dir_flag, make_number (0)) ? GT_NOCREATE
685 : GT_DIR);
686 int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
687 bool failed = fd < 0;
688 if (!failed)
690 ptrdiff_t count = SPECPDL_INDEX ();
691 record_unwind_protect_int (close_file_unwind, fd);
692 val = DECODE_FILE (val);
693 if (STRINGP (text) && SBYTES (text) != 0)
694 write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd);
695 failed = NILP (dir_flag) && emacs_close (fd) != 0;
696 /* Discard the unwind protect. */
697 specpdl_ptr = specpdl + count;
699 if (failed)
701 static char const kind_message[][32] =
703 [GT_FILE] = "Creating file with prefix",
704 [GT_DIR] = "Creating directory with prefix",
705 [GT_NOCREATE] = "Creating file name with prefix"
707 report_file_error (kind_message[kind], prefix);
709 return val;
713 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
714 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
716 This function tries to choose a name that has no existing file.
717 For this to work, PREFIX should be an absolute file name, and PREFIX
718 and the returned string should both be non-magic.
720 There is a race condition between calling `make-temp-name' and
721 later creating the file, which opens all kinds of security holes.
722 For that reason, you should normally use `make-temp-file' instead. */)
723 (Lisp_Object prefix)
725 return Fmake_temp_file_internal (prefix, make_number (0),
726 empty_unibyte_string, Qnil);
729 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
730 doc: /* Convert filename NAME to absolute, and canonicalize it.
731 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
732 \(does not start with slash or tilde); both the directory name and
733 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
734 missing, the current buffer's value of `default-directory' is used.
735 NAME should be a string that is a valid file name for the underlying
736 filesystem.
737 File name components that are `.' are removed, and
738 so are file name components followed by `..', along with the `..' itself;
739 note that these simplifications are done without checking the resulting
740 file names in the file system.
741 Multiple consecutive slashes are collapsed into a single slash,
742 except at the beginning of the file name when they are significant (e.g.,
743 UNC file names on MS-Windows.)
744 An initial `~/' expands to your home directory.
745 An initial `~USER/' expands to USER's home directory.
746 See also the function `substitute-in-file-name'.
748 For technical reasons, this function can return correct but
749 non-intuitive results for the root directory; for instance,
750 \(expand-file-name ".." "/") returns "/..". For this reason, use
751 \(directory-file-name (file-name-directory dirname)) to traverse a
752 filesystem tree, not (expand-file-name ".." dirname). Note: make
753 sure DIRNAME in this example doesn't end in a slash, unless it's
754 the root directory. */)
755 (Lisp_Object name, Lisp_Object default_directory)
757 /* These point to SDATA and need to be careful with string-relocation
758 during GC (via DECODE_FILE). */
759 char *nm;
760 char *nmlim;
761 const char *newdir;
762 const char *newdirlim;
763 /* This should only point to alloca'd data. */
764 char *target;
766 ptrdiff_t tlen;
767 struct passwd *pw;
768 #ifdef DOS_NT
769 int drive = 0;
770 bool collapse_newdir = true;
771 bool is_escaped = 0;
772 #endif /* DOS_NT */
773 ptrdiff_t length, nbytes;
774 Lisp_Object handler, result, handled_name;
775 bool multibyte;
776 Lisp_Object hdir;
777 USE_SAFE_ALLOCA;
779 CHECK_STRING (name);
781 /* If the file name has special constructs in it,
782 call the corresponding file handler. */
783 handler = Ffind_file_name_handler (name, Qexpand_file_name);
784 if (!NILP (handler))
786 handled_name = call3 (handler, Qexpand_file_name,
787 name, default_directory);
788 if (STRINGP (handled_name))
789 return handled_name;
790 error ("Invalid handler in `file-name-handler-alist'");
794 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
795 if (NILP (default_directory))
796 default_directory = BVAR (current_buffer, directory);
797 if (! STRINGP (default_directory))
799 #ifdef DOS_NT
800 /* "/" is not considered a root directory on DOS_NT, so using "/"
801 here causes an infinite recursion in, e.g., the following:
803 (let (default-directory)
804 (expand-file-name "a"))
806 To avoid this, we set default_directory to the root of the
807 current drive. */
808 default_directory = build_string (emacs_root_dir ());
809 #else
810 default_directory = build_string ("/");
811 #endif
814 if (!NILP (default_directory))
816 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
817 if (!NILP (handler))
819 handled_name = call3 (handler, Qexpand_file_name,
820 name, default_directory);
821 if (STRINGP (handled_name))
822 return handled_name;
823 error ("Invalid handler in `file-name-handler-alist'");
828 char *o = SSDATA (default_directory);
830 /* Make sure DEFAULT_DIRECTORY is properly expanded.
831 It would be better to do this down below where we actually use
832 default_directory. Unfortunately, calling Fexpand_file_name recursively
833 could invoke GC, and the strings might be relocated. This would
834 be annoying because we have pointers into strings lying around
835 that would need adjusting, and people would add new pointers to
836 the code and forget to adjust them, resulting in intermittent bugs.
837 Putting this call here avoids all that crud.
839 The EQ test avoids infinite recursion. */
840 if (! NILP (default_directory) && !EQ (default_directory, name)
841 /* Save time in some common cases - as long as default_directory
842 is not relative, it can be canonicalized with name below (if it
843 is needed at all) without requiring it to be expanded now. */
844 #ifdef DOS_NT
845 /* Detect MSDOS file names with drive specifiers. */
846 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
847 && IS_DIRECTORY_SEP (o[2]))
848 /* Detect escaped file names without drive spec after "/:".
849 These should not be recursively expanded, to avoid
850 including the default directory twice in the expanded
851 result. */
852 && ! (o[0] == '/' && o[1] == ':')
853 #ifdef WINDOWSNT
854 /* Detect Windows file names in UNC format. */
855 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
856 #endif
857 #else /* not DOS_NT */
858 /* Detect Unix absolute file names (/... alone is not absolute on
859 DOS or Windows). */
860 && ! (IS_DIRECTORY_SEP (o[0]))
861 #endif /* not DOS_NT */
864 default_directory = Fexpand_file_name (default_directory, Qnil);
867 multibyte = STRING_MULTIBYTE (name);
868 if (multibyte != STRING_MULTIBYTE (default_directory))
870 if (multibyte)
872 unsigned char *p = SDATA (name);
874 while (*p && ASCII_CHAR_P (*p))
875 p++;
876 if (*p == '\0')
878 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
879 unibyte. Do not convert DEFAULT_DIRECTORY to
880 multibyte; instead, convert NAME to a unibyte string,
881 so that the result of this function is also a unibyte
882 string. This is needed during bootstrapping and
883 dumping, when Emacs cannot decode file names, because
884 the locale environment is not set up. */
885 name = make_unibyte_string (SSDATA (name), SBYTES (name));
886 multibyte = 0;
888 else
889 default_directory = string_to_multibyte (default_directory);
891 else
893 name = string_to_multibyte (name);
894 multibyte = 1;
898 #ifdef WINDOWSNT
899 if (!NILP (Vw32_downcase_file_names))
900 default_directory = Fdowncase (default_directory);
901 #endif
903 /* Make a local copy of NAME to protect it from GC in DECODE_FILE below. */
904 SAFE_ALLOCA_STRING (nm, name);
905 nmlim = nm + SBYTES (name);
907 #ifdef DOS_NT
908 /* Note if special escape prefix is present, but remove for now. */
909 if (nm[0] == '/' && nm[1] == ':')
911 is_escaped = 1;
912 nm += 2;
915 /* Find and remove drive specifier if present; this makes nm absolute
916 even if the rest of the name appears to be relative. Only look for
917 drive specifier at the beginning. */
918 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
920 drive = (unsigned char) nm[0];
921 nm += 2;
924 #ifdef WINDOWSNT
925 /* If we see "c://somedir", we want to strip the first slash after the
926 colon when stripping the drive letter. Otherwise, this expands to
927 "//somedir". */
928 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
929 nm++;
931 /* Discard any previous drive specifier if nm is now in UNC format. */
932 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
933 && !IS_DIRECTORY_SEP (nm[2]))
934 drive = 0;
935 #endif /* WINDOWSNT */
936 #endif /* DOS_NT */
938 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
939 none are found, we can probably return right away. We will avoid
940 allocating a new string if name is already fully expanded. */
941 if (
942 IS_DIRECTORY_SEP (nm[0])
943 #ifdef MSDOS
944 && drive && !is_escaped
945 #endif
946 #ifdef WINDOWSNT
947 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
948 #endif
951 /* If it turns out that the filename we want to return is just a
952 suffix of FILENAME, we don't need to go through and edit
953 things; we just need to construct a new string using data
954 starting at the middle of FILENAME. If we set LOSE, that
955 means we've discovered that we can't do that cool trick. */
956 bool lose = 0;
957 char *p = nm;
959 while (*p)
961 /* Since we know the name is absolute, we can assume that each
962 element starts with a "/". */
964 /* "." and ".." are hairy. */
965 if (IS_DIRECTORY_SEP (p[0])
966 && p[1] == '.'
967 && (IS_DIRECTORY_SEP (p[2])
968 || p[2] == 0
969 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
970 || p[3] == 0))))
971 lose = 1;
972 /* Replace multiple slashes with a single one, except
973 leave leading "//" alone. */
974 else if (IS_DIRECTORY_SEP (p[0])
975 && IS_DIRECTORY_SEP (p[1])
976 && (p != nm || IS_DIRECTORY_SEP (p[2])))
977 lose = 1;
978 p++;
980 if (!lose)
982 #ifdef DOS_NT
983 /* Make sure directories are all separated with /, but
984 avoid allocation of a new string when not required. */
985 dostounix_filename (nm);
986 #ifdef WINDOWSNT
987 if (IS_DIRECTORY_SEP (nm[1]))
989 if (strcmp (nm, SSDATA (name)) != 0)
990 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
992 else
993 #endif
994 /* Drive must be set, so this is okay. */
995 if (strcmp (nm - 2, SSDATA (name)) != 0)
997 name = make_specified_string (nm, -1, p - nm, multibyte);
998 char temp[] = { DRIVE_LETTER (drive), ':', 0 };
999 AUTO_STRING_WITH_LEN (drive_prefix, temp, 2);
1000 name = concat2 (drive_prefix, name);
1002 #ifdef WINDOWSNT
1003 if (!NILP (Vw32_downcase_file_names))
1004 name = Fdowncase (name);
1005 #endif
1006 #else /* not DOS_NT */
1007 if (strcmp (nm, SSDATA (name)) != 0)
1008 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1009 #endif /* not DOS_NT */
1010 SAFE_FREE ();
1011 return name;
1015 /* At this point, nm might or might not be an absolute file name. We
1016 need to expand ~ or ~user if present, otherwise prefix nm with
1017 default_directory if nm is not absolute, and finally collapse /./
1018 and /foo/../ sequences.
1020 We set newdir to be the appropriate prefix if one is needed:
1021 - the relevant user directory if nm starts with ~ or ~user
1022 - the specified drive's working dir (DOS/NT only) if nm does not
1023 start with /
1024 - the value of default_directory.
1026 Note that these prefixes are not guaranteed to be absolute (except
1027 for the working dir of a drive). Therefore, to ensure we always
1028 return an absolute name, if the final prefix is not absolute we
1029 append it to the current working directory. */
1031 newdir = newdirlim = 0;
1033 if (nm[0] == '~' /* prefix ~ */
1034 #ifdef DOS_NT
1035 && !is_escaped /* don't expand ~ in escaped file names */
1036 #endif
1039 if (IS_DIRECTORY_SEP (nm[1])
1040 || nm[1] == 0) /* ~ by itself */
1042 Lisp_Object tem;
1044 if (!(newdir = egetenv ("HOME")))
1045 newdir = newdirlim = "";
1046 nm++;
1047 #ifdef WINDOWSNT
1048 if (newdir[0])
1050 char newdir_utf8[MAX_UTF8_PATH];
1052 filename_from_ansi (newdir, newdir_utf8);
1053 tem = make_unibyte_string (newdir_utf8, strlen (newdir_utf8));
1054 newdir = SSDATA (tem);
1056 else
1057 #endif
1058 tem = build_string (newdir);
1059 newdirlim = newdir + SBYTES (tem);
1060 /* `egetenv' may return a unibyte string, which will bite us
1061 if we expect the directory to be multibyte. */
1062 if (multibyte && !STRING_MULTIBYTE (tem))
1064 hdir = DECODE_FILE (tem);
1065 newdir = SSDATA (hdir);
1066 newdirlim = newdir + SBYTES (hdir);
1068 #ifdef DOS_NT
1069 collapse_newdir = false;
1070 #endif
1072 else /* ~user/filename */
1074 char *o, *p;
1075 for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
1076 continue;
1077 o = SAFE_ALLOCA (p - nm + 1);
1078 memcpy (o, nm, p - nm);
1079 o[p - nm] = 0;
1081 block_input ();
1082 pw = getpwnam (o + 1);
1083 unblock_input ();
1084 if (pw)
1086 Lisp_Object tem;
1088 newdir = pw->pw_dir;
1089 /* `getpwnam' may return a unibyte string, which will
1090 bite us when we expect the directory to be multibyte. */
1091 tem = make_unibyte_string (newdir, strlen (newdir));
1092 newdirlim = newdir + SBYTES (tem);
1093 if (multibyte && !STRING_MULTIBYTE (tem))
1095 hdir = DECODE_FILE (tem);
1096 newdir = SSDATA (hdir);
1097 newdirlim = newdir + SBYTES (hdir);
1099 nm = p;
1100 #ifdef DOS_NT
1101 collapse_newdir = false;
1102 #endif
1105 /* If we don't find a user of that name, leave the name
1106 unchanged; don't move nm forward to p. */
1110 #ifdef DOS_NT
1111 /* On DOS and Windows, nm is absolute if a drive name was specified;
1112 use the drive's current directory as the prefix if needed. */
1113 if (!newdir && drive)
1115 /* Get default directory if needed to make nm absolute. */
1116 char *adir = NULL;
1117 if (!IS_DIRECTORY_SEP (nm[0]))
1119 adir = alloca (MAXPATHLEN + 1);
1120 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1121 adir = NULL;
1122 else if (multibyte)
1124 Lisp_Object tem = build_string (adir);
1126 tem = DECODE_FILE (tem);
1127 newdirlim = adir + SBYTES (tem);
1128 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1130 else
1131 newdirlim = adir + strlen (adir);
1133 if (!adir)
1135 /* Either nm starts with /, or drive isn't mounted. */
1136 adir = alloca (4);
1137 adir[0] = DRIVE_LETTER (drive);
1138 adir[1] = ':';
1139 adir[2] = '/';
1140 adir[3] = 0;
1141 newdirlim = adir + 3;
1143 newdir = adir;
1145 #endif /* DOS_NT */
1147 /* Finally, if no prefix has been specified and nm is not absolute,
1148 then it must be expanded relative to default_directory. */
1150 if (1
1151 #ifndef DOS_NT
1152 /* /... alone is not absolute on DOS and Windows. */
1153 && !IS_DIRECTORY_SEP (nm[0])
1154 #endif
1155 #ifdef WINDOWSNT
1156 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1157 && !IS_DIRECTORY_SEP (nm[2]))
1158 #endif
1159 && !newdir)
1161 newdir = SSDATA (default_directory);
1162 newdirlim = newdir + SBYTES (default_directory);
1163 #ifdef DOS_NT
1164 /* Note if special escape prefix is present, but remove for now. */
1165 if (newdir[0] == '/' && newdir[1] == ':')
1167 is_escaped = 1;
1168 newdir += 2;
1170 #endif
1173 #ifdef DOS_NT
1174 if (newdir)
1176 /* First ensure newdir is an absolute name. */
1177 if (
1178 /* Detect MSDOS file names with drive specifiers. */
1179 ! (IS_DRIVE (newdir[0])
1180 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1181 #ifdef WINDOWSNT
1182 /* Detect Windows file names in UNC format. */
1183 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1184 && !IS_DIRECTORY_SEP (newdir[2]))
1185 #endif
1188 /* Effectively, let newdir be (expand-file-name newdir cwd).
1189 Because of the admonition against calling expand-file-name
1190 when we have pointers into lisp strings, we accomplish this
1191 indirectly by prepending newdir to nm if necessary, and using
1192 cwd (or the wd of newdir's drive) as the new newdir. */
1193 char *adir;
1194 #ifdef WINDOWSNT
1195 const int adir_size = MAX_UTF8_PATH;
1196 #else
1197 const int adir_size = MAXPATHLEN + 1;
1198 #endif
1200 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1202 drive = (unsigned char) newdir[0];
1203 newdir += 2;
1205 if (!IS_DIRECTORY_SEP (nm[0]))
1207 ptrdiff_t nmlen = nmlim - nm;
1208 ptrdiff_t newdirlen = newdirlim - newdir;
1209 char *tmp = alloca (newdirlen + file_name_as_directory_slop
1210 + nmlen + 1);
1211 ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
1212 multibyte);
1213 memcpy (tmp + dlen, nm, nmlen + 1);
1214 nm = tmp;
1215 nmlim = nm + dlen + nmlen;
1217 adir = alloca (adir_size);
1218 if (drive)
1220 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1221 strcpy (adir, "/");
1223 else
1224 getcwd (adir, adir_size);
1225 if (multibyte)
1227 Lisp_Object tem = build_string (adir);
1229 tem = DECODE_FILE (tem);
1230 newdirlim = adir + SBYTES (tem);
1231 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1233 else
1234 newdirlim = adir + strlen (adir);
1235 newdir = adir;
1238 /* Strip off drive name from prefix, if present. */
1239 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1241 drive = newdir[0];
1242 newdir += 2;
1245 /* Keep only a prefix from newdir if nm starts with slash
1246 (//server/share for UNC, nothing otherwise). */
1247 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1249 #ifdef WINDOWSNT
1250 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1251 && !IS_DIRECTORY_SEP (newdir[2]))
1253 char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
1254 char *p = adir + 2;
1255 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1256 p++;
1257 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1258 *p = 0;
1259 newdir = adir;
1260 newdirlim = newdir + strlen (adir);
1262 else
1263 #endif
1264 newdir = newdirlim = "";
1267 #endif /* DOS_NT */
1269 /* Ignore any slash at the end of newdir, unless newdir is
1270 just "/" or "//". */
1271 length = newdirlim - newdir;
1272 while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1273 && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
1274 length--;
1276 /* Now concatenate the directory and name to new space in the stack frame. */
1277 tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
1278 eassert (tlen > file_name_as_directory_slop + 1);
1279 #ifdef DOS_NT
1280 /* Reserve space for drive specifier and escape prefix, since either
1281 or both may need to be inserted. (The Microsoft x86 compiler
1282 produces incorrect code if the following two lines are combined.) */
1283 target = alloca (tlen + 4);
1284 target += 4;
1285 #else /* not DOS_NT */
1286 target = SAFE_ALLOCA (tlen);
1287 #endif /* not DOS_NT */
1288 *target = 0;
1289 nbytes = 0;
1291 if (newdir)
1293 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1295 #ifdef DOS_NT
1296 /* If newdir is effectively "C:/", then the drive letter will have
1297 been stripped and newdir will be "/". Concatenating with an
1298 absolute directory in nm produces "//", which will then be
1299 incorrectly treated as a network share. Ignore newdir in
1300 this case (keeping the drive letter). */
1301 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1302 && newdir[1] == '\0'))
1303 #endif
1305 memcpy (target, newdir, length);
1306 target[length] = 0;
1307 nbytes = length;
1310 else
1311 nbytes = file_name_as_directory (target, newdir, length, multibyte);
1314 memcpy (target + nbytes, nm, nmlim - nm + 1);
1316 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1317 appear. */
1319 char *p = target;
1320 char *o = target;
1322 while (*p)
1324 if (!IS_DIRECTORY_SEP (*p))
1326 *o++ = *p++;
1328 else if (p[1] == '.'
1329 && (IS_DIRECTORY_SEP (p[2])
1330 || p[2] == 0))
1332 /* If "/." is the entire filename, keep the "/". Otherwise,
1333 just delete the whole "/.". */
1334 if (o == target && p[2] == '\0')
1335 *o++ = *p;
1336 p += 2;
1338 else if (p[1] == '.' && p[2] == '.'
1339 /* `/../' is the "superroot" on certain file systems.
1340 Turned off on DOS_NT systems because they have no
1341 "superroot" and because this causes us to produce
1342 file names like "d:/../foo" which fail file-related
1343 functions of the underlying OS. (To reproduce, try a
1344 long series of "../../" in default_directory, longer
1345 than the number of levels from the root.) */
1346 #ifndef DOS_NT
1347 && o != target
1348 #endif
1349 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1351 #ifdef WINDOWSNT
1352 char *prev_o = o;
1353 #endif
1354 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1355 continue;
1356 #ifdef WINDOWSNT
1357 /* Don't go below server level in UNC filenames. */
1358 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1359 && IS_DIRECTORY_SEP (*target))
1360 o = prev_o;
1361 else
1362 #endif
1363 /* Keep initial / only if this is the whole name. */
1364 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1365 ++o;
1366 p += 3;
1368 else if (IS_DIRECTORY_SEP (p[1])
1369 && (p != target || IS_DIRECTORY_SEP (p[2])))
1370 /* Collapse multiple "/", except leave leading "//" alone. */
1371 p++;
1372 else
1374 *o++ = *p++;
1378 #ifdef DOS_NT
1379 /* At last, set drive name. */
1380 #ifdef WINDOWSNT
1381 /* Except for network file name. */
1382 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1383 #endif /* WINDOWSNT */
1385 if (!drive) emacs_abort ();
1386 target -= 2;
1387 target[0] = DRIVE_LETTER (drive);
1388 target[1] = ':';
1390 /* Reinsert the escape prefix if required. */
1391 if (is_escaped)
1393 target -= 2;
1394 target[0] = '/';
1395 target[1] = ':';
1397 result = make_specified_string (target, -1, o - target, multibyte);
1398 dostounix_filename (SSDATA (result));
1399 #ifdef WINDOWSNT
1400 if (!NILP (Vw32_downcase_file_names))
1401 result = Fdowncase (result);
1402 #endif
1403 #else /* !DOS_NT */
1404 result = make_specified_string (target, -1, o - target, multibyte);
1405 #endif /* !DOS_NT */
1408 /* Again look to see if the file name has special constructs in it
1409 and perhaps call the corresponding file handler. This is needed
1410 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1411 the ".." component gives us "/user@host:/bar/../baz" which needs
1412 to be expanded again. */
1413 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1414 if (!NILP (handler))
1416 handled_name = call3 (handler, Qexpand_file_name,
1417 result, default_directory);
1418 if (! STRINGP (handled_name))
1419 error ("Invalid handler in `file-name-handler-alist'");
1420 result = handled_name;
1423 SAFE_FREE ();
1424 return result;
1427 #if 0
1428 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1429 This is the old version of expand-file-name, before it was thoroughly
1430 rewritten for Emacs 10.31. We leave this version here commented-out,
1431 because the code is very complex and likely to have subtle bugs. If
1432 bugs _are_ found, it might be of interest to look at the old code and
1433 see what did it do in the relevant situation.
1435 Don't remove this code: it's true that it will be accessible
1436 from the repository, but a few years from deletion, people will
1437 forget it is there. */
1439 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1440 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1441 "Convert FILENAME to absolute, and canonicalize it.\n\
1442 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1443 \(does not start with slash); if DEFAULT is nil or missing,\n\
1444 the current buffer's value of default-directory is used.\n\
1445 Filenames containing `.' or `..' as components are simplified;\n\
1446 initial `~/' expands to your home directory.\n\
1447 See also the function `substitute-in-file-name'.")
1448 (name, defalt)
1449 Lisp_Object name, defalt;
1451 unsigned char *nm;
1453 register unsigned char *newdir, *p, *o;
1454 ptrdiff_t tlen;
1455 unsigned char *target;
1456 struct passwd *pw;
1458 CHECK_STRING (name);
1459 nm = SDATA (name);
1461 /* If nm is absolute, flush ...// and detect /./ and /../.
1462 If no /./ or /../ we can return right away. */
1463 if (nm[0] == '/')
1465 bool lose = 0;
1466 p = nm;
1467 while (*p)
1469 if (p[0] == '/' && p[1] == '/')
1470 nm = p + 1;
1471 if (p[0] == '/' && p[1] == '~')
1472 nm = p + 1, lose = 1;
1473 if (p[0] == '/' && p[1] == '.'
1474 && (p[2] == '/' || p[2] == 0
1475 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1476 lose = 1;
1477 p++;
1479 if (!lose)
1481 if (nm == SDATA (name))
1482 return name;
1483 return build_string (nm);
1487 /* Now determine directory to start with and put it in NEWDIR. */
1489 newdir = 0;
1491 if (nm[0] == '~') /* prefix ~ */
1492 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
1494 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1495 newdir = (unsigned char *) "";
1496 nm++;
1498 else /* ~user/filename */
1500 /* Get past ~ to user. */
1501 unsigned char *user = nm + 1;
1502 /* Find end of name. */
1503 unsigned char *ptr = (unsigned char *) strchr (user, '/');
1504 ptrdiff_t len = ptr ? ptr - user : strlen (user);
1505 /* Copy the user name into temp storage. */
1506 o = alloca (len + 1);
1507 memcpy (o, user, len);
1508 o[len] = 0;
1510 /* Look up the user name. */
1511 block_input ();
1512 pw = (struct passwd *) getpwnam (o + 1);
1513 unblock_input ();
1514 if (!pw)
1515 error ("\"%s\" isn't a registered user", o + 1);
1517 newdir = (unsigned char *) pw->pw_dir;
1519 /* Discard the user name from NM. */
1520 nm += len;
1523 if (nm[0] != '/' && !newdir)
1525 if (NILP (defalt))
1526 defalt = current_buffer->directory;
1527 CHECK_STRING (defalt);
1528 newdir = SDATA (defalt);
1531 /* Now concatenate the directory and name to new space in the stack frame. */
1533 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1534 target = alloca (tlen);
1535 *target = 0;
1537 if (newdir)
1539 if (nm[0] == 0 || nm[0] == '/')
1540 strcpy (target, newdir);
1541 else
1542 file_name_as_directory (target, newdir);
1545 strcat (target, nm);
1547 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1549 p = target;
1550 o = target;
1552 while (*p)
1554 if (*p != '/')
1556 *o++ = *p++;
1558 else if (!strncmp (p, "//", 2)
1561 o = target;
1562 p++;
1564 else if (p[0] == '/' && p[1] == '.'
1565 && (p[2] == '/' || p[2] == 0))
1566 p += 2;
1567 else if (!strncmp (p, "/..", 3)
1568 /* `/../' is the "superroot" on certain file systems. */
1569 && o != target
1570 && (p[3] == '/' || p[3] == 0))
1572 while (o != target && *--o != '/')
1574 if (o == target && *o == '/')
1575 ++o;
1576 p += 3;
1578 else
1580 *o++ = *p++;
1584 return make_string (target, o - target);
1586 #endif
1588 /* If /~ or // appears, discard everything through first slash. */
1589 static bool
1590 file_name_absolute_p (const char *filename)
1592 return
1593 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
1594 #ifdef DOS_NT
1595 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1596 && IS_DIRECTORY_SEP (filename[2]))
1597 #endif
1601 static char *
1602 search_embedded_absfilename (char *nm, char *endp)
1604 char *p, *s;
1606 for (p = nm + 1; p < endp; p++)
1608 if (IS_DIRECTORY_SEP (p[-1])
1609 && file_name_absolute_p (p)
1610 #if defined (WINDOWSNT) || defined (CYGWIN)
1611 /* // at start of file name is meaningful in Apollo,
1612 WindowsNT and Cygwin systems. */
1613 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1614 #endif /* not (WINDOWSNT || CYGWIN) */
1617 for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
1618 if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
1620 USE_SAFE_ALLOCA;
1621 char *o = SAFE_ALLOCA (s - p + 1);
1622 struct passwd *pw;
1623 memcpy (o, p, s - p);
1624 o [s - p] = 0;
1626 /* If we have ~user and `user' exists, discard
1627 everything up to ~. But if `user' does not exist, leave
1628 ~user alone, it might be a literal file name. */
1629 block_input ();
1630 pw = getpwnam (o + 1);
1631 unblock_input ();
1632 SAFE_FREE ();
1633 if (pw)
1634 return p;
1636 else
1637 return p;
1640 return NULL;
1643 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1644 Ssubstitute_in_file_name, 1, 1, 0,
1645 doc: /* Substitute environment variables referred to in FILENAME.
1646 `$FOO' where FOO is an environment variable name means to substitute
1647 the value of that variable. The variable name should be terminated
1648 with a character not a letter, digit or underscore; otherwise, enclose
1649 the entire variable name in braces.
1651 If `/~' appears, all of FILENAME through that `/' is discarded.
1652 If `//' appears, everything up to and including the first of
1653 those `/' is discarded. */)
1654 (Lisp_Object filename)
1656 char *nm, *p, *x, *endp;
1657 bool substituted = false;
1658 bool multibyte;
1659 char *xnm;
1660 Lisp_Object handler;
1662 CHECK_STRING (filename);
1664 multibyte = STRING_MULTIBYTE (filename);
1666 /* If the file name has special constructs in it,
1667 call the corresponding file handler. */
1668 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1669 if (!NILP (handler))
1671 Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
1672 filename);
1673 if (STRINGP (handled_name))
1674 return handled_name;
1675 error ("Invalid handler in `file-name-handler-alist'");
1678 /* Always work on a copy of the string, in case GC happens during
1679 decode of environment variables, causing the original Lisp_String
1680 data to be relocated. */
1681 USE_SAFE_ALLOCA;
1682 SAFE_ALLOCA_STRING (nm, filename);
1684 #ifdef DOS_NT
1685 dostounix_filename (nm);
1686 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1687 #endif
1688 endp = nm + SBYTES (filename);
1690 /* If /~ or // appears, discard everything through first slash. */
1691 p = search_embedded_absfilename (nm, endp);
1692 if (p)
1693 /* Start over with the new string, so we check the file-name-handler
1694 again. Important with filenames like "/home/foo//:/hello///there"
1695 which would substitute to "/:/hello///there" rather than "/there". */
1697 Lisp_Object result
1698 = (Fsubstitute_in_file_name
1699 (make_specified_string (p, -1, endp - p, multibyte)));
1700 SAFE_FREE ();
1701 return result;
1704 /* See if any variables are substituted into the string. */
1706 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
1708 Lisp_Object name
1709 = (!substituted ? filename
1710 : make_specified_string (nm, -1, endp - nm, multibyte));
1711 Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
1712 CHECK_STRING (tmp);
1713 if (!EQ (tmp, name))
1714 substituted = true;
1715 filename = tmp;
1718 if (!substituted)
1720 #ifdef WINDOWSNT
1721 if (!NILP (Vw32_downcase_file_names))
1722 filename = Fdowncase (filename);
1723 #endif
1724 SAFE_FREE ();
1725 return filename;
1728 xnm = SSDATA (filename);
1729 x = xnm + SBYTES (filename);
1731 /* If /~ or // appears, discard everything through first slash. */
1732 while ((p = search_embedded_absfilename (xnm, x)) != NULL)
1733 /* This time we do not start over because we've already expanded envvars
1734 and replaced $$ with $. Maybe we should start over as well, but we'd
1735 need to quote some $ to $$ first. */
1736 xnm = p;
1738 #ifdef WINDOWSNT
1739 if (!NILP (Vw32_downcase_file_names))
1741 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1743 filename = Fdowncase (xname);
1745 else
1746 #endif
1747 if (xnm != SSDATA (filename))
1748 filename = make_specified_string (xnm, -1, x - xnm, multibyte);
1749 SAFE_FREE ();
1750 return filename;
1753 /* A slightly faster and more convenient way to get
1754 (directory-file-name (expand-file-name FOO)). */
1756 Lisp_Object
1757 expand_and_dir_to_file (Lisp_Object filename)
1759 Lisp_Object absname = Fexpand_file_name (filename, Qnil);
1761 /* Remove final slash, if any (unless this is the root dir).
1762 stat behaves differently depending! */
1763 if (SCHARS (absname) > 1
1764 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1765 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
1766 /* We cannot take shortcuts; they might be wrong for magic file names. */
1767 absname = Fdirectory_file_name (absname);
1768 return absname;
1771 /* Signal an error if the file ABSNAME already exists.
1772 If KNOWN_TO_EXIST, the file is known to exist.
1773 QUERYSTRING is a name for the action that is being considered
1774 to alter the file.
1775 If INTERACTIVE, ask the user whether to proceed,
1776 and bypass the error if the user says to go ahead.
1777 If QUICK, ask for y or n, not yes or no. */
1779 static void
1780 barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
1781 const char *querystring, bool interactive,
1782 bool quick)
1784 Lisp_Object tem, encoded_filename;
1785 struct stat statbuf;
1787 encoded_filename = ENCODE_FILE (absname);
1789 if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0)
1791 if (S_ISDIR (statbuf.st_mode))
1792 xsignal2 (Qfile_error,
1793 build_string ("File is a directory"), absname);
1794 known_to_exist = true;
1797 if (known_to_exist)
1799 if (! interactive)
1800 xsignal2 (Qfile_already_exists,
1801 build_string ("File already exists"), absname);
1802 AUTO_STRING (format, "File %s already exists; %s anyway? ");
1803 tem = CALLN (Fformat, format, absname, build_string (querystring));
1804 if (quick)
1805 tem = call1 (intern ("y-or-n-p"), tem);
1806 else
1807 tem = do_yes_or_no_p (tem);
1808 if (NILP (tem))
1809 xsignal2 (Qfile_already_exists,
1810 build_string ("File already exists"), absname);
1814 #ifndef WINDOWSNT
1815 /* Copy data to DEST from SOURCE if possible. Return true if OK. */
1816 static bool
1817 clone_file (int dest, int source)
1819 #ifdef FICLONE
1820 return ioctl (dest, FICLONE, source) == 0;
1821 #endif
1822 return false;
1824 #endif
1826 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
1827 "fCopy file: \nGCopy %s to file: \np\nP",
1828 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1829 If NEWNAME is a directory name, copy FILE to a like-named file under
1830 NEWNAME. For NEWNAME to be recognized as a directory name, it should
1831 end in a slash.
1833 This function always sets the file modes of the output file to match
1834 the input file.
1836 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1837 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil,
1838 signal a `file-already-exists' error without overwriting. If
1839 OK-IF-ALREADY-EXISTS is an integer, request confirmation from the user
1840 about overwriting; this is what happens in interactive use with M-x.
1841 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1842 existing file.
1844 Fourth arg KEEP-TIME non-nil means give the output file the same
1845 last-modified time as the old one. (This works on only some systems.)
1847 A prefix arg makes KEEP-TIME non-nil.
1849 If PRESERVE-UID-GID is non-nil, try to transfer the uid and gid of
1850 FILE to NEWNAME.
1852 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1853 this includes the file modes, along with ACL entries and SELinux
1854 context if present. Otherwise, if NEWNAME is created its file
1855 permission bits are those of FILE, masked by the default file
1856 permissions. */)
1857 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists,
1858 Lisp_Object keep_time, Lisp_Object preserve_uid_gid,
1859 Lisp_Object preserve_permissions)
1861 Lisp_Object handler;
1862 ptrdiff_t count = SPECPDL_INDEX ();
1863 Lisp_Object encoded_file, encoded_newname;
1864 #if HAVE_LIBSELINUX
1865 security_context_t con;
1866 int conlength = 0;
1867 #endif
1868 #ifdef WINDOWSNT
1869 int result;
1870 #else
1871 bool already_exists = false;
1872 mode_t new_mask;
1873 int ifd, ofd;
1874 struct stat st;
1875 #endif
1877 file = Fexpand_file_name (file, Qnil);
1878 newname = expand_cp_target (file, newname);
1880 /* If the input file name has special constructs in it,
1881 call the corresponding file handler. */
1882 handler = Ffind_file_name_handler (file, Qcopy_file);
1883 /* Likewise for output file name. */
1884 if (NILP (handler))
1885 handler = Ffind_file_name_handler (newname, Qcopy_file);
1886 if (!NILP (handler))
1887 return call7 (handler, Qcopy_file, file, newname,
1888 ok_if_already_exists, keep_time, preserve_uid_gid,
1889 preserve_permissions);
1891 encoded_file = ENCODE_FILE (file);
1892 encoded_newname = ENCODE_FILE (newname);
1894 #ifdef WINDOWSNT
1895 if (NILP (ok_if_already_exists)
1896 || INTEGERP (ok_if_already_exists))
1897 barf_or_query_if_file_exists (newname, false, "copy to it",
1898 INTEGERP (ok_if_already_exists), false);
1900 result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
1901 !NILP (keep_time), !NILP (preserve_uid_gid),
1902 !NILP (preserve_permissions));
1903 switch (result)
1905 case -1:
1906 report_file_error ("Copying file", list2 (file, newname));
1907 case -2:
1908 report_file_error ("Copying permissions from", file);
1909 case -3:
1910 xsignal2 (Qfile_date_error,
1911 build_string ("Resetting file times"), newname);
1912 case -4:
1913 report_file_error ("Copying permissions to", newname);
1915 #else /* not WINDOWSNT */
1916 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1918 if (ifd < 0)
1919 report_file_error ("Opening input file", file);
1921 record_unwind_protect_int (close_file_unwind, ifd);
1923 if (fstat (ifd, &st) != 0)
1924 report_file_error ("Input file status", file);
1926 if (!NILP (preserve_permissions))
1928 #if HAVE_LIBSELINUX
1929 if (is_selinux_enabled ())
1931 conlength = fgetfilecon (ifd, &con);
1932 if (conlength == -1)
1933 report_file_error ("Doing fgetfilecon", file);
1935 #endif
1938 /* We can copy only regular files. */
1939 if (!S_ISREG (st.st_mode))
1940 report_file_errno ("Non-regular file", file,
1941 S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
1943 #ifndef MSDOS
1944 new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0700 : 0777);
1945 #else
1946 new_mask = S_IREAD | S_IWRITE;
1947 #endif
1949 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY | O_CREAT | O_EXCL,
1950 new_mask);
1951 if (ofd < 0 && errno == EEXIST)
1953 if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
1954 barf_or_query_if_file_exists (newname, true, "copy to it",
1955 INTEGERP (ok_if_already_exists), false);
1956 already_exists = true;
1957 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
1959 if (ofd < 0)
1960 report_file_error ("Opening output file", newname);
1962 record_unwind_protect_int (close_file_unwind, ofd);
1964 off_t oldsize = 0, newsize;
1966 if (already_exists)
1968 struct stat out_st;
1969 if (fstat (ofd, &out_st) != 0)
1970 report_file_error ("Output file status", newname);
1971 if (st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1972 report_file_errno ("Input and output files are the same",
1973 list2 (file, newname), 0);
1974 if (S_ISREG (out_st.st_mode))
1975 oldsize = out_st.st_size;
1978 maybe_quit ();
1980 if (clone_file (ofd, ifd))
1981 newsize = st.st_size;
1982 else
1984 char buf[MAX_ALLOCA];
1985 ptrdiff_t n;
1986 for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
1987 newsize += n)
1988 if (emacs_write_quit (ofd, buf, n) != n)
1989 report_file_error ("Write error", newname);
1990 if (n < 0)
1991 report_file_error ("Read error", file);
1994 /* Truncate any existing output file after writing the data. This
1995 is more likely to work than truncation before writing, if the
1996 file system is out of space or the user is over disk quota. */
1997 if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
1998 report_file_error ("Truncating output file", newname);
2000 #ifndef MSDOS
2001 /* Preserve the original file permissions, and if requested, also its
2002 owner and group. */
2004 mode_t preserved_permissions = st.st_mode & 07777;
2005 mode_t default_permissions = st.st_mode & 0777 & ~realmask;
2006 if (!NILP (preserve_uid_gid))
2008 /* Attempt to change owner and group. If that doesn't work
2009 attempt to change just the group, as that is sometimes allowed.
2010 Adjust the mode mask to eliminate setuid or setgid bits
2011 or group permissions bits that are inappropriate if the
2012 owner or group are wrong. */
2013 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2015 if (fchown (ofd, -1, st.st_gid) == 0)
2016 preserved_permissions &= ~04000;
2017 else
2019 preserved_permissions &= ~06000;
2021 /* Copy the other bits to the group bits, since the
2022 group is wrong. */
2023 preserved_permissions &= ~070;
2024 preserved_permissions |= (preserved_permissions & 7) << 3;
2025 default_permissions &= ~070;
2026 default_permissions |= (default_permissions & 7) << 3;
2031 switch (!NILP (preserve_permissions)
2032 ? qcopy_acl (SSDATA (encoded_file), ifd,
2033 SSDATA (encoded_newname), ofd,
2034 preserved_permissions)
2035 : (already_exists
2036 || (new_mask & ~realmask) == default_permissions)
2038 : fchmod (ofd, default_permissions))
2040 case -2: report_file_error ("Copying permissions from", file);
2041 case -1: report_file_error ("Copying permissions to", newname);
2044 #endif /* not MSDOS */
2046 #if HAVE_LIBSELINUX
2047 if (conlength > 0)
2049 /* Set the modified context back to the file. */
2050 bool fail = fsetfilecon (ofd, con) != 0;
2051 /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
2052 if (fail && errno != ENOTSUP)
2053 report_file_error ("Doing fsetfilecon", newname);
2055 freecon (con);
2057 #endif
2059 if (!NILP (keep_time))
2061 struct timespec atime = get_stat_atime (&st);
2062 struct timespec mtime = get_stat_mtime (&st);
2063 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
2064 xsignal2 (Qfile_date_error,
2065 build_string ("Cannot set file date"), newname);
2068 if (emacs_close (ofd) < 0)
2069 report_file_error ("Write error", newname);
2071 emacs_close (ifd);
2073 #ifdef MSDOS
2074 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2075 and if it can't, it tells so. Otherwise, under MSDOS we usually
2076 get only the READ bit, which will make the copied file read-only,
2077 so it's better not to chmod at all. */
2078 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2079 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2080 #endif /* MSDOS */
2081 #endif /* not WINDOWSNT */
2083 /* Discard the unwind protects. */
2084 specpdl_ptr = specpdl + count;
2086 return Qnil;
2089 DEFUN ("make-directory-internal", Fmake_directory_internal,
2090 Smake_directory_internal, 1, 1, 0,
2091 doc: /* Create a new directory named DIRECTORY. */)
2092 (Lisp_Object directory)
2094 const char *dir;
2095 Lisp_Object handler;
2096 Lisp_Object encoded_dir;
2098 CHECK_STRING (directory);
2099 directory = Fexpand_file_name (directory, Qnil);
2101 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
2102 if (!NILP (handler))
2103 return call2 (handler, Qmake_directory_internal, directory);
2105 encoded_dir = ENCODE_FILE (directory);
2107 dir = SSDATA (encoded_dir);
2109 if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
2110 report_file_error ("Creating directory", directory);
2112 return Qnil;
2115 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2116 Sdelete_directory_internal, 1, 1, 0,
2117 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2118 (Lisp_Object directory)
2120 const char *dir;
2121 Lisp_Object encoded_dir;
2123 CHECK_STRING (directory);
2124 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
2125 encoded_dir = ENCODE_FILE (directory);
2126 dir = SSDATA (encoded_dir);
2128 if (rmdir (dir) != 0)
2129 report_file_error ("Removing directory", directory);
2131 return Qnil;
2134 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
2135 "(list (read-file-name \
2136 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2137 \"Move file to trash: \" \"Delete file: \") \
2138 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2139 (null current-prefix-arg))",
2140 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2141 If file has multiple names, it continues to exist with the other names.
2142 TRASH non-nil means to trash the file instead of deleting, provided
2143 `delete-by-moving-to-trash' is non-nil.
2145 When called interactively, TRASH is t if no prefix argument is given.
2146 With a prefix argument, TRASH is nil. */)
2147 (Lisp_Object filename, Lisp_Object trash)
2149 Lisp_Object handler;
2150 Lisp_Object encoded_file;
2152 if (!NILP (Ffile_directory_p (filename))
2153 && NILP (Ffile_symlink_p (filename)))
2154 xsignal2 (Qfile_error,
2155 build_string ("Removing old name: is a directory"),
2156 filename);
2157 filename = Fexpand_file_name (filename, Qnil);
2159 handler = Ffind_file_name_handler (filename, Qdelete_file);
2160 if (!NILP (handler))
2161 return call3 (handler, Qdelete_file, filename, trash);
2163 if (delete_by_moving_to_trash && !NILP (trash))
2164 return call1 (Qmove_file_to_trash, filename);
2166 encoded_file = ENCODE_FILE (filename);
2168 if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT)
2169 report_file_error ("Removing old name", filename);
2170 return Qnil;
2173 static Lisp_Object
2174 internal_delete_file_1 (Lisp_Object ignore)
2176 return Qt;
2179 /* Delete file FILENAME, returning true if successful.
2180 This ignores `delete-by-moving-to-trash'. */
2182 bool
2183 internal_delete_file (Lisp_Object filename)
2185 Lisp_Object tem;
2187 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2188 Qt, internal_delete_file_1);
2189 return NILP (tem);
2192 /* Filesystems are case-sensitive on all supported systems except
2193 MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always
2194 case-insensitive on the first two, but they may or may not be
2195 case-insensitive on Cygwin and OS X. The following function
2196 attempts to provide a runtime test on those two systems. If the
2197 test is not conclusive, we assume case-insensitivity on Cygwin and
2198 case-sensitivity on Mac OS X.
2200 FIXME: Mounted filesystems on Posix hosts, like Samba shares or
2201 NFS-mounted Windows volumes, might be case-insensitive. Can we
2202 detect this? */
2204 static bool
2205 file_name_case_insensitive_p (const char *filename)
2207 /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
2208 those flags are available. As of this writing (2017-05-20),
2209 Cygwin is the only platform known to support the former (starting
2210 with Cygwin-2.6.1), and macOS is the only platform known to
2211 support the latter. */
2213 #ifdef _PC_CASE_INSENSITIVE
2214 int res = pathconf (filename, _PC_CASE_INSENSITIVE);
2215 if (res >= 0)
2216 return res > 0;
2217 #elif defined _PC_CASE_SENSITIVE
2218 int res = pathconf (filename, _PC_CASE_SENSITIVE);
2219 if (res >= 0)
2220 return res == 0;
2221 #endif
2223 #if defined CYGWIN || defined DOS_NT
2224 return true;
2225 #else
2226 return false;
2227 #endif
2230 DEFUN ("file-name-case-insensitive-p", Ffile_name_case_insensitive_p,
2231 Sfile_name_case_insensitive_p, 1, 1, 0,
2232 doc: /* Return t if file FILENAME is on a case-insensitive filesystem.
2233 The arg must be a string. */)
2234 (Lisp_Object filename)
2236 Lisp_Object handler;
2238 CHECK_STRING (filename);
2239 filename = Fexpand_file_name (filename, Qnil);
2241 /* If the file name has special constructs in it,
2242 call the corresponding file handler. */
2243 handler = Ffind_file_name_handler (filename, Qfile_name_case_insensitive_p);
2244 if (!NILP (handler))
2245 return call2 (handler, Qfile_name_case_insensitive_p, filename);
2247 filename = ENCODE_FILE (filename);
2248 return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil;
2251 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2252 "fRename file: \nGRename %s to file: \np",
2253 doc: /* Rename FILE as NEWNAME. Both args must be strings.
2254 If file has names other than FILE, it continues to have those names.
2255 If NEWNAME is a directory name, rename FILE to a like-named file under
2256 NEWNAME. For NEWNAME to be recognized as a directory name, it should
2257 end in a slash.
2259 Signal a `file-already-exists' error if a file NEWNAME already exists
2260 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2261 An integer third arg means request confirmation if NEWNAME already exists.
2262 This is what happens in interactive use with M-x. */)
2263 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2265 Lisp_Object handler;
2266 Lisp_Object encoded_file, encoded_newname;
2268 file = Fexpand_file_name (file, Qnil);
2270 /* If the filesystem is case-insensitive and the file names are
2271 identical but for case, treat it as a change-case request, and do
2272 not worry whether NEWNAME exists or whether it is a directory, as
2273 it is already another name for FILE. */
2274 bool case_only_rename = false;
2275 #if defined CYGWIN || defined DOS_NT
2276 if (!NILP (Ffile_name_case_insensitive_p (file)))
2278 newname = Fexpand_file_name (newname, Qnil);
2279 case_only_rename = !NILP (Fstring_equal (Fdowncase (file),
2280 Fdowncase (newname)));
2282 #endif
2284 if (!case_only_rename)
2285 newname = expand_cp_target (Fdirectory_file_name (file), newname);
2287 /* If the file name has special constructs in it,
2288 call the corresponding file handler. */
2289 handler = Ffind_file_name_handler (file, Qrename_file);
2290 if (NILP (handler))
2291 handler = Ffind_file_name_handler (newname, Qrename_file);
2292 if (!NILP (handler))
2293 return call4 (handler, Qrename_file,
2294 file, newname, ok_if_already_exists);
2296 encoded_file = ENCODE_FILE (file);
2297 encoded_newname = ENCODE_FILE (newname);
2299 bool plain_rename = (case_only_rename
2300 || (!NILP (ok_if_already_exists)
2301 && !INTEGERP (ok_if_already_exists)));
2302 int rename_errno UNINIT;
2303 if (!plain_rename)
2305 if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file),
2306 AT_FDCWD, SSDATA (encoded_newname))
2307 == 0)
2308 return Qnil;
2310 rename_errno = errno;
2311 switch (rename_errno)
2313 case EEXIST: case EINVAL: case ENOSYS:
2314 #if ENOSYS != ENOTSUP
2315 case ENOTSUP:
2316 #endif
2317 barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
2318 "rename to it",
2319 INTEGERP (ok_if_already_exists),
2320 false);
2321 plain_rename = true;
2322 break;
2326 if (plain_rename)
2328 if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
2329 return Qnil;
2330 rename_errno = errno;
2331 /* Don't prompt again. */
2332 ok_if_already_exists = Qt;
2334 else if (!NILP (ok_if_already_exists))
2335 ok_if_already_exists = Qt;
2337 if (rename_errno != EXDEV)
2338 report_file_errno ("Renaming", list2 (file, newname), rename_errno);
2340 struct stat file_st;
2341 bool dirp = !NILP (Fdirectory_name_p (file));
2342 if (!dirp)
2344 if (lstat (SSDATA (encoded_file), &file_st) != 0)
2345 report_file_error ("Renaming", list2 (file, newname));
2346 dirp = S_ISDIR (file_st.st_mode) != 0;
2348 if (dirp)
2349 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2350 else
2352 Lisp_Object symlink_target
2353 = (S_ISLNK (file_st.st_mode)
2354 ? emacs_readlinkat (AT_FDCWD, SSDATA (encoded_file))
2355 : Qnil);
2356 if (!NILP (symlink_target))
2357 Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
2358 else
2359 Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt);
2362 ptrdiff_t count = SPECPDL_INDEX ();
2363 specbind (Qdelete_by_moving_to_trash, Qnil);
2364 if (dirp)
2365 call2 (Qdelete_directory, file, Qt);
2366 else
2367 Fdelete_file (file, Qnil);
2368 return unbind_to (count, Qnil);
2371 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
2372 "fAdd name to file: \nGName to add to %s: \np",
2373 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
2374 If NEWNAME is a directory name, give FILE a like-named new name under
2375 NEWNAME.
2377 Signal a `file-already-exists' error if a file NEWNAME already exists
2378 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2379 An integer third arg means request confirmation if NEWNAME already exists.
2380 This is what happens in interactive use with M-x. */)
2381 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2383 Lisp_Object handler;
2384 Lisp_Object encoded_file, encoded_newname;
2386 file = Fexpand_file_name (file, Qnil);
2387 newname = expand_cp_target (file, newname);
2389 /* If the file name has special constructs in it,
2390 call the corresponding file handler. */
2391 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
2392 if (!NILP (handler))
2393 return call4 (handler, Qadd_name_to_file, file,
2394 newname, ok_if_already_exists);
2396 /* If the new name has special constructs in it,
2397 call the corresponding file handler. */
2398 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2399 if (!NILP (handler))
2400 return call4 (handler, Qadd_name_to_file, file,
2401 newname, ok_if_already_exists);
2403 encoded_file = ENCODE_FILE (file);
2404 encoded_newname = ENCODE_FILE (newname);
2406 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
2407 return Qnil;
2409 if (errno == EEXIST)
2411 if (NILP (ok_if_already_exists)
2412 || INTEGERP (ok_if_already_exists))
2413 barf_or_query_if_file_exists (newname, true, "make it a new name",
2414 INTEGERP (ok_if_already_exists), false);
2415 unlink (SSDATA (newname));
2416 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
2417 return Qnil;
2420 report_file_error ("Adding new name", list2 (file, newname));
2423 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
2424 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2425 doc: /* Make a symbolic link to TARGET, named NEWNAME.
2426 If NEWNAME is a directory name, make a like-named symbolic link under
2427 NEWNAME.
2429 Signal a `file-already-exists' error if a file NEWNAME already exists
2430 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2431 An integer third arg means request confirmation if NEWNAME already
2432 exists, and expand leading "~" or strip leading "/:" in TARGET.
2433 This happens for interactive use with M-x. */)
2434 (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
2436 Lisp_Object handler;
2437 Lisp_Object encoded_target, encoded_linkname;
2439 CHECK_STRING (target);
2440 if (INTEGERP (ok_if_already_exists))
2442 if (SREF (target, 0) == '~')
2443 target = Fexpand_file_name (target, Qnil);
2444 else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
2445 target = Fsubstring_no_properties (target, make_number (2), Qnil);
2447 linkname = expand_cp_target (target, linkname);
2449 /* If the new link name has special constructs in it,
2450 call the corresponding file handler. */
2451 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2452 if (!NILP (handler))
2453 return call4 (handler, Qmake_symbolic_link, target,
2454 linkname, ok_if_already_exists);
2456 encoded_target = ENCODE_FILE (target);
2457 encoded_linkname = ENCODE_FILE (linkname);
2459 if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
2460 return Qnil;
2462 if (errno == ENOSYS)
2463 xsignal1 (Qfile_error,
2464 build_string ("Symbolic links are not supported"));
2466 if (errno == EEXIST)
2468 if (NILP (ok_if_already_exists)
2469 || INTEGERP (ok_if_already_exists))
2470 barf_or_query_if_file_exists (linkname, true, "make it a link",
2471 INTEGERP (ok_if_already_exists), false);
2472 unlink (SSDATA (encoded_linkname));
2473 if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
2474 return Qnil;
2477 report_file_error ("Making symbolic link", list2 (target, linkname));
2481 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2482 1, 1, 0,
2483 doc: /* Return t if FILENAME is an absolute file name or starts with `~'.
2484 On Unix, absolute file names start with `/'. */)
2485 (Lisp_Object filename)
2487 CHECK_STRING (filename);
2488 return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
2491 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2492 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2493 See also `file-readable-p' and `file-attributes'.
2494 This returns nil for a symlink to a nonexistent file.
2495 Use `file-symlink-p' to test for such links. */)
2496 (Lisp_Object filename)
2498 Lisp_Object absname;
2499 Lisp_Object handler;
2501 CHECK_STRING (filename);
2502 absname = Fexpand_file_name (filename, Qnil);
2504 /* If the file name has special constructs in it,
2505 call the corresponding file handler. */
2506 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2507 if (!NILP (handler))
2509 Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
2510 errno = 0;
2511 return result;
2514 absname = ENCODE_FILE (absname);
2516 return check_existing (SSDATA (absname)) ? Qt : Qnil;
2519 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
2520 doc: /* Return t if FILENAME can be executed by you.
2521 For a directory, this means you can access files in that directory.
2522 \(It is generally better to use `file-accessible-directory-p' for that
2523 purpose, though.) */)
2524 (Lisp_Object filename)
2526 Lisp_Object absname;
2527 Lisp_Object handler;
2529 CHECK_STRING (filename);
2530 absname = Fexpand_file_name (filename, Qnil);
2532 /* If the file name has special constructs in it,
2533 call the corresponding file handler. */
2534 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2535 if (!NILP (handler))
2536 return call2 (handler, Qfile_executable_p, absname);
2538 absname = ENCODE_FILE (absname);
2540 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
2543 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2544 doc: /* Return t if file FILENAME exists and you can read it.
2545 See also `file-exists-p' and `file-attributes'. */)
2546 (Lisp_Object filename)
2548 Lisp_Object absname;
2549 Lisp_Object handler;
2551 CHECK_STRING (filename);
2552 absname = Fexpand_file_name (filename, Qnil);
2554 /* If the file name has special constructs in it,
2555 call the corresponding file handler. */
2556 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2557 if (!NILP (handler))
2558 return call2 (handler, Qfile_readable_p, absname);
2560 absname = ENCODE_FILE (absname);
2561 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2562 ? Qt : Qnil);
2565 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2566 doc: /* Return t if file FILENAME can be written or created by you. */)
2567 (Lisp_Object filename)
2569 Lisp_Object absname, dir, encoded;
2570 Lisp_Object handler;
2572 CHECK_STRING (filename);
2573 absname = Fexpand_file_name (filename, Qnil);
2575 /* If the file name has special constructs in it,
2576 call the corresponding file handler. */
2577 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
2578 if (!NILP (handler))
2579 return call2 (handler, Qfile_writable_p, absname);
2581 encoded = ENCODE_FILE (absname);
2582 if (check_writable (SSDATA (encoded), W_OK))
2583 return Qt;
2584 if (errno != ENOENT)
2585 return Qnil;
2587 dir = Ffile_name_directory (absname);
2588 eassert (!NILP (dir));
2589 #ifdef MSDOS
2590 dir = Fdirectory_file_name (dir);
2591 #endif /* MSDOS */
2593 dir = ENCODE_FILE (dir);
2594 #ifdef WINDOWSNT
2595 /* The read-only attribute of the parent directory doesn't affect
2596 whether a file or directory can be created within it. Some day we
2597 should check ACLs though, which do affect this. */
2598 return file_directory_p (SSDATA (dir)) ? Qt : Qnil;
2599 #else
2600 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
2601 #endif
2604 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2605 doc: /* Access file FILENAME, and get an error if that does not work.
2606 The second argument STRING is prepended to the error message.
2607 If there is no error, returns nil. */)
2608 (Lisp_Object filename, Lisp_Object string)
2610 Lisp_Object handler, encoded_filename, absname;
2612 CHECK_STRING (filename);
2613 absname = Fexpand_file_name (filename, Qnil);
2615 CHECK_STRING (string);
2617 /* If the file name has special constructs in it,
2618 call the corresponding file handler. */
2619 handler = Ffind_file_name_handler (absname, Qaccess_file);
2620 if (!NILP (handler))
2621 return call3 (handler, Qaccess_file, absname, string);
2623 encoded_filename = ENCODE_FILE (absname);
2625 if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
2626 report_file_error (SSDATA (string), filename);
2628 return Qnil;
2631 /* Relative to directory FD, return the symbolic link value of FILENAME.
2632 On failure, return nil. */
2633 Lisp_Object
2634 emacs_readlinkat (int fd, char const *filename)
2636 static struct allocator const emacs_norealloc_allocator =
2637 { xmalloc, NULL, xfree, memory_full };
2638 Lisp_Object val;
2639 char readlink_buf[1024];
2640 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2641 &emacs_norealloc_allocator, readlinkat);
2642 if (!buf)
2643 return Qnil;
2645 val = build_unibyte_string (buf);
2646 if (buf != readlink_buf)
2647 xfree (buf);
2648 val = DECODE_FILE (val);
2649 return val;
2652 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2653 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2654 The value is the link target, as a string.
2655 Otherwise it returns nil.
2657 This function does not check whether the link target exists. */)
2658 (Lisp_Object filename)
2660 Lisp_Object handler;
2662 CHECK_STRING (filename);
2663 filename = Fexpand_file_name (filename, Qnil);
2665 /* If the file name has special constructs in it,
2666 call the corresponding file handler. */
2667 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2668 if (!NILP (handler))
2669 return call2 (handler, Qfile_symlink_p, filename);
2671 filename = ENCODE_FILE (filename);
2673 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2676 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2677 doc: /* Return t if FILENAME names an existing directory.
2678 Symbolic links to directories count as directories.
2679 See `file-symlink-p' to distinguish symlinks. */)
2680 (Lisp_Object filename)
2682 Lisp_Object absname = expand_and_dir_to_file (filename);
2684 /* If the file name has special constructs in it,
2685 call the corresponding file handler. */
2686 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p);
2687 if (!NILP (handler))
2688 return call2 (handler, Qfile_directory_p, absname);
2690 absname = ENCODE_FILE (absname);
2692 return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
2695 /* Return true if FILE is a directory or a symlink to a directory. */
2696 bool
2697 file_directory_p (char const *file)
2699 #ifdef WINDOWSNT
2700 /* This is cheaper than 'stat'. */
2701 return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
2702 #else
2703 struct stat st;
2704 return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
2705 #endif
2708 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
2709 Sfile_accessible_directory_p, 1, 1, 0,
2710 doc: /* Return t if FILENAME names a directory you can open.
2711 For the value to be t, FILENAME must specify the name of a directory
2712 as a file, and the directory must allow you to open files in it. In
2713 order to use a directory as a buffer's current directory, this
2714 predicate must return true. A directory name spec may be given
2715 instead; then the value is t if the directory so specified exists and
2716 really is a readable and searchable directory. */)
2717 (Lisp_Object filename)
2719 Lisp_Object absname;
2720 Lisp_Object handler;
2722 CHECK_STRING (filename);
2723 absname = Fexpand_file_name (filename, Qnil);
2725 /* If the file name has special constructs in it,
2726 call the corresponding file handler. */
2727 handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
2728 if (!NILP (handler))
2730 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2732 /* Set errno in case the handler failed. EACCES might be a lie
2733 (e.g., the directory might not exist, or be a regular file),
2734 but at least it does TRT in the "usual" case of an existing
2735 directory that is not accessible by the current user, and
2736 avoids reporting "Success" for a failed operation. Perhaps
2737 someday we can fix this in a better way, by improving
2738 file-accessible-directory-p's API; see Bug#25419. */
2739 if (!EQ (r, Qt))
2740 errno = EACCES;
2742 return r;
2745 absname = ENCODE_FILE (absname);
2746 return file_accessible_directory_p (absname) ? Qt : Qnil;
2749 /* If FILE is a searchable directory or a symlink to a
2750 searchable directory, return true. Otherwise return
2751 false and set errno to an error number. */
2752 bool
2753 file_accessible_directory_p (Lisp_Object file)
2755 #ifdef DOS_NT
2756 # ifdef WINDOWSNT
2757 /* We need a special-purpose test because (a) NTFS security data is
2758 not reflected in Posix-style mode bits, and (b) the trick with
2759 accessing "DIR/.", used below on Posix hosts, doesn't work on
2760 Windows, because "DIR/." is normalized to just "DIR" before
2761 hitting the disk. */
2762 return (SBYTES (file) == 0
2763 || w32_accessible_directory_p (SSDATA (file), SBYTES (file)));
2764 # else /* MSDOS */
2765 return file_directory_p (SSDATA (file));
2766 # endif /* MSDOS */
2767 #else /* !DOS_NT */
2768 /* On POSIXish platforms, use just one system call; this avoids a
2769 race and is typically faster. */
2770 const char *data = SSDATA (file);
2771 ptrdiff_t len = SBYTES (file);
2772 char const *dir;
2773 bool ok;
2774 int saved_errno;
2775 USE_SAFE_ALLOCA;
2777 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2778 There are three exceptions: "", "/", and "//". Leave "" alone,
2779 as it's invalid. Append only "." to the other two exceptions as
2780 "/" and "//" are distinct on some platforms, whereas "/", "///",
2781 "////", etc. are all equivalent. */
2782 if (! len)
2783 dir = data;
2784 else
2786 /* Just check for trailing '/' when deciding whether to append '/'.
2787 That's simpler than testing the two special cases "/" and "//",
2788 and it's a safe optimization here. */
2789 char *buf = SAFE_ALLOCA (len + 3);
2790 memcpy (buf, data, len);
2791 strcpy (buf + len, &"/."[data[len - 1] == '/']);
2792 dir = buf;
2795 ok = check_existing (dir);
2796 saved_errno = errno;
2797 SAFE_FREE ();
2798 errno = saved_errno;
2799 return ok;
2800 #endif /* !DOS_NT */
2803 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
2804 doc: /* Return t if FILENAME names a regular file.
2805 This is the sort of file that holds an ordinary stream of data bytes.
2806 Symbolic links to regular files count as regular files.
2807 See `file-symlink-p' to distinguish symlinks. */)
2808 (Lisp_Object filename)
2810 struct stat st;
2811 Lisp_Object absname = expand_and_dir_to_file (filename);
2813 /* If the file name has special constructs in it,
2814 call the corresponding file handler. */
2815 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_regular_p);
2816 if (!NILP (handler))
2817 return call2 (handler, Qfile_regular_p, absname);
2819 absname = ENCODE_FILE (absname);
2821 #ifdef WINDOWSNT
2823 int result;
2824 Lisp_Object tem = Vw32_get_true_file_attributes;
2826 /* Tell stat to use expensive method to get accurate info. */
2827 Vw32_get_true_file_attributes = Qt;
2828 result = stat (SSDATA (absname), &st);
2829 Vw32_get_true_file_attributes = tem;
2831 if (result < 0)
2832 return Qnil;
2833 return S_ISREG (st.st_mode) ? Qt : Qnil;
2835 #else
2836 if (stat (SSDATA (absname), &st) < 0)
2837 return Qnil;
2838 return S_ISREG (st.st_mode) ? Qt : Qnil;
2839 #endif
2842 DEFUN ("file-selinux-context", Ffile_selinux_context,
2843 Sfile_selinux_context, 1, 1, 0,
2844 doc: /* Return SELinux context of file named FILENAME.
2845 The return value is a list (USER ROLE TYPE RANGE), where the list
2846 elements are strings naming the user, role, type, and range of the
2847 file's SELinux security context.
2849 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2850 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2851 (Lisp_Object filename)
2853 Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
2854 Lisp_Object absname = expand_and_dir_to_file (filename);
2856 /* If the file name has special constructs in it,
2857 call the corresponding file handler. */
2858 Lisp_Object handler = Ffind_file_name_handler (absname,
2859 Qfile_selinux_context);
2860 if (!NILP (handler))
2861 return call2 (handler, Qfile_selinux_context, absname);
2863 absname = ENCODE_FILE (absname);
2865 #if HAVE_LIBSELINUX
2866 if (is_selinux_enabled ())
2868 security_context_t con;
2869 int conlength = lgetfilecon (SSDATA (absname), &con);
2870 if (conlength > 0)
2872 context_t context = context_new (con);
2873 if (context_user_get (context))
2874 user = build_string (context_user_get (context));
2875 if (context_role_get (context))
2876 role = build_string (context_role_get (context));
2877 if (context_type_get (context))
2878 type = build_string (context_type_get (context));
2879 if (context_range_get (context))
2880 range = build_string (context_range_get (context));
2881 context_free (context);
2882 freecon (con);
2885 #endif
2887 return list4 (user, role, type, range);
2890 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2891 Sset_file_selinux_context, 2, 2, 0,
2892 doc: /* Set SELinux context of file named FILENAME to CONTEXT.
2893 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2894 elements are strings naming the components of a SELinux context.
2896 Value is t if setting of SELinux context was successful, nil otherwise.
2898 This function does nothing and returns nil if SELinux is disabled,
2899 or if Emacs was not compiled with SELinux support. */)
2900 (Lisp_Object filename, Lisp_Object context)
2902 Lisp_Object absname;
2903 Lisp_Object handler;
2904 #if HAVE_LIBSELINUX
2905 Lisp_Object encoded_absname;
2906 Lisp_Object user = CAR_SAFE (context);
2907 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2908 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2909 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
2910 security_context_t con;
2911 bool fail;
2912 int conlength;
2913 context_t parsed_con;
2914 #endif
2916 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
2918 /* If the file name has special constructs in it,
2919 call the corresponding file handler. */
2920 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2921 if (!NILP (handler))
2922 return call3 (handler, Qset_file_selinux_context, absname, context);
2924 #if HAVE_LIBSELINUX
2925 if (is_selinux_enabled ())
2927 /* Get current file context. */
2928 encoded_absname = ENCODE_FILE (absname);
2929 conlength = lgetfilecon (SSDATA (encoded_absname), &con);
2930 if (conlength > 0)
2932 parsed_con = context_new (con);
2933 /* Change the parts defined in the parameter.*/
2934 if (STRINGP (user))
2936 if (context_user_set (parsed_con, SSDATA (user)))
2937 error ("Doing context_user_set");
2939 if (STRINGP (role))
2941 if (context_role_set (parsed_con, SSDATA (role)))
2942 error ("Doing context_role_set");
2944 if (STRINGP (type))
2946 if (context_type_set (parsed_con, SSDATA (type)))
2947 error ("Doing context_type_set");
2949 if (STRINGP (range))
2951 if (context_range_set (parsed_con, SSDATA (range)))
2952 error ("Doing context_range_set");
2955 /* Set the modified context back to the file. */
2956 fail = (lsetfilecon (SSDATA (encoded_absname),
2957 context_str (parsed_con))
2958 != 0);
2959 /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
2960 if (fail && errno != ENOTSUP)
2961 report_file_error ("Doing lsetfilecon", absname);
2963 context_free (parsed_con);
2964 freecon (con);
2965 return fail ? Qnil : Qt;
2967 else
2968 report_file_error ("Doing lgetfilecon", absname);
2970 #endif
2972 return Qnil;
2975 DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
2976 doc: /* Return ACL entries of file named FILENAME.
2977 The entries are returned in a format suitable for use in `set-file-acl'
2978 but is otherwise undocumented and subject to change.
2979 Return nil if file does not exist or is not accessible, or if Emacs
2980 was unable to determine the ACL entries. */)
2981 (Lisp_Object filename)
2983 Lisp_Object acl_string = Qnil;
2985 #if USE_ACL
2986 Lisp_Object absname = expand_and_dir_to_file (filename);
2988 /* If the file name has special constructs in it,
2989 call the corresponding file handler. */
2990 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_acl);
2991 if (!NILP (handler))
2992 return call2 (handler, Qfile_acl, absname);
2994 # ifdef HAVE_ACL_SET_FILE
2995 absname = ENCODE_FILE (absname);
2997 # ifndef HAVE_ACL_TYPE_EXTENDED
2998 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
2999 # endif
3000 acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
3001 if (acl == NULL)
3002 return Qnil;
3004 char *str = acl_to_text (acl, NULL);
3005 if (str == NULL)
3007 acl_free (acl);
3008 return Qnil;
3011 acl_string = build_string (str);
3012 acl_free (str);
3013 acl_free (acl);
3014 # endif
3015 #endif
3017 return acl_string;
3020 DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
3021 2, 2, 0,
3022 doc: /* Set ACL of file named FILENAME to ACL-STRING.
3023 ACL-STRING should contain the textual representation of the ACL
3024 entries in a format suitable for the platform.
3026 Value is t if setting of ACL was successful, nil otherwise.
3028 Setting ACL for local files requires Emacs to be built with ACL
3029 support. */)
3030 (Lisp_Object filename, Lisp_Object acl_string)
3032 #if USE_ACL
3033 Lisp_Object absname;
3034 Lisp_Object handler;
3035 # ifdef HAVE_ACL_SET_FILE
3036 Lisp_Object encoded_absname;
3037 acl_t acl;
3038 bool fail;
3039 # endif
3041 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3043 /* If the file name has special constructs in it,
3044 call the corresponding file handler. */
3045 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3046 if (!NILP (handler))
3047 return call3 (handler, Qset_file_acl, absname, acl_string);
3049 # ifdef HAVE_ACL_SET_FILE
3050 if (STRINGP (acl_string))
3052 acl = acl_from_text (SSDATA (acl_string));
3053 if (acl == NULL)
3055 if (acl_errno_valid (errno))
3056 report_file_error ("Converting ACL", absname);
3057 return Qnil;
3060 encoded_absname = ENCODE_FILE (absname);
3062 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3063 acl)
3064 != 0);
3065 if (fail && acl_errno_valid (errno))
3066 report_file_error ("Setting ACL", absname);
3068 acl_free (acl);
3069 return fail ? Qnil : Qt;
3071 # endif
3072 #endif
3074 return Qnil;
3077 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3078 doc: /* Return mode bits of file named FILENAME, as an integer.
3079 Return nil, if file does not exist or is not accessible. */)
3080 (Lisp_Object filename)
3082 struct stat st;
3083 Lisp_Object absname = expand_and_dir_to_file (filename);
3085 /* If the file name has special constructs in it,
3086 call the corresponding file handler. */
3087 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes);
3088 if (!NILP (handler))
3089 return call2 (handler, Qfile_modes, absname);
3091 absname = ENCODE_FILE (absname);
3093 if (stat (SSDATA (absname), &st) < 0)
3094 return Qnil;
3096 return make_number (st.st_mode & 07777);
3099 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
3100 "(let ((file (read-file-name \"File: \"))) \
3101 (list file (read-file-modes nil file)))",
3102 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
3103 Only the 12 low bits of MODE are used.
3105 Interactively, mode bits are read by `read-file-modes', which accepts
3106 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3107 (Lisp_Object filename, Lisp_Object mode)
3109 Lisp_Object absname, encoded_absname;
3110 Lisp_Object handler;
3112 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3113 CHECK_NUMBER (mode);
3115 /* If the file name has special constructs in it,
3116 call the corresponding file handler. */
3117 handler = Ffind_file_name_handler (absname, Qset_file_modes);
3118 if (!NILP (handler))
3119 return call3 (handler, Qset_file_modes, absname, mode);
3121 encoded_absname = ENCODE_FILE (absname);
3123 if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
3124 report_file_error ("Doing chmod", absname);
3126 return Qnil;
3129 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
3130 doc: /* Set the file permission bits for newly created files.
3131 The argument MODE should be an integer; only the low 9 bits are used.
3132 On Posix hosts, this setting is inherited by subprocesses.
3134 This function works by setting the Emacs's file mode creation mask.
3135 Each bit that is set in the mask means that the corresponding bit
3136 in the permissions of newly created files will be disabled.
3138 Note that when `write-region' creates a file, it resets the
3139 execute bit, even if the mask set by this function allows that bit
3140 by having the corresponding bit in the mask reset. */)
3141 (Lisp_Object mode)
3143 mode_t oldrealmask, oldumask, newumask;
3144 CHECK_NUMBER (mode);
3145 oldrealmask = realmask;
3146 newumask = ~ XINT (mode) & 0777;
3148 block_input ();
3149 realmask = newumask;
3150 oldumask = umask (newumask);
3151 unblock_input ();
3153 eassert (oldumask == oldrealmask);
3154 return Qnil;
3157 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
3158 doc: /* Return the default file protection for created files.
3159 The value is an integer. */)
3160 (void)
3162 Lisp_Object value;
3163 XSETINT (value, (~ realmask) & 0777);
3164 return value;
3168 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
3169 doc: /* Set times of file FILENAME to TIMESTAMP.
3170 Set both access and modification times.
3171 Return t on success, else nil.
3172 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3173 `current-time'. */)
3174 (Lisp_Object filename, Lisp_Object timestamp)
3176 Lisp_Object absname, encoded_absname;
3177 Lisp_Object handler;
3178 struct timespec t = lisp_time_argument (timestamp);
3180 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3182 /* If the file name has special constructs in it,
3183 call the corresponding file handler. */
3184 handler = Ffind_file_name_handler (absname, Qset_file_times);
3185 if (!NILP (handler))
3186 return call3 (handler, Qset_file_times, absname, timestamp);
3188 encoded_absname = ENCODE_FILE (absname);
3191 if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
3193 #ifdef MSDOS
3194 /* Setting times on a directory always fails. */
3195 if (file_directory_p (SSDATA (encoded_absname)))
3196 return Qnil;
3197 #endif
3198 report_file_error ("Setting file times", absname);
3202 return Qt;
3205 #ifdef HAVE_SYNC
3206 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3207 doc: /* Tell Unix to finish all pending disk updates. */)
3208 (void)
3210 sync ();
3211 return Qnil;
3214 #endif /* HAVE_SYNC */
3216 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3217 doc: /* Return t if file FILE1 is newer than file FILE2.
3218 If FILE1 does not exist, the answer is nil;
3219 otherwise, if FILE2 does not exist, the answer is t. */)
3220 (Lisp_Object file1, Lisp_Object file2)
3222 struct stat st1, st2;
3224 CHECK_STRING (file1);
3225 CHECK_STRING (file2);
3227 Lisp_Object absname1 = expand_and_dir_to_file (file1);
3228 Lisp_Object absname2 = expand_and_dir_to_file (file2);
3230 /* If the file name has special constructs in it,
3231 call the corresponding file handler. */
3232 Lisp_Object handler = Ffind_file_name_handler (absname1,
3233 Qfile_newer_than_file_p);
3234 if (NILP (handler))
3235 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
3236 if (!NILP (handler))
3237 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3239 absname1 = ENCODE_FILE (absname1);
3240 absname2 = ENCODE_FILE (absname2);
3242 if (stat (SSDATA (absname1), &st1) < 0)
3243 return Qnil;
3245 if (stat (SSDATA (absname2), &st2) < 0)
3246 return Qt;
3248 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
3249 ? Qt : Qnil);
3252 enum { READ_BUF_SIZE = MAX_ALLOCA };
3254 /* This function is called after Lisp functions to decide a coding
3255 system are called, or when they cause an error. Before they are
3256 called, the current buffer is set unibyte and it contains only a
3257 newly inserted text (thus the buffer was empty before the
3258 insertion).
3260 The functions may set markers, overlays, text properties, or even
3261 alter the buffer contents, change the current buffer.
3263 Here, we reset all those changes by:
3264 o set back the current buffer.
3265 o move all markers and overlays to BEG.
3266 o remove all text properties.
3267 o set back the buffer multibyteness. */
3269 static void
3270 decide_coding_unwind (Lisp_Object unwind_data)
3272 Lisp_Object multibyte, undo_list, buffer;
3274 multibyte = XCAR (unwind_data);
3275 unwind_data = XCDR (unwind_data);
3276 undo_list = XCAR (unwind_data);
3277 buffer = XCDR (unwind_data);
3279 set_buffer_internal (XBUFFER (buffer));
3280 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3281 adjust_overlays_for_delete (BEG, Z - BEG);
3282 set_buffer_intervals (current_buffer, NULL);
3283 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3285 /* Now we are safe to change the buffer's multibyteness directly. */
3286 bset_enable_multibyte_characters (current_buffer, multibyte);
3287 bset_undo_list (current_buffer, undo_list);
3290 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3291 object where slot 0 is the file descriptor, slot 1 specifies
3292 an offset to put the read bytes, and slot 2 is the maximum
3293 amount of bytes to read. Value is the number of bytes read. */
3295 static Lisp_Object
3296 read_non_regular (Lisp_Object state)
3298 int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
3299 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3300 + XSAVE_INTEGER (state, 1)),
3301 XSAVE_INTEGER (state, 2));
3302 /* Fast recycle this object for the likely next call. */
3303 free_misc (state);
3304 return make_number (nbytes);
3308 /* Condition-case handler used when reading from non-regular files
3309 in insert-file-contents. */
3311 static Lisp_Object
3312 read_non_regular_quit (Lisp_Object ignore)
3314 return Qnil;
3317 /* Return the file offset that VAL represents, checking for type
3318 errors and overflow. */
3319 static off_t
3320 file_offset (Lisp_Object val)
3322 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3323 return XINT (val);
3325 if (FLOATP (val))
3327 double v = XFLOAT_DATA (val);
3328 if (0 <= v && v < 1.0 + TYPE_MAXIMUM (off_t))
3330 off_t o = v;
3331 if (o == v)
3332 return o;
3336 wrong_type_argument (intern ("file-offset"), val);
3339 /* Return a special time value indicating the error number ERRNUM. */
3340 static struct timespec
3341 time_error_value (int errnum)
3343 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
3344 ? NONEXISTENT_MODTIME_NSECS
3345 : UNKNOWN_MODTIME_NSECS);
3346 return make_timespec (0, ns);
3349 static Lisp_Object
3350 get_window_points_and_markers (void)
3352 Lisp_Object pt_marker = Fpoint_marker ();
3353 Lisp_Object windows
3354 = call3 (Qget_buffer_window_list, Fcurrent_buffer (), Qnil, Qt);
3355 Lisp_Object window_markers = windows;
3356 /* Window markers (and point) are handled specially: rather than move to
3357 just before or just after the modified text, we try to keep the
3358 markers at the same distance (bug#19161).
3359 In general, this is wrong, but for window-markers, this should be harmless
3360 and is convenient for the end user when most of the file is unmodified,
3361 except for a few minor details near the beginning and near the end. */
3362 for (; CONSP (windows); windows = XCDR (windows))
3363 if (WINDOWP (XCAR (windows)))
3365 Lisp_Object window_marker = XWINDOW (XCAR (windows))->pointm;
3366 XSETCAR (windows,
3367 Fcons (window_marker, Fmarker_position (window_marker)));
3369 return Fcons (Fcons (pt_marker, Fpoint ()), window_markers);
3372 static void
3373 restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
3374 ptrdiff_t same_at_start, ptrdiff_t same_at_end)
3376 for (; CONSP (window_markers); window_markers = XCDR (window_markers))
3377 if (CONSP (XCAR (window_markers)))
3379 Lisp_Object car = XCAR (window_markers);
3380 Lisp_Object marker = XCAR (car);
3381 Lisp_Object oldpos = XCDR (car);
3382 if (MARKERP (marker) && INTEGERP (oldpos)
3383 && XINT (oldpos) > same_at_start
3384 && XINT (oldpos) < same_at_end)
3386 ptrdiff_t oldsize = same_at_end - same_at_start;
3387 ptrdiff_t newsize = inserted;
3388 double growth = newsize / (double)oldsize;
3389 ptrdiff_t newpos
3390 = same_at_start + growth * (XINT (oldpos) - same_at_start);
3391 Fset_marker (marker, make_number (newpos), Qnil);
3396 /* Make sure the gap is at Z_BYTE. This is required to treat buffer
3397 text as a linear C char array. */
3398 static void
3399 maybe_move_gap (struct buffer *b)
3401 if (BUF_GPT_BYTE (b) != BUF_Z_BYTE (b))
3403 struct buffer *cb = current_buffer;
3405 set_buffer_internal (b);
3406 move_gap_both (Z, Z_BYTE);
3407 set_buffer_internal (cb);
3411 /* FIXME: insert-file-contents should be split with the top-level moved to
3412 Elisp and only the core kept in C. */
3414 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
3415 1, 5, 0,
3416 doc: /* Insert contents of file FILENAME after point.
3417 Returns list of absolute file name and number of characters inserted.
3418 If second argument VISIT is non-nil, the buffer's visited filename and
3419 last save file modtime are set, and it is marked unmodified. If
3420 visiting and the file does not exist, visiting is completed before the
3421 error is signaled.
3423 The optional third and fourth arguments BEG and END specify what portion
3424 of the file to insert. These arguments count bytes in the file, not
3425 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3427 If optional fifth argument REPLACE is non-nil, replace the current
3428 buffer contents (in the accessible portion) with the file contents.
3429 This is better than simply deleting and inserting the whole thing
3430 because (1) it preserves some marker positions and (2) it puts less data
3431 in the undo list. When REPLACE is non-nil, the second return value is
3432 the number of characters that replace previous buffer contents.
3434 This function does code conversion according to the value of
3435 `coding-system-for-read' or `file-coding-system-alist', and sets the
3436 variable `last-coding-system-used' to the coding system actually used.
3438 In addition, this function decodes the inserted text from known formats
3439 by calling `format-decode', which see. */)
3440 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3442 struct stat st;
3443 struct timespec mtime;
3444 int fd;
3445 ptrdiff_t inserted = 0;
3446 ptrdiff_t how_much;
3447 off_t beg_offset, end_offset;
3448 int unprocessed;
3449 ptrdiff_t count = SPECPDL_INDEX ();
3450 Lisp_Object handler, val, insval, orig_filename, old_undo;
3451 Lisp_Object p;
3452 ptrdiff_t total = 0;
3453 bool not_regular = 0;
3454 int save_errno = 0;
3455 char read_buf[READ_BUF_SIZE];
3456 struct coding_system coding;
3457 bool replace_handled = false;
3458 bool set_coding_system = false;
3459 Lisp_Object coding_system;
3460 bool read_quit = false;
3461 /* If the undo log only contains the insertion, there's no point
3462 keeping it. It's typically when we first fill a file-buffer. */
3463 bool empty_undo_list_p
3464 = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
3465 && BEG == Z);
3466 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
3467 bool we_locked_file = false;
3468 ptrdiff_t fd_index;
3469 Lisp_Object window_markers = Qnil;
3470 /* same_at_start and same_at_end count bytes, because file access counts
3471 bytes and BEG and END count bytes. */
3472 ptrdiff_t same_at_start = BEGV_BYTE;
3473 ptrdiff_t same_at_end = ZV_BYTE;
3474 /* SAME_AT_END_CHARPOS counts characters, because
3475 restore_window_points needs the old character count. */
3476 ptrdiff_t same_at_end_charpos = ZV;
3478 if (current_buffer->base_buffer && ! NILP (visit))
3479 error ("Cannot do file visiting in an indirect buffer");
3481 if (!NILP (BVAR (current_buffer, read_only)))
3482 Fbarf_if_buffer_read_only (Qnil);
3484 val = Qnil;
3485 p = Qnil;
3486 orig_filename = Qnil;
3487 old_undo = Qnil;
3489 CHECK_STRING (filename);
3490 filename = Fexpand_file_name (filename, Qnil);
3492 /* The value Qnil means that the coding system is not yet
3493 decided. */
3494 coding_system = Qnil;
3496 /* If the file name has special constructs in it,
3497 call the corresponding file handler. */
3498 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3499 if (!NILP (handler))
3501 val = call6 (handler, Qinsert_file_contents, filename,
3502 visit, beg, end, replace);
3503 if (CONSP (val) && CONSP (XCDR (val))
3504 && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
3505 inserted = XINT (XCAR (XCDR (val)));
3506 goto handled;
3509 orig_filename = filename;
3510 filename = ENCODE_FILE (filename);
3512 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3513 if (fd < 0)
3515 save_errno = errno;
3516 if (NILP (visit))
3517 report_file_error ("Opening input file", orig_filename);
3518 mtime = time_error_value (save_errno);
3519 st.st_size = -1;
3520 if (!NILP (Vcoding_system_for_read))
3522 /* Don't let invalid values into buffer-file-coding-system. */
3523 CHECK_CODING_SYSTEM (Vcoding_system_for_read);
3524 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3526 goto notfound;
3529 fd_index = SPECPDL_INDEX ();
3530 record_unwind_protect_int (close_file_unwind, fd);
3532 /* Replacement should preserve point as it preserves markers. */
3533 if (!NILP (replace))
3535 window_markers = get_window_points_and_markers ();
3536 record_unwind_protect (restore_point_unwind,
3537 XCAR (XCAR (window_markers)));
3540 if (fstat (fd, &st) != 0)
3541 report_file_error ("Input file status", orig_filename);
3542 mtime = get_stat_mtime (&st);
3544 /* This code will need to be changed in order to work on named
3545 pipes, and it's probably just not worth it. So we should at
3546 least signal an error. */
3547 if (!S_ISREG (st.st_mode))
3549 not_regular = 1;
3551 if (! NILP (visit))
3552 goto notfound;
3554 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
3555 xsignal2 (Qfile_error,
3556 build_string ("not a regular file"), orig_filename);
3559 if (!NILP (visit))
3561 if (!NILP (beg) || !NILP (end))
3562 error ("Attempt to visit less than an entire file");
3563 if (BEG < Z && NILP (replace))
3564 error ("Cannot do file visiting in a non-empty buffer");
3567 if (!NILP (beg))
3568 beg_offset = file_offset (beg);
3569 else
3570 beg_offset = 0;
3572 if (!NILP (end))
3573 end_offset = file_offset (end);
3574 else
3576 if (not_regular)
3577 end_offset = TYPE_MAXIMUM (off_t);
3578 else
3580 end_offset = st.st_size;
3582 /* A negative size can happen on a platform that allows file
3583 sizes greater than the maximum off_t value. */
3584 if (end_offset < 0)
3585 buffer_overflow ();
3587 /* The file size returned from stat may be zero, but data
3588 may be readable nonetheless, for example when this is a
3589 file in the /proc filesystem. */
3590 if (end_offset == 0)
3591 end_offset = READ_BUF_SIZE;
3595 /* Check now whether the buffer will become too large,
3596 in the likely case where the file's length is not changing.
3597 This saves a lot of needless work before a buffer overflow. */
3598 if (! not_regular)
3600 /* The likely offset where we will stop reading. We could read
3601 more (or less), if the file grows (or shrinks) as we read it. */
3602 off_t likely_end = min (end_offset, st.st_size);
3604 if (beg_offset < likely_end)
3606 ptrdiff_t buf_bytes
3607 = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
3608 ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
3609 off_t likely_growth = likely_end - beg_offset;
3610 if (buf_growth_max < likely_growth)
3611 buffer_overflow ();
3615 /* Prevent redisplay optimizations. */
3616 current_buffer->clip_changed = true;
3618 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
3620 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
3621 setup_coding_system (coding_system, &coding);
3622 /* Ensure we set Vlast_coding_system_used. */
3623 set_coding_system = true;
3625 else if (BEG < Z)
3627 /* Decide the coding system to use for reading the file now
3628 because we can't use an optimized method for handling
3629 `coding:' tag if the current buffer is not empty. */
3630 if (!NILP (Vcoding_system_for_read))
3631 coding_system = Vcoding_system_for_read;
3632 else
3634 /* Don't try looking inside a file for a coding system
3635 specification if it is not seekable. */
3636 if (! not_regular && ! NILP (Vset_auto_coding_function))
3638 /* Find a coding system specified in the heading two
3639 lines or in the tailing several lines of the file.
3640 We assume that the 1K-byte and 3K-byte for heading
3641 and tailing respectively are sufficient for this
3642 purpose. */
3643 int nread;
3645 if (st.st_size <= (1024 * 4))
3646 nread = emacs_read_quit (fd, read_buf, 1024 * 4);
3647 else
3649 nread = emacs_read_quit (fd, read_buf, 1024);
3650 if (nread == 1024)
3652 int ntail;
3653 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3654 report_file_error ("Setting file position",
3655 orig_filename);
3656 ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
3657 nread = ntail < 0 ? ntail : nread + ntail;
3661 if (nread < 0)
3662 report_file_error ("Read error", orig_filename);
3663 else if (nread > 0)
3665 AUTO_STRING (name, " *code-converting-work*");
3666 struct buffer *prev = current_buffer;
3667 Lisp_Object workbuf;
3668 struct buffer *buf;
3670 record_unwind_current_buffer ();
3672 workbuf = Fget_buffer_create (name);
3673 buf = XBUFFER (workbuf);
3675 delete_all_overlays (buf);
3676 bset_directory (buf, BVAR (current_buffer, directory));
3677 bset_read_only (buf, Qnil);
3678 bset_filename (buf, Qnil);
3679 bset_undo_list (buf, Qt);
3680 eassert (buf->overlays_before == NULL);
3681 eassert (buf->overlays_after == NULL);
3683 set_buffer_internal (buf);
3684 Ferase_buffer ();
3685 bset_enable_multibyte_characters (buf, Qnil);
3687 insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
3688 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3689 coding_system = call2 (Vset_auto_coding_function,
3690 filename, make_number (nread));
3691 set_buffer_internal (prev);
3693 /* Discard the unwind protect for recovering the
3694 current buffer. */
3695 specpdl_ptr--;
3697 /* Rewind the file for the actual read done later. */
3698 if (lseek (fd, 0, SEEK_SET) < 0)
3699 report_file_error ("Setting file position", orig_filename);
3703 if (NILP (coding_system))
3705 /* If we have not yet decided a coding system, check
3706 file-coding-system-alist. */
3707 coding_system = CALLN (Ffind_operation_coding_system,
3708 Qinsert_file_contents, orig_filename,
3709 visit, beg, end, replace);
3710 if (CONSP (coding_system))
3711 coding_system = XCAR (coding_system);
3715 if (NILP (coding_system))
3716 coding_system = Qundecided;
3717 else
3718 CHECK_CODING_SYSTEM (coding_system);
3720 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3721 /* We must suppress all character code conversion except for
3722 end-of-line conversion. */
3723 coding_system = raw_text_coding_system (coding_system);
3725 setup_coding_system (coding_system, &coding);
3726 /* Ensure we set Vlast_coding_system_used. */
3727 set_coding_system = true;
3730 /* If requested, replace the accessible part of the buffer
3731 with the file contents. Avoid replacing text at the
3732 beginning or end of the buffer that matches the file contents;
3733 that preserves markers pointing to the unchanged parts.
3735 Here we implement this feature in an optimized way
3736 for the case where code conversion is NOT needed.
3737 The following if-statement handles the case of conversion
3738 in a less optimal way.
3740 If the code conversion is "automatic" then we try using this
3741 method and hope for the best.
3742 But if we discover the need for conversion, we give up on this method
3743 and let the following if-statement handle the replace job. */
3744 if (!NILP (replace)
3745 && BEGV < ZV
3746 && (NILP (coding_system)
3747 || ! CODING_REQUIRE_DECODING (&coding)))
3749 ptrdiff_t overlap;
3750 /* There is still a possibility we will find the need to do code
3751 conversion. If that happens, set this variable to
3752 give up on handling REPLACE in the optimized way. */
3753 bool giveup_match_end = false;
3755 if (beg_offset != 0)
3757 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3758 report_file_error ("Setting file position", orig_filename);
3761 /* Count how many chars at the start of the file
3762 match the text at the beginning of the buffer. */
3763 while (true)
3765 int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
3766 if (nread < 0)
3767 report_file_error ("Read error", orig_filename);
3768 else if (nread == 0)
3769 break;
3771 if (CODING_REQUIRE_DETECTION (&coding))
3773 coding_system = detect_coding_system ((unsigned char *) read_buf,
3774 nread, nread, 1, 0,
3775 coding_system);
3776 setup_coding_system (coding_system, &coding);
3779 if (CODING_REQUIRE_DECODING (&coding))
3780 /* We found that the file should be decoded somehow.
3781 Let's give up here. */
3783 giveup_match_end = true;
3784 break;
3787 int bufpos = 0;
3788 while (bufpos < nread && same_at_start < ZV_BYTE
3789 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3790 same_at_start++, bufpos++;
3791 /* If we found a discrepancy, stop the scan.
3792 Otherwise loop around and scan the next bufferful. */
3793 if (bufpos != nread)
3794 break;
3796 /* If the file matches the buffer completely,
3797 there's no need to replace anything. */
3798 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
3800 emacs_close (fd);
3801 clear_unwind_protect (fd_index);
3803 /* Truncate the buffer to the size of the file. */
3804 del_range_1 (same_at_start, same_at_end, 0, 0);
3805 goto handled;
3808 /* Count how many chars at the end of the file
3809 match the text at the end of the buffer. But, if we have
3810 already found that decoding is necessary, don't waste time. */
3811 while (!giveup_match_end)
3813 int total_read, nread, bufpos, trial;
3814 off_t curpos;
3816 /* At what file position are we now scanning? */
3817 curpos = end_offset - (ZV_BYTE - same_at_end);
3818 /* If the entire file matches the buffer tail, stop the scan. */
3819 if (curpos == 0)
3820 break;
3821 /* How much can we scan in the next step? */
3822 trial = min (curpos, sizeof read_buf);
3823 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
3824 report_file_error ("Setting file position", orig_filename);
3826 total_read = nread = 0;
3827 while (total_read < trial)
3829 nread = emacs_read_quit (fd, read_buf + total_read,
3830 trial - total_read);
3831 if (nread < 0)
3832 report_file_error ("Read error", orig_filename);
3833 else if (nread == 0)
3834 break;
3835 total_read += nread;
3838 /* Scan this bufferful from the end, comparing with
3839 the Emacs buffer. */
3840 bufpos = total_read;
3842 /* Compare with same_at_start to avoid counting some buffer text
3843 as matching both at the file's beginning and at the end. */
3844 while (bufpos > 0 && same_at_end > same_at_start
3845 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3846 same_at_end--, bufpos--;
3848 /* If we found a discrepancy, stop the scan.
3849 Otherwise loop around and scan the preceding bufferful. */
3850 if (bufpos != 0)
3852 /* If this discrepancy is because of code conversion,
3853 we cannot use this method; giveup and try the other. */
3854 if (same_at_end > same_at_start
3855 && FETCH_BYTE (same_at_end - 1) >= 0200
3856 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
3857 && (CODING_MAY_REQUIRE_DECODING (&coding)))
3858 giveup_match_end = true;
3859 break;
3862 if (nread == 0)
3863 break;
3866 if (! giveup_match_end)
3868 ptrdiff_t temp;
3869 ptrdiff_t this_count = SPECPDL_INDEX ();
3871 /* We win! We can handle REPLACE the optimized way. */
3873 /* Extend the start of non-matching text area to multibyte
3874 character boundary. */
3875 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3876 while (same_at_start > BEGV_BYTE
3877 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3878 same_at_start--;
3880 /* Extend the end of non-matching text area to multibyte
3881 character boundary. */
3882 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3883 while (same_at_end < ZV_BYTE
3884 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3885 same_at_end++;
3887 /* Don't try to reuse the same piece of text twice. */
3888 overlap = (same_at_start - BEGV_BYTE
3889 - (same_at_end
3890 + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
3891 if (overlap > 0)
3892 same_at_end += overlap;
3893 same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
3895 /* Arrange to read only the nonmatching middle part of the file. */
3896 beg_offset += same_at_start - BEGV_BYTE;
3897 end_offset -= ZV_BYTE - same_at_end;
3899 /* This binding is to avoid ask-user-about-supersession-threat
3900 being called in insert_from_buffer or del_range_bytes (via
3901 prepare_to_modify_buffer).
3902 AFAICT we could avoid ask-user-about-supersession-threat by setting
3903 current_buffer->modtime earlier, but we could still end up calling
3904 ask-user-about-supersession-threat if the file is modified while
3905 we read it, so we bind buffer-file-name instead. */
3906 specbind (intern ("buffer-file-name"), Qnil);
3907 del_range_byte (same_at_start, same_at_end);
3908 /* Insert from the file at the proper position. */
3909 temp = BYTE_TO_CHAR (same_at_start);
3910 SET_PT_BOTH (temp, same_at_start);
3911 unbind_to (this_count, Qnil);
3913 /* If display currently starts at beginning of line,
3914 keep it that way. */
3915 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3916 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3918 replace_handled = true;
3922 /* If requested, replace the accessible part of the buffer
3923 with the file contents. Avoid replacing text at the
3924 beginning or end of the buffer that matches the file contents;
3925 that preserves markers pointing to the unchanged parts.
3927 Here we implement this feature for the case where code conversion
3928 is needed, in a simple way that needs a lot of memory.
3929 The preceding if-statement handles the case of no conversion
3930 in a more optimized way. */
3931 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3933 ptrdiff_t same_at_start_charpos;
3934 ptrdiff_t inserted_chars;
3935 ptrdiff_t overlap;
3936 ptrdiff_t bufpos;
3937 unsigned char *decoded;
3938 ptrdiff_t temp;
3939 ptrdiff_t this = 0;
3940 ptrdiff_t this_count = SPECPDL_INDEX ();
3941 bool multibyte
3942 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3943 Lisp_Object conversion_buffer;
3945 conversion_buffer = code_conversion_save (1, multibyte);
3947 /* First read the whole file, performing code conversion into
3948 CONVERSION_BUFFER. */
3950 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3951 report_file_error ("Setting file position", orig_filename);
3953 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3954 unprocessed = 0; /* Bytes not processed in previous loop. */
3956 while (true)
3958 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3959 quitting while reading a huge file. */
3961 this = emacs_read_quit (fd, read_buf + unprocessed,
3962 READ_BUF_SIZE - unprocessed);
3963 if (this <= 0)
3964 break;
3966 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3967 BUF_Z (XBUFFER (conversion_buffer)));
3968 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3969 unprocessed + this, conversion_buffer);
3970 unprocessed = coding.carryover_bytes;
3971 if (coding.carryover_bytes > 0)
3972 memcpy (read_buf, coding.carryover, unprocessed);
3975 if (this < 0)
3976 report_file_error ("Read error", orig_filename);
3977 emacs_close (fd);
3978 clear_unwind_protect (fd_index);
3980 if (unprocessed > 0)
3982 coding.mode |= CODING_MODE_LAST_BLOCK;
3983 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3984 unprocessed, conversion_buffer);
3985 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3988 coding_system = CODING_ID_NAME (coding.id);
3989 set_coding_system = true;
3990 maybe_move_gap (XBUFFER (conversion_buffer));
3991 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
3992 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3993 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3995 /* Compare the beginning of the converted string with the buffer
3996 text. */
3998 bufpos = 0;
3999 while (bufpos < inserted && same_at_start < same_at_end
4000 && FETCH_BYTE (same_at_start) == decoded[bufpos])
4001 same_at_start++, bufpos++;
4003 /* If the file matches the head of buffer completely,
4004 there's no need to replace anything. */
4006 if (bufpos == inserted)
4008 /* Truncate the buffer to the size of the file. */
4009 if (same_at_start != same_at_end)
4011 /* See previous specbind for the reason behind this. */
4012 specbind (intern ("buffer-file-name"), Qnil);
4013 del_range_byte (same_at_start, same_at_end);
4015 inserted = 0;
4017 unbind_to (this_count, Qnil);
4018 goto handled;
4021 /* Extend the start of non-matching text area to the previous
4022 multibyte character boundary. */
4023 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4024 while (same_at_start > BEGV_BYTE
4025 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
4026 same_at_start--;
4028 /* Scan this bufferful from the end, comparing with
4029 the Emacs buffer. */
4030 bufpos = inserted;
4032 /* Compare with same_at_start to avoid counting some buffer text
4033 as matching both at the file's beginning and at the end. */
4034 while (bufpos > 0 && same_at_end > same_at_start
4035 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
4036 same_at_end--, bufpos--;
4038 /* Extend the end of non-matching text area to the next
4039 multibyte character boundary. */
4040 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4041 while (same_at_end < ZV_BYTE
4042 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
4043 same_at_end++;
4045 /* Don't try to reuse the same piece of text twice. */
4046 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
4047 if (overlap > 0)
4048 same_at_end += overlap;
4049 same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
4051 /* If display currently starts at beginning of line,
4052 keep it that way. */
4053 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
4054 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
4056 /* Replace the chars that we need to replace,
4057 and update INSERTED to equal the number of bytes
4058 we are taking from the decoded string. */
4059 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
4061 /* See previous specbind for the reason behind this. */
4062 specbind (intern ("buffer-file-name"), Qnil);
4063 if (same_at_end != same_at_start)
4065 del_range_byte (same_at_start, same_at_end);
4066 temp = GPT;
4067 eassert (same_at_start == GPT_BYTE);
4068 same_at_start = GPT_BYTE;
4070 else
4072 temp = same_at_end_charpos;
4074 /* Insert from the file at the proper position. */
4075 SET_PT_BOTH (temp, same_at_start);
4076 same_at_start_charpos
4077 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4078 same_at_start - BEGV_BYTE
4079 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
4080 eassert (same_at_start_charpos == temp - (BEGV - BEG));
4081 inserted_chars
4082 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4083 same_at_start + inserted - BEGV_BYTE
4084 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
4085 - same_at_start_charpos);
4086 insert_from_buffer (XBUFFER (conversion_buffer),
4087 same_at_start_charpos, inserted_chars, 0);
4088 /* Set `inserted' to the number of inserted characters. */
4089 inserted = PT - temp;
4090 /* Set point before the inserted characters. */
4091 SET_PT_BOTH (temp, same_at_start);
4093 unbind_to (this_count, Qnil);
4095 goto handled;
4098 if (! not_regular)
4099 total = end_offset - beg_offset;
4100 else
4101 /* For a special file, all we can do is guess. */
4102 total = READ_BUF_SIZE;
4104 if (NILP (visit) && total > 0)
4106 if (!NILP (BVAR (current_buffer, file_truename))
4107 /* Make binding buffer-file-name to nil effective. */
4108 && !NILP (BVAR (current_buffer, filename))
4109 && SAVE_MODIFF >= MODIFF)
4110 we_locked_file = true;
4111 prepare_to_modify_buffer (PT, PT, NULL);
4114 move_gap_both (PT, PT_BYTE);
4115 if (GAP_SIZE < total)
4116 make_gap (total - GAP_SIZE);
4118 if (beg_offset != 0 || !NILP (replace))
4120 if (lseek (fd, beg_offset, SEEK_SET) < 0)
4121 report_file_error ("Setting file position", orig_filename);
4124 /* In the following loop, HOW_MUCH contains the total bytes read so
4125 far for a regular file, and not changed for a special file. But,
4126 before exiting the loop, it is set to a negative value if I/O
4127 error occurs. */
4128 how_much = 0;
4130 /* Total bytes inserted. */
4131 inserted = 0;
4133 /* Here, we don't do code conversion in the loop. It is done by
4134 decode_coding_gap after all data are read into the buffer. */
4136 ptrdiff_t gap_size = GAP_SIZE;
4138 while (how_much < total)
4140 /* `try' is reserved in some compilers (Microsoft C). */
4141 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4142 ptrdiff_t this;
4144 if (not_regular)
4146 Lisp_Object nbytes;
4148 /* Maybe make more room. */
4149 if (gap_size < trytry)
4151 make_gap (trytry - gap_size);
4152 gap_size = GAP_SIZE - inserted;
4155 /* Read from the file, capturing `quit'. When an
4156 error occurs, end the loop, and arrange for a quit
4157 to be signaled after decoding the text we read. */
4158 nbytes = internal_condition_case_1
4159 (read_non_regular,
4160 make_save_int_int_int (fd, inserted, trytry),
4161 Qerror, read_non_regular_quit);
4163 if (NILP (nbytes))
4165 read_quit = true;
4166 break;
4169 this = XINT (nbytes);
4171 else
4173 /* Allow quitting out of the actual I/O. We don't make text
4174 part of the buffer until all the reading is done, so a C-g
4175 here doesn't do any harm. */
4176 this = emacs_read_quit (fd,
4177 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4178 + inserted),
4179 trytry);
4182 if (this <= 0)
4184 how_much = this;
4185 break;
4188 gap_size -= this;
4190 /* For a regular file, where TOTAL is the real size,
4191 count HOW_MUCH to compare with it.
4192 For a special file, where TOTAL is just a buffer size,
4193 so don't bother counting in HOW_MUCH.
4194 (INSERTED is where we count the number of characters inserted.) */
4195 if (! not_regular)
4196 how_much += this;
4197 inserted += this;
4201 /* Now we have either read all the file data into the gap,
4202 or stop reading on I/O error or quit. If nothing was
4203 read, undo marking the buffer modified. */
4205 if (inserted == 0)
4207 if (we_locked_file)
4208 unlock_file (BVAR (current_buffer, file_truename));
4209 Vdeactivate_mark = old_Vdeactivate_mark;
4211 else
4212 Fset (Qdeactivate_mark, Qt);
4214 emacs_close (fd);
4215 clear_unwind_protect (fd_index);
4217 if (how_much < 0)
4218 report_file_error ("Read error", orig_filename);
4220 /* Make the text read part of the buffer. */
4221 GAP_SIZE -= inserted;
4222 GPT += inserted;
4223 GPT_BYTE += inserted;
4224 ZV += inserted;
4225 ZV_BYTE += inserted;
4226 Z += inserted;
4227 Z_BYTE += inserted;
4229 if (GAP_SIZE > 0)
4230 /* Put an anchor to ensure multi-byte form ends at gap. */
4231 *GPT_ADDR = 0;
4233 notfound:
4235 if (NILP (coding_system))
4237 /* The coding system is not yet decided. Decide it by an
4238 optimized method for handling `coding:' tag.
4240 Note that we can get here only if the buffer was empty
4241 before the insertion. */
4243 if (!NILP (Vcoding_system_for_read))
4244 coding_system = Vcoding_system_for_read;
4245 else
4247 /* Since we are sure that the current buffer was empty
4248 before the insertion, we can toggle
4249 enable-multibyte-characters directly here without taking
4250 care of marker adjustment. By this way, we can run Lisp
4251 program safely before decoding the inserted text. */
4252 Lisp_Object unwind_data;
4253 ptrdiff_t count1 = SPECPDL_INDEX ();
4255 unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
4256 Fcons (BVAR (current_buffer, undo_list),
4257 Fcurrent_buffer ()));
4258 bset_enable_multibyte_characters (current_buffer, Qnil);
4259 bset_undo_list (current_buffer, Qt);
4260 record_unwind_protect (decide_coding_unwind, unwind_data);
4262 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4264 coding_system = call2 (Vset_auto_coding_function,
4265 filename, make_number (inserted));
4268 if (NILP (coding_system))
4270 /* If the coding system is not yet decided, check
4271 file-coding-system-alist. */
4272 coding_system = CALLN (Ffind_operation_coding_system,
4273 Qinsert_file_contents, orig_filename,
4274 visit, beg, end, Qnil);
4275 if (CONSP (coding_system))
4276 coding_system = XCAR (coding_system);
4278 unbind_to (count1, Qnil);
4279 inserted = Z_BYTE - BEG_BYTE;
4282 if (NILP (coding_system))
4283 coding_system = Qundecided;
4284 else
4285 CHECK_CODING_SYSTEM (coding_system);
4287 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4288 /* We must suppress all character code conversion except for
4289 end-of-line conversion. */
4290 coding_system = raw_text_coding_system (coding_system);
4291 setup_coding_system (coding_system, &coding);
4292 /* Ensure we set Vlast_coding_system_used. */
4293 set_coding_system = true;
4296 if (!NILP (visit))
4298 /* When we visit a file by raw-text, we change the buffer to
4299 unibyte. */
4300 if (CODING_FOR_UNIBYTE (&coding)
4301 /* Can't do this if part of the buffer might be preserved. */
4302 && NILP (replace))
4304 /* Visiting a file with these coding system makes the buffer
4305 unibyte. */
4306 if (inserted > 0)
4307 bset_enable_multibyte_characters (current_buffer, Qnil);
4308 else
4309 Fset_buffer_multibyte (Qnil);
4313 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
4314 if (CODING_MAY_REQUIRE_DECODING (&coding)
4315 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
4317 move_gap_both (PT, PT_BYTE);
4318 GAP_SIZE += inserted;
4319 ZV_BYTE -= inserted;
4320 Z_BYTE -= inserted;
4321 ZV -= inserted;
4322 Z -= inserted;
4323 decode_coding_gap (&coding, inserted, inserted);
4324 inserted = coding.produced_char;
4325 coding_system = CODING_ID_NAME (coding.id);
4327 else if (inserted > 0)
4329 invalidate_buffer_caches (current_buffer, PT, PT + inserted);
4330 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4331 inserted);
4334 /* Call after-change hooks for the inserted text, aside from the case
4335 of normal visiting (not with REPLACE), which is done in a new buffer
4336 "before" the buffer is changed. */
4337 if (inserted > 0 && total > 0
4338 && (NILP (visit) || !NILP (replace)))
4340 signal_after_change (PT, 0, inserted);
4341 update_compositions (PT, PT, CHECK_BORDER);
4344 /* Now INSERTED is measured in characters. */
4346 handled:
4348 if (inserted > 0)
4349 restore_window_points (window_markers, inserted,
4350 BYTE_TO_CHAR (same_at_start),
4351 same_at_end_charpos);
4353 if (!NILP (visit))
4355 if (empty_undo_list_p)
4356 bset_undo_list (current_buffer, Qnil);
4358 if (NILP (handler))
4360 current_buffer->modtime = mtime;
4361 current_buffer->modtime_size = st.st_size;
4362 bset_filename (current_buffer, orig_filename);
4365 SAVE_MODIFF = MODIFF;
4366 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4367 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4368 if (NILP (handler))
4370 if (!NILP (BVAR (current_buffer, file_truename)))
4371 unlock_file (BVAR (current_buffer, file_truename));
4372 unlock_file (filename);
4374 if (not_regular)
4375 xsignal2 (Qfile_error,
4376 build_string ("not a regular file"), orig_filename);
4379 if (set_coding_system)
4380 Vlast_coding_system_used = coding_system;
4382 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
4384 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4385 visit);
4386 if (! NILP (insval))
4388 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4389 wrong_type_argument (intern ("inserted-chars"), insval);
4390 inserted = XFASTINT (insval);
4394 /* Decode file format. */
4395 if (inserted > 0)
4397 /* Don't run point motion or modification hooks when decoding. */
4398 ptrdiff_t count1 = SPECPDL_INDEX ();
4399 ptrdiff_t old_inserted = inserted;
4400 specbind (Qinhibit_point_motion_hooks, Qt);
4401 specbind (Qinhibit_modification_hooks, Qt);
4403 /* Save old undo list and don't record undo for decoding. */
4404 old_undo = BVAR (current_buffer, undo_list);
4405 bset_undo_list (current_buffer, Qt);
4407 if (NILP (replace))
4409 insval = call3 (Qformat_decode,
4410 Qnil, make_number (inserted), visit);
4411 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4412 wrong_type_argument (intern ("inserted-chars"), insval);
4413 inserted = XFASTINT (insval);
4415 else
4417 /* If REPLACE is non-nil and we succeeded in not replacing the
4418 beginning or end of the buffer text with the file's contents,
4419 call format-decode with `point' positioned at the beginning
4420 of the buffer and `inserted' equaling the number of
4421 characters in the buffer. Otherwise, format-decode might
4422 fail to correctly analyze the beginning or end of the buffer.
4423 Hence we temporarily save `point' and `inserted' here and
4424 restore `point' iff format-decode did not insert or delete
4425 any text. Otherwise we leave `point' at point-min. */
4426 ptrdiff_t opoint = PT;
4427 ptrdiff_t opoint_byte = PT_BYTE;
4428 ptrdiff_t oinserted = ZV - BEGV;
4429 EMACS_INT ochars_modiff = CHARS_MODIFF;
4431 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4432 insval = call3 (Qformat_decode,
4433 Qnil, make_number (oinserted), visit);
4434 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4435 wrong_type_argument (intern ("inserted-chars"), insval);
4436 if (ochars_modiff == CHARS_MODIFF)
4437 /* format_decode didn't modify buffer's characters => move
4438 point back to position before inserted text and leave
4439 value of inserted alone. */
4440 SET_PT_BOTH (opoint, opoint_byte);
4441 else
4442 /* format_decode modified buffer's characters => consider
4443 entire buffer changed and leave point at point-min. */
4444 inserted = XFASTINT (insval);
4447 /* For consistency with format-decode call these now iff inserted > 0
4448 (martin 2007-06-28). */
4449 p = Vafter_insert_file_functions;
4450 while (CONSP (p))
4452 if (NILP (replace))
4454 insval = call1 (XCAR (p), make_number (inserted));
4455 if (!NILP (insval))
4457 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4458 wrong_type_argument (intern ("inserted-chars"), insval);
4459 inserted = XFASTINT (insval);
4462 else
4464 /* For the rationale of this see the comment on
4465 format-decode above. */
4466 ptrdiff_t opoint = PT;
4467 ptrdiff_t opoint_byte = PT_BYTE;
4468 ptrdiff_t oinserted = ZV - BEGV;
4469 EMACS_INT ochars_modiff = CHARS_MODIFF;
4471 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4472 insval = call1 (XCAR (p), make_number (oinserted));
4473 if (!NILP (insval))
4475 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4476 wrong_type_argument (intern ("inserted-chars"), insval);
4477 if (ochars_modiff == CHARS_MODIFF)
4478 /* after_insert_file_functions didn't modify
4479 buffer's characters => move point back to
4480 position before inserted text and leave value of
4481 inserted alone. */
4482 SET_PT_BOTH (opoint, opoint_byte);
4483 else
4484 /* after_insert_file_functions did modify buffer's
4485 characters => consider entire buffer changed and
4486 leave point at point-min. */
4487 inserted = XFASTINT (insval);
4491 maybe_quit ();
4492 p = XCDR (p);
4495 if (!empty_undo_list_p)
4497 bset_undo_list (current_buffer, old_undo);
4498 if (CONSP (old_undo) && inserted != old_inserted)
4500 /* Adjust the last undo record for the size change during
4501 the format conversion. */
4502 Lisp_Object tem = XCAR (old_undo);
4503 if (CONSP (tem) && INTEGERP (XCAR (tem))
4504 && INTEGERP (XCDR (tem))
4505 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4506 XSETCDR (tem, make_number (PT + inserted));
4509 else
4510 /* If undo_list was Qt before, keep it that way.
4511 Otherwise start with an empty undo_list. */
4512 bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
4514 unbind_to (count1, Qnil);
4517 if (!NILP (visit)
4518 && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
4520 /* If visiting nonexistent file, return nil. */
4521 report_file_errno ("Opening input file", orig_filename, save_errno);
4524 /* We made a lot of deletions and insertions above, so invalidate
4525 the newline cache for the entire region of the inserted
4526 characters. */
4527 if (current_buffer->base_buffer && current_buffer->base_buffer->newline_cache)
4528 invalidate_region_cache (current_buffer->base_buffer,
4529 current_buffer->base_buffer->newline_cache,
4530 PT - BEG, Z - PT - inserted);
4531 else if (current_buffer->newline_cache)
4532 invalidate_region_cache (current_buffer,
4533 current_buffer->newline_cache,
4534 PT - BEG, Z - PT - inserted);
4536 if (read_quit)
4537 quit ();
4539 /* Retval needs to be dealt with in all cases consistently. */
4540 if (NILP (val))
4541 val = list2 (orig_filename, make_number (inserted));
4543 return unbind_to (count, val);
4546 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
4548 static void
4549 build_annotations_unwind (Lisp_Object arg)
4551 Vwrite_region_annotation_buffers = arg;
4554 /* Decide the coding-system to encode the data with. */
4556 static Lisp_Object
4557 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4558 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4559 struct coding_system *coding)
4561 Lisp_Object val;
4562 Lisp_Object eol_parent = Qnil;
4564 if (auto_saving
4565 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4566 BVAR (current_buffer, auto_save_file_name))))
4568 val = Qutf_8_emacs;
4569 eol_parent = Qunix;
4571 else if (!NILP (Vcoding_system_for_write))
4573 val = Vcoding_system_for_write;
4574 if (coding_system_require_warning
4575 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4576 /* Confirm that VAL can surely encode the current region. */
4577 val = call5 (Vselect_safe_coding_system_function,
4578 start, end, list2 (Qt, val),
4579 Qnil, filename);
4581 else
4583 /* If the variable `buffer-file-coding-system' is set locally,
4584 it means that the file was read with some kind of code
4585 conversion or the variable is explicitly set by users. We
4586 had better write it out with the same coding system even if
4587 `enable-multibyte-characters' is nil.
4589 If it is not set locally, we anyway have to convert EOL
4590 format if the default value of `buffer-file-coding-system'
4591 tells that it is not Unix-like (LF only) format. */
4592 bool using_default_coding = 0;
4593 bool force_raw_text = 0;
4595 val = BVAR (current_buffer, buffer_file_coding_system);
4596 if (NILP (val)
4597 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4599 val = Qnil;
4600 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4601 force_raw_text = 1;
4604 if (NILP (val))
4606 /* Check file-coding-system-alist. */
4607 Lisp_Object coding_systems
4608 = CALLN (Ffind_operation_coding_system, Qwrite_region, start, end,
4609 filename, append, visit, lockname);
4610 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4611 val = XCDR (coding_systems);
4614 if (NILP (val))
4616 /* If we still have not decided a coding system, use the
4617 current buffer's value of buffer-file-coding-system. */
4618 val = BVAR (current_buffer, buffer_file_coding_system);
4619 using_default_coding = 1;
4622 if (! NILP (val) && ! force_raw_text)
4624 Lisp_Object spec, attrs;
4626 CHECK_CODING_SYSTEM (val);
4627 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4628 attrs = AREF (spec, 0);
4629 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4630 force_raw_text = 1;
4633 if (!force_raw_text
4634 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4636 /* Confirm that VAL can surely encode the current region. */
4637 val = call5 (Vselect_safe_coding_system_function,
4638 start, end, val, Qnil, filename);
4639 /* As the function specified by select-safe-coding-system-function
4640 is out of our control, make sure we are not fed by bogus
4641 values. */
4642 if (!NILP (val))
4643 CHECK_CODING_SYSTEM (val);
4646 /* If the decided coding-system doesn't specify end-of-line
4647 format, we use that of `buffer-file-coding-system'. */
4648 if (! using_default_coding)
4650 Lisp_Object dflt = BVAR (&buffer_defaults, buffer_file_coding_system);
4652 if (! NILP (dflt))
4653 val = coding_inherit_eol_type (val, dflt);
4656 /* If we decide not to encode text, use `raw-text' or one of its
4657 subsidiaries. */
4658 if (force_raw_text)
4659 val = raw_text_coding_system (val);
4662 val = coding_inherit_eol_type (val, eol_parent);
4663 setup_coding_system (val, coding);
4665 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4666 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4667 return val;
4670 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
4671 "r\nFWrite region to file: \ni\ni\ni\np",
4672 doc: /* Write current region into specified file.
4673 When called from a program, requires three arguments:
4674 START, END and FILENAME. START and END are normally buffer positions
4675 specifying the part of the buffer to write.
4676 If START is nil, that means to use the entire buffer contents; END is
4677 ignored.
4678 If START is a string, then output that string to the file
4679 instead of any buffer contents; END is ignored.
4681 Optional fourth argument APPEND if non-nil means
4682 append to existing file contents (if any). If it is a number,
4683 seek to that offset in the file before writing.
4684 Optional fifth argument VISIT, if t or a string, means
4685 set the last-save-file-modtime of buffer to this file's modtime
4686 and mark buffer not modified.
4687 If VISIT is a string, it is a second file name;
4688 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4689 VISIT is also the file name to lock and unlock for clash detection.
4690 If VISIT is neither t nor nil nor a string, or if Emacs is in batch mode,
4691 do not display the \"Wrote file\" message.
4692 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4693 use for locking and unlocking, overriding FILENAME and VISIT.
4694 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4695 for an existing file with the same name. If MUSTBENEW is `excl',
4696 that means to get an error if the file already exists; never overwrite.
4697 If MUSTBENEW is neither nil nor `excl', that means ask for
4698 confirmation before overwriting, but do go ahead and overwrite the file
4699 if the user confirms.
4701 This does code conversion according to the value of
4702 `coding-system-for-write', `buffer-file-coding-system', or
4703 `file-coding-system-alist', and sets the variable
4704 `last-coding-system-used' to the coding system actually used.
4706 This calls `write-region-annotate-functions' at the start, and
4707 `write-region-post-annotation-function' at the end. */)
4708 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
4709 Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4711 return write_region (start, end, filename, append, visit, lockname, mustbenew,
4712 -1);
4715 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4716 descriptor for FILENAME, so do not open or close FILENAME. */
4718 Lisp_Object
4719 write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4720 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4721 Lisp_Object mustbenew, int desc)
4723 int open_flags;
4724 int mode;
4725 off_t offset UNINIT;
4726 bool open_and_close_file = desc < 0;
4727 bool ok;
4728 int save_errno = 0;
4729 const char *fn;
4730 struct stat st;
4731 struct timespec modtime;
4732 ptrdiff_t count = SPECPDL_INDEX ();
4733 ptrdiff_t count1 UNINIT;
4734 Lisp_Object handler;
4735 Lisp_Object visit_file;
4736 Lisp_Object annotations;
4737 Lisp_Object encoded_filename;
4738 bool visiting = (EQ (visit, Qt) || STRINGP (visit));
4739 bool quietly = !NILP (visit);
4740 bool file_locked = 0;
4741 struct buffer *given_buffer;
4742 struct coding_system coding;
4744 if (current_buffer->base_buffer && visiting)
4745 error ("Cannot do file visiting in an indirect buffer");
4747 if (!NILP (start) && !STRINGP (start))
4748 validate_region (&start, &end);
4750 visit_file = Qnil;
4752 filename = Fexpand_file_name (filename, Qnil);
4754 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
4755 barf_or_query_if_file_exists (filename, false, "overwrite", true, true);
4757 if (STRINGP (visit))
4758 visit_file = Fexpand_file_name (visit, Qnil);
4759 else
4760 visit_file = filename;
4762 if (NILP (lockname))
4763 lockname = visit_file;
4765 annotations = Qnil;
4767 /* If the file name has special constructs in it,
4768 call the corresponding file handler. */
4769 handler = Ffind_file_name_handler (filename, Qwrite_region);
4770 /* If FILENAME has no handler, see if VISIT has one. */
4771 if (NILP (handler) && STRINGP (visit))
4772 handler = Ffind_file_name_handler (visit, Qwrite_region);
4774 if (!NILP (handler))
4776 Lisp_Object val;
4777 val = call8 (handler, Qwrite_region, start, end,
4778 filename, append, visit, lockname, mustbenew);
4780 if (visiting)
4782 SAVE_MODIFF = MODIFF;
4783 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4784 bset_filename (current_buffer, visit_file);
4787 return val;
4790 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4792 /* Special kludge to simplify auto-saving. */
4793 if (NILP (start))
4795 /* Do it later, so write-region-annotate-function can work differently
4796 if we save "the buffer" vs "a region".
4797 This is useful in tar-mode. --Stef
4798 XSETFASTINT (start, BEG);
4799 XSETFASTINT (end, Z); */
4800 Fwiden ();
4803 record_unwind_protect (build_annotations_unwind,
4804 Vwrite_region_annotation_buffers);
4805 Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
4807 given_buffer = current_buffer;
4809 if (!STRINGP (start))
4811 annotations = build_annotations (start, end);
4813 if (current_buffer != given_buffer)
4815 XSETFASTINT (start, BEGV);
4816 XSETFASTINT (end, ZV);
4820 if (NILP (start))
4822 XSETFASTINT (start, BEGV);
4823 XSETFASTINT (end, ZV);
4826 /* Decide the coding-system to encode the data with.
4827 We used to make this choice before calling build_annotations, but that
4828 leads to problems when a write-annotate-function takes care of
4829 unsavable chars (as was the case with X-Symbol). */
4830 Vlast_coding_system_used
4831 = choose_write_coding_system (start, end, filename,
4832 append, visit, lockname, &coding);
4834 if (open_and_close_file && !auto_saving)
4836 lock_file (lockname);
4837 file_locked = 1;
4840 encoded_filename = ENCODE_FILE (filename);
4841 fn = SSDATA (encoded_filename);
4842 open_flags = O_WRONLY | O_CREAT;
4843 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4844 if (NUMBERP (append))
4845 offset = file_offset (append);
4846 else if (!NILP (append))
4847 open_flags |= O_APPEND;
4848 #ifdef DOS_NT
4849 mode = S_IREAD | S_IWRITE;
4850 #else
4851 mode = auto_saving ? auto_save_mode_bits : 0666;
4852 #endif
4854 if (open_and_close_file)
4856 desc = emacs_open (fn, open_flags, mode);
4857 if (desc < 0)
4859 int open_errno = errno;
4860 if (file_locked)
4861 unlock_file (lockname);
4862 report_file_errno ("Opening output file", filename, open_errno);
4865 count1 = SPECPDL_INDEX ();
4866 record_unwind_protect_int (close_file_unwind, desc);
4869 if (NUMBERP (append))
4871 off_t ret = lseek (desc, offset, SEEK_SET);
4872 if (ret < 0)
4874 int lseek_errno = errno;
4875 if (file_locked)
4876 unlock_file (lockname);
4877 report_file_errno ("Lseek error", filename, lseek_errno);
4881 if (STRINGP (start))
4882 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
4883 else if (XINT (start) != XINT (end))
4884 ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
4885 &annotations, &coding);
4886 else
4888 /* If file was empty, still need to write the annotations. */
4889 coding.mode |= CODING_MODE_LAST_BLOCK;
4890 ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
4892 save_errno = errno;
4894 if (ok && CODING_REQUIRE_FLUSHING (&coding)
4895 && !(coding.mode & CODING_MODE_LAST_BLOCK))
4897 /* We have to flush out a data. */
4898 coding.mode |= CODING_MODE_LAST_BLOCK;
4899 ok = e_write (desc, Qnil, 1, 1, &coding);
4900 save_errno = errno;
4903 /* fsync is not crucial for temporary files. Nor for auto-save
4904 files, since they might lose some work anyway. */
4905 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
4907 /* Transfer data and metadata to disk, retrying if interrupted.
4908 fsync can report a write failure here, e.g., due to disk full
4909 under NFS. But ignore EINVAL, which means fsync is not
4910 supported on this file. */
4911 while (fsync (desc) != 0)
4912 if (errno != EINTR)
4914 if (errno != EINVAL)
4915 ok = 0, save_errno = errno;
4916 break;
4920 modtime = invalid_timespec ();
4921 if (visiting)
4923 if (fstat (desc, &st) == 0)
4924 modtime = get_stat_mtime (&st);
4925 else
4926 ok = 0, save_errno = errno;
4929 if (open_and_close_file)
4931 /* NFS can report a write failure now. */
4932 if (emacs_close (desc) < 0)
4933 ok = 0, save_errno = errno;
4935 /* Discard the unwind protect for close_file_unwind. */
4936 specpdl_ptr = specpdl + count1;
4939 /* Some file systems have a bug where st_mtime is not updated
4940 properly after a write. For example, CIFS might not see the
4941 st_mtime change until after the file is opened again.
4943 Attempt to detect this file system bug, and update MODTIME to the
4944 newer st_mtime if the bug appears to be present. This introduces
4945 a race condition, so to avoid most instances of the race condition
4946 on non-buggy file systems, skip this check if the most recently
4947 encountered non-buggy file system was the current file system.
4949 A race condition can occur if some other process modifies the
4950 file between the fstat above and the fstat below, but the race is
4951 unlikely and a similar race between the last write and the fstat
4952 above cannot possibly be closed anyway. */
4954 if (timespec_valid_p (modtime)
4955 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
4957 int desc1 = emacs_open (fn, O_WRONLY, 0);
4958 if (desc1 >= 0)
4960 struct stat st1;
4961 if (fstat (desc1, &st1) == 0
4962 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
4964 /* Use the heuristic if it appears to be valid. With neither
4965 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4966 file, the time stamp won't change. Also, some non-POSIX
4967 systems don't update an empty file's time stamp when
4968 truncating it. Finally, file systems with 100 ns or worse
4969 resolution sometimes seem to have bugs: on a system with ns
4970 resolution, checking ns % 100 incorrectly avoids the heuristic
4971 1% of the time, but the problem should be temporary as we will
4972 try again on the next time stamp. */
4973 bool use_heuristic
4974 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
4975 && st.st_size != 0
4976 && modtime.tv_nsec % 100 != 0);
4978 struct timespec modtime1 = get_stat_mtime (&st1);
4979 if (use_heuristic
4980 && timespec_cmp (modtime, modtime1) == 0
4981 && st.st_size == st1.st_size)
4983 timestamp_file_system = st.st_dev;
4984 valid_timestamp_file_system = 1;
4986 else
4988 st.st_size = st1.st_size;
4989 modtime = modtime1;
4992 emacs_close (desc1);
4996 /* Call write-region-post-annotation-function. */
4997 while (CONSP (Vwrite_region_annotation_buffers))
4999 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
5000 if (!NILP (Fbuffer_live_p (buf)))
5002 Fset_buffer (buf);
5003 if (FUNCTIONP (Vwrite_region_post_annotation_function))
5004 call0 (Vwrite_region_post_annotation_function);
5006 Vwrite_region_annotation_buffers
5007 = XCDR (Vwrite_region_annotation_buffers);
5010 unbind_to (count, Qnil);
5012 if (file_locked)
5013 unlock_file (lockname);
5015 /* Do this before reporting IO error
5016 to avoid a "file has changed on disk" warning on
5017 next attempt to save. */
5018 if (timespec_valid_p (modtime))
5020 current_buffer->modtime = modtime;
5021 current_buffer->modtime_size = st.st_size;
5024 if (! ok)
5025 report_file_errno ("Write error", filename, save_errno);
5027 bool auto_saving_into_visited_file =
5028 auto_saving
5029 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5030 BVAR (current_buffer, auto_save_file_name)));
5031 if (visiting)
5033 SAVE_MODIFF = MODIFF;
5034 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5035 bset_filename (current_buffer, visit_file);
5036 update_mode_lines = 14;
5037 if (auto_saving_into_visited_file)
5038 unlock_file (lockname);
5040 else if (quietly)
5042 if (auto_saving_into_visited_file)
5044 SAVE_MODIFF = MODIFF;
5045 unlock_file (lockname);
5048 return Qnil;
5051 if (!auto_saving && !noninteractive)
5052 message_with_string ((NUMBERP (append)
5053 ? "Updated %s"
5054 : ! NILP (append)
5055 ? "Added to %s"
5056 : "Wrote %s"),
5057 visit_file, 1);
5059 return Qnil;
5062 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
5063 doc: /* Return t if (car A) is numerically less than (car B). */)
5064 (Lisp_Object a, Lisp_Object b)
5066 return arithcompare (Fcar (a), Fcar (b), ARITH_LESS);
5069 /* Build the complete list of annotations appropriate for writing out
5070 the text between START and END, by calling all the functions in
5071 write-region-annotate-functions and merging the lists they return.
5072 If one of these functions switches to a different buffer, we assume
5073 that buffer contains altered text. Therefore, the caller must
5074 make sure to restore the current buffer in all cases,
5075 as save-excursion would do. */
5077 static Lisp_Object
5078 build_annotations (Lisp_Object start, Lisp_Object end)
5080 Lisp_Object annotations;
5081 Lisp_Object p, res;
5082 Lisp_Object original_buffer;
5083 int i;
5084 bool used_global = false;
5086 XSETBUFFER (original_buffer, current_buffer);
5088 annotations = Qnil;
5089 p = Vwrite_region_annotate_functions;
5090 while (CONSP (p))
5092 struct buffer *given_buffer = current_buffer;
5093 if (EQ (Qt, XCAR (p)) && !used_global)
5094 { /* Use the global value of the hook. */
5095 used_global = true;
5096 p = CALLN (Fappend,
5097 Fdefault_value (Qwrite_region_annotate_functions),
5098 XCDR (p));
5099 continue;
5101 Vwrite_region_annotations_so_far = annotations;
5102 res = call2 (XCAR (p), start, end);
5103 /* If the function makes a different buffer current,
5104 assume that means this buffer contains altered text to be output.
5105 Reset START and END from the buffer bounds
5106 and discard all previous annotations because they should have
5107 been dealt with by this function. */
5108 if (current_buffer != given_buffer)
5110 Vwrite_region_annotation_buffers
5111 = Fcons (Fcurrent_buffer (),
5112 Vwrite_region_annotation_buffers);
5113 XSETFASTINT (start, BEGV);
5114 XSETFASTINT (end, ZV);
5115 annotations = Qnil;
5117 Flength (res); /* Check basic validity of return value */
5118 annotations = merge (annotations, res, Qcar_less_than_car);
5119 p = XCDR (p);
5122 /* Now do the same for annotation functions implied by the file-format */
5123 if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
5124 p = BVAR (current_buffer, auto_save_file_format);
5125 else
5126 p = BVAR (current_buffer, file_format);
5127 for (i = 0; CONSP (p); p = XCDR (p), ++i)
5129 struct buffer *given_buffer = current_buffer;
5131 Vwrite_region_annotations_so_far = annotations;
5133 /* Value is either a list of annotations or nil if the function
5134 has written annotations to a temporary buffer, which is now
5135 current. */
5136 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
5137 original_buffer, make_number (i));
5138 if (current_buffer != given_buffer)
5140 XSETFASTINT (start, BEGV);
5141 XSETFASTINT (end, ZV);
5142 annotations = Qnil;
5145 if (CONSP (res))
5146 annotations = merge (annotations, res, Qcar_less_than_car);
5149 return annotations;
5153 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5154 If STRING is nil, POS is the character position in the current buffer.
5155 Intersperse with them the annotations from *ANNOT
5156 which fall within the range of POS to POS + NCHARS,
5157 each at its appropriate position.
5159 We modify *ANNOT by discarding elements as we use them up.
5161 Return true if successful. */
5163 static bool
5164 a_write (int desc, Lisp_Object string, ptrdiff_t pos,
5165 ptrdiff_t nchars, Lisp_Object *annot,
5166 struct coding_system *coding)
5168 Lisp_Object tem;
5169 ptrdiff_t nextpos;
5170 ptrdiff_t lastpos = pos + nchars;
5172 while (NILP (*annot) || CONSP (*annot))
5174 tem = Fcar_safe (Fcar (*annot));
5175 nextpos = pos - 1;
5176 if (INTEGERP (tem))
5177 nextpos = XFASTINT (tem);
5179 /* If there are no more annotations in this range,
5180 output the rest of the range all at once. */
5181 if (! (nextpos >= pos && nextpos <= lastpos))
5182 return e_write (desc, string, pos, lastpos, coding);
5184 /* Output buffer text up to the next annotation's position. */
5185 if (nextpos > pos)
5187 if (!e_write (desc, string, pos, nextpos, coding))
5188 return 0;
5189 pos = nextpos;
5191 /* Output the annotation. */
5192 tem = Fcdr (Fcar (*annot));
5193 if (STRINGP (tem))
5195 if (!e_write (desc, tem, 0, SCHARS (tem), coding))
5196 return 0;
5198 *annot = Fcdr (*annot);
5200 return 1;
5203 /* Maximum number of characters that the next
5204 function encodes per one loop iteration. */
5206 enum { E_WRITE_MAX = 8 * 1024 * 1024 };
5208 /* Write text in the range START and END into descriptor DESC,
5209 encoding them with coding system CODING. If STRING is nil, START
5210 and END are character positions of the current buffer, else they
5211 are indexes to the string STRING. Return true if successful. */
5213 static bool
5214 e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5215 struct coding_system *coding)
5217 if (STRINGP (string))
5219 start = 0;
5220 end = SCHARS (string);
5223 /* We used to have a code for handling selective display here. But,
5224 now it is handled within encode_coding. */
5226 while (start < end)
5228 if (STRINGP (string))
5230 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5231 if (CODING_REQUIRE_ENCODING (coding))
5233 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5235 /* Avoid creating huge Lisp string in encode_coding_object. */
5236 if (nchars == E_WRITE_MAX)
5237 coding->raw_destination = 1;
5239 encode_coding_object
5240 (coding, string, start, string_char_to_byte (string, start),
5241 start + nchars, string_char_to_byte (string, start + nchars),
5242 Qt);
5244 else
5246 coding->dst_object = string;
5247 coding->consumed_char = SCHARS (string);
5248 coding->produced = SBYTES (string);
5251 else
5253 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
5254 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
5256 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5257 if (CODING_REQUIRE_ENCODING (coding))
5259 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5261 /* Likewise. */
5262 if (nchars == E_WRITE_MAX)
5263 coding->raw_destination = 1;
5265 encode_coding_object
5266 (coding, Fcurrent_buffer (), start, start_byte,
5267 start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
5269 else
5271 coding->dst_object = Qnil;
5272 coding->dst_pos_byte = start_byte;
5273 if (start >= GPT || end <= GPT)
5275 coding->consumed_char = end - start;
5276 coding->produced = end_byte - start_byte;
5278 else
5280 coding->consumed_char = GPT - start;
5281 coding->produced = GPT_BYTE - start_byte;
5286 if (coding->produced > 0)
5288 char *buf = (coding->raw_destination ? (char *) coding->destination
5289 : (STRINGP (coding->dst_object)
5290 ? SSDATA (coding->dst_object)
5291 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5292 coding->produced -= emacs_write_quit (desc, buf, coding->produced);
5294 if (coding->raw_destination)
5296 /* We're responsible for freeing this, see
5297 encode_coding_object to check why. */
5298 xfree (coding->destination);
5299 coding->raw_destination = 0;
5301 if (coding->produced)
5302 return 0;
5304 start += coding->consumed_char;
5307 return 1;
5310 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5311 Sverify_visited_file_modtime, 0, 1, 0,
5312 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
5313 This means that the file has not been changed since it was visited or saved.
5314 If BUF is omitted or nil, it defaults to the current buffer.
5315 See Info node `(elisp)Modification Time' for more details. */)
5316 (Lisp_Object buf)
5318 struct buffer *b = decode_buffer (buf);
5319 struct stat st;
5320 Lisp_Object handler;
5321 Lisp_Object filename;
5322 struct timespec mtime;
5324 if (!STRINGP (BVAR (b, filename))) return Qt;
5325 if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
5327 /* If the file name has special constructs in it,
5328 call the corresponding file handler. */
5329 handler = Ffind_file_name_handler (BVAR (b, filename),
5330 Qverify_visited_file_modtime);
5331 if (!NILP (handler))
5332 return call2 (handler, Qverify_visited_file_modtime, buf);
5334 filename = ENCODE_FILE (BVAR (b, filename));
5336 mtime = (stat (SSDATA (filename), &st) == 0
5337 ? get_stat_mtime (&st)
5338 : time_error_value (errno));
5339 if (timespec_cmp (mtime, b->modtime) == 0
5340 && (b->modtime_size < 0
5341 || st.st_size == b->modtime_size))
5342 return Qt;
5343 return Qnil;
5346 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
5347 Svisited_file_modtime, 0, 0, 0,
5348 doc: /* Return the current buffer's recorded visited file modification time.
5349 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5350 `file-attributes' returns. If the current buffer has no recorded file
5351 modification time, this function returns 0. If the visited file
5352 doesn't exist, return -1.
5353 See Info node `(elisp)Modification Time' for more details. */)
5354 (void)
5356 int ns = current_buffer->modtime.tv_nsec;
5357 if (ns < 0)
5358 return make_number (UNKNOWN_MODTIME_NSECS - ns);
5359 return make_lisp_time (current_buffer->modtime);
5362 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5363 Sset_visited_file_modtime, 0, 1, 0,
5364 doc: /* Update buffer's recorded modification time from the visited file's time.
5365 Useful if the buffer was not read from the file normally
5366 or if the file itself has been changed for some known benign reason.
5367 An argument specifies the modification time value to use
5368 \(instead of that of the visited file), in the form of a list
5369 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5370 `visited-file-modtime'. */)
5371 (Lisp_Object time_flag)
5373 if (!NILP (time_flag))
5375 struct timespec mtime;
5376 if (INTEGERP (time_flag))
5378 CHECK_RANGED_INTEGER (time_flag, -1, 0);
5379 mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
5381 else
5382 mtime = lisp_time_argument (time_flag);
5384 current_buffer->modtime = mtime;
5385 current_buffer->modtime_size = -1;
5387 else
5389 register Lisp_Object filename;
5390 struct stat st;
5391 Lisp_Object handler;
5393 filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
5395 /* If the file name has special constructs in it,
5396 call the corresponding file handler. */
5397 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5398 if (!NILP (handler))
5399 /* The handler can find the file name the same way we did. */
5400 return call2 (handler, Qset_visited_file_modtime, Qnil);
5402 filename = ENCODE_FILE (filename);
5404 if (stat (SSDATA (filename), &st) >= 0)
5406 current_buffer->modtime = get_stat_mtime (&st);
5407 current_buffer->modtime_size = st.st_size;
5411 return Qnil;
5414 static Lisp_Object
5415 auto_save_error (Lisp_Object error_val)
5417 auto_save_error_occurred = 1;
5419 ring_bell (XFRAME (selected_frame));
5421 AUTO_STRING (format, "Auto-saving %s: %s");
5422 Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name),
5423 Ferror_message_string (error_val));
5424 call3 (intern ("display-warning"),
5425 intern ("auto-save"), msg, intern ("error"));
5427 return Qnil;
5430 static Lisp_Object
5431 auto_save_1 (void)
5433 struct stat st;
5434 Lisp_Object modes;
5436 auto_save_mode_bits = 0666;
5438 /* Get visited file's mode to become the auto save file's mode. */
5439 if (! NILP (BVAR (current_buffer, filename)))
5441 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
5442 /* But make sure we can overwrite it later! */
5443 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
5444 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5445 INTEGERP (modes))
5446 /* Remote files don't cooperate with stat. */
5447 auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
5450 return
5451 Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
5452 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5453 Qnil, Qnil);
5456 struct auto_save_unwind
5458 FILE *stream;
5459 bool auto_raise;
5462 static void
5463 do_auto_save_unwind (void *arg)
5465 struct auto_save_unwind *p = arg;
5466 FILE *stream = p->stream;
5467 minibuffer_auto_raise = p->auto_raise;
5468 auto_saving = 0;
5469 if (stream != NULL)
5471 block_input ();
5472 fclose (stream);
5473 unblock_input ();
5477 static Lisp_Object
5478 do_auto_save_make_dir (Lisp_Object dir)
5480 Lisp_Object result;
5482 auto_saving_dir_umask = 077;
5483 result = call2 (Qmake_directory, dir, Qt);
5484 auto_saving_dir_umask = 0;
5485 return result;
5488 static Lisp_Object
5489 do_auto_save_eh (Lisp_Object ignore)
5491 auto_saving_dir_umask = 0;
5492 return Qnil;
5495 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5496 doc: /* Auto-save all buffers that need it.
5497 This is all buffers that have auto-saving enabled
5498 and are changed since last auto-saved.
5499 Auto-saving writes the buffer into a file
5500 so that your editing is not lost if the system crashes.
5501 This file is not the file you visited; that changes only when you save.
5502 Normally, run the normal hook `auto-save-hook' before saving.
5504 A non-nil NO-MESSAGE argument means do not print any message if successful.
5505 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5506 (Lisp_Object no_message, Lisp_Object current_only)
5508 struct buffer *old = current_buffer, *b;
5509 Lisp_Object tail, buf, hook;
5510 bool auto_saved = 0;
5511 int do_handled_files;
5512 Lisp_Object oquit;
5513 FILE *stream = NULL;
5514 ptrdiff_t count = SPECPDL_INDEX ();
5515 bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
5516 bool old_message_p = 0;
5517 struct auto_save_unwind auto_save_unwind;
5519 if (max_specpdl_size < specpdl_size + 40)
5520 max_specpdl_size = specpdl_size + 40;
5522 if (minibuf_level)
5523 no_message = Qt;
5525 if (NILP (no_message))
5527 old_message_p = push_message ();
5528 record_unwind_protect_void (pop_message_unwind);
5531 /* Ordinarily don't quit within this function,
5532 but don't make it impossible to quit (in case we get hung in I/O). */
5533 oquit = Vquit_flag;
5534 Vquit_flag = Qnil;
5536 hook = intern ("auto-save-hook");
5537 safe_run_hooks (hook);
5539 if (STRINGP (Vauto_save_list_file_name))
5541 Lisp_Object listfile;
5543 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5545 /* Don't try to create the directory when shutting down Emacs,
5546 because creating the directory might signal an error, and
5547 that would leave Emacs in a strange state. */
5548 if (!NILP (Vrun_hooks))
5550 Lisp_Object dir;
5551 dir = Ffile_name_directory (listfile);
5552 if (NILP (Ffile_directory_p (dir)))
5553 internal_condition_case_1 (do_auto_save_make_dir,
5554 dir, Qt,
5555 do_auto_save_eh);
5558 stream = emacs_fopen (SSDATA (listfile), "w");
5561 auto_save_unwind.stream = stream;
5562 auto_save_unwind.auto_raise = minibuffer_auto_raise;
5563 record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
5564 minibuffer_auto_raise = 0;
5565 auto_saving = 1;
5566 auto_save_error_occurred = 0;
5568 /* On first pass, save all files that don't have handlers.
5569 On second pass, save all files that do have handlers.
5571 If Emacs is crashing, the handlers may tweak what is causing
5572 Emacs to crash in the first place, and it would be a shame if
5573 Emacs failed to autosave perfectly ordinary files because it
5574 couldn't handle some ange-ftp'd file. */
5576 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
5577 FOR_EACH_LIVE_BUFFER (tail, buf)
5579 b = XBUFFER (buf);
5581 /* Record all the buffers that have auto save mode
5582 in the special file that lists them. For each of these buffers,
5583 Record visited name (if any) and auto save name. */
5584 if (STRINGP (BVAR (b, auto_save_file_name))
5585 && stream != NULL && do_handled_files == 0)
5587 block_input ();
5588 if (!NILP (BVAR (b, filename)))
5589 fwrite_unlocked (SDATA (BVAR (b, filename)), 1,
5590 SBYTES (BVAR (b, filename)), stream);
5591 putc_unlocked ('\n', stream);
5592 fwrite_unlocked (SDATA (BVAR (b, auto_save_file_name)), 1,
5593 SBYTES (BVAR (b, auto_save_file_name)), stream);
5594 putc_unlocked ('\n', stream);
5595 unblock_input ();
5598 if (!NILP (current_only)
5599 && b != current_buffer)
5600 continue;
5602 /* Don't auto-save indirect buffers.
5603 The base buffer takes care of it. */
5604 if (b->base_buffer)
5605 continue;
5607 /* Check for auto save enabled
5608 and file changed since last auto save
5609 and file changed since last real save. */
5610 if (STRINGP (BVAR (b, auto_save_file_name))
5611 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
5612 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
5613 /* -1 means we've turned off autosaving for a while--see below. */
5614 && XINT (BVAR (b, save_length)) >= 0
5615 && (do_handled_files
5616 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
5617 Qwrite_region))))
5619 struct timespec before_time = current_timespec ();
5620 struct timespec after_time;
5622 /* If we had a failure, don't try again for 20 minutes. */
5623 if (b->auto_save_failure_time > 0
5624 && before_time.tv_sec - b->auto_save_failure_time < 1200)
5625 continue;
5627 set_buffer_internal (b);
5628 if (NILP (Vauto_save_include_big_deletions)
5629 && (XFASTINT (BVAR (b, save_length)) * 10
5630 > (BUF_Z (b) - BUF_BEG (b)) * 13)
5631 /* A short file is likely to change a large fraction;
5632 spare the user annoying messages. */
5633 && XFASTINT (BVAR (b, save_length)) > 5000
5634 /* These messages are frequent and annoying for `*mail*'. */
5635 && !EQ (BVAR (b, filename), Qnil)
5636 && NILP (no_message))
5638 /* It has shrunk too much; turn off auto-saving here. */
5639 minibuffer_auto_raise = orig_minibuffer_auto_raise;
5640 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5641 BVAR (b, name), 1);
5642 minibuffer_auto_raise = 0;
5643 /* Turn off auto-saving until there's a real save,
5644 and prevent any more warnings. */
5645 XSETINT (BVAR (b, save_length), -1);
5646 Fsleep_for (make_number (1), Qnil);
5647 continue;
5649 if (!auto_saved && NILP (no_message))
5650 message1 ("Auto-saving...");
5651 internal_condition_case (auto_save_1, Qt, auto_save_error);
5652 auto_saved = 1;
5653 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
5654 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5655 set_buffer_internal (old);
5657 after_time = current_timespec ();
5659 /* If auto-save took more than 60 seconds,
5660 assume it was an NFS failure that got a timeout. */
5661 if (after_time.tv_sec - before_time.tv_sec > 60)
5662 b->auto_save_failure_time = after_time.tv_sec;
5666 /* Prevent another auto save till enough input events come in. */
5667 record_auto_save ();
5669 if (auto_saved && NILP (no_message))
5671 if (old_message_p)
5673 /* If we are going to restore an old message,
5674 give time to read ours. */
5675 sit_for (make_number (1), 0, 0);
5676 restore_message ();
5678 else if (!auto_save_error_occurred)
5679 /* Don't overwrite the error message if an error occurred.
5680 If we displayed a message and then restored a state
5681 with no message, leave a "done" message on the screen. */
5682 message1 ("Auto-saving...done");
5685 Vquit_flag = oquit;
5687 /* This restores the message-stack status. */
5688 unbind_to (count, Qnil);
5689 return Qnil;
5692 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5693 Sset_buffer_auto_saved, 0, 0, 0,
5694 doc: /* Mark current buffer as auto-saved with its current text.
5695 No auto-save file will be written until the buffer changes again. */)
5696 (void)
5698 /* FIXME: This should not be called in indirect buffers, since
5699 they're not autosaved. */
5700 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
5701 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5702 current_buffer->auto_save_failure_time = 0;
5703 return Qnil;
5706 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
5707 Sclear_buffer_auto_save_failure, 0, 0, 0,
5708 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5709 (void)
5711 current_buffer->auto_save_failure_time = 0;
5712 return Qnil;
5715 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5716 0, 0, 0,
5717 doc: /* Return t if current buffer has been auto-saved recently.
5718 More precisely, if it has been auto-saved since last read from or saved
5719 in the visited file. If the buffer has no visited file,
5720 then any auto-save counts as "recent". */)
5721 (void)
5723 /* FIXME: maybe we should return nil for indirect buffers since
5724 they're never autosaved. */
5725 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5728 /* Reading and completing file names. */
5730 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5731 Snext_read_file_uses_dialog_p, 0, 0, 0,
5732 doc: /* Return t if a call to `read-file-name' will use a dialog.
5733 The return value is only relevant for a call to `read-file-name' that happens
5734 before any other event (mouse or keypress) is handled. */)
5735 (void)
5737 #if (defined USE_GTK || defined USE_MOTIF \
5738 || defined HAVE_NS || defined HAVE_NTGUI)
5739 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5740 && use_dialog_box
5741 && use_file_dialog
5742 && window_system_available (SELECTED_FRAME ()))
5743 return Qt;
5744 #endif
5745 return Qnil;
5749 DEFUN ("set-binary-mode", Fset_binary_mode, Sset_binary_mode, 2, 2, 0,
5750 doc: /* Switch STREAM to binary I/O mode or text I/O mode.
5751 STREAM can be one of the symbols `stdin', `stdout', or `stderr'.
5752 If MODE is non-nil, switch STREAM to binary mode, otherwise switch
5753 it to text mode.
5755 As a side effect, this function flushes any pending STREAM's data.
5757 Value is the previous value of STREAM's I/O mode, nil for text mode,
5758 non-nil for binary mode.
5760 On MS-Windows and MS-DOS, binary mode is needed to read or write
5761 arbitrary binary data, and for disabling translation between CR-LF
5762 pairs and a single newline character. Examples include generation
5763 of text files with Unix-style end-of-line format using `princ' in
5764 batch mode, with standard output redirected to a file.
5766 On Posix systems, this function always returns non-nil, and has no
5767 effect except for flushing STREAM's data. */)
5768 (Lisp_Object stream, Lisp_Object mode)
5770 FILE *fp = NULL;
5771 int binmode;
5773 CHECK_SYMBOL (stream);
5774 if (EQ (stream, Qstdin))
5775 fp = stdin;
5776 else if (EQ (stream, Qstdout))
5777 fp = stdout;
5778 else if (EQ (stream, Qstderr))
5779 fp = stderr;
5780 else
5781 xsignal2 (Qerror, build_string ("unsupported stream"), stream);
5783 binmode = NILP (mode) ? O_TEXT : O_BINARY;
5784 if (fp != stdin)
5785 fflush_unlocked (fp);
5787 return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
5790 #ifndef DOS_NT
5792 /* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with
5793 the result negated if NEGATE. */
5794 static Lisp_Object
5795 blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate)
5797 /* On typical platforms the following code is accurate to 53 bits,
5798 which is close enough. BLOCKSIZE is invariably a power of 2, so
5799 converting it to double does not lose information. */
5800 double bs = blocksize;
5801 return make_float (negate ? -bs * -blocks : bs * blocks);
5804 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
5805 doc: /* Return storage information about the file system FILENAME is on.
5806 Value is a list of numbers (TOTAL FREE AVAIL), where TOTAL is the total
5807 storage of the file system, FREE is the free storage, and AVAIL is the
5808 storage available to a non-superuser. All 3 numbers are in bytes.
5809 If the underlying system call fails, value is nil. */)
5810 (Lisp_Object filename)
5812 Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil));
5814 /* If the file name has special constructs in it,
5815 call the corresponding file handler. */
5816 Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info);
5817 if (!NILP (handler))
5819 Lisp_Object result = call2 (handler, Qfile_system_info, encoded);
5820 if (CONSP (result) || NILP (result))
5821 return result;
5822 error ("Invalid handler in `file-name-handler-alist'");
5825 struct fs_usage u;
5826 if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0)
5827 return Qnil;
5828 return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false),
5829 blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false),
5830 blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail,
5831 u.fsu_bavail_top_bit_set));
5834 #endif /* !DOS_NT */
5836 void
5837 init_fileio (void)
5839 realmask = umask (0);
5840 umask (realmask);
5842 valid_timestamp_file_system = 0;
5844 /* fsync can be a significant performance hit. Often it doesn't
5845 suffice to make the file-save operation survive a crash. For
5846 batch scripts, which are typically part of larger shell commands
5847 that don't fsync other files, its effect on performance can be
5848 significant so its utility is particularly questionable.
5849 Hence, for now by default fsync is used only when interactive.
5851 For more on why fsync often fails to work on today's hardware, see:
5852 Zheng M et al. Understanding the robustness of SSDs under power fault.
5853 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5854 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5856 For more on why fsync does not suffice even if it works properly, see:
5857 Roche X. Necessary step(s) to synchronize filename operations on disk.
5858 Austin Group Defect 672, 2013-03-19
5859 http://austingroupbugs.net/view.php?id=672 */
5860 write_region_inhibit_fsync = noninteractive;
5863 void
5864 syms_of_fileio (void)
5866 /* Property name of a file name handler,
5867 which gives a list of operations it handles. */
5868 DEFSYM (Qoperations, "operations");
5870 DEFSYM (Qexpand_file_name, "expand-file-name");
5871 DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
5872 DEFSYM (Qdirectory_file_name, "directory-file-name");
5873 DEFSYM (Qfile_name_directory, "file-name-directory");
5874 DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
5875 DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
5876 DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
5877 DEFSYM (Qcopy_file, "copy-file");
5878 DEFSYM (Qmake_directory_internal, "make-directory-internal");
5879 DEFSYM (Qmake_directory, "make-directory");
5880 DEFSYM (Qdelete_file, "delete-file");
5881 DEFSYM (Qfile_name_case_insensitive_p, "file-name-case-insensitive-p");
5882 DEFSYM (Qrename_file, "rename-file");
5883 DEFSYM (Qadd_name_to_file, "add-name-to-file");
5884 DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
5885 DEFSYM (Qfile_exists_p, "file-exists-p");
5886 DEFSYM (Qfile_executable_p, "file-executable-p");
5887 DEFSYM (Qfile_readable_p, "file-readable-p");
5888 DEFSYM (Qfile_writable_p, "file-writable-p");
5889 DEFSYM (Qfile_symlink_p, "file-symlink-p");
5890 DEFSYM (Qaccess_file, "access-file");
5891 DEFSYM (Qfile_directory_p, "file-directory-p");
5892 DEFSYM (Qfile_regular_p, "file-regular-p");
5893 DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
5894 DEFSYM (Qfile_modes, "file-modes");
5895 DEFSYM (Qset_file_modes, "set-file-modes");
5896 DEFSYM (Qset_file_times, "set-file-times");
5897 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5898 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
5899 DEFSYM (Qfile_acl, "file-acl");
5900 DEFSYM (Qset_file_acl, "set-file-acl");
5901 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5902 DEFSYM (Qinsert_file_contents, "insert-file-contents");
5903 DEFSYM (Qwrite_region, "write-region");
5904 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5905 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
5906 DEFSYM (Qfile_system_info, "file-system-info");
5908 /* The symbol bound to coding-system-for-read when
5909 insert-file-contents is called for recovering a file. This is not
5910 an actual coding system name, but just an indicator to tell
5911 insert-file-contents to use `emacs-mule' with a special flag for
5912 auto saving and recovering a file. */
5913 DEFSYM (Qauto_save_coding, "auto-save-coding");
5915 DEFSYM (Qfile_name_history, "file-name-history");
5916 Fset (Qfile_name_history, Qnil);
5918 DEFSYM (Qfile_error, "file-error");
5919 DEFSYM (Qfile_already_exists, "file-already-exists");
5920 DEFSYM (Qfile_date_error, "file-date-error");
5921 DEFSYM (Qfile_missing, "file-missing");
5922 DEFSYM (Qfile_notify_error, "file-notify-error");
5923 DEFSYM (Qexcl, "excl");
5925 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
5926 doc: /* Coding system for encoding file names.
5927 If it is nil, `default-file-name-coding-system' (which see) is used.
5929 On MS-Windows, the value of this variable is largely ignored if
5930 `w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5931 behaves as if file names were encoded in `utf-8'. */);
5932 Vfile_name_coding_system = Qnil;
5934 DEFVAR_LISP ("default-file-name-coding-system",
5935 Vdefault_file_name_coding_system,
5936 doc: /* Default coding system for encoding file names.
5937 This variable is used only when `file-name-coding-system' is nil.
5939 This variable is set/changed by the command `set-language-environment'.
5940 User should not set this variable manually,
5941 instead use `file-name-coding-system' to get a constant encoding
5942 of file names regardless of the current language environment.
5944 On MS-Windows, the value of this variable is largely ignored if
5945 `w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5946 behaves as if file names were encoded in `utf-8'. */);
5947 Vdefault_file_name_coding_system = Qnil;
5949 /* Lisp functions for translating file formats. */
5950 DEFSYM (Qformat_decode, "format-decode");
5951 DEFSYM (Qformat_annotate_function, "format-annotate-function");
5953 /* Lisp function for setting buffer-file-coding-system and the
5954 multibyteness of the current buffer after inserting a file. */
5955 DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
5957 DEFSYM (Qcar_less_than_car, "car-less-than-car");
5959 Fput (Qfile_error, Qerror_conditions,
5960 Fpurecopy (list2 (Qfile_error, Qerror)));
5961 Fput (Qfile_error, Qerror_message,
5962 build_pure_c_string ("File error"));
5964 Fput (Qfile_already_exists, Qerror_conditions,
5965 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
5966 Fput (Qfile_already_exists, Qerror_message,
5967 build_pure_c_string ("File already exists"));
5969 Fput (Qfile_date_error, Qerror_conditions,
5970 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
5971 Fput (Qfile_date_error, Qerror_message,
5972 build_pure_c_string ("Cannot set file date"));
5974 Fput (Qfile_missing, Qerror_conditions,
5975 Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
5976 Fput (Qfile_missing, Qerror_message,
5977 build_pure_c_string ("File is missing"));
5979 Fput (Qfile_notify_error, Qerror_conditions,
5980 Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
5981 Fput (Qfile_notify_error, Qerror_message,
5982 build_pure_c_string ("File notification error"));
5984 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
5985 doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5986 If a file name matches REGEXP, all I/O on that file is done by calling
5987 HANDLER. If a file name matches more than one handler, the handler
5988 whose match starts last in the file name gets precedence. The
5989 function `find-file-name-handler' checks this list for a handler for
5990 its argument.
5992 HANDLER should be a function. The first argument given to it is the
5993 name of the I/O primitive to be handled; the remaining arguments are
5994 the arguments that were passed to that primitive. For example, if you
5995 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5996 HANDLER is called like this:
5998 (funcall HANDLER \\='file-exists-p FILENAME)
6000 Note that HANDLER must be able to handle all I/O primitives; if it has
6001 nothing special to do for a primitive, it should reinvoke the
6002 primitive to handle the operation \"the usual way\".
6003 See Info node `(elisp)Magic File Names' for more details. */);
6004 Vfile_name_handler_alist = Qnil;
6006 DEFVAR_LISP ("set-auto-coding-function",
6007 Vset_auto_coding_function,
6008 doc: /* If non-nil, a function to call to decide a coding system of file.
6009 Two arguments are passed to this function: the file name
6010 and the length of a file contents following the point.
6011 This function should return a coding system to decode the file contents.
6012 It should check the file name against `auto-coding-alist'.
6013 If no coding system is decided, it should check a coding system
6014 specified in the heading lines with the format:
6015 -*- ... coding: CODING-SYSTEM; ... -*-
6016 or local variable spec of the tailing lines with `coding:' tag. */);
6017 Vset_auto_coding_function = Qnil;
6019 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
6020 doc: /* A list of functions to be called at the end of `insert-file-contents'.
6021 Each is passed one argument, the number of characters inserted,
6022 with point at the start of the inserted text. Each function
6023 should leave point the same, and return the new character count.
6024 If `insert-file-contents' is intercepted by a handler from
6025 `file-name-handler-alist', that handler is responsible for calling the
6026 functions in `after-insert-file-functions' if appropriate. */);
6027 Vafter_insert_file_functions = Qnil;
6029 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
6030 doc: /* A list of functions to be called at the start of `write-region'.
6031 Each is passed two arguments, START and END as for `write-region'.
6032 These are usually two numbers but not always; see the documentation
6033 for `write-region'. The function should return a list of pairs
6034 of the form (POSITION . STRING), consisting of strings to be effectively
6035 inserted at the specified positions of the file being written (1 means to
6036 insert before the first byte written). The POSITIONs must be sorted into
6037 increasing order.
6039 If there are several annotation functions, the lists returned by these
6040 functions are merged destructively. As each annotation function runs,
6041 the variable `write-region-annotations-so-far' contains a list of all
6042 annotations returned by previous annotation functions.
6044 An annotation function can return with a different buffer current.
6045 Doing so removes the annotations returned by previous functions, and
6046 resets START and END to `point-min' and `point-max' of the new buffer.
6048 After `write-region' completes, Emacs calls the function stored in
6049 `write-region-post-annotation-function', once for each buffer that was
6050 current when building the annotations (i.e., at least once), with that
6051 buffer current. */);
6052 Vwrite_region_annotate_functions = Qnil;
6053 DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
6055 DEFVAR_LISP ("write-region-post-annotation-function",
6056 Vwrite_region_post_annotation_function,
6057 doc: /* Function to call after `write-region' completes.
6058 The function is called with no arguments. If one or more of the
6059 annotation functions in `write-region-annotate-functions' changed the
6060 current buffer, the function stored in this variable is called for
6061 each of those additional buffers as well, in addition to the original
6062 buffer. The relevant buffer is current during each function call. */);
6063 Vwrite_region_post_annotation_function = Qnil;
6064 staticpro (&Vwrite_region_annotation_buffers);
6066 DEFVAR_LISP ("write-region-annotations-so-far",
6067 Vwrite_region_annotations_so_far,
6068 doc: /* When an annotation function is called, this holds the previous annotations.
6069 These are the annotations made by other annotation functions
6070 that were already called. See also `write-region-annotate-functions'. */);
6071 Vwrite_region_annotations_so_far = Qnil;
6073 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
6074 doc: /* A list of file name handlers that temporarily should not be used.
6075 This applies only to the operation `inhibit-file-name-operation'. */);
6076 Vinhibit_file_name_handlers = Qnil;
6078 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
6079 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6080 Vinhibit_file_name_operation = Qnil;
6082 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
6083 doc: /* File name in which to write a list of all auto save file names.
6084 This variable is initialized automatically from `auto-save-list-file-prefix'
6085 shortly after Emacs reads your init file, if you have not yet given it
6086 a non-nil value. */);
6087 Vauto_save_list_file_name = Qnil;
6089 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
6090 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6091 Normally auto-save files are written under other names. */);
6092 Vauto_save_visited_file_name = Qnil;
6094 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
6095 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
6096 If nil, deleting a substantial portion of the text disables auto-save
6097 in the buffer; this is the default behavior, because the auto-save
6098 file is usually more useful if it contains the deleted text. */);
6099 Vauto_save_include_big_deletions = Qnil;
6101 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
6102 doc: /* Non-nil means don't call fsync in `write-region'.
6103 This variable affects calls to `write-region' as well as save commands.
6104 Setting this to nil may avoid data loss if the system loses power or
6105 the operating system crashes. By default, it is non-nil in batch mode. */);
6106 write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */
6108 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
6109 doc: /* Specifies whether to use the system's trash can.
6110 When non-nil, certain file deletion commands use the function
6111 `move-file-to-trash' instead of deleting files outright.
6112 This includes interactive calls to `delete-file' and
6113 `delete-directory' and the Dired deletion commands. */);
6114 delete_by_moving_to_trash = 0;
6115 DEFSYM (Qdelete_by_moving_to_trash, "delete-by-moving-to-trash");
6117 /* Lisp function for moving files to trash. */
6118 DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
6120 /* Lisp function for recursively copying directories. */
6121 DEFSYM (Qcopy_directory, "copy-directory");
6123 /* Lisp function for recursively deleting directories. */
6124 DEFSYM (Qdelete_directory, "delete-directory");
6126 DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
6127 DEFSYM (Qget_buffer_window_list, "get-buffer-window-list");
6129 DEFSYM (Qstdin, "stdin");
6130 DEFSYM (Qstdout, "stdout");
6131 DEFSYM (Qstderr, "stderr");
6133 defsubr (&Sfind_file_name_handler);
6134 defsubr (&Sfile_name_directory);
6135 defsubr (&Sfile_name_nondirectory);
6136 defsubr (&Sunhandled_file_name_directory);
6137 defsubr (&Sfile_name_as_directory);
6138 defsubr (&Sdirectory_name_p);
6139 defsubr (&Sdirectory_file_name);
6140 defsubr (&Smake_temp_file_internal);
6141 defsubr (&Smake_temp_name);
6142 defsubr (&Sexpand_file_name);
6143 defsubr (&Ssubstitute_in_file_name);
6144 defsubr (&Scopy_file);
6145 defsubr (&Smake_directory_internal);
6146 defsubr (&Sdelete_directory_internal);
6147 defsubr (&Sdelete_file);
6148 defsubr (&Sfile_name_case_insensitive_p);
6149 defsubr (&Srename_file);
6150 defsubr (&Sadd_name_to_file);
6151 defsubr (&Smake_symbolic_link);
6152 defsubr (&Sfile_name_absolute_p);
6153 defsubr (&Sfile_exists_p);
6154 defsubr (&Sfile_executable_p);
6155 defsubr (&Sfile_readable_p);
6156 defsubr (&Sfile_writable_p);
6157 defsubr (&Saccess_file);
6158 defsubr (&Sfile_symlink_p);
6159 defsubr (&Sfile_directory_p);
6160 defsubr (&Sfile_accessible_directory_p);
6161 defsubr (&Sfile_regular_p);
6162 defsubr (&Sfile_modes);
6163 defsubr (&Sset_file_modes);
6164 defsubr (&Sset_file_times);
6165 defsubr (&Sfile_selinux_context);
6166 defsubr (&Sfile_acl);
6167 defsubr (&Sset_file_acl);
6168 defsubr (&Sset_file_selinux_context);
6169 defsubr (&Sset_default_file_modes);
6170 defsubr (&Sdefault_file_modes);
6171 defsubr (&Sfile_newer_than_file_p);
6172 defsubr (&Sinsert_file_contents);
6173 defsubr (&Swrite_region);
6174 defsubr (&Scar_less_than_car);
6175 defsubr (&Sverify_visited_file_modtime);
6176 defsubr (&Svisited_file_modtime);
6177 defsubr (&Sset_visited_file_modtime);
6178 defsubr (&Sdo_auto_save);
6179 defsubr (&Sset_buffer_auto_saved);
6180 defsubr (&Sclear_buffer_auto_save_failure);
6181 defsubr (&Srecent_auto_save_p);
6183 defsubr (&Snext_read_file_uses_dialog_p);
6185 defsubr (&Sset_binary_mode);
6187 #ifndef DOS_NT
6188 defsubr (&Sfile_system_info);
6189 #endif
6191 #ifdef HAVE_SYNC
6192 defsubr (&Sunix_sync);
6193 #endif