Let rename-file rename dirs across filesystems
[emacs.git] / src / fileio.c
blobe57bf46015cfeb6927f4aff6a63c704a0b71473c
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 <stat-time.h>
100 #include <tempname.h>
102 #include <binary-io.h>
104 #ifdef HPUX
105 #include <netio.h>
106 #endif
108 #include "commands.h"
110 /* True during writing of auto-save files. */
111 static bool auto_saving;
113 /* Emacs's real umask. */
114 static mode_t realmask;
116 /* Nonzero umask during creation of auto-save directories. */
117 static mode_t auto_saving_dir_umask;
119 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
120 a new file with the same mode as the original. */
121 static mode_t auto_save_mode_bits;
123 /* Set by auto_save_1 if an error occurred during the last auto-save. */
124 static bool auto_save_error_occurred;
126 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
127 number of a file system where time stamps were observed to work. */
128 static bool valid_timestamp_file_system;
129 static dev_t timestamp_file_system;
131 /* Each time an annotation function changes the buffer, the new buffer
132 is added here. */
133 static Lisp_Object Vwrite_region_annotation_buffers;
135 static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
136 Lisp_Object *, struct coding_system *);
137 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
138 struct coding_system *);
141 /* Return true if FILENAME exists. */
143 static bool
144 check_existing (const char *filename)
146 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
149 /* Return true if file FILENAME exists and can be executed. */
151 static bool
152 check_executable (char *filename)
154 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
157 /* Return true if file FILENAME exists and can be accessed
158 according to AMODE, which should include W_OK.
159 On failure, return false and set errno. */
161 static bool
162 check_writable (const char *filename, int amode)
164 #ifdef MSDOS
165 /* FIXME: an faccessat implementation should be added to the
166 DOS/Windows ports and this #ifdef branch should be removed. */
167 struct stat st;
168 if (stat (filename, &st) < 0)
169 return 0;
170 errno = EPERM;
171 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
172 #else /* not MSDOS */
173 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
174 #ifdef CYGWIN
175 /* faccessat may have returned failure because Cygwin couldn't
176 determine the file's UID or GID; if so, we return success. */
177 if (!res)
179 int faccessat_errno = errno;
180 struct stat st;
181 if (stat (filename, &st) < 0)
182 return 0;
183 res = (st.st_uid == -1 || st.st_gid == -1);
184 errno = faccessat_errno;
186 #endif /* CYGWIN */
187 return res;
188 #endif /* not MSDOS */
191 /* Signal a file-access failure. STRING describes the failure,
192 NAME the file involved, and ERRORNO the errno value.
194 If NAME is neither null nor a pair, package it up as a singleton
195 list before reporting it; this saves report_file_errno's caller the
196 trouble of preserving errno before calling list1. */
198 void
199 report_file_errno (char const *string, Lisp_Object name, int errorno)
201 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
202 char *str = emacs_strerror (errorno);
203 AUTO_STRING (unibyte_str, str);
204 Lisp_Object errstring
205 = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
206 Lisp_Object errdata = Fcons (errstring, data);
208 if (errorno == EEXIST)
209 xsignal (Qfile_already_exists, errdata);
210 else
211 xsignal (errorno == ENOENT ? Qfile_missing : Qfile_error,
212 Fcons (build_string (string), errdata));
215 /* Signal a file-access failure that set errno. STRING describes the
216 failure, NAME the file involved. When invoking this function, take
217 care to not use arguments such as build_string ("foo") that involve
218 side effects that may set errno. */
220 void
221 report_file_error (char const *string, Lisp_Object name)
223 report_file_errno (string, name, errno);
226 /* Like report_file_error, but reports a file-notify-error instead. */
228 void
229 report_file_notify_error (const char *string, Lisp_Object name)
231 char *str = emacs_strerror (errno);
232 AUTO_STRING (unibyte_str, str);
233 Lisp_Object errstring
234 = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
235 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
236 Lisp_Object errdata = Fcons (errstring, data);
238 xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
241 void
242 close_file_unwind (int fd)
244 emacs_close (fd);
247 void
248 fclose_unwind (void *arg)
250 FILE *stream = arg;
251 fclose (stream);
254 /* Restore point, having saved it as a marker. */
256 void
257 restore_point_unwind (Lisp_Object location)
259 Fgoto_char (location);
260 unchain_marker (XMARKER (location));
264 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
265 Sfind_file_name_handler, 2, 2, 0,
266 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
267 Otherwise, return nil.
268 A file name is handled if one of the regular expressions in
269 `file-name-handler-alist' matches it.
271 If OPERATION equals `inhibit-file-name-operation', then ignore
272 any handlers that are members of `inhibit-file-name-handlers',
273 but still do run any other handlers. This lets handlers
274 use the standard functions without calling themselves recursively. */)
275 (Lisp_Object filename, Lisp_Object operation)
277 /* This function must not munge the match data. */
278 Lisp_Object chain, inhibited_handlers, result;
279 ptrdiff_t pos = -1;
281 result = Qnil;
282 CHECK_STRING (filename);
284 if (EQ (operation, Vinhibit_file_name_operation))
285 inhibited_handlers = Vinhibit_file_name_handlers;
286 else
287 inhibited_handlers = Qnil;
289 for (chain = Vfile_name_handler_alist; CONSP (chain);
290 chain = XCDR (chain))
292 Lisp_Object elt;
293 elt = XCAR (chain);
294 if (CONSP (elt))
296 Lisp_Object string = XCAR (elt);
297 ptrdiff_t match_pos;
298 Lisp_Object handler = XCDR (elt);
299 Lisp_Object operations = Qnil;
301 if (SYMBOLP (handler))
302 operations = Fget (handler, Qoperations);
304 if (STRINGP (string)
305 && (match_pos = fast_string_match (string, filename)) > pos
306 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
308 Lisp_Object tem;
310 handler = XCDR (elt);
311 tem = Fmemq (handler, inhibited_handlers);
312 if (NILP (tem))
314 result = handler;
315 pos = match_pos;
320 maybe_quit ();
322 return result;
325 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
326 1, 1, 0,
327 doc: /* Return the directory component in file name FILENAME.
328 Return nil if FILENAME does not include a directory.
329 Otherwise return a directory name.
330 Given a Unix syntax file name, returns a string ending in slash. */)
331 (Lisp_Object filename)
333 Lisp_Object handler;
335 CHECK_STRING (filename);
337 /* If the file name has special constructs in it,
338 call the corresponding file handler. */
339 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
340 if (!NILP (handler))
342 Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
343 filename);
344 return STRINGP (handled_name) ? handled_name : Qnil;
347 char *beg = SSDATA (filename);
348 char const *p = beg + SBYTES (filename);
350 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
351 #ifdef DOS_NT
352 /* only recognize drive specifier at the beginning */
353 && !(p[-1] == ':'
354 /* handle the "/:d:foo" and "/:foo" cases correctly */
355 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
356 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
357 #endif
358 ) p--;
360 if (p == beg)
361 return Qnil;
362 #ifdef DOS_NT
363 /* Expansion of "c:" to drive and default directory. */
364 Lisp_Object tem_fn;
365 USE_SAFE_ALLOCA;
366 SAFE_ALLOCA_STRING (beg, filename);
367 p = beg + (p - SSDATA (filename));
369 if (p[-1] == ':')
371 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
372 char *res = alloca (MAXPATHLEN + 1);
373 char *r = res;
375 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
377 memcpy (res, beg, 2);
378 beg += 2;
379 r += 2;
382 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
384 size_t l = strlen (res);
386 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
387 strcat (res, "/");
388 beg = res;
389 p = beg + strlen (beg);
390 dostounix_filename (beg);
391 tem_fn = make_specified_string (beg, -1, p - beg,
392 STRING_MULTIBYTE (filename));
394 else
395 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
396 STRING_MULTIBYTE (filename));
398 else if (STRING_MULTIBYTE (filename))
400 tem_fn = make_specified_string (beg, -1, p - beg, 1);
401 dostounix_filename (SSDATA (tem_fn));
402 #ifdef WINDOWSNT
403 if (!NILP (Vw32_downcase_file_names))
404 tem_fn = Fdowncase (tem_fn);
405 #endif
407 else
409 dostounix_filename (beg);
410 tem_fn = make_specified_string (beg, -1, p - beg, 0);
412 SAFE_FREE ();
413 return tem_fn;
414 #else /* DOS_NT */
415 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
416 #endif /* DOS_NT */
419 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
420 Sfile_name_nondirectory, 1, 1, 0,
421 doc: /* Return file name FILENAME sans its directory.
422 For example, in a Unix-syntax file name,
423 this is everything after the last slash,
424 or the entire name if it contains no slash. */)
425 (Lisp_Object filename)
427 register const char *beg, *p, *end;
428 Lisp_Object handler;
430 CHECK_STRING (filename);
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
435 if (!NILP (handler))
437 Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
438 filename);
439 if (STRINGP (handled_name))
440 return handled_name;
441 error ("Invalid handler in `file-name-handler-alist'");
444 beg = SSDATA (filename);
445 end = p = beg + SBYTES (filename);
447 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
448 #ifdef DOS_NT
449 /* only recognize drive specifier at beginning */
450 && !(p[-1] == ':'
451 /* handle the "/:d:foo" case correctly */
452 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
453 #endif
455 p--;
457 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
460 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
461 Sunhandled_file_name_directory, 1, 1, 0,
462 doc: /* Return a directly usable directory name somehow associated with FILENAME.
463 A `directly usable' directory name is one that may be used without the
464 intervention of any file handler.
465 If FILENAME is a directly usable file itself, return
466 \(file-name-as-directory FILENAME).
467 If FILENAME refers to a file which is not accessible from a local process,
468 then this should return nil.
469 The `call-process' and `start-process' functions use this function to
470 get a current directory to run processes in. */)
471 (Lisp_Object filename)
473 Lisp_Object handler;
475 /* If the file name has special constructs in it,
476 call the corresponding file handler. */
477 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
478 if (!NILP (handler))
480 Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
481 filename);
482 return STRINGP (handled_name) ? handled_name : Qnil;
485 return Ffile_name_as_directory (filename);
488 /* Maximum number of bytes that DST will be longer than SRC
489 in file_name_as_directory. This occurs when SRCLEN == 0. */
490 enum { file_name_as_directory_slop = 2 };
492 /* Convert from file name SRC of length SRCLEN to directory name in
493 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
494 string. On UNIX, just make sure there is a terminating /. Return
495 the length of DST in bytes. */
497 static ptrdiff_t
498 file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
499 bool multibyte)
501 if (srclen == 0)
503 dst[0] = '.';
504 dst[1] = '/';
505 dst[2] = '\0';
506 return 2;
509 memcpy (dst, src, srclen);
510 if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
511 dst[srclen++] = DIRECTORY_SEP;
512 dst[srclen] = 0;
513 #ifdef DOS_NT
514 dostounix_filename (dst);
515 #endif
516 return srclen;
519 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
520 Sfile_name_as_directory, 1, 1, 0,
521 doc: /* Return a string representing the file name FILE interpreted as a directory.
522 This operation exists because a directory is also a file, but its name as
523 a directory is different from its name as a file.
524 The result can be used as the value of `default-directory'
525 or passed as second argument to `expand-file-name'.
526 For a Unix-syntax file name, just appends a slash unless a trailing slash
527 is already present. */)
528 (Lisp_Object file)
530 char *buf;
531 ptrdiff_t length;
532 Lisp_Object handler, val;
533 USE_SAFE_ALLOCA;
535 CHECK_STRING (file);
537 /* If the file name has special constructs in it,
538 call the corresponding file handler. */
539 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
540 if (!NILP (handler))
542 Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
543 file);
544 if (STRINGP (handled_name))
545 return handled_name;
546 error ("Invalid handler in `file-name-handler-alist'");
549 #ifdef WINDOWSNT
550 if (!NILP (Vw32_downcase_file_names))
551 file = Fdowncase (file);
552 #endif
553 buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
554 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
555 STRING_MULTIBYTE (file));
556 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
557 SAFE_FREE ();
558 return val;
561 /* Convert from directory name SRC of length SRCLEN to file name in
562 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
563 string. On UNIX, just make sure there isn't a terminating /.
564 Return the length of DST in bytes. */
566 static ptrdiff_t
567 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
569 /* In Unix-like systems, just remove any final slashes. However, if
570 they are all slashes, leave "/" and "//" alone, and treat "///"
571 and longer as if they were "/". */
572 if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
573 while (srclen > 1
574 #ifdef DOS_NT
575 && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2]))
576 #endif
577 && IS_DIRECTORY_SEP (src[srclen - 1]))
578 srclen--;
580 memcpy (dst, src, srclen);
581 dst[srclen] = 0;
582 #ifdef DOS_NT
583 dostounix_filename (dst);
584 #endif
585 return srclen;
588 DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0,
589 doc: /* Return non-nil if NAME ends with a directory separator character. */)
590 (Lisp_Object name)
592 CHECK_STRING (name);
593 ptrdiff_t namelen = SBYTES (name);
594 unsigned char c = namelen ? SREF (name, namelen - 1) : 0;
595 return IS_DIRECTORY_SEP (c) ? Qt : Qnil;
598 /* Return the expansion of NEWNAME, except that if NEWNAME is a
599 directory name then return the expansion of FILE's basename under
600 NEWNAME. This resembles how 'cp FILE NEWNAME' works, except that
601 it requires NEWNAME to be a directory name (typically, by ending in
602 "/"). */
604 static Lisp_Object
605 expand_cp_target (Lisp_Object file, Lisp_Object newname)
607 return (!NILP (Fdirectory_name_p (newname))
608 ? Fexpand_file_name (Ffile_name_nondirectory (file), newname)
609 : Fexpand_file_name (newname, Qnil));
612 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
613 1, 1, 0,
614 doc: /* Returns the file name of the directory named DIRECTORY.
615 This is the name of the file that holds the data for the directory DIRECTORY.
616 This operation exists because a directory is also a file, but its name as
617 a directory is different from its name as a file.
618 In Unix-syntax, this function just removes the final slash. */)
619 (Lisp_Object directory)
621 char *buf;
622 ptrdiff_t length;
623 Lisp_Object handler, val;
624 USE_SAFE_ALLOCA;
626 CHECK_STRING (directory);
628 /* If the file name has special constructs in it,
629 call the corresponding file handler. */
630 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
631 if (!NILP (handler))
633 Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
634 directory);
635 if (STRINGP (handled_name))
636 return handled_name;
637 error ("Invalid handler in `file-name-handler-alist'");
640 #ifdef WINDOWSNT
641 if (!NILP (Vw32_downcase_file_names))
642 directory = Fdowncase (directory);
643 #endif
644 buf = SAFE_ALLOCA (SBYTES (directory) + 1);
645 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
646 STRING_MULTIBYTE (directory));
647 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
648 SAFE_FREE ();
649 return val;
652 DEFUN ("make-temp-file-internal", Fmake_temp_file_internal,
653 Smake_temp_file_internal, 4, 4, 0,
654 doc: /* Generate a new file whose name starts with PREFIX, a string.
655 Return the name of the generated file. If DIR-FLAG is zero, do not
656 create the file, just its name. Otherwise, if DIR-FLAG is non-nil,
657 create an empty directory. The file name should end in SUFFIX.
658 Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
659 working directory. If TEXT is a string, insert it into the newly
660 created file.
662 Signal an error if the file could not be created.
664 This function does not grok magic file names. */)
665 (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix,
666 Lisp_Object text)
668 CHECK_STRING (prefix);
669 CHECK_STRING (suffix);
670 Lisp_Object encoded_prefix = ENCODE_FILE (prefix);
671 Lisp_Object encoded_suffix = ENCODE_FILE (suffix);
672 ptrdiff_t prefix_len = SBYTES (encoded_prefix);
673 ptrdiff_t suffix_len = SBYTES (encoded_suffix);
674 if (INT_MAX < suffix_len)
675 args_out_of_range (prefix, suffix);
676 int nX = 6;
677 Lisp_Object val = make_uninit_string (prefix_len + nX + suffix_len);
678 char *data = SSDATA (val);
679 memcpy (data, SSDATA (encoded_prefix), prefix_len);
680 memset (data + prefix_len, 'X', nX);
681 memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
682 int kind = (NILP (dir_flag) ? GT_FILE
683 : EQ (dir_flag, make_number (0)) ? GT_NOCREATE
684 : GT_DIR);
685 int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
686 bool failed = fd < 0;
687 if (!failed)
689 ptrdiff_t count = SPECPDL_INDEX ();
690 record_unwind_protect_int (close_file_unwind, fd);
691 val = DECODE_FILE (val);
692 if (STRINGP (text) && SBYTES (text) != 0)
693 write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd);
694 failed = NILP (dir_flag) && emacs_close (fd) != 0;
695 /* Discard the unwind protect. */
696 specpdl_ptr = specpdl + count;
698 if (failed)
700 static char const kind_message[][32] =
702 [GT_FILE] = "Creating file with prefix",
703 [GT_DIR] = "Creating directory with prefix",
704 [GT_NOCREATE] = "Creating file name with prefix"
706 report_file_error (kind_message[kind], prefix);
708 return val;
712 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
713 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
715 This function tries to choose a name that has no existing file.
716 For this to work, PREFIX should be an absolute file name, and PREFIX
717 and the returned string should both be non-magic.
719 There is a race condition between calling `make-temp-name' and
720 later creating the file, which opens all kinds of security holes.
721 For that reason, you should normally use `make-temp-file' instead. */)
722 (Lisp_Object prefix)
724 return Fmake_temp_file_internal (prefix, make_number (0),
725 empty_unibyte_string, Qnil);
728 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
729 doc: /* Convert filename NAME to absolute, and canonicalize it.
730 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
731 \(does not start with slash or tilde); both the directory name and
732 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
733 missing, the current buffer's value of `default-directory' is used.
734 NAME should be a string that is a valid file name for the underlying
735 filesystem.
736 File name components that are `.' are removed, and
737 so are file name components followed by `..', along with the `..' itself;
738 note that these simplifications are done without checking the resulting
739 file names in the file system.
740 Multiple consecutive slashes are collapsed into a single slash,
741 except at the beginning of the file name when they are significant (e.g.,
742 UNC file names on MS-Windows.)
743 An initial `~/' expands to your home directory.
744 An initial `~USER/' expands to USER's home directory.
745 See also the function `substitute-in-file-name'.
747 For technical reasons, this function can return correct but
748 non-intuitive results for the root directory; for instance,
749 \(expand-file-name ".." "/") returns "/..". For this reason, use
750 \(directory-file-name (file-name-directory dirname)) to traverse a
751 filesystem tree, not (expand-file-name ".." dirname). Note: make
752 sure DIRNAME in this example doesn't end in a slash, unless it's
753 the root directory. */)
754 (Lisp_Object name, Lisp_Object default_directory)
756 /* These point to SDATA and need to be careful with string-relocation
757 during GC (via DECODE_FILE). */
758 char *nm;
759 char *nmlim;
760 const char *newdir;
761 const char *newdirlim;
762 /* This should only point to alloca'd data. */
763 char *target;
765 ptrdiff_t tlen;
766 struct passwd *pw;
767 #ifdef DOS_NT
768 int drive = 0;
769 bool collapse_newdir = true;
770 bool is_escaped = 0;
771 #endif /* DOS_NT */
772 ptrdiff_t length, nbytes;
773 Lisp_Object handler, result, handled_name;
774 bool multibyte;
775 Lisp_Object hdir;
776 USE_SAFE_ALLOCA;
778 CHECK_STRING (name);
780 /* If the file name has special constructs in it,
781 call the corresponding file handler. */
782 handler = Ffind_file_name_handler (name, Qexpand_file_name);
783 if (!NILP (handler))
785 handled_name = call3 (handler, Qexpand_file_name,
786 name, default_directory);
787 if (STRINGP (handled_name))
788 return handled_name;
789 error ("Invalid handler in `file-name-handler-alist'");
793 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
794 if (NILP (default_directory))
795 default_directory = BVAR (current_buffer, directory);
796 if (! STRINGP (default_directory))
798 #ifdef DOS_NT
799 /* "/" is not considered a root directory on DOS_NT, so using "/"
800 here causes an infinite recursion in, e.g., the following:
802 (let (default-directory)
803 (expand-file-name "a"))
805 To avoid this, we set default_directory to the root of the
806 current drive. */
807 default_directory = build_string (emacs_root_dir ());
808 #else
809 default_directory = build_string ("/");
810 #endif
813 if (!NILP (default_directory))
815 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
816 if (!NILP (handler))
818 handled_name = call3 (handler, Qexpand_file_name,
819 name, default_directory);
820 if (STRINGP (handled_name))
821 return handled_name;
822 error ("Invalid handler in `file-name-handler-alist'");
827 char *o = SSDATA (default_directory);
829 /* Make sure DEFAULT_DIRECTORY is properly expanded.
830 It would be better to do this down below where we actually use
831 default_directory. Unfortunately, calling Fexpand_file_name recursively
832 could invoke GC, and the strings might be relocated. This would
833 be annoying because we have pointers into strings lying around
834 that would need adjusting, and people would add new pointers to
835 the code and forget to adjust them, resulting in intermittent bugs.
836 Putting this call here avoids all that crud.
838 The EQ test avoids infinite recursion. */
839 if (! NILP (default_directory) && !EQ (default_directory, name)
840 /* Save time in some common cases - as long as default_directory
841 is not relative, it can be canonicalized with name below (if it
842 is needed at all) without requiring it to be expanded now. */
843 #ifdef DOS_NT
844 /* Detect MSDOS file names with drive specifiers. */
845 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
846 && IS_DIRECTORY_SEP (o[2]))
847 /* Detect escaped file names without drive spec after "/:".
848 These should not be recursively expanded, to avoid
849 including the default directory twice in the expanded
850 result. */
851 && ! (o[0] == '/' && o[1] == ':')
852 #ifdef WINDOWSNT
853 /* Detect Windows file names in UNC format. */
854 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
855 #endif
856 #else /* not DOS_NT */
857 /* Detect Unix absolute file names (/... alone is not absolute on
858 DOS or Windows). */
859 && ! (IS_DIRECTORY_SEP (o[0]))
860 #endif /* not DOS_NT */
863 default_directory = Fexpand_file_name (default_directory, Qnil);
866 multibyte = STRING_MULTIBYTE (name);
867 if (multibyte != STRING_MULTIBYTE (default_directory))
869 if (multibyte)
871 unsigned char *p = SDATA (name);
873 while (*p && ASCII_CHAR_P (*p))
874 p++;
875 if (*p == '\0')
877 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
878 unibyte. Do not convert DEFAULT_DIRECTORY to
879 multibyte; instead, convert NAME to a unibyte string,
880 so that the result of this function is also a unibyte
881 string. This is needed during bootstrapping and
882 dumping, when Emacs cannot decode file names, because
883 the locale environment is not set up. */
884 name = make_unibyte_string (SSDATA (name), SBYTES (name));
885 multibyte = 0;
887 else
888 default_directory = string_to_multibyte (default_directory);
890 else
892 name = string_to_multibyte (name);
893 multibyte = 1;
897 #ifdef WINDOWSNT
898 if (!NILP (Vw32_downcase_file_names))
899 default_directory = Fdowncase (default_directory);
900 #endif
902 /* Make a local copy of NAME to protect it from GC in DECODE_FILE below. */
903 SAFE_ALLOCA_STRING (nm, name);
904 nmlim = nm + SBYTES (name);
906 #ifdef DOS_NT
907 /* Note if special escape prefix is present, but remove for now. */
908 if (nm[0] == '/' && nm[1] == ':')
910 is_escaped = 1;
911 nm += 2;
914 /* Find and remove drive specifier if present; this makes nm absolute
915 even if the rest of the name appears to be relative. Only look for
916 drive specifier at the beginning. */
917 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
919 drive = (unsigned char) nm[0];
920 nm += 2;
923 #ifdef WINDOWSNT
924 /* If we see "c://somedir", we want to strip the first slash after the
925 colon when stripping the drive letter. Otherwise, this expands to
926 "//somedir". */
927 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
928 nm++;
930 /* Discard any previous drive specifier if nm is now in UNC format. */
931 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
932 && !IS_DIRECTORY_SEP (nm[2]))
933 drive = 0;
934 #endif /* WINDOWSNT */
935 #endif /* DOS_NT */
937 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
938 none are found, we can probably return right away. We will avoid
939 allocating a new string if name is already fully expanded. */
940 if (
941 IS_DIRECTORY_SEP (nm[0])
942 #ifdef MSDOS
943 && drive && !is_escaped
944 #endif
945 #ifdef WINDOWSNT
946 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
947 #endif
950 /* If it turns out that the filename we want to return is just a
951 suffix of FILENAME, we don't need to go through and edit
952 things; we just need to construct a new string using data
953 starting at the middle of FILENAME. If we set LOSE, that
954 means we've discovered that we can't do that cool trick. */
955 bool lose = 0;
956 char *p = nm;
958 while (*p)
960 /* Since we know the name is absolute, we can assume that each
961 element starts with a "/". */
963 /* "." and ".." are hairy. */
964 if (IS_DIRECTORY_SEP (p[0])
965 && p[1] == '.'
966 && (IS_DIRECTORY_SEP (p[2])
967 || p[2] == 0
968 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
969 || p[3] == 0))))
970 lose = 1;
971 /* Replace multiple slashes with a single one, except
972 leave leading "//" alone. */
973 else if (IS_DIRECTORY_SEP (p[0])
974 && IS_DIRECTORY_SEP (p[1])
975 && (p != nm || IS_DIRECTORY_SEP (p[2])))
976 lose = 1;
977 p++;
979 if (!lose)
981 #ifdef DOS_NT
982 /* Make sure directories are all separated with /, but
983 avoid allocation of a new string when not required. */
984 dostounix_filename (nm);
985 #ifdef WINDOWSNT
986 if (IS_DIRECTORY_SEP (nm[1]))
988 if (strcmp (nm, SSDATA (name)) != 0)
989 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
991 else
992 #endif
993 /* Drive must be set, so this is okay. */
994 if (strcmp (nm - 2, SSDATA (name)) != 0)
996 name = make_specified_string (nm, -1, p - nm, multibyte);
997 char temp[] = { DRIVE_LETTER (drive), ':', 0 };
998 AUTO_STRING_WITH_LEN (drive_prefix, temp, 2);
999 name = concat2 (drive_prefix, name);
1001 #ifdef WINDOWSNT
1002 if (!NILP (Vw32_downcase_file_names))
1003 name = Fdowncase (name);
1004 #endif
1005 #else /* not DOS_NT */
1006 if (strcmp (nm, SSDATA (name)) != 0)
1007 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1008 #endif /* not DOS_NT */
1009 SAFE_FREE ();
1010 return name;
1014 /* At this point, nm might or might not be an absolute file name. We
1015 need to expand ~ or ~user if present, otherwise prefix nm with
1016 default_directory if nm is not absolute, and finally collapse /./
1017 and /foo/../ sequences.
1019 We set newdir to be the appropriate prefix if one is needed:
1020 - the relevant user directory if nm starts with ~ or ~user
1021 - the specified drive's working dir (DOS/NT only) if nm does not
1022 start with /
1023 - the value of default_directory.
1025 Note that these prefixes are not guaranteed to be absolute (except
1026 for the working dir of a drive). Therefore, to ensure we always
1027 return an absolute name, if the final prefix is not absolute we
1028 append it to the current working directory. */
1030 newdir = newdirlim = 0;
1032 if (nm[0] == '~' /* prefix ~ */
1033 #ifdef DOS_NT
1034 && !is_escaped /* don't expand ~ in escaped file names */
1035 #endif
1038 if (IS_DIRECTORY_SEP (nm[1])
1039 || nm[1] == 0) /* ~ by itself */
1041 Lisp_Object tem;
1043 if (!(newdir = egetenv ("HOME")))
1044 newdir = newdirlim = "";
1045 nm++;
1046 #ifdef WINDOWSNT
1047 if (newdir[0])
1049 char newdir_utf8[MAX_UTF8_PATH];
1051 filename_from_ansi (newdir, newdir_utf8);
1052 tem = make_unibyte_string (newdir_utf8, strlen (newdir_utf8));
1053 newdir = SSDATA (tem);
1055 else
1056 #endif
1057 tem = build_string (newdir);
1058 newdirlim = newdir + SBYTES (tem);
1059 /* `egetenv' may return a unibyte string, which will bite us
1060 if we expect the directory to be multibyte. */
1061 if (multibyte && !STRING_MULTIBYTE (tem))
1063 hdir = DECODE_FILE (tem);
1064 newdir = SSDATA (hdir);
1065 newdirlim = newdir + SBYTES (hdir);
1067 #ifdef DOS_NT
1068 collapse_newdir = false;
1069 #endif
1071 else /* ~user/filename */
1073 char *o, *p;
1074 for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
1075 continue;
1076 o = SAFE_ALLOCA (p - nm + 1);
1077 memcpy (o, nm, p - nm);
1078 o[p - nm] = 0;
1080 block_input ();
1081 pw = getpwnam (o + 1);
1082 unblock_input ();
1083 if (pw)
1085 Lisp_Object tem;
1087 newdir = pw->pw_dir;
1088 /* `getpwnam' may return a unibyte string, which will
1089 bite us when we expect the directory to be multibyte. */
1090 tem = make_unibyte_string (newdir, strlen (newdir));
1091 newdirlim = newdir + SBYTES (tem);
1092 if (multibyte && !STRING_MULTIBYTE (tem))
1094 hdir = DECODE_FILE (tem);
1095 newdir = SSDATA (hdir);
1096 newdirlim = newdir + SBYTES (hdir);
1098 nm = p;
1099 #ifdef DOS_NT
1100 collapse_newdir = false;
1101 #endif
1104 /* If we don't find a user of that name, leave the name
1105 unchanged; don't move nm forward to p. */
1109 #ifdef DOS_NT
1110 /* On DOS and Windows, nm is absolute if a drive name was specified;
1111 use the drive's current directory as the prefix if needed. */
1112 if (!newdir && drive)
1114 /* Get default directory if needed to make nm absolute. */
1115 char *adir = NULL;
1116 if (!IS_DIRECTORY_SEP (nm[0]))
1118 adir = alloca (MAXPATHLEN + 1);
1119 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1120 adir = NULL;
1121 else if (multibyte)
1123 Lisp_Object tem = build_string (adir);
1125 tem = DECODE_FILE (tem);
1126 newdirlim = adir + SBYTES (tem);
1127 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1129 else
1130 newdirlim = adir + strlen (adir);
1132 if (!adir)
1134 /* Either nm starts with /, or drive isn't mounted. */
1135 adir = alloca (4);
1136 adir[0] = DRIVE_LETTER (drive);
1137 adir[1] = ':';
1138 adir[2] = '/';
1139 adir[3] = 0;
1140 newdirlim = adir + 3;
1142 newdir = adir;
1144 #endif /* DOS_NT */
1146 /* Finally, if no prefix has been specified and nm is not absolute,
1147 then it must be expanded relative to default_directory. */
1149 if (1
1150 #ifndef DOS_NT
1151 /* /... alone is not absolute on DOS and Windows. */
1152 && !IS_DIRECTORY_SEP (nm[0])
1153 #endif
1154 #ifdef WINDOWSNT
1155 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1156 && !IS_DIRECTORY_SEP (nm[2]))
1157 #endif
1158 && !newdir)
1160 newdir = SSDATA (default_directory);
1161 newdirlim = newdir + SBYTES (default_directory);
1162 #ifdef DOS_NT
1163 /* Note if special escape prefix is present, but remove for now. */
1164 if (newdir[0] == '/' && newdir[1] == ':')
1166 is_escaped = 1;
1167 newdir += 2;
1169 #endif
1172 #ifdef DOS_NT
1173 if (newdir)
1175 /* First ensure newdir is an absolute name. */
1176 if (
1177 /* Detect MSDOS file names with drive specifiers. */
1178 ! (IS_DRIVE (newdir[0])
1179 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1180 #ifdef WINDOWSNT
1181 /* Detect Windows file names in UNC format. */
1182 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1183 && !IS_DIRECTORY_SEP (newdir[2]))
1184 #endif
1187 /* Effectively, let newdir be (expand-file-name newdir cwd).
1188 Because of the admonition against calling expand-file-name
1189 when we have pointers into lisp strings, we accomplish this
1190 indirectly by prepending newdir to nm if necessary, and using
1191 cwd (or the wd of newdir's drive) as the new newdir. */
1192 char *adir;
1193 #ifdef WINDOWSNT
1194 const int adir_size = MAX_UTF8_PATH;
1195 #else
1196 const int adir_size = MAXPATHLEN + 1;
1197 #endif
1199 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1201 drive = (unsigned char) newdir[0];
1202 newdir += 2;
1204 if (!IS_DIRECTORY_SEP (nm[0]))
1206 ptrdiff_t nmlen = nmlim - nm;
1207 ptrdiff_t newdirlen = newdirlim - newdir;
1208 char *tmp = alloca (newdirlen + file_name_as_directory_slop
1209 + nmlen + 1);
1210 ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
1211 multibyte);
1212 memcpy (tmp + dlen, nm, nmlen + 1);
1213 nm = tmp;
1214 nmlim = nm + dlen + nmlen;
1216 adir = alloca (adir_size);
1217 if (drive)
1219 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1220 strcpy (adir, "/");
1222 else
1223 getcwd (adir, adir_size);
1224 if (multibyte)
1226 Lisp_Object tem = build_string (adir);
1228 tem = DECODE_FILE (tem);
1229 newdirlim = adir + SBYTES (tem);
1230 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1232 else
1233 newdirlim = adir + strlen (adir);
1234 newdir = adir;
1237 /* Strip off drive name from prefix, if present. */
1238 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1240 drive = newdir[0];
1241 newdir += 2;
1244 /* Keep only a prefix from newdir if nm starts with slash
1245 (//server/share for UNC, nothing otherwise). */
1246 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1248 #ifdef WINDOWSNT
1249 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1250 && !IS_DIRECTORY_SEP (newdir[2]))
1252 char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
1253 char *p = adir + 2;
1254 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1255 p++;
1256 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1257 *p = 0;
1258 newdir = adir;
1259 newdirlim = newdir + strlen (adir);
1261 else
1262 #endif
1263 newdir = newdirlim = "";
1266 #endif /* DOS_NT */
1268 /* Ignore any slash at the end of newdir, unless newdir is
1269 just "/" or "//". */
1270 length = newdirlim - newdir;
1271 while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1272 && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
1273 length--;
1275 /* Now concatenate the directory and name to new space in the stack frame. */
1276 tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
1277 eassert (tlen > file_name_as_directory_slop + 1);
1278 #ifdef DOS_NT
1279 /* Reserve space for drive specifier and escape prefix, since either
1280 or both may need to be inserted. (The Microsoft x86 compiler
1281 produces incorrect code if the following two lines are combined.) */
1282 target = alloca (tlen + 4);
1283 target += 4;
1284 #else /* not DOS_NT */
1285 target = SAFE_ALLOCA (tlen);
1286 #endif /* not DOS_NT */
1287 *target = 0;
1288 nbytes = 0;
1290 if (newdir)
1292 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1294 #ifdef DOS_NT
1295 /* If newdir is effectively "C:/", then the drive letter will have
1296 been stripped and newdir will be "/". Concatenating with an
1297 absolute directory in nm produces "//", which will then be
1298 incorrectly treated as a network share. Ignore newdir in
1299 this case (keeping the drive letter). */
1300 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1301 && newdir[1] == '\0'))
1302 #endif
1304 memcpy (target, newdir, length);
1305 target[length] = 0;
1306 nbytes = length;
1309 else
1310 nbytes = file_name_as_directory (target, newdir, length, multibyte);
1313 memcpy (target + nbytes, nm, nmlim - nm + 1);
1315 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1316 appear. */
1318 char *p = target;
1319 char *o = target;
1321 while (*p)
1323 if (!IS_DIRECTORY_SEP (*p))
1325 *o++ = *p++;
1327 else if (p[1] == '.'
1328 && (IS_DIRECTORY_SEP (p[2])
1329 || p[2] == 0))
1331 /* If "/." is the entire filename, keep the "/". Otherwise,
1332 just delete the whole "/.". */
1333 if (o == target && p[2] == '\0')
1334 *o++ = *p;
1335 p += 2;
1337 else if (p[1] == '.' && p[2] == '.'
1338 /* `/../' is the "superroot" on certain file systems.
1339 Turned off on DOS_NT systems because they have no
1340 "superroot" and because this causes us to produce
1341 file names like "d:/../foo" which fail file-related
1342 functions of the underlying OS. (To reproduce, try a
1343 long series of "../../" in default_directory, longer
1344 than the number of levels from the root.) */
1345 #ifndef DOS_NT
1346 && o != target
1347 #endif
1348 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1350 #ifdef WINDOWSNT
1351 char *prev_o = o;
1352 #endif
1353 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1354 continue;
1355 #ifdef WINDOWSNT
1356 /* Don't go below server level in UNC filenames. */
1357 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1358 && IS_DIRECTORY_SEP (*target))
1359 o = prev_o;
1360 else
1361 #endif
1362 /* Keep initial / only if this is the whole name. */
1363 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1364 ++o;
1365 p += 3;
1367 else if (IS_DIRECTORY_SEP (p[1])
1368 && (p != target || IS_DIRECTORY_SEP (p[2])))
1369 /* Collapse multiple "/", except leave leading "//" alone. */
1370 p++;
1371 else
1373 *o++ = *p++;
1377 #ifdef DOS_NT
1378 /* At last, set drive name. */
1379 #ifdef WINDOWSNT
1380 /* Except for network file name. */
1381 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1382 #endif /* WINDOWSNT */
1384 if (!drive) emacs_abort ();
1385 target -= 2;
1386 target[0] = DRIVE_LETTER (drive);
1387 target[1] = ':';
1389 /* Reinsert the escape prefix if required. */
1390 if (is_escaped)
1392 target -= 2;
1393 target[0] = '/';
1394 target[1] = ':';
1396 result = make_specified_string (target, -1, o - target, multibyte);
1397 dostounix_filename (SSDATA (result));
1398 #ifdef WINDOWSNT
1399 if (!NILP (Vw32_downcase_file_names))
1400 result = Fdowncase (result);
1401 #endif
1402 #else /* !DOS_NT */
1403 result = make_specified_string (target, -1, o - target, multibyte);
1404 #endif /* !DOS_NT */
1407 /* Again look to see if the file name has special constructs in it
1408 and perhaps call the corresponding file handler. This is needed
1409 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1410 the ".." component gives us "/user@host:/bar/../baz" which needs
1411 to be expanded again. */
1412 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1413 if (!NILP (handler))
1415 handled_name = call3 (handler, Qexpand_file_name,
1416 result, default_directory);
1417 if (! STRINGP (handled_name))
1418 error ("Invalid handler in `file-name-handler-alist'");
1419 result = handled_name;
1422 SAFE_FREE ();
1423 return result;
1426 #if 0
1427 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1428 This is the old version of expand-file-name, before it was thoroughly
1429 rewritten for Emacs 10.31. We leave this version here commented-out,
1430 because the code is very complex and likely to have subtle bugs. If
1431 bugs _are_ found, it might be of interest to look at the old code and
1432 see what did it do in the relevant situation.
1434 Don't remove this code: it's true that it will be accessible
1435 from the repository, but a few years from deletion, people will
1436 forget it is there. */
1438 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1439 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1440 "Convert FILENAME to absolute, and canonicalize it.\n\
1441 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1442 \(does not start with slash); if DEFAULT is nil or missing,\n\
1443 the current buffer's value of default-directory is used.\n\
1444 Filenames containing `.' or `..' as components are simplified;\n\
1445 initial `~/' expands to your home directory.\n\
1446 See also the function `substitute-in-file-name'.")
1447 (name, defalt)
1448 Lisp_Object name, defalt;
1450 unsigned char *nm;
1452 register unsigned char *newdir, *p, *o;
1453 ptrdiff_t tlen;
1454 unsigned char *target;
1455 struct passwd *pw;
1457 CHECK_STRING (name);
1458 nm = SDATA (name);
1460 /* If nm is absolute, flush ...// and detect /./ and /../.
1461 If no /./ or /../ we can return right away. */
1462 if (nm[0] == '/')
1464 bool lose = 0;
1465 p = nm;
1466 while (*p)
1468 if (p[0] == '/' && p[1] == '/')
1469 nm = p + 1;
1470 if (p[0] == '/' && p[1] == '~')
1471 nm = p + 1, lose = 1;
1472 if (p[0] == '/' && p[1] == '.'
1473 && (p[2] == '/' || p[2] == 0
1474 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1475 lose = 1;
1476 p++;
1478 if (!lose)
1480 if (nm == SDATA (name))
1481 return name;
1482 return build_string (nm);
1486 /* Now determine directory to start with and put it in NEWDIR. */
1488 newdir = 0;
1490 if (nm[0] == '~') /* prefix ~ */
1491 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
1493 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1494 newdir = (unsigned char *) "";
1495 nm++;
1497 else /* ~user/filename */
1499 /* Get past ~ to user. */
1500 unsigned char *user = nm + 1;
1501 /* Find end of name. */
1502 unsigned char *ptr = (unsigned char *) strchr (user, '/');
1503 ptrdiff_t len = ptr ? ptr - user : strlen (user);
1504 /* Copy the user name into temp storage. */
1505 o = alloca (len + 1);
1506 memcpy (o, user, len);
1507 o[len] = 0;
1509 /* Look up the user name. */
1510 block_input ();
1511 pw = (struct passwd *) getpwnam (o + 1);
1512 unblock_input ();
1513 if (!pw)
1514 error ("\"%s\" isn't a registered user", o + 1);
1516 newdir = (unsigned char *) pw->pw_dir;
1518 /* Discard the user name from NM. */
1519 nm += len;
1522 if (nm[0] != '/' && !newdir)
1524 if (NILP (defalt))
1525 defalt = current_buffer->directory;
1526 CHECK_STRING (defalt);
1527 newdir = SDATA (defalt);
1530 /* Now concatenate the directory and name to new space in the stack frame. */
1532 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1533 target = alloca (tlen);
1534 *target = 0;
1536 if (newdir)
1538 if (nm[0] == 0 || nm[0] == '/')
1539 strcpy (target, newdir);
1540 else
1541 file_name_as_directory (target, newdir);
1544 strcat (target, nm);
1546 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1548 p = target;
1549 o = target;
1551 while (*p)
1553 if (*p != '/')
1555 *o++ = *p++;
1557 else if (!strncmp (p, "//", 2)
1560 o = target;
1561 p++;
1563 else if (p[0] == '/' && p[1] == '.'
1564 && (p[2] == '/' || p[2] == 0))
1565 p += 2;
1566 else if (!strncmp (p, "/..", 3)
1567 /* `/../' is the "superroot" on certain file systems. */
1568 && o != target
1569 && (p[3] == '/' || p[3] == 0))
1571 while (o != target && *--o != '/')
1573 if (o == target && *o == '/')
1574 ++o;
1575 p += 3;
1577 else
1579 *o++ = *p++;
1583 return make_string (target, o - target);
1585 #endif
1587 /* If /~ or // appears, discard everything through first slash. */
1588 static bool
1589 file_name_absolute_p (const char *filename)
1591 return
1592 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
1593 #ifdef DOS_NT
1594 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1595 && IS_DIRECTORY_SEP (filename[2]))
1596 #endif
1600 static char *
1601 search_embedded_absfilename (char *nm, char *endp)
1603 char *p, *s;
1605 for (p = nm + 1; p < endp; p++)
1607 if (IS_DIRECTORY_SEP (p[-1])
1608 && file_name_absolute_p (p)
1609 #if defined (WINDOWSNT) || defined (CYGWIN)
1610 /* // at start of file name is meaningful in Apollo,
1611 WindowsNT and Cygwin systems. */
1612 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1613 #endif /* not (WINDOWSNT || CYGWIN) */
1616 for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
1617 if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
1619 USE_SAFE_ALLOCA;
1620 char *o = SAFE_ALLOCA (s - p + 1);
1621 struct passwd *pw;
1622 memcpy (o, p, s - p);
1623 o [s - p] = 0;
1625 /* If we have ~user and `user' exists, discard
1626 everything up to ~. But if `user' does not exist, leave
1627 ~user alone, it might be a literal file name. */
1628 block_input ();
1629 pw = getpwnam (o + 1);
1630 unblock_input ();
1631 SAFE_FREE ();
1632 if (pw)
1633 return p;
1635 else
1636 return p;
1639 return NULL;
1642 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1643 Ssubstitute_in_file_name, 1, 1, 0,
1644 doc: /* Substitute environment variables referred to in FILENAME.
1645 `$FOO' where FOO is an environment variable name means to substitute
1646 the value of that variable. The variable name should be terminated
1647 with a character not a letter, digit or underscore; otherwise, enclose
1648 the entire variable name in braces.
1650 If `/~' appears, all of FILENAME through that `/' is discarded.
1651 If `//' appears, everything up to and including the first of
1652 those `/' is discarded. */)
1653 (Lisp_Object filename)
1655 char *nm, *p, *x, *endp;
1656 bool substituted = false;
1657 bool multibyte;
1658 char *xnm;
1659 Lisp_Object handler;
1661 CHECK_STRING (filename);
1663 multibyte = STRING_MULTIBYTE (filename);
1665 /* If the file name has special constructs in it,
1666 call the corresponding file handler. */
1667 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1668 if (!NILP (handler))
1670 Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
1671 filename);
1672 if (STRINGP (handled_name))
1673 return handled_name;
1674 error ("Invalid handler in `file-name-handler-alist'");
1677 /* Always work on a copy of the string, in case GC happens during
1678 decode of environment variables, causing the original Lisp_String
1679 data to be relocated. */
1680 USE_SAFE_ALLOCA;
1681 SAFE_ALLOCA_STRING (nm, filename);
1683 #ifdef DOS_NT
1684 dostounix_filename (nm);
1685 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1686 #endif
1687 endp = nm + SBYTES (filename);
1689 /* If /~ or // appears, discard everything through first slash. */
1690 p = search_embedded_absfilename (nm, endp);
1691 if (p)
1692 /* Start over with the new string, so we check the file-name-handler
1693 again. Important with filenames like "/home/foo//:/hello///there"
1694 which would substitute to "/:/hello///there" rather than "/there". */
1696 Lisp_Object result
1697 = (Fsubstitute_in_file_name
1698 (make_specified_string (p, -1, endp - p, multibyte)));
1699 SAFE_FREE ();
1700 return result;
1703 /* See if any variables are substituted into the string. */
1705 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
1707 Lisp_Object name
1708 = (!substituted ? filename
1709 : make_specified_string (nm, -1, endp - nm, multibyte));
1710 Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
1711 CHECK_STRING (tmp);
1712 if (!EQ (tmp, name))
1713 substituted = true;
1714 filename = tmp;
1717 if (!substituted)
1719 #ifdef WINDOWSNT
1720 if (!NILP (Vw32_downcase_file_names))
1721 filename = Fdowncase (filename);
1722 #endif
1723 SAFE_FREE ();
1724 return filename;
1727 xnm = SSDATA (filename);
1728 x = xnm + SBYTES (filename);
1730 /* If /~ or // appears, discard everything through first slash. */
1731 while ((p = search_embedded_absfilename (xnm, x)) != NULL)
1732 /* This time we do not start over because we've already expanded envvars
1733 and replaced $$ with $. Maybe we should start over as well, but we'd
1734 need to quote some $ to $$ first. */
1735 xnm = p;
1737 #ifdef WINDOWSNT
1738 if (!NILP (Vw32_downcase_file_names))
1740 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1742 filename = Fdowncase (xname);
1744 else
1745 #endif
1746 if (xnm != SSDATA (filename))
1747 filename = make_specified_string (xnm, -1, x - xnm, multibyte);
1748 SAFE_FREE ();
1749 return filename;
1752 /* A slightly faster and more convenient way to get
1753 (directory-file-name (expand-file-name FOO)). */
1755 Lisp_Object
1756 expand_and_dir_to_file (Lisp_Object filename)
1758 Lisp_Object absname = Fexpand_file_name (filename, Qnil);
1760 /* Remove final slash, if any (unless this is the root dir).
1761 stat behaves differently depending! */
1762 if (SCHARS (absname) > 1
1763 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1764 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
1765 /* We cannot take shortcuts; they might be wrong for magic file names. */
1766 absname = Fdirectory_file_name (absname);
1767 return absname;
1770 /* Signal an error if the file ABSNAME already exists.
1771 If KNOWN_TO_EXIST, the file is known to exist.
1772 QUERYSTRING is a name for the action that is being considered
1773 to alter the file.
1774 If INTERACTIVE, ask the user whether to proceed,
1775 and bypass the error if the user says to go ahead.
1776 If QUICK, ask for y or n, not yes or no. */
1778 static void
1779 barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
1780 const char *querystring, bool interactive,
1781 bool quick)
1783 Lisp_Object tem, encoded_filename;
1784 struct stat statbuf;
1786 encoded_filename = ENCODE_FILE (absname);
1788 if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0)
1790 if (S_ISDIR (statbuf.st_mode))
1791 xsignal2 (Qfile_error,
1792 build_string ("File is a directory"), absname);
1793 known_to_exist = true;
1796 if (known_to_exist)
1798 if (! interactive)
1799 xsignal2 (Qfile_already_exists,
1800 build_string ("File already exists"), absname);
1801 AUTO_STRING (format, "File %s already exists; %s anyway? ");
1802 tem = CALLN (Fformat, format, absname, build_string (querystring));
1803 if (quick)
1804 tem = call1 (intern ("y-or-n-p"), tem);
1805 else
1806 tem = do_yes_or_no_p (tem);
1807 if (NILP (tem))
1808 xsignal2 (Qfile_already_exists,
1809 build_string ("File already exists"), absname);
1813 #ifndef WINDOWSNT
1814 /* Copy data to DEST from SOURCE if possible. Return true if OK. */
1815 static bool
1816 clone_file (int dest, int source)
1818 #ifdef FICLONE
1819 return ioctl (dest, FICLONE, source) == 0;
1820 #endif
1821 return false;
1823 #endif
1825 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
1826 "fCopy file: \nGCopy %s to file: \np\nP",
1827 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1828 If NEWNAME is a directory name, copy FILE to a like-named file under
1829 NEWNAME.
1831 This function always sets the file modes of the output file to match
1832 the input file.
1834 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1835 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil,
1836 signal a `file-already-exists' error without overwriting. If
1837 OK-IF-ALREADY-EXISTS is an integer, request confirmation from the user
1838 about overwriting; this is what happens in interactive use with M-x.
1839 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1840 existing file.
1842 Fourth arg KEEP-TIME non-nil means give the output file the same
1843 last-modified time as the old one. (This works on only some systems.)
1845 A prefix arg makes KEEP-TIME non-nil.
1847 If PRESERVE-UID-GID is non-nil, try to transfer the uid and gid of
1848 FILE to NEWNAME.
1850 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1851 this includes the file modes, along with ACL entries and SELinux
1852 context if present. Otherwise, if NEWNAME is created its file
1853 permission bits are those of FILE, masked by the default file
1854 permissions. */)
1855 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists,
1856 Lisp_Object keep_time, Lisp_Object preserve_uid_gid,
1857 Lisp_Object preserve_permissions)
1859 Lisp_Object handler;
1860 ptrdiff_t count = SPECPDL_INDEX ();
1861 Lisp_Object encoded_file, encoded_newname;
1862 #if HAVE_LIBSELINUX
1863 security_context_t con;
1864 int conlength = 0;
1865 #endif
1866 #ifdef WINDOWSNT
1867 int result;
1868 #else
1869 bool already_exists = false;
1870 mode_t new_mask;
1871 int ifd, ofd;
1872 struct stat st;
1873 #endif
1875 file = Fexpand_file_name (file, Qnil);
1876 newname = expand_cp_target (file, newname);
1878 /* If the input file name has special constructs in it,
1879 call the corresponding file handler. */
1880 handler = Ffind_file_name_handler (file, Qcopy_file);
1881 /* Likewise for output file name. */
1882 if (NILP (handler))
1883 handler = Ffind_file_name_handler (newname, Qcopy_file);
1884 if (!NILP (handler))
1885 return call7 (handler, Qcopy_file, file, newname,
1886 ok_if_already_exists, keep_time, preserve_uid_gid,
1887 preserve_permissions);
1889 encoded_file = ENCODE_FILE (file);
1890 encoded_newname = ENCODE_FILE (newname);
1892 #ifdef WINDOWSNT
1893 if (NILP (ok_if_already_exists)
1894 || INTEGERP (ok_if_already_exists))
1895 barf_or_query_if_file_exists (newname, false, "copy to it",
1896 INTEGERP (ok_if_already_exists), false);
1898 result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
1899 !NILP (keep_time), !NILP (preserve_uid_gid),
1900 !NILP (preserve_permissions));
1901 switch (result)
1903 case -1:
1904 report_file_error ("Copying file", list2 (file, newname));
1905 case -2:
1906 report_file_error ("Copying permissions from", file);
1907 case -3:
1908 xsignal2 (Qfile_date_error,
1909 build_string ("Resetting file times"), newname);
1910 case -4:
1911 report_file_error ("Copying permissions to", newname);
1913 #else /* not WINDOWSNT */
1914 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1916 if (ifd < 0)
1917 report_file_error ("Opening input file", file);
1919 record_unwind_protect_int (close_file_unwind, ifd);
1921 if (fstat (ifd, &st) != 0)
1922 report_file_error ("Input file status", file);
1924 if (!NILP (preserve_permissions))
1926 #if HAVE_LIBSELINUX
1927 if (is_selinux_enabled ())
1929 conlength = fgetfilecon (ifd, &con);
1930 if (conlength == -1)
1931 report_file_error ("Doing fgetfilecon", file);
1933 #endif
1936 /* We can copy only regular files. */
1937 if (!S_ISREG (st.st_mode))
1938 report_file_errno ("Non-regular file", file,
1939 S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
1941 #ifndef MSDOS
1942 new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0700 : 0777);
1943 #else
1944 new_mask = S_IREAD | S_IWRITE;
1945 #endif
1947 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY | O_CREAT | O_EXCL,
1948 new_mask);
1949 if (ofd < 0 && errno == EEXIST)
1951 if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
1952 barf_or_query_if_file_exists (newname, true, "copy to it",
1953 INTEGERP (ok_if_already_exists), false);
1954 already_exists = true;
1955 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
1957 if (ofd < 0)
1958 report_file_error ("Opening output file", newname);
1960 record_unwind_protect_int (close_file_unwind, ofd);
1962 off_t oldsize = 0, newsize;
1964 if (already_exists)
1966 struct stat out_st;
1967 if (fstat (ofd, &out_st) != 0)
1968 report_file_error ("Output file status", newname);
1969 if (st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1970 report_file_errno ("Input and output files are the same",
1971 list2 (file, newname), 0);
1972 if (S_ISREG (out_st.st_mode))
1973 oldsize = out_st.st_size;
1976 maybe_quit ();
1978 if (clone_file (ofd, ifd))
1979 newsize = st.st_size;
1980 else
1982 char buf[MAX_ALLOCA];
1983 ptrdiff_t n;
1984 for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
1985 newsize += n)
1986 if (emacs_write_quit (ofd, buf, n) != n)
1987 report_file_error ("Write error", newname);
1988 if (n < 0)
1989 report_file_error ("Read error", file);
1992 /* Truncate any existing output file after writing the data. This
1993 is more likely to work than truncation before writing, if the
1994 file system is out of space or the user is over disk quota. */
1995 if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
1996 report_file_error ("Truncating output file", newname);
1998 #ifndef MSDOS
1999 /* Preserve the original file permissions, and if requested, also its
2000 owner and group. */
2002 mode_t preserved_permissions = st.st_mode & 07777;
2003 mode_t default_permissions = st.st_mode & 0777 & ~realmask;
2004 if (!NILP (preserve_uid_gid))
2006 /* Attempt to change owner and group. If that doesn't work
2007 attempt to change just the group, as that is sometimes allowed.
2008 Adjust the mode mask to eliminate setuid or setgid bits
2009 or group permissions bits that are inappropriate if the
2010 owner or group are wrong. */
2011 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2013 if (fchown (ofd, -1, st.st_gid) == 0)
2014 preserved_permissions &= ~04000;
2015 else
2017 preserved_permissions &= ~06000;
2019 /* Copy the other bits to the group bits, since the
2020 group is wrong. */
2021 preserved_permissions &= ~070;
2022 preserved_permissions |= (preserved_permissions & 7) << 3;
2023 default_permissions &= ~070;
2024 default_permissions |= (default_permissions & 7) << 3;
2029 switch (!NILP (preserve_permissions)
2030 ? qcopy_acl (SSDATA (encoded_file), ifd,
2031 SSDATA (encoded_newname), ofd,
2032 preserved_permissions)
2033 : (already_exists
2034 || (new_mask & ~realmask) == default_permissions)
2036 : fchmod (ofd, default_permissions))
2038 case -2: report_file_error ("Copying permissions from", file);
2039 case -1: report_file_error ("Copying permissions to", newname);
2042 #endif /* not MSDOS */
2044 #if HAVE_LIBSELINUX
2045 if (conlength > 0)
2047 /* Set the modified context back to the file. */
2048 bool fail = fsetfilecon (ofd, con) != 0;
2049 /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
2050 if (fail && errno != ENOTSUP)
2051 report_file_error ("Doing fsetfilecon", newname);
2053 freecon (con);
2055 #endif
2057 if (!NILP (keep_time))
2059 struct timespec atime = get_stat_atime (&st);
2060 struct timespec mtime = get_stat_mtime (&st);
2061 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
2062 xsignal2 (Qfile_date_error,
2063 build_string ("Cannot set file date"), newname);
2066 if (emacs_close (ofd) < 0)
2067 report_file_error ("Write error", newname);
2069 emacs_close (ifd);
2071 #ifdef MSDOS
2072 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2073 and if it can't, it tells so. Otherwise, under MSDOS we usually
2074 get only the READ bit, which will make the copied file read-only,
2075 so it's better not to chmod at all. */
2076 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2077 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2078 #endif /* MSDOS */
2079 #endif /* not WINDOWSNT */
2081 /* Discard the unwind protects. */
2082 specpdl_ptr = specpdl + count;
2084 return Qnil;
2087 DEFUN ("make-directory-internal", Fmake_directory_internal,
2088 Smake_directory_internal, 1, 1, 0,
2089 doc: /* Create a new directory named DIRECTORY. */)
2090 (Lisp_Object directory)
2092 const char *dir;
2093 Lisp_Object handler;
2094 Lisp_Object encoded_dir;
2096 CHECK_STRING (directory);
2097 directory = Fexpand_file_name (directory, Qnil);
2099 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
2100 if (!NILP (handler))
2101 return call2 (handler, Qmake_directory_internal, directory);
2103 encoded_dir = ENCODE_FILE (directory);
2105 dir = SSDATA (encoded_dir);
2107 if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
2108 report_file_error ("Creating directory", directory);
2110 return Qnil;
2113 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2114 Sdelete_directory_internal, 1, 1, 0,
2115 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2116 (Lisp_Object directory)
2118 const char *dir;
2119 Lisp_Object encoded_dir;
2121 CHECK_STRING (directory);
2122 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
2123 encoded_dir = ENCODE_FILE (directory);
2124 dir = SSDATA (encoded_dir);
2126 if (rmdir (dir) != 0)
2127 report_file_error ("Removing directory", directory);
2129 return Qnil;
2132 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
2133 "(list (read-file-name \
2134 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2135 \"Move file to trash: \" \"Delete file: \") \
2136 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2137 (null current-prefix-arg))",
2138 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2139 If file has multiple names, it continues to exist with the other names.
2140 TRASH non-nil means to trash the file instead of deleting, provided
2141 `delete-by-moving-to-trash' is non-nil.
2143 When called interactively, TRASH is t if no prefix argument is given.
2144 With a prefix argument, TRASH is nil. */)
2145 (Lisp_Object filename, Lisp_Object trash)
2147 Lisp_Object handler;
2148 Lisp_Object encoded_file;
2150 if (!NILP (Ffile_directory_p (filename))
2151 && NILP (Ffile_symlink_p (filename)))
2152 xsignal2 (Qfile_error,
2153 build_string ("Removing old name: is a directory"),
2154 filename);
2155 filename = Fexpand_file_name (filename, Qnil);
2157 handler = Ffind_file_name_handler (filename, Qdelete_file);
2158 if (!NILP (handler))
2159 return call3 (handler, Qdelete_file, filename, trash);
2161 if (delete_by_moving_to_trash && !NILP (trash))
2162 return call1 (Qmove_file_to_trash, filename);
2164 encoded_file = ENCODE_FILE (filename);
2166 if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT)
2167 report_file_error ("Removing old name", filename);
2168 return Qnil;
2171 static Lisp_Object
2172 internal_delete_file_1 (Lisp_Object ignore)
2174 return Qt;
2177 /* Delete file FILENAME, returning true if successful.
2178 This ignores `delete-by-moving-to-trash'. */
2180 bool
2181 internal_delete_file (Lisp_Object filename)
2183 Lisp_Object tem;
2185 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2186 Qt, internal_delete_file_1);
2187 return NILP (tem);
2190 /* Filesystems are case-sensitive on all supported systems except
2191 MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always
2192 case-insensitive on the first two, but they may or may not be
2193 case-insensitive on Cygwin and OS X. The following function
2194 attempts to provide a runtime test on those two systems. If the
2195 test is not conclusive, we assume case-insensitivity on Cygwin and
2196 case-sensitivity on Mac OS X.
2198 FIXME: Mounted filesystems on Posix hosts, like Samba shares or
2199 NFS-mounted Windows volumes, might be case-insensitive. Can we
2200 detect this? */
2202 static bool
2203 file_name_case_insensitive_p (const char *filename)
2205 /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
2206 those flags are available. As of this writing (2017-05-20),
2207 Cygwin is the only platform known to support the former (starting
2208 with Cygwin-2.6.1), and macOS is the only platform known to
2209 support the latter. */
2211 #ifdef _PC_CASE_INSENSITIVE
2212 int res = pathconf (filename, _PC_CASE_INSENSITIVE);
2213 if (res >= 0)
2214 return res > 0;
2215 #elif defined _PC_CASE_SENSITIVE
2216 int res = pathconf (filename, _PC_CASE_SENSITIVE);
2217 if (res >= 0)
2218 return res == 0;
2219 #endif
2221 #if defined CYGWIN || defined DOS_NT
2222 return true;
2223 #else
2224 return false;
2225 #endif
2228 DEFUN ("file-name-case-insensitive-p", Ffile_name_case_insensitive_p,
2229 Sfile_name_case_insensitive_p, 1, 1, 0,
2230 doc: /* Return t if file FILENAME is on a case-insensitive filesystem.
2231 The arg must be a string. */)
2232 (Lisp_Object filename)
2234 Lisp_Object handler;
2236 CHECK_STRING (filename);
2237 filename = Fexpand_file_name (filename, Qnil);
2239 /* If the file name has special constructs in it,
2240 call the corresponding file handler. */
2241 handler = Ffind_file_name_handler (filename, Qfile_name_case_insensitive_p);
2242 if (!NILP (handler))
2243 return call2 (handler, Qfile_name_case_insensitive_p, filename);
2245 filename = ENCODE_FILE (filename);
2246 return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil;
2249 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2250 "fRename file: \nGRename %s to file: \np",
2251 doc: /* Rename FILE as NEWNAME. Both args must be strings.
2252 If file has names other than FILE, it continues to have those names.
2253 If NEWNAME is a directory name, rename FILE to a like-named file under
2254 NEWNAME.
2256 Signal a `file-already-exists' error if a file NEWNAME already exists
2257 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2258 An integer third arg means request confirmation if NEWNAME already exists.
2259 This is what happens in interactive use with M-x. */)
2260 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2262 Lisp_Object handler;
2263 Lisp_Object encoded_file, encoded_newname;
2265 file = Fexpand_file_name (file, Qnil);
2267 /* If the filesystem is case-insensitive and the file names are
2268 identical but for case, treat it as a change-case request, and do
2269 not worry whether NEWNAME exists or whether it is a directory, as
2270 it is already another name for FILE. */
2271 bool case_only_rename = false;
2272 #if defined CYGWIN || defined DOS_NT
2273 if (!NILP (Ffile_name_case_insensitive_p (file)))
2275 newname = Fexpand_file_name (newname, Qnil);
2276 case_only_rename = !NILP (Fstring_equal (Fdowncase (file),
2277 Fdowncase (newname)));
2279 #endif
2281 if (!case_only_rename)
2282 newname = expand_cp_target (Fdirectory_file_name (file), newname);
2284 /* If the file name has special constructs in it,
2285 call the corresponding file handler. */
2286 handler = Ffind_file_name_handler (file, Qrename_file);
2287 if (NILP (handler))
2288 handler = Ffind_file_name_handler (newname, Qrename_file);
2289 if (!NILP (handler))
2290 return call4 (handler, Qrename_file,
2291 file, newname, ok_if_already_exists);
2293 encoded_file = ENCODE_FILE (file);
2294 encoded_newname = ENCODE_FILE (newname);
2296 bool plain_rename = (case_only_rename
2297 || (!NILP (ok_if_already_exists)
2298 && !INTEGERP (ok_if_already_exists)));
2299 int rename_errno;
2300 if (!plain_rename)
2302 if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file),
2303 AT_FDCWD, SSDATA (encoded_newname))
2304 == 0)
2305 return Qnil;
2307 rename_errno = errno;
2308 switch (rename_errno)
2310 case EEXIST: case EINVAL: case ENOSYS:
2311 #if ENOSYS != ENOTSUP
2312 case ENOTSUP:
2313 #endif
2314 barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
2315 "rename to it",
2316 INTEGERP (ok_if_already_exists),
2317 false);
2318 plain_rename = true;
2319 break;
2323 if (plain_rename)
2325 if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
2326 return Qnil;
2327 rename_errno = errno;
2328 /* Don't prompt again. */
2329 ok_if_already_exists = Qt;
2331 else if (!NILP (ok_if_already_exists))
2332 ok_if_already_exists = Qt;
2334 if (rename_errno != EXDEV)
2335 report_file_errno ("Renaming", list2 (file, newname), rename_errno);
2337 struct stat file_st;
2338 bool dirp = !NILP (Fdirectory_name_p (file));
2339 if (!dirp)
2341 if (lstat (SSDATA (encoded_file), &file_st) != 0)
2342 report_file_error ("Renaming", list2 (file, newname));
2343 dirp = S_ISDIR (file_st.st_mode) != 0;
2345 if (dirp)
2346 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2347 else
2349 Lisp_Object symlink_target
2350 = (S_ISLNK (file_st.st_mode)
2351 ? emacs_readlinkat (AT_FDCWD, SSDATA (encoded_file))
2352 : Qnil);
2353 if (!NILP (symlink_target))
2354 Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
2355 else
2356 Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt);
2359 ptrdiff_t count = SPECPDL_INDEX ();
2360 specbind (Qdelete_by_moving_to_trash, Qnil);
2361 if (dirp)
2362 call2 (Qdelete_directory, file, Qt);
2363 else
2364 Fdelete_file (file, Qnil);
2365 return unbind_to (count, Qnil);
2368 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
2369 "fAdd name to file: \nGName to add to %s: \np",
2370 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
2371 If NEWNAME is a directory name, give FILE a like-named new name under
2372 NEWNAME.
2374 Signal a `file-already-exists' error if a file NEWNAME already exists
2375 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2376 An integer third arg means request confirmation if NEWNAME already exists.
2377 This is what happens in interactive use with M-x. */)
2378 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2380 Lisp_Object handler;
2381 Lisp_Object encoded_file, encoded_newname;
2383 file = Fexpand_file_name (file, Qnil);
2384 newname = expand_cp_target (file, newname);
2386 /* If the file name has special constructs in it,
2387 call the corresponding file handler. */
2388 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
2389 if (!NILP (handler))
2390 return call4 (handler, Qadd_name_to_file, file,
2391 newname, ok_if_already_exists);
2393 /* If the new name has special constructs in it,
2394 call the corresponding file handler. */
2395 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2396 if (!NILP (handler))
2397 return call4 (handler, Qadd_name_to_file, file,
2398 newname, ok_if_already_exists);
2400 encoded_file = ENCODE_FILE (file);
2401 encoded_newname = ENCODE_FILE (newname);
2403 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
2404 return Qnil;
2406 if (errno == EEXIST)
2408 if (NILP (ok_if_already_exists)
2409 || INTEGERP (ok_if_already_exists))
2410 barf_or_query_if_file_exists (newname, true, "make it a new name",
2411 INTEGERP (ok_if_already_exists), false);
2412 unlink (SSDATA (newname));
2413 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
2414 return Qnil;
2417 report_file_error ("Adding new name", list2 (file, newname));
2420 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
2421 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2422 doc: /* Make a symbolic link to TARGET, named NEWNAME.
2423 If NEWNAME is a directory name, make a like-named symbolic link under
2424 NEWNAME.
2426 Signal a `file-already-exists' error if a file NEWNAME already exists
2427 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2428 An integer third arg means request confirmation if NEWNAME already
2429 exists, and expand leading "~" or strip leading "/:" in TARGET.
2430 This happens for interactive use with M-x. */)
2431 (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
2433 Lisp_Object handler;
2434 Lisp_Object encoded_target, encoded_linkname;
2436 CHECK_STRING (target);
2437 if (INTEGERP (ok_if_already_exists))
2439 if (SREF (target, 0) == '~')
2440 target = Fexpand_file_name (target, Qnil);
2441 else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
2442 target = Fsubstring_no_properties (target, make_number (2), Qnil);
2444 linkname = expand_cp_target (target, linkname);
2446 /* If the new link name has special constructs in it,
2447 call the corresponding file handler. */
2448 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2449 if (!NILP (handler))
2450 return call4 (handler, Qmake_symbolic_link, target,
2451 linkname, ok_if_already_exists);
2453 encoded_target = ENCODE_FILE (target);
2454 encoded_linkname = ENCODE_FILE (linkname);
2456 if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
2457 return Qnil;
2459 if (errno == ENOSYS)
2460 xsignal1 (Qfile_error,
2461 build_string ("Symbolic links are not supported"));
2463 if (errno == EEXIST)
2465 if (NILP (ok_if_already_exists)
2466 || INTEGERP (ok_if_already_exists))
2467 barf_or_query_if_file_exists (linkname, true, "make it a link",
2468 INTEGERP (ok_if_already_exists), false);
2469 unlink (SSDATA (encoded_linkname));
2470 if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
2471 return Qnil;
2474 report_file_error ("Making symbolic link", list2 (target, linkname));
2478 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2479 1, 1, 0,
2480 doc: /* Return t if FILENAME is an absolute file name or starts with `~'.
2481 On Unix, absolute file names start with `/'. */)
2482 (Lisp_Object filename)
2484 CHECK_STRING (filename);
2485 return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
2488 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2489 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2490 See also `file-readable-p' and `file-attributes'.
2491 This returns nil for a symlink to a nonexistent file.
2492 Use `file-symlink-p' to test for such links. */)
2493 (Lisp_Object filename)
2495 Lisp_Object absname;
2496 Lisp_Object handler;
2498 CHECK_STRING (filename);
2499 absname = Fexpand_file_name (filename, Qnil);
2501 /* If the file name has special constructs in it,
2502 call the corresponding file handler. */
2503 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2504 if (!NILP (handler))
2506 Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
2507 errno = 0;
2508 return result;
2511 absname = ENCODE_FILE (absname);
2513 return check_existing (SSDATA (absname)) ? Qt : Qnil;
2516 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
2517 doc: /* Return t if FILENAME can be executed by you.
2518 For a directory, this means you can access files in that directory.
2519 \(It is generally better to use `file-accessible-directory-p' for that
2520 purpose, though.) */)
2521 (Lisp_Object filename)
2523 Lisp_Object absname;
2524 Lisp_Object handler;
2526 CHECK_STRING (filename);
2527 absname = Fexpand_file_name (filename, Qnil);
2529 /* If the file name has special constructs in it,
2530 call the corresponding file handler. */
2531 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2532 if (!NILP (handler))
2533 return call2 (handler, Qfile_executable_p, absname);
2535 absname = ENCODE_FILE (absname);
2537 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
2540 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2541 doc: /* Return t if file FILENAME exists and you can read it.
2542 See also `file-exists-p' and `file-attributes'. */)
2543 (Lisp_Object filename)
2545 Lisp_Object absname;
2546 Lisp_Object handler;
2548 CHECK_STRING (filename);
2549 absname = Fexpand_file_name (filename, Qnil);
2551 /* If the file name has special constructs in it,
2552 call the corresponding file handler. */
2553 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2554 if (!NILP (handler))
2555 return call2 (handler, Qfile_readable_p, absname);
2557 absname = ENCODE_FILE (absname);
2558 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2559 ? Qt : Qnil);
2562 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2563 doc: /* Return t if file FILENAME can be written or created by you. */)
2564 (Lisp_Object filename)
2566 Lisp_Object absname, dir, encoded;
2567 Lisp_Object handler;
2569 CHECK_STRING (filename);
2570 absname = Fexpand_file_name (filename, Qnil);
2572 /* If the file name has special constructs in it,
2573 call the corresponding file handler. */
2574 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
2575 if (!NILP (handler))
2576 return call2 (handler, Qfile_writable_p, absname);
2578 encoded = ENCODE_FILE (absname);
2579 if (check_writable (SSDATA (encoded), W_OK))
2580 return Qt;
2581 if (errno != ENOENT)
2582 return Qnil;
2584 dir = Ffile_name_directory (absname);
2585 eassert (!NILP (dir));
2586 #ifdef MSDOS
2587 dir = Fdirectory_file_name (dir);
2588 #endif /* MSDOS */
2590 dir = ENCODE_FILE (dir);
2591 #ifdef WINDOWSNT
2592 /* The read-only attribute of the parent directory doesn't affect
2593 whether a file or directory can be created within it. Some day we
2594 should check ACLs though, which do affect this. */
2595 return file_directory_p (SSDATA (dir)) ? Qt : Qnil;
2596 #else
2597 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
2598 #endif
2601 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2602 doc: /* Access file FILENAME, and get an error if that does not work.
2603 The second argument STRING is prepended to the error message.
2604 If there is no error, returns nil. */)
2605 (Lisp_Object filename, Lisp_Object string)
2607 Lisp_Object handler, encoded_filename, absname;
2609 CHECK_STRING (filename);
2610 absname = Fexpand_file_name (filename, Qnil);
2612 CHECK_STRING (string);
2614 /* If the file name has special constructs in it,
2615 call the corresponding file handler. */
2616 handler = Ffind_file_name_handler (absname, Qaccess_file);
2617 if (!NILP (handler))
2618 return call3 (handler, Qaccess_file, absname, string);
2620 encoded_filename = ENCODE_FILE (absname);
2622 if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
2623 report_file_error (SSDATA (string), filename);
2625 return Qnil;
2628 /* Relative to directory FD, return the symbolic link value of FILENAME.
2629 On failure, return nil. */
2630 Lisp_Object
2631 emacs_readlinkat (int fd, char const *filename)
2633 static struct allocator const emacs_norealloc_allocator =
2634 { xmalloc, NULL, xfree, memory_full };
2635 Lisp_Object val;
2636 char readlink_buf[1024];
2637 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2638 &emacs_norealloc_allocator, readlinkat);
2639 if (!buf)
2640 return Qnil;
2642 val = build_unibyte_string (buf);
2643 if (buf != readlink_buf)
2644 xfree (buf);
2645 val = DECODE_FILE (val);
2646 return val;
2649 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2650 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2651 The value is the link target, as a string.
2652 Otherwise it returns nil.
2654 This function does not check whether the link target exists. */)
2655 (Lisp_Object filename)
2657 Lisp_Object handler;
2659 CHECK_STRING (filename);
2660 filename = Fexpand_file_name (filename, Qnil);
2662 /* If the file name has special constructs in it,
2663 call the corresponding file handler. */
2664 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2665 if (!NILP (handler))
2666 return call2 (handler, Qfile_symlink_p, filename);
2668 filename = ENCODE_FILE (filename);
2670 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2673 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2674 doc: /* Return t if FILENAME names an existing directory.
2675 Symbolic links to directories count as directories.
2676 See `file-symlink-p' to distinguish symlinks. */)
2677 (Lisp_Object filename)
2679 Lisp_Object absname = expand_and_dir_to_file (filename);
2681 /* If the file name has special constructs in it,
2682 call the corresponding file handler. */
2683 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p);
2684 if (!NILP (handler))
2685 return call2 (handler, Qfile_directory_p, absname);
2687 absname = ENCODE_FILE (absname);
2689 return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
2692 /* Return true if FILE is a directory or a symlink to a directory. */
2693 bool
2694 file_directory_p (char const *file)
2696 #ifdef WINDOWSNT
2697 /* This is cheaper than 'stat'. */
2698 return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
2699 #else
2700 struct stat st;
2701 return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
2702 #endif
2705 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
2706 Sfile_accessible_directory_p, 1, 1, 0,
2707 doc: /* Return t if FILENAME names a directory you can open.
2708 For the value to be t, FILENAME must specify the name of a directory
2709 as a file, and the directory must allow you to open files in it. In
2710 order to use a directory as a buffer's current directory, this
2711 predicate must return true. A directory name spec may be given
2712 instead; then the value is t if the directory so specified exists and
2713 really is a readable and searchable directory. */)
2714 (Lisp_Object filename)
2716 Lisp_Object absname;
2717 Lisp_Object handler;
2719 CHECK_STRING (filename);
2720 absname = Fexpand_file_name (filename, Qnil);
2722 /* If the file name has special constructs in it,
2723 call the corresponding file handler. */
2724 handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
2725 if (!NILP (handler))
2727 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2729 /* Set errno in case the handler failed. EACCES might be a lie
2730 (e.g., the directory might not exist, or be a regular file),
2731 but at least it does TRT in the "usual" case of an existing
2732 directory that is not accessible by the current user, and
2733 avoids reporting "Success" for a failed operation. Perhaps
2734 someday we can fix this in a better way, by improving
2735 file-accessible-directory-p's API; see Bug#25419. */
2736 if (!EQ (r, Qt))
2737 errno = EACCES;
2739 return r;
2742 absname = ENCODE_FILE (absname);
2743 return file_accessible_directory_p (absname) ? Qt : Qnil;
2746 /* If FILE is a searchable directory or a symlink to a
2747 searchable directory, return true. Otherwise return
2748 false and set errno to an error number. */
2749 bool
2750 file_accessible_directory_p (Lisp_Object file)
2752 #ifdef DOS_NT
2753 # ifdef WINDOWSNT
2754 /* We need a special-purpose test because (a) NTFS security data is
2755 not reflected in Posix-style mode bits, and (b) the trick with
2756 accessing "DIR/.", used below on Posix hosts, doesn't work on
2757 Windows, because "DIR/." is normalized to just "DIR" before
2758 hitting the disk. */
2759 return (SBYTES (file) == 0
2760 || w32_accessible_directory_p (SSDATA (file), SBYTES (file)));
2761 # else /* MSDOS */
2762 return file_directory_p (SSDATA (file));
2763 # endif /* MSDOS */
2764 #else /* !DOS_NT */
2765 /* On POSIXish platforms, use just one system call; this avoids a
2766 race and is typically faster. */
2767 const char *data = SSDATA (file);
2768 ptrdiff_t len = SBYTES (file);
2769 char const *dir;
2770 bool ok;
2771 int saved_errno;
2772 USE_SAFE_ALLOCA;
2774 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2775 There are three exceptions: "", "/", and "//". Leave "" alone,
2776 as it's invalid. Append only "." to the other two exceptions as
2777 "/" and "//" are distinct on some platforms, whereas "/", "///",
2778 "////", etc. are all equivalent. */
2779 if (! len)
2780 dir = data;
2781 else
2783 /* Just check for trailing '/' when deciding whether to append '/'.
2784 That's simpler than testing the two special cases "/" and "//",
2785 and it's a safe optimization here. */
2786 char *buf = SAFE_ALLOCA (len + 3);
2787 memcpy (buf, data, len);
2788 strcpy (buf + len, &"/."[data[len - 1] == '/']);
2789 dir = buf;
2792 ok = check_existing (dir);
2793 saved_errno = errno;
2794 SAFE_FREE ();
2795 errno = saved_errno;
2796 return ok;
2797 #endif /* !DOS_NT */
2800 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
2801 doc: /* Return t if FILENAME names a regular file.
2802 This is the sort of file that holds an ordinary stream of data bytes.
2803 Symbolic links to regular files count as regular files.
2804 See `file-symlink-p' to distinguish symlinks. */)
2805 (Lisp_Object filename)
2807 struct stat st;
2808 Lisp_Object absname = expand_and_dir_to_file (filename);
2810 /* If the file name has special constructs in it,
2811 call the corresponding file handler. */
2812 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_regular_p);
2813 if (!NILP (handler))
2814 return call2 (handler, Qfile_regular_p, absname);
2816 absname = ENCODE_FILE (absname);
2818 #ifdef WINDOWSNT
2820 int result;
2821 Lisp_Object tem = Vw32_get_true_file_attributes;
2823 /* Tell stat to use expensive method to get accurate info. */
2824 Vw32_get_true_file_attributes = Qt;
2825 result = stat (SSDATA (absname), &st);
2826 Vw32_get_true_file_attributes = tem;
2828 if (result < 0)
2829 return Qnil;
2830 return S_ISREG (st.st_mode) ? Qt : Qnil;
2832 #else
2833 if (stat (SSDATA (absname), &st) < 0)
2834 return Qnil;
2835 return S_ISREG (st.st_mode) ? Qt : Qnil;
2836 #endif
2839 DEFUN ("file-selinux-context", Ffile_selinux_context,
2840 Sfile_selinux_context, 1, 1, 0,
2841 doc: /* Return SELinux context of file named FILENAME.
2842 The return value is a list (USER ROLE TYPE RANGE), where the list
2843 elements are strings naming the user, role, type, and range of the
2844 file's SELinux security context.
2846 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2847 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2848 (Lisp_Object filename)
2850 Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
2851 Lisp_Object absname = expand_and_dir_to_file (filename);
2853 /* If the file name has special constructs in it,
2854 call the corresponding file handler. */
2855 Lisp_Object handler = Ffind_file_name_handler (absname,
2856 Qfile_selinux_context);
2857 if (!NILP (handler))
2858 return call2 (handler, Qfile_selinux_context, absname);
2860 absname = ENCODE_FILE (absname);
2862 #if HAVE_LIBSELINUX
2863 if (is_selinux_enabled ())
2865 security_context_t con;
2866 int conlength = lgetfilecon (SSDATA (absname), &con);
2867 if (conlength > 0)
2869 context_t context = context_new (con);
2870 if (context_user_get (context))
2871 user = build_string (context_user_get (context));
2872 if (context_role_get (context))
2873 role = build_string (context_role_get (context));
2874 if (context_type_get (context))
2875 type = build_string (context_type_get (context));
2876 if (context_range_get (context))
2877 range = build_string (context_range_get (context));
2878 context_free (context);
2879 freecon (con);
2882 #endif
2884 return list4 (user, role, type, range);
2887 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2888 Sset_file_selinux_context, 2, 2, 0,
2889 doc: /* Set SELinux context of file named FILENAME to CONTEXT.
2890 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2891 elements are strings naming the components of a SELinux context.
2893 Value is t if setting of SELinux context was successful, nil otherwise.
2895 This function does nothing and returns nil if SELinux is disabled,
2896 or if Emacs was not compiled with SELinux support. */)
2897 (Lisp_Object filename, Lisp_Object context)
2899 Lisp_Object absname;
2900 Lisp_Object handler;
2901 #if HAVE_LIBSELINUX
2902 Lisp_Object encoded_absname;
2903 Lisp_Object user = CAR_SAFE (context);
2904 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2905 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2906 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
2907 security_context_t con;
2908 bool fail;
2909 int conlength;
2910 context_t parsed_con;
2911 #endif
2913 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
2915 /* If the file name has special constructs in it,
2916 call the corresponding file handler. */
2917 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2918 if (!NILP (handler))
2919 return call3 (handler, Qset_file_selinux_context, absname, context);
2921 #if HAVE_LIBSELINUX
2922 if (is_selinux_enabled ())
2924 /* Get current file context. */
2925 encoded_absname = ENCODE_FILE (absname);
2926 conlength = lgetfilecon (SSDATA (encoded_absname), &con);
2927 if (conlength > 0)
2929 parsed_con = context_new (con);
2930 /* Change the parts defined in the parameter.*/
2931 if (STRINGP (user))
2933 if (context_user_set (parsed_con, SSDATA (user)))
2934 error ("Doing context_user_set");
2936 if (STRINGP (role))
2938 if (context_role_set (parsed_con, SSDATA (role)))
2939 error ("Doing context_role_set");
2941 if (STRINGP (type))
2943 if (context_type_set (parsed_con, SSDATA (type)))
2944 error ("Doing context_type_set");
2946 if (STRINGP (range))
2948 if (context_range_set (parsed_con, SSDATA (range)))
2949 error ("Doing context_range_set");
2952 /* Set the modified context back to the file. */
2953 fail = (lsetfilecon (SSDATA (encoded_absname),
2954 context_str (parsed_con))
2955 != 0);
2956 /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
2957 if (fail && errno != ENOTSUP)
2958 report_file_error ("Doing lsetfilecon", absname);
2960 context_free (parsed_con);
2961 freecon (con);
2962 return fail ? Qnil : Qt;
2964 else
2965 report_file_error ("Doing lgetfilecon", absname);
2967 #endif
2969 return Qnil;
2972 DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
2973 doc: /* Return ACL entries of file named FILENAME.
2974 The entries are returned in a format suitable for use in `set-file-acl'
2975 but is otherwise undocumented and subject to change.
2976 Return nil if file does not exist or is not accessible, or if Emacs
2977 was unable to determine the ACL entries. */)
2978 (Lisp_Object filename)
2980 Lisp_Object acl_string = Qnil;
2982 #if USE_ACL
2983 Lisp_Object absname = expand_and_dir_to_file (filename);
2985 /* If the file name has special constructs in it,
2986 call the corresponding file handler. */
2987 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_acl);
2988 if (!NILP (handler))
2989 return call2 (handler, Qfile_acl, absname);
2991 # ifdef HAVE_ACL_SET_FILE
2992 absname = ENCODE_FILE (absname);
2994 # ifndef HAVE_ACL_TYPE_EXTENDED
2995 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
2996 # endif
2997 acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
2998 if (acl == NULL)
2999 return Qnil;
3001 char *str = acl_to_text (acl, NULL);
3002 if (str == NULL)
3004 acl_free (acl);
3005 return Qnil;
3008 acl_string = build_string (str);
3009 acl_free (str);
3010 acl_free (acl);
3011 # endif
3012 #endif
3014 return acl_string;
3017 DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
3018 2, 2, 0,
3019 doc: /* Set ACL of file named FILENAME to ACL-STRING.
3020 ACL-STRING should contain the textual representation of the ACL
3021 entries in a format suitable for the platform.
3023 Value is t if setting of ACL was successful, nil otherwise.
3025 Setting ACL for local files requires Emacs to be built with ACL
3026 support. */)
3027 (Lisp_Object filename, Lisp_Object acl_string)
3029 #if USE_ACL
3030 Lisp_Object absname;
3031 Lisp_Object handler;
3032 # ifdef HAVE_ACL_SET_FILE
3033 Lisp_Object encoded_absname;
3034 acl_t acl;
3035 bool fail;
3036 # endif
3038 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3040 /* If the file name has special constructs in it,
3041 call the corresponding file handler. */
3042 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3043 if (!NILP (handler))
3044 return call3 (handler, Qset_file_acl, absname, acl_string);
3046 # ifdef HAVE_ACL_SET_FILE
3047 if (STRINGP (acl_string))
3049 acl = acl_from_text (SSDATA (acl_string));
3050 if (acl == NULL)
3052 report_file_error ("Converting ACL", absname);
3053 return Qnil;
3056 encoded_absname = ENCODE_FILE (absname);
3058 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3059 acl)
3060 != 0);
3061 if (fail && acl_errno_valid (errno))
3062 report_file_error ("Setting ACL", absname);
3064 acl_free (acl);
3065 return fail ? Qnil : Qt;
3067 # endif
3068 #endif
3070 return Qnil;
3073 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3074 doc: /* Return mode bits of file named FILENAME, as an integer.
3075 Return nil, if file does not exist or is not accessible. */)
3076 (Lisp_Object filename)
3078 struct stat st;
3079 Lisp_Object absname = expand_and_dir_to_file (filename);
3081 /* If the file name has special constructs in it,
3082 call the corresponding file handler. */
3083 Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes);
3084 if (!NILP (handler))
3085 return call2 (handler, Qfile_modes, absname);
3087 absname = ENCODE_FILE (absname);
3089 if (stat (SSDATA (absname), &st) < 0)
3090 return Qnil;
3092 return make_number (st.st_mode & 07777);
3095 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
3096 "(let ((file (read-file-name \"File: \"))) \
3097 (list file (read-file-modes nil file)))",
3098 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
3099 Only the 12 low bits of MODE are used.
3101 Interactively, mode bits are read by `read-file-modes', which accepts
3102 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3103 (Lisp_Object filename, Lisp_Object mode)
3105 Lisp_Object absname, encoded_absname;
3106 Lisp_Object handler;
3108 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3109 CHECK_NUMBER (mode);
3111 /* If the file name has special constructs in it,
3112 call the corresponding file handler. */
3113 handler = Ffind_file_name_handler (absname, Qset_file_modes);
3114 if (!NILP (handler))
3115 return call3 (handler, Qset_file_modes, absname, mode);
3117 encoded_absname = ENCODE_FILE (absname);
3119 if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
3120 report_file_error ("Doing chmod", absname);
3122 return Qnil;
3125 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
3126 doc: /* Set the file permission bits for newly created files.
3127 The argument MODE should be an integer; only the low 9 bits are used.
3128 This setting is inherited by subprocesses. */)
3129 (Lisp_Object mode)
3131 mode_t oldrealmask, oldumask, newumask;
3132 CHECK_NUMBER (mode);
3133 oldrealmask = realmask;
3134 newumask = ~ XINT (mode) & 0777;
3136 block_input ();
3137 realmask = newumask;
3138 oldumask = umask (newumask);
3139 unblock_input ();
3141 eassert (oldumask == oldrealmask);
3142 return Qnil;
3145 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
3146 doc: /* Return the default file protection for created files.
3147 The value is an integer. */)
3148 (void)
3150 Lisp_Object value;
3151 XSETINT (value, (~ realmask) & 0777);
3152 return value;
3156 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
3157 doc: /* Set times of file FILENAME to TIMESTAMP.
3158 Set both access and modification times.
3159 Return t on success, else nil.
3160 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3161 `current-time'. */)
3162 (Lisp_Object filename, Lisp_Object timestamp)
3164 Lisp_Object absname, encoded_absname;
3165 Lisp_Object handler;
3166 struct timespec t = lisp_time_argument (timestamp);
3168 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3170 /* If the file name has special constructs in it,
3171 call the corresponding file handler. */
3172 handler = Ffind_file_name_handler (absname, Qset_file_times);
3173 if (!NILP (handler))
3174 return call3 (handler, Qset_file_times, absname, timestamp);
3176 encoded_absname = ENCODE_FILE (absname);
3179 if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
3181 #ifdef MSDOS
3182 /* Setting times on a directory always fails. */
3183 if (file_directory_p (SSDATA (encoded_absname)))
3184 return Qnil;
3185 #endif
3186 report_file_error ("Setting file times", absname);
3190 return Qt;
3193 #ifdef HAVE_SYNC
3194 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3195 doc: /* Tell Unix to finish all pending disk updates. */)
3196 (void)
3198 sync ();
3199 return Qnil;
3202 #endif /* HAVE_SYNC */
3204 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3205 doc: /* Return t if file FILE1 is newer than file FILE2.
3206 If FILE1 does not exist, the answer is nil;
3207 otherwise, if FILE2 does not exist, the answer is t. */)
3208 (Lisp_Object file1, Lisp_Object file2)
3210 struct stat st1, st2;
3212 CHECK_STRING (file1);
3213 CHECK_STRING (file2);
3215 Lisp_Object absname1 = expand_and_dir_to_file (file1);
3216 Lisp_Object absname2 = expand_and_dir_to_file (file2);
3218 /* If the file name has special constructs in it,
3219 call the corresponding file handler. */
3220 Lisp_Object handler = Ffind_file_name_handler (absname1,
3221 Qfile_newer_than_file_p);
3222 if (NILP (handler))
3223 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
3224 if (!NILP (handler))
3225 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3227 absname1 = ENCODE_FILE (absname1);
3228 absname2 = ENCODE_FILE (absname2);
3230 if (stat (SSDATA (absname1), &st1) < 0)
3231 return Qnil;
3233 if (stat (SSDATA (absname2), &st2) < 0)
3234 return Qt;
3236 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
3237 ? Qt : Qnil);
3240 enum { READ_BUF_SIZE = MAX_ALLOCA };
3242 /* This function is called after Lisp functions to decide a coding
3243 system are called, or when they cause an error. Before they are
3244 called, the current buffer is set unibyte and it contains only a
3245 newly inserted text (thus the buffer was empty before the
3246 insertion).
3248 The functions may set markers, overlays, text properties, or even
3249 alter the buffer contents, change the current buffer.
3251 Here, we reset all those changes by:
3252 o set back the current buffer.
3253 o move all markers and overlays to BEG.
3254 o remove all text properties.
3255 o set back the buffer multibyteness. */
3257 static void
3258 decide_coding_unwind (Lisp_Object unwind_data)
3260 Lisp_Object multibyte, undo_list, buffer;
3262 multibyte = XCAR (unwind_data);
3263 unwind_data = XCDR (unwind_data);
3264 undo_list = XCAR (unwind_data);
3265 buffer = XCDR (unwind_data);
3267 set_buffer_internal (XBUFFER (buffer));
3268 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3269 adjust_overlays_for_delete (BEG, Z - BEG);
3270 set_buffer_intervals (current_buffer, NULL);
3271 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3273 /* Now we are safe to change the buffer's multibyteness directly. */
3274 bset_enable_multibyte_characters (current_buffer, multibyte);
3275 bset_undo_list (current_buffer, undo_list);
3278 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3279 object where slot 0 is the file descriptor, slot 1 specifies
3280 an offset to put the read bytes, and slot 2 is the maximum
3281 amount of bytes to read. Value is the number of bytes read. */
3283 static Lisp_Object
3284 read_non_regular (Lisp_Object state)
3286 int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
3287 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3288 + XSAVE_INTEGER (state, 1)),
3289 XSAVE_INTEGER (state, 2));
3290 /* Fast recycle this object for the likely next call. */
3291 free_misc (state);
3292 return make_number (nbytes);
3296 /* Condition-case handler used when reading from non-regular files
3297 in insert-file-contents. */
3299 static Lisp_Object
3300 read_non_regular_quit (Lisp_Object ignore)
3302 return Qnil;
3305 /* Return the file offset that VAL represents, checking for type
3306 errors and overflow. */
3307 static off_t
3308 file_offset (Lisp_Object val)
3310 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3311 return XINT (val);
3313 if (FLOATP (val))
3315 double v = XFLOAT_DATA (val);
3316 if (0 <= v && v < 1.0 + TYPE_MAXIMUM (off_t))
3318 off_t o = v;
3319 if (o == v)
3320 return o;
3324 wrong_type_argument (intern ("file-offset"), val);
3327 /* Return a special time value indicating the error number ERRNUM. */
3328 static struct timespec
3329 time_error_value (int errnum)
3331 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
3332 ? NONEXISTENT_MODTIME_NSECS
3333 : UNKNOWN_MODTIME_NSECS);
3334 return make_timespec (0, ns);
3337 static Lisp_Object
3338 get_window_points_and_markers (void)
3340 Lisp_Object pt_marker = Fpoint_marker ();
3341 Lisp_Object windows
3342 = call3 (Qget_buffer_window_list, Fcurrent_buffer (), Qnil, Qt);
3343 Lisp_Object window_markers = windows;
3344 /* Window markers (and point) are handled specially: rather than move to
3345 just before or just after the modified text, we try to keep the
3346 markers at the same distance (bug#19161).
3347 In general, this is wrong, but for window-markers, this should be harmless
3348 and is convenient for the end user when most of the file is unmodified,
3349 except for a few minor details near the beginning and near the end. */
3350 for (; CONSP (windows); windows = XCDR (windows))
3351 if (WINDOWP (XCAR (windows)))
3353 Lisp_Object window_marker = XWINDOW (XCAR (windows))->pointm;
3354 XSETCAR (windows,
3355 Fcons (window_marker, Fmarker_position (window_marker)));
3357 return Fcons (Fcons (pt_marker, Fpoint ()), window_markers);
3360 static void
3361 restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
3362 ptrdiff_t same_at_start, ptrdiff_t same_at_end)
3364 for (; CONSP (window_markers); window_markers = XCDR (window_markers))
3365 if (CONSP (XCAR (window_markers)))
3367 Lisp_Object car = XCAR (window_markers);
3368 Lisp_Object marker = XCAR (car);
3369 Lisp_Object oldpos = XCDR (car);
3370 if (MARKERP (marker) && INTEGERP (oldpos)
3371 && XINT (oldpos) > same_at_start
3372 && XINT (oldpos) < same_at_end)
3374 ptrdiff_t oldsize = same_at_end - same_at_start;
3375 ptrdiff_t newsize = inserted;
3376 double growth = newsize / (double)oldsize;
3377 ptrdiff_t newpos
3378 = same_at_start + growth * (XINT (oldpos) - same_at_start);
3379 Fset_marker (marker, make_number (newpos), Qnil);
3384 /* Make sure the gap is at Z_BYTE. This is required to treat buffer
3385 text as a linear C char array. */
3386 static void
3387 maybe_move_gap (struct buffer *b)
3389 if (BUF_GPT_BYTE (b) != BUF_Z_BYTE (b))
3391 struct buffer *cb = current_buffer;
3393 set_buffer_internal (b);
3394 move_gap_both (Z, Z_BYTE);
3395 set_buffer_internal (cb);
3399 /* FIXME: insert-file-contents should be split with the top-level moved to
3400 Elisp and only the core kept in C. */
3402 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
3403 1, 5, 0,
3404 doc: /* Insert contents of file FILENAME after point.
3405 Returns list of absolute file name and number of characters inserted.
3406 If second argument VISIT is non-nil, the buffer's visited filename and
3407 last save file modtime are set, and it is marked unmodified. If
3408 visiting and the file does not exist, visiting is completed before the
3409 error is signaled.
3411 The optional third and fourth arguments BEG and END specify what portion
3412 of the file to insert. These arguments count bytes in the file, not
3413 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3415 If optional fifth argument REPLACE is non-nil, replace the current
3416 buffer contents (in the accessible portion) with the file contents.
3417 This is better than simply deleting and inserting the whole thing
3418 because (1) it preserves some marker positions and (2) it puts less data
3419 in the undo list. When REPLACE is non-nil, the second return value is
3420 the number of characters that replace previous buffer contents.
3422 This function does code conversion according to the value of
3423 `coding-system-for-read' or `file-coding-system-alist', and sets the
3424 variable `last-coding-system-used' to the coding system actually used.
3426 In addition, this function decodes the inserted text from known formats
3427 by calling `format-decode', which see. */)
3428 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3430 struct stat st;
3431 struct timespec mtime;
3432 int fd;
3433 ptrdiff_t inserted = 0;
3434 ptrdiff_t how_much;
3435 off_t beg_offset, end_offset;
3436 int unprocessed;
3437 ptrdiff_t count = SPECPDL_INDEX ();
3438 Lisp_Object handler, val, insval, orig_filename, old_undo;
3439 Lisp_Object p;
3440 ptrdiff_t total = 0;
3441 bool not_regular = 0;
3442 int save_errno = 0;
3443 char read_buf[READ_BUF_SIZE];
3444 struct coding_system coding;
3445 bool replace_handled = false;
3446 bool set_coding_system = false;
3447 Lisp_Object coding_system;
3448 bool read_quit = false;
3449 /* If the undo log only contains the insertion, there's no point
3450 keeping it. It's typically when we first fill a file-buffer. */
3451 bool empty_undo_list_p
3452 = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
3453 && BEG == Z);
3454 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
3455 bool we_locked_file = false;
3456 ptrdiff_t fd_index;
3457 Lisp_Object window_markers = Qnil;
3458 /* same_at_start and same_at_end count bytes, because file access counts
3459 bytes and BEG and END count bytes. */
3460 ptrdiff_t same_at_start = BEGV_BYTE;
3461 ptrdiff_t same_at_end = ZV_BYTE;
3462 /* SAME_AT_END_CHARPOS counts characters, because
3463 restore_window_points needs the old character count. */
3464 ptrdiff_t same_at_end_charpos = ZV;
3466 if (current_buffer->base_buffer && ! NILP (visit))
3467 error ("Cannot do file visiting in an indirect buffer");
3469 if (!NILP (BVAR (current_buffer, read_only)))
3470 Fbarf_if_buffer_read_only (Qnil);
3472 val = Qnil;
3473 p = Qnil;
3474 orig_filename = Qnil;
3475 old_undo = Qnil;
3477 CHECK_STRING (filename);
3478 filename = Fexpand_file_name (filename, Qnil);
3480 /* The value Qnil means that the coding system is not yet
3481 decided. */
3482 coding_system = Qnil;
3484 /* If the file name has special constructs in it,
3485 call the corresponding file handler. */
3486 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3487 if (!NILP (handler))
3489 val = call6 (handler, Qinsert_file_contents, filename,
3490 visit, beg, end, replace);
3491 if (CONSP (val) && CONSP (XCDR (val))
3492 && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
3493 inserted = XINT (XCAR (XCDR (val)));
3494 goto handled;
3497 orig_filename = filename;
3498 filename = ENCODE_FILE (filename);
3500 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3501 if (fd < 0)
3503 save_errno = errno;
3504 if (NILP (visit))
3505 report_file_error ("Opening input file", orig_filename);
3506 mtime = time_error_value (save_errno);
3507 st.st_size = -1;
3508 if (!NILP (Vcoding_system_for_read))
3510 /* Don't let invalid values into buffer-file-coding-system. */
3511 CHECK_CODING_SYSTEM (Vcoding_system_for_read);
3512 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3514 goto notfound;
3517 fd_index = SPECPDL_INDEX ();
3518 record_unwind_protect_int (close_file_unwind, fd);
3520 /* Replacement should preserve point as it preserves markers. */
3521 if (!NILP (replace))
3523 window_markers = get_window_points_and_markers ();
3524 record_unwind_protect (restore_point_unwind,
3525 XCAR (XCAR (window_markers)));
3528 if (fstat (fd, &st) != 0)
3529 report_file_error ("Input file status", orig_filename);
3530 mtime = get_stat_mtime (&st);
3532 /* This code will need to be changed in order to work on named
3533 pipes, and it's probably just not worth it. So we should at
3534 least signal an error. */
3535 if (!S_ISREG (st.st_mode))
3537 not_regular = 1;
3539 if (! NILP (visit))
3540 goto notfound;
3542 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
3543 xsignal2 (Qfile_error,
3544 build_string ("not a regular file"), orig_filename);
3547 if (!NILP (visit))
3549 if (!NILP (beg) || !NILP (end))
3550 error ("Attempt to visit less than an entire file");
3551 if (BEG < Z && NILP (replace))
3552 error ("Cannot do file visiting in a non-empty buffer");
3555 if (!NILP (beg))
3556 beg_offset = file_offset (beg);
3557 else
3558 beg_offset = 0;
3560 if (!NILP (end))
3561 end_offset = file_offset (end);
3562 else
3564 if (not_regular)
3565 end_offset = TYPE_MAXIMUM (off_t);
3566 else
3568 end_offset = st.st_size;
3570 /* A negative size can happen on a platform that allows file
3571 sizes greater than the maximum off_t value. */
3572 if (end_offset < 0)
3573 buffer_overflow ();
3575 /* The file size returned from stat may be zero, but data
3576 may be readable nonetheless, for example when this is a
3577 file in the /proc filesystem. */
3578 if (end_offset == 0)
3579 end_offset = READ_BUF_SIZE;
3583 /* Check now whether the buffer will become too large,
3584 in the likely case where the file's length is not changing.
3585 This saves a lot of needless work before a buffer overflow. */
3586 if (! not_regular)
3588 /* The likely offset where we will stop reading. We could read
3589 more (or less), if the file grows (or shrinks) as we read it. */
3590 off_t likely_end = min (end_offset, st.st_size);
3592 if (beg_offset < likely_end)
3594 ptrdiff_t buf_bytes
3595 = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
3596 ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
3597 off_t likely_growth = likely_end - beg_offset;
3598 if (buf_growth_max < likely_growth)
3599 buffer_overflow ();
3603 /* Prevent redisplay optimizations. */
3604 current_buffer->clip_changed = true;
3606 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
3608 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
3609 setup_coding_system (coding_system, &coding);
3610 /* Ensure we set Vlast_coding_system_used. */
3611 set_coding_system = true;
3613 else if (BEG < Z)
3615 /* Decide the coding system to use for reading the file now
3616 because we can't use an optimized method for handling
3617 `coding:' tag if the current buffer is not empty. */
3618 if (!NILP (Vcoding_system_for_read))
3619 coding_system = Vcoding_system_for_read;
3620 else
3622 /* Don't try looking inside a file for a coding system
3623 specification if it is not seekable. */
3624 if (! not_regular && ! NILP (Vset_auto_coding_function))
3626 /* Find a coding system specified in the heading two
3627 lines or in the tailing several lines of the file.
3628 We assume that the 1K-byte and 3K-byte for heading
3629 and tailing respectively are sufficient for this
3630 purpose. */
3631 int nread;
3633 if (st.st_size <= (1024 * 4))
3634 nread = emacs_read_quit (fd, read_buf, 1024 * 4);
3635 else
3637 nread = emacs_read_quit (fd, read_buf, 1024);
3638 if (nread == 1024)
3640 int ntail;
3641 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3642 report_file_error ("Setting file position",
3643 orig_filename);
3644 ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
3645 nread = ntail < 0 ? ntail : nread + ntail;
3649 if (nread < 0)
3650 report_file_error ("Read error", orig_filename);
3651 else if (nread > 0)
3653 AUTO_STRING (name, " *code-converting-work*");
3654 struct buffer *prev = current_buffer;
3655 Lisp_Object workbuf;
3656 struct buffer *buf;
3658 record_unwind_current_buffer ();
3660 workbuf = Fget_buffer_create (name);
3661 buf = XBUFFER (workbuf);
3663 delete_all_overlays (buf);
3664 bset_directory (buf, BVAR (current_buffer, directory));
3665 bset_read_only (buf, Qnil);
3666 bset_filename (buf, Qnil);
3667 bset_undo_list (buf, Qt);
3668 eassert (buf->overlays_before == NULL);
3669 eassert (buf->overlays_after == NULL);
3671 set_buffer_internal (buf);
3672 Ferase_buffer ();
3673 bset_enable_multibyte_characters (buf, Qnil);
3675 insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
3676 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3677 coding_system = call2 (Vset_auto_coding_function,
3678 filename, make_number (nread));
3679 set_buffer_internal (prev);
3681 /* Discard the unwind protect for recovering the
3682 current buffer. */
3683 specpdl_ptr--;
3685 /* Rewind the file for the actual read done later. */
3686 if (lseek (fd, 0, SEEK_SET) < 0)
3687 report_file_error ("Setting file position", orig_filename);
3691 if (NILP (coding_system))
3693 /* If we have not yet decided a coding system, check
3694 file-coding-system-alist. */
3695 coding_system = CALLN (Ffind_operation_coding_system,
3696 Qinsert_file_contents, orig_filename,
3697 visit, beg, end, replace);
3698 if (CONSP (coding_system))
3699 coding_system = XCAR (coding_system);
3703 if (NILP (coding_system))
3704 coding_system = Qundecided;
3705 else
3706 CHECK_CODING_SYSTEM (coding_system);
3708 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3709 /* We must suppress all character code conversion except for
3710 end-of-line conversion. */
3711 coding_system = raw_text_coding_system (coding_system);
3713 setup_coding_system (coding_system, &coding);
3714 /* Ensure we set Vlast_coding_system_used. */
3715 set_coding_system = true;
3718 /* If requested, replace the accessible part of the buffer
3719 with the file contents. Avoid replacing text at the
3720 beginning or end of the buffer that matches the file contents;
3721 that preserves markers pointing to the unchanged parts.
3723 Here we implement this feature in an optimized way
3724 for the case where code conversion is NOT needed.
3725 The following if-statement handles the case of conversion
3726 in a less optimal way.
3728 If the code conversion is "automatic" then we try using this
3729 method and hope for the best.
3730 But if we discover the need for conversion, we give up on this method
3731 and let the following if-statement handle the replace job. */
3732 if (!NILP (replace)
3733 && BEGV < ZV
3734 && (NILP (coding_system)
3735 || ! CODING_REQUIRE_DECODING (&coding)))
3737 ptrdiff_t overlap;
3738 /* There is still a possibility we will find the need to do code
3739 conversion. If that happens, set this variable to
3740 give up on handling REPLACE in the optimized way. */
3741 bool giveup_match_end = false;
3743 if (beg_offset != 0)
3745 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3746 report_file_error ("Setting file position", orig_filename);
3749 /* Count how many chars at the start of the file
3750 match the text at the beginning of the buffer. */
3751 while (true)
3753 int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
3754 if (nread < 0)
3755 report_file_error ("Read error", orig_filename);
3756 else if (nread == 0)
3757 break;
3759 if (CODING_REQUIRE_DETECTION (&coding))
3761 coding_system = detect_coding_system ((unsigned char *) read_buf,
3762 nread, nread, 1, 0,
3763 coding_system);
3764 setup_coding_system (coding_system, &coding);
3767 if (CODING_REQUIRE_DECODING (&coding))
3768 /* We found that the file should be decoded somehow.
3769 Let's give up here. */
3771 giveup_match_end = true;
3772 break;
3775 int bufpos = 0;
3776 while (bufpos < nread && same_at_start < ZV_BYTE
3777 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3778 same_at_start++, bufpos++;
3779 /* If we found a discrepancy, stop the scan.
3780 Otherwise loop around and scan the next bufferful. */
3781 if (bufpos != nread)
3782 break;
3784 /* If the file matches the buffer completely,
3785 there's no need to replace anything. */
3786 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
3788 emacs_close (fd);
3789 clear_unwind_protect (fd_index);
3791 /* Truncate the buffer to the size of the file. */
3792 del_range_1 (same_at_start, same_at_end, 0, 0);
3793 goto handled;
3796 /* Count how many chars at the end of the file
3797 match the text at the end of the buffer. But, if we have
3798 already found that decoding is necessary, don't waste time. */
3799 while (!giveup_match_end)
3801 int total_read, nread, bufpos, trial;
3802 off_t curpos;
3804 /* At what file position are we now scanning? */
3805 curpos = end_offset - (ZV_BYTE - same_at_end);
3806 /* If the entire file matches the buffer tail, stop the scan. */
3807 if (curpos == 0)
3808 break;
3809 /* How much can we scan in the next step? */
3810 trial = min (curpos, sizeof read_buf);
3811 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
3812 report_file_error ("Setting file position", orig_filename);
3814 total_read = nread = 0;
3815 while (total_read < trial)
3817 nread = emacs_read_quit (fd, read_buf + total_read,
3818 trial - total_read);
3819 if (nread < 0)
3820 report_file_error ("Read error", orig_filename);
3821 else if (nread == 0)
3822 break;
3823 total_read += nread;
3826 /* Scan this bufferful from the end, comparing with
3827 the Emacs buffer. */
3828 bufpos = total_read;
3830 /* Compare with same_at_start to avoid counting some buffer text
3831 as matching both at the file's beginning and at the end. */
3832 while (bufpos > 0 && same_at_end > same_at_start
3833 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3834 same_at_end--, bufpos--;
3836 /* If we found a discrepancy, stop the scan.
3837 Otherwise loop around and scan the preceding bufferful. */
3838 if (bufpos != 0)
3840 /* If this discrepancy is because of code conversion,
3841 we cannot use this method; giveup and try the other. */
3842 if (same_at_end > same_at_start
3843 && FETCH_BYTE (same_at_end - 1) >= 0200
3844 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
3845 && (CODING_MAY_REQUIRE_DECODING (&coding)))
3846 giveup_match_end = true;
3847 break;
3850 if (nread == 0)
3851 break;
3854 if (! giveup_match_end)
3856 ptrdiff_t temp;
3857 ptrdiff_t this_count = SPECPDL_INDEX ();
3859 /* We win! We can handle REPLACE the optimized way. */
3861 /* Extend the start of non-matching text area to multibyte
3862 character boundary. */
3863 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3864 while (same_at_start > BEGV_BYTE
3865 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3866 same_at_start--;
3868 /* Extend the end of non-matching text area to multibyte
3869 character boundary. */
3870 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3871 while (same_at_end < ZV_BYTE
3872 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3873 same_at_end++;
3875 /* Don't try to reuse the same piece of text twice. */
3876 overlap = (same_at_start - BEGV_BYTE
3877 - (same_at_end
3878 + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
3879 if (overlap > 0)
3880 same_at_end += overlap;
3881 same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
3883 /* Arrange to read only the nonmatching middle part of the file. */
3884 beg_offset += same_at_start - BEGV_BYTE;
3885 end_offset -= ZV_BYTE - same_at_end;
3887 /* This binding is to avoid ask-user-about-supersession-threat
3888 being called in insert_from_buffer or del_range_bytes (via
3889 prepare_to_modify_buffer).
3890 AFAICT we could avoid ask-user-about-supersession-threat by setting
3891 current_buffer->modtime earlier, but we could still end up calling
3892 ask-user-about-supersession-threat if the file is modified while
3893 we read it, so we bind buffer-file-name instead. */
3894 specbind (intern ("buffer-file-name"), Qnil);
3895 del_range_byte (same_at_start, same_at_end);
3896 /* Insert from the file at the proper position. */
3897 temp = BYTE_TO_CHAR (same_at_start);
3898 SET_PT_BOTH (temp, same_at_start);
3899 unbind_to (this_count, Qnil);
3901 /* If display currently starts at beginning of line,
3902 keep it that way. */
3903 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3904 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3906 replace_handled = true;
3910 /* If requested, replace the accessible part of the buffer
3911 with the file contents. Avoid replacing text at the
3912 beginning or end of the buffer that matches the file contents;
3913 that preserves markers pointing to the unchanged parts.
3915 Here we implement this feature for the case where code conversion
3916 is needed, in a simple way that needs a lot of memory.
3917 The preceding if-statement handles the case of no conversion
3918 in a more optimized way. */
3919 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3921 ptrdiff_t same_at_start_charpos;
3922 ptrdiff_t inserted_chars;
3923 ptrdiff_t overlap;
3924 ptrdiff_t bufpos;
3925 unsigned char *decoded;
3926 ptrdiff_t temp;
3927 ptrdiff_t this = 0;
3928 ptrdiff_t this_count = SPECPDL_INDEX ();
3929 bool multibyte
3930 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3931 Lisp_Object conversion_buffer;
3933 conversion_buffer = code_conversion_save (1, multibyte);
3935 /* First read the whole file, performing code conversion into
3936 CONVERSION_BUFFER. */
3938 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3939 report_file_error ("Setting file position", orig_filename);
3941 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3942 unprocessed = 0; /* Bytes not processed in previous loop. */
3944 while (true)
3946 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3947 quitting while reading a huge file. */
3949 this = emacs_read_quit (fd, read_buf + unprocessed,
3950 READ_BUF_SIZE - unprocessed);
3951 if (this <= 0)
3952 break;
3954 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3955 BUF_Z (XBUFFER (conversion_buffer)));
3956 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3957 unprocessed + this, conversion_buffer);
3958 unprocessed = coding.carryover_bytes;
3959 if (coding.carryover_bytes > 0)
3960 memcpy (read_buf, coding.carryover, unprocessed);
3963 if (this < 0)
3964 report_file_error ("Read error", orig_filename);
3965 emacs_close (fd);
3966 clear_unwind_protect (fd_index);
3968 if (unprocessed > 0)
3970 coding.mode |= CODING_MODE_LAST_BLOCK;
3971 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3972 unprocessed, conversion_buffer);
3973 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3976 coding_system = CODING_ID_NAME (coding.id);
3977 set_coding_system = true;
3978 maybe_move_gap (XBUFFER (conversion_buffer));
3979 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
3980 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3981 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3983 /* Compare the beginning of the converted string with the buffer
3984 text. */
3986 bufpos = 0;
3987 while (bufpos < inserted && same_at_start < same_at_end
3988 && FETCH_BYTE (same_at_start) == decoded[bufpos])
3989 same_at_start++, bufpos++;
3991 /* If the file matches the head of buffer completely,
3992 there's no need to replace anything. */
3994 if (bufpos == inserted)
3996 /* Truncate the buffer to the size of the file. */
3997 if (same_at_start != same_at_end)
3999 /* See previous specbind for the reason behind this. */
4000 specbind (intern ("buffer-file-name"), Qnil);
4001 del_range_byte (same_at_start, same_at_end);
4003 inserted = 0;
4005 unbind_to (this_count, Qnil);
4006 goto handled;
4009 /* Extend the start of non-matching text area to the previous
4010 multibyte character boundary. */
4011 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4012 while (same_at_start > BEGV_BYTE
4013 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
4014 same_at_start--;
4016 /* Scan this bufferful from the end, comparing with
4017 the Emacs buffer. */
4018 bufpos = inserted;
4020 /* Compare with same_at_start to avoid counting some buffer text
4021 as matching both at the file's beginning and at the end. */
4022 while (bufpos > 0 && same_at_end > same_at_start
4023 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
4024 same_at_end--, bufpos--;
4026 /* Extend the end of non-matching text area to the next
4027 multibyte character boundary. */
4028 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4029 while (same_at_end < ZV_BYTE
4030 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
4031 same_at_end++;
4033 /* Don't try to reuse the same piece of text twice. */
4034 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
4035 if (overlap > 0)
4036 same_at_end += overlap;
4037 same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
4039 /* If display currently starts at beginning of line,
4040 keep it that way. */
4041 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
4042 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
4044 /* Replace the chars that we need to replace,
4045 and update INSERTED to equal the number of bytes
4046 we are taking from the decoded string. */
4047 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
4049 /* See previous specbind for the reason behind this. */
4050 specbind (intern ("buffer-file-name"), Qnil);
4051 if (same_at_end != same_at_start)
4053 del_range_byte (same_at_start, same_at_end);
4054 temp = GPT;
4055 eassert (same_at_start == GPT_BYTE);
4056 same_at_start = GPT_BYTE;
4058 else
4060 temp = same_at_end_charpos;
4062 /* Insert from the file at the proper position. */
4063 SET_PT_BOTH (temp, same_at_start);
4064 same_at_start_charpos
4065 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4066 same_at_start - BEGV_BYTE
4067 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
4068 eassert (same_at_start_charpos == temp - (BEGV - BEG));
4069 inserted_chars
4070 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4071 same_at_start + inserted - BEGV_BYTE
4072 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
4073 - same_at_start_charpos);
4074 insert_from_buffer (XBUFFER (conversion_buffer),
4075 same_at_start_charpos, inserted_chars, 0);
4076 /* Set `inserted' to the number of inserted characters. */
4077 inserted = PT - temp;
4078 /* Set point before the inserted characters. */
4079 SET_PT_BOTH (temp, same_at_start);
4081 unbind_to (this_count, Qnil);
4083 goto handled;
4086 if (! not_regular)
4087 total = end_offset - beg_offset;
4088 else
4089 /* For a special file, all we can do is guess. */
4090 total = READ_BUF_SIZE;
4092 if (NILP (visit) && total > 0)
4094 if (!NILP (BVAR (current_buffer, file_truename))
4095 /* Make binding buffer-file-name to nil effective. */
4096 && !NILP (BVAR (current_buffer, filename))
4097 && SAVE_MODIFF >= MODIFF)
4098 we_locked_file = true;
4099 prepare_to_modify_buffer (PT, PT, NULL);
4102 move_gap_both (PT, PT_BYTE);
4103 if (GAP_SIZE < total)
4104 make_gap (total - GAP_SIZE);
4106 if (beg_offset != 0 || !NILP (replace))
4108 if (lseek (fd, beg_offset, SEEK_SET) < 0)
4109 report_file_error ("Setting file position", orig_filename);
4112 /* In the following loop, HOW_MUCH contains the total bytes read so
4113 far for a regular file, and not changed for a special file. But,
4114 before exiting the loop, it is set to a negative value if I/O
4115 error occurs. */
4116 how_much = 0;
4118 /* Total bytes inserted. */
4119 inserted = 0;
4121 /* Here, we don't do code conversion in the loop. It is done by
4122 decode_coding_gap after all data are read into the buffer. */
4124 ptrdiff_t gap_size = GAP_SIZE;
4126 while (how_much < total)
4128 /* `try' is reserved in some compilers (Microsoft C). */
4129 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4130 ptrdiff_t this;
4132 if (not_regular)
4134 Lisp_Object nbytes;
4136 /* Maybe make more room. */
4137 if (gap_size < trytry)
4139 make_gap (trytry - gap_size);
4140 gap_size = GAP_SIZE - inserted;
4143 /* Read from the file, capturing `quit'. When an
4144 error occurs, end the loop, and arrange for a quit
4145 to be signaled after decoding the text we read. */
4146 nbytes = internal_condition_case_1
4147 (read_non_regular,
4148 make_save_int_int_int (fd, inserted, trytry),
4149 Qerror, read_non_regular_quit);
4151 if (NILP (nbytes))
4153 read_quit = true;
4154 break;
4157 this = XINT (nbytes);
4159 else
4161 /* Allow quitting out of the actual I/O. We don't make text
4162 part of the buffer until all the reading is done, so a C-g
4163 here doesn't do any harm. */
4164 this = emacs_read_quit (fd,
4165 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4166 + inserted),
4167 trytry);
4170 if (this <= 0)
4172 how_much = this;
4173 break;
4176 gap_size -= this;
4178 /* For a regular file, where TOTAL is the real size,
4179 count HOW_MUCH to compare with it.
4180 For a special file, where TOTAL is just a buffer size,
4181 so don't bother counting in HOW_MUCH.
4182 (INSERTED is where we count the number of characters inserted.) */
4183 if (! not_regular)
4184 how_much += this;
4185 inserted += this;
4189 /* Now we have either read all the file data into the gap,
4190 or stop reading on I/O error or quit. If nothing was
4191 read, undo marking the buffer modified. */
4193 if (inserted == 0)
4195 if (we_locked_file)
4196 unlock_file (BVAR (current_buffer, file_truename));
4197 Vdeactivate_mark = old_Vdeactivate_mark;
4199 else
4200 Fset (Qdeactivate_mark, Qt);
4202 emacs_close (fd);
4203 clear_unwind_protect (fd_index);
4205 if (how_much < 0)
4206 report_file_error ("Read error", orig_filename);
4208 /* Make the text read part of the buffer. */
4209 GAP_SIZE -= inserted;
4210 GPT += inserted;
4211 GPT_BYTE += inserted;
4212 ZV += inserted;
4213 ZV_BYTE += inserted;
4214 Z += inserted;
4215 Z_BYTE += inserted;
4217 if (GAP_SIZE > 0)
4218 /* Put an anchor to ensure multi-byte form ends at gap. */
4219 *GPT_ADDR = 0;
4221 notfound:
4223 if (NILP (coding_system))
4225 /* The coding system is not yet decided. Decide it by an
4226 optimized method for handling `coding:' tag.
4228 Note that we can get here only if the buffer was empty
4229 before the insertion. */
4231 if (!NILP (Vcoding_system_for_read))
4232 coding_system = Vcoding_system_for_read;
4233 else
4235 /* Since we are sure that the current buffer was empty
4236 before the insertion, we can toggle
4237 enable-multibyte-characters directly here without taking
4238 care of marker adjustment. By this way, we can run Lisp
4239 program safely before decoding the inserted text. */
4240 Lisp_Object unwind_data;
4241 ptrdiff_t count1 = SPECPDL_INDEX ();
4243 unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
4244 Fcons (BVAR (current_buffer, undo_list),
4245 Fcurrent_buffer ()));
4246 bset_enable_multibyte_characters (current_buffer, Qnil);
4247 bset_undo_list (current_buffer, Qt);
4248 record_unwind_protect (decide_coding_unwind, unwind_data);
4250 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4252 coding_system = call2 (Vset_auto_coding_function,
4253 filename, make_number (inserted));
4256 if (NILP (coding_system))
4258 /* If the coding system is not yet decided, check
4259 file-coding-system-alist. */
4260 coding_system = CALLN (Ffind_operation_coding_system,
4261 Qinsert_file_contents, orig_filename,
4262 visit, beg, end, Qnil);
4263 if (CONSP (coding_system))
4264 coding_system = XCAR (coding_system);
4266 unbind_to (count1, Qnil);
4267 inserted = Z_BYTE - BEG_BYTE;
4270 if (NILP (coding_system))
4271 coding_system = Qundecided;
4272 else
4273 CHECK_CODING_SYSTEM (coding_system);
4275 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4276 /* We must suppress all character code conversion except for
4277 end-of-line conversion. */
4278 coding_system = raw_text_coding_system (coding_system);
4279 setup_coding_system (coding_system, &coding);
4280 /* Ensure we set Vlast_coding_system_used. */
4281 set_coding_system = true;
4284 if (!NILP (visit))
4286 /* When we visit a file by raw-text, we change the buffer to
4287 unibyte. */
4288 if (CODING_FOR_UNIBYTE (&coding)
4289 /* Can't do this if part of the buffer might be preserved. */
4290 && NILP (replace))
4292 /* Visiting a file with these coding system makes the buffer
4293 unibyte. */
4294 if (inserted > 0)
4295 bset_enable_multibyte_characters (current_buffer, Qnil);
4296 else
4297 Fset_buffer_multibyte (Qnil);
4301 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
4302 if (CODING_MAY_REQUIRE_DECODING (&coding)
4303 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
4305 move_gap_both (PT, PT_BYTE);
4306 GAP_SIZE += inserted;
4307 ZV_BYTE -= inserted;
4308 Z_BYTE -= inserted;
4309 ZV -= inserted;
4310 Z -= inserted;
4311 decode_coding_gap (&coding, inserted, inserted);
4312 inserted = coding.produced_char;
4313 coding_system = CODING_ID_NAME (coding.id);
4315 else if (inserted > 0)
4317 invalidate_buffer_caches (current_buffer, PT, PT + inserted);
4318 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4319 inserted);
4322 /* Call after-change hooks for the inserted text, aside from the case
4323 of normal visiting (not with REPLACE), which is done in a new buffer
4324 "before" the buffer is changed. */
4325 if (inserted > 0 && total > 0
4326 && (NILP (visit) || !NILP (replace)))
4328 signal_after_change (PT, 0, inserted);
4329 update_compositions (PT, PT, CHECK_BORDER);
4332 /* Now INSERTED is measured in characters. */
4334 handled:
4336 if (inserted > 0)
4337 restore_window_points (window_markers, inserted,
4338 BYTE_TO_CHAR (same_at_start),
4339 same_at_end_charpos);
4341 if (!NILP (visit))
4343 if (empty_undo_list_p)
4344 bset_undo_list (current_buffer, Qnil);
4346 if (NILP (handler))
4348 current_buffer->modtime = mtime;
4349 current_buffer->modtime_size = st.st_size;
4350 bset_filename (current_buffer, orig_filename);
4353 SAVE_MODIFF = MODIFF;
4354 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4355 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4356 if (NILP (handler))
4358 if (!NILP (BVAR (current_buffer, file_truename)))
4359 unlock_file (BVAR (current_buffer, file_truename));
4360 unlock_file (filename);
4362 if (not_regular)
4363 xsignal2 (Qfile_error,
4364 build_string ("not a regular file"), orig_filename);
4367 if (set_coding_system)
4368 Vlast_coding_system_used = coding_system;
4370 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
4372 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4373 visit);
4374 if (! NILP (insval))
4376 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4377 wrong_type_argument (intern ("inserted-chars"), insval);
4378 inserted = XFASTINT (insval);
4382 /* Decode file format. */
4383 if (inserted > 0)
4385 /* Don't run point motion or modification hooks when decoding. */
4386 ptrdiff_t count1 = SPECPDL_INDEX ();
4387 ptrdiff_t old_inserted = inserted;
4388 specbind (Qinhibit_point_motion_hooks, Qt);
4389 specbind (Qinhibit_modification_hooks, Qt);
4391 /* Save old undo list and don't record undo for decoding. */
4392 old_undo = BVAR (current_buffer, undo_list);
4393 bset_undo_list (current_buffer, Qt);
4395 if (NILP (replace))
4397 insval = call3 (Qformat_decode,
4398 Qnil, make_number (inserted), visit);
4399 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4400 wrong_type_argument (intern ("inserted-chars"), insval);
4401 inserted = XFASTINT (insval);
4403 else
4405 /* If REPLACE is non-nil and we succeeded in not replacing the
4406 beginning or end of the buffer text with the file's contents,
4407 call format-decode with `point' positioned at the beginning
4408 of the buffer and `inserted' equaling the number of
4409 characters in the buffer. Otherwise, format-decode might
4410 fail to correctly analyze the beginning or end of the buffer.
4411 Hence we temporarily save `point' and `inserted' here and
4412 restore `point' iff format-decode did not insert or delete
4413 any text. Otherwise we leave `point' at point-min. */
4414 ptrdiff_t opoint = PT;
4415 ptrdiff_t opoint_byte = PT_BYTE;
4416 ptrdiff_t oinserted = ZV - BEGV;
4417 EMACS_INT ochars_modiff = CHARS_MODIFF;
4419 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4420 insval = call3 (Qformat_decode,
4421 Qnil, make_number (oinserted), visit);
4422 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4423 wrong_type_argument (intern ("inserted-chars"), insval);
4424 if (ochars_modiff == CHARS_MODIFF)
4425 /* format_decode didn't modify buffer's characters => move
4426 point back to position before inserted text and leave
4427 value of inserted alone. */
4428 SET_PT_BOTH (opoint, opoint_byte);
4429 else
4430 /* format_decode modified buffer's characters => consider
4431 entire buffer changed and leave point at point-min. */
4432 inserted = XFASTINT (insval);
4435 /* For consistency with format-decode call these now iff inserted > 0
4436 (martin 2007-06-28). */
4437 p = Vafter_insert_file_functions;
4438 while (CONSP (p))
4440 if (NILP (replace))
4442 insval = call1 (XCAR (p), make_number (inserted));
4443 if (!NILP (insval))
4445 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4446 wrong_type_argument (intern ("inserted-chars"), insval);
4447 inserted = XFASTINT (insval);
4450 else
4452 /* For the rationale of this see the comment on
4453 format-decode above. */
4454 ptrdiff_t opoint = PT;
4455 ptrdiff_t opoint_byte = PT_BYTE;
4456 ptrdiff_t oinserted = ZV - BEGV;
4457 EMACS_INT ochars_modiff = CHARS_MODIFF;
4459 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4460 insval = call1 (XCAR (p), make_number (oinserted));
4461 if (!NILP (insval))
4463 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4464 wrong_type_argument (intern ("inserted-chars"), insval);
4465 if (ochars_modiff == CHARS_MODIFF)
4466 /* after_insert_file_functions didn't modify
4467 buffer's characters => move point back to
4468 position before inserted text and leave value of
4469 inserted alone. */
4470 SET_PT_BOTH (opoint, opoint_byte);
4471 else
4472 /* after_insert_file_functions did modify buffer's
4473 characters => consider entire buffer changed and
4474 leave point at point-min. */
4475 inserted = XFASTINT (insval);
4479 maybe_quit ();
4480 p = XCDR (p);
4483 if (!empty_undo_list_p)
4485 bset_undo_list (current_buffer, old_undo);
4486 if (CONSP (old_undo) && inserted != old_inserted)
4488 /* Adjust the last undo record for the size change during
4489 the format conversion. */
4490 Lisp_Object tem = XCAR (old_undo);
4491 if (CONSP (tem) && INTEGERP (XCAR (tem))
4492 && INTEGERP (XCDR (tem))
4493 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4494 XSETCDR (tem, make_number (PT + inserted));
4497 else
4498 /* If undo_list was Qt before, keep it that way.
4499 Otherwise start with an empty undo_list. */
4500 bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
4502 unbind_to (count1, Qnil);
4505 if (!NILP (visit)
4506 && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
4508 /* If visiting nonexistent file, return nil. */
4509 report_file_errno ("Opening input file", orig_filename, save_errno);
4512 /* We made a lot of deletions and insertions above, so invalidate
4513 the newline cache for the entire region of the inserted
4514 characters. */
4515 if (current_buffer->base_buffer && current_buffer->base_buffer->newline_cache)
4516 invalidate_region_cache (current_buffer->base_buffer,
4517 current_buffer->base_buffer->newline_cache,
4518 PT - BEG, Z - PT - inserted);
4519 else if (current_buffer->newline_cache)
4520 invalidate_region_cache (current_buffer,
4521 current_buffer->newline_cache,
4522 PT - BEG, Z - PT - inserted);
4524 if (read_quit)
4525 quit ();
4527 /* Retval needs to be dealt with in all cases consistently. */
4528 if (NILP (val))
4529 val = list2 (orig_filename, make_number (inserted));
4531 return unbind_to (count, val);
4534 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
4536 static void
4537 build_annotations_unwind (Lisp_Object arg)
4539 Vwrite_region_annotation_buffers = arg;
4542 /* Decide the coding-system to encode the data with. */
4544 static Lisp_Object
4545 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4546 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4547 struct coding_system *coding)
4549 Lisp_Object val;
4550 Lisp_Object eol_parent = Qnil;
4552 if (auto_saving
4553 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4554 BVAR (current_buffer, auto_save_file_name))))
4556 val = Qutf_8_emacs;
4557 eol_parent = Qunix;
4559 else if (!NILP (Vcoding_system_for_write))
4561 val = Vcoding_system_for_write;
4562 if (coding_system_require_warning
4563 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4564 /* Confirm that VAL can surely encode the current region. */
4565 val = call5 (Vselect_safe_coding_system_function,
4566 start, end, list2 (Qt, val),
4567 Qnil, filename);
4569 else
4571 /* If the variable `buffer-file-coding-system' is set locally,
4572 it means that the file was read with some kind of code
4573 conversion or the variable is explicitly set by users. We
4574 had better write it out with the same coding system even if
4575 `enable-multibyte-characters' is nil.
4577 If it is not set locally, we anyway have to convert EOL
4578 format if the default value of `buffer-file-coding-system'
4579 tells that it is not Unix-like (LF only) format. */
4580 bool using_default_coding = 0;
4581 bool force_raw_text = 0;
4583 val = BVAR (current_buffer, buffer_file_coding_system);
4584 if (NILP (val)
4585 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4587 val = Qnil;
4588 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4589 force_raw_text = 1;
4592 if (NILP (val))
4594 /* Check file-coding-system-alist. */
4595 Lisp_Object coding_systems
4596 = CALLN (Ffind_operation_coding_system, Qwrite_region, start, end,
4597 filename, append, visit, lockname);
4598 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4599 val = XCDR (coding_systems);
4602 if (NILP (val))
4604 /* If we still have not decided a coding system, use the
4605 current buffer's value of buffer-file-coding-system. */
4606 val = BVAR (current_buffer, buffer_file_coding_system);
4607 using_default_coding = 1;
4610 if (! NILP (val) && ! force_raw_text)
4612 Lisp_Object spec, attrs;
4614 CHECK_CODING_SYSTEM (val);
4615 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4616 attrs = AREF (spec, 0);
4617 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4618 force_raw_text = 1;
4621 if (!force_raw_text
4622 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4624 /* Confirm that VAL can surely encode the current region. */
4625 val = call5 (Vselect_safe_coding_system_function,
4626 start, end, val, Qnil, filename);
4627 /* As the function specified by select-safe-coding-system-function
4628 is out of our control, make sure we are not fed by bogus
4629 values. */
4630 if (!NILP (val))
4631 CHECK_CODING_SYSTEM (val);
4634 /* If the decided coding-system doesn't specify end-of-line
4635 format, we use that of `buffer-file-coding-system'. */
4636 if (! using_default_coding)
4638 Lisp_Object dflt = BVAR (&buffer_defaults, buffer_file_coding_system);
4640 if (! NILP (dflt))
4641 val = coding_inherit_eol_type (val, dflt);
4644 /* If we decide not to encode text, use `raw-text' or one of its
4645 subsidiaries. */
4646 if (force_raw_text)
4647 val = raw_text_coding_system (val);
4650 val = coding_inherit_eol_type (val, eol_parent);
4651 setup_coding_system (val, coding);
4653 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4654 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4655 return val;
4658 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
4659 "r\nFWrite region to file: \ni\ni\ni\np",
4660 doc: /* Write current region into specified file.
4661 When called from a program, requires three arguments:
4662 START, END and FILENAME. START and END are normally buffer positions
4663 specifying the part of the buffer to write.
4664 If START is nil, that means to use the entire buffer contents; END is
4665 ignored.
4666 If START is a string, then output that string to the file
4667 instead of any buffer contents; END is ignored.
4669 Optional fourth argument APPEND if non-nil means
4670 append to existing file contents (if any). If it is a number,
4671 seek to that offset in the file before writing.
4672 Optional fifth argument VISIT, if t or a string, means
4673 set the last-save-file-modtime of buffer to this file's modtime
4674 and mark buffer not modified.
4675 If VISIT is a string, it is a second file name;
4676 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4677 VISIT is also the file name to lock and unlock for clash detection.
4678 If VISIT is neither t nor nil nor a string, or if Emacs is in batch mode,
4679 do not display the \"Wrote file\" message.
4680 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4681 use for locking and unlocking, overriding FILENAME and VISIT.
4682 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4683 for an existing file with the same name. If MUSTBENEW is `excl',
4684 that means to get an error if the file already exists; never overwrite.
4685 If MUSTBENEW is neither nil nor `excl', that means ask for
4686 confirmation before overwriting, but do go ahead and overwrite the file
4687 if the user confirms.
4689 This does code conversion according to the value of
4690 `coding-system-for-write', `buffer-file-coding-system', or
4691 `file-coding-system-alist', and sets the variable
4692 `last-coding-system-used' to the coding system actually used.
4694 This calls `write-region-annotate-functions' at the start, and
4695 `write-region-post-annotation-function' at the end. */)
4696 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
4697 Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4699 return write_region (start, end, filename, append, visit, lockname, mustbenew,
4700 -1);
4703 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4704 descriptor for FILENAME, so do not open or close FILENAME. */
4706 Lisp_Object
4707 write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4708 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4709 Lisp_Object mustbenew, int desc)
4711 int open_flags;
4712 int mode;
4713 off_t offset UNINIT;
4714 bool open_and_close_file = desc < 0;
4715 bool ok;
4716 int save_errno = 0;
4717 const char *fn;
4718 struct stat st;
4719 struct timespec modtime;
4720 ptrdiff_t count = SPECPDL_INDEX ();
4721 ptrdiff_t count1 UNINIT;
4722 Lisp_Object handler;
4723 Lisp_Object visit_file;
4724 Lisp_Object annotations;
4725 Lisp_Object encoded_filename;
4726 bool visiting = (EQ (visit, Qt) || STRINGP (visit));
4727 bool quietly = !NILP (visit);
4728 bool file_locked = 0;
4729 struct buffer *given_buffer;
4730 struct coding_system coding;
4732 if (current_buffer->base_buffer && visiting)
4733 error ("Cannot do file visiting in an indirect buffer");
4735 if (!NILP (start) && !STRINGP (start))
4736 validate_region (&start, &end);
4738 visit_file = Qnil;
4740 filename = Fexpand_file_name (filename, Qnil);
4742 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
4743 barf_or_query_if_file_exists (filename, false, "overwrite", true, true);
4745 if (STRINGP (visit))
4746 visit_file = Fexpand_file_name (visit, Qnil);
4747 else
4748 visit_file = filename;
4750 if (NILP (lockname))
4751 lockname = visit_file;
4753 annotations = Qnil;
4755 /* If the file name has special constructs in it,
4756 call the corresponding file handler. */
4757 handler = Ffind_file_name_handler (filename, Qwrite_region);
4758 /* If FILENAME has no handler, see if VISIT has one. */
4759 if (NILP (handler) && STRINGP (visit))
4760 handler = Ffind_file_name_handler (visit, Qwrite_region);
4762 if (!NILP (handler))
4764 Lisp_Object val;
4765 val = call8 (handler, Qwrite_region, start, end,
4766 filename, append, visit, lockname, mustbenew);
4768 if (visiting)
4770 SAVE_MODIFF = MODIFF;
4771 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4772 bset_filename (current_buffer, visit_file);
4775 return val;
4778 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4780 /* Special kludge to simplify auto-saving. */
4781 if (NILP (start))
4783 /* Do it later, so write-region-annotate-function can work differently
4784 if we save "the buffer" vs "a region".
4785 This is useful in tar-mode. --Stef
4786 XSETFASTINT (start, BEG);
4787 XSETFASTINT (end, Z); */
4788 Fwiden ();
4791 record_unwind_protect (build_annotations_unwind,
4792 Vwrite_region_annotation_buffers);
4793 Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
4795 given_buffer = current_buffer;
4797 if (!STRINGP (start))
4799 annotations = build_annotations (start, end);
4801 if (current_buffer != given_buffer)
4803 XSETFASTINT (start, BEGV);
4804 XSETFASTINT (end, ZV);
4808 if (NILP (start))
4810 XSETFASTINT (start, BEGV);
4811 XSETFASTINT (end, ZV);
4814 /* Decide the coding-system to encode the data with.
4815 We used to make this choice before calling build_annotations, but that
4816 leads to problems when a write-annotate-function takes care of
4817 unsavable chars (as was the case with X-Symbol). */
4818 Vlast_coding_system_used
4819 = choose_write_coding_system (start, end, filename,
4820 append, visit, lockname, &coding);
4822 if (open_and_close_file && !auto_saving)
4824 lock_file (lockname);
4825 file_locked = 1;
4828 encoded_filename = ENCODE_FILE (filename);
4829 fn = SSDATA (encoded_filename);
4830 open_flags = O_WRONLY | O_CREAT;
4831 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4832 if (NUMBERP (append))
4833 offset = file_offset (append);
4834 else if (!NILP (append))
4835 open_flags |= O_APPEND;
4836 #ifdef DOS_NT
4837 mode = S_IREAD | S_IWRITE;
4838 #else
4839 mode = auto_saving ? auto_save_mode_bits : 0666;
4840 #endif
4842 if (open_and_close_file)
4844 desc = emacs_open (fn, open_flags, mode);
4845 if (desc < 0)
4847 int open_errno = errno;
4848 if (file_locked)
4849 unlock_file (lockname);
4850 report_file_errno ("Opening output file", filename, open_errno);
4853 count1 = SPECPDL_INDEX ();
4854 record_unwind_protect_int (close_file_unwind, desc);
4857 if (NUMBERP (append))
4859 off_t ret = lseek (desc, offset, SEEK_SET);
4860 if (ret < 0)
4862 int lseek_errno = errno;
4863 if (file_locked)
4864 unlock_file (lockname);
4865 report_file_errno ("Lseek error", filename, lseek_errno);
4869 if (STRINGP (start))
4870 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
4871 else if (XINT (start) != XINT (end))
4872 ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
4873 &annotations, &coding);
4874 else
4876 /* If file was empty, still need to write the annotations. */
4877 coding.mode |= CODING_MODE_LAST_BLOCK;
4878 ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
4880 save_errno = errno;
4882 if (ok && CODING_REQUIRE_FLUSHING (&coding)
4883 && !(coding.mode & CODING_MODE_LAST_BLOCK))
4885 /* We have to flush out a data. */
4886 coding.mode |= CODING_MODE_LAST_BLOCK;
4887 ok = e_write (desc, Qnil, 1, 1, &coding);
4888 save_errno = errno;
4891 /* fsync is not crucial for temporary files. Nor for auto-save
4892 files, since they might lose some work anyway. */
4893 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
4895 /* Transfer data and metadata to disk, retrying if interrupted.
4896 fsync can report a write failure here, e.g., due to disk full
4897 under NFS. But ignore EINVAL, which means fsync is not
4898 supported on this file. */
4899 while (fsync (desc) != 0)
4900 if (errno != EINTR)
4902 if (errno != EINVAL)
4903 ok = 0, save_errno = errno;
4904 break;
4908 modtime = invalid_timespec ();
4909 if (visiting)
4911 if (fstat (desc, &st) == 0)
4912 modtime = get_stat_mtime (&st);
4913 else
4914 ok = 0, save_errno = errno;
4917 if (open_and_close_file)
4919 /* NFS can report a write failure now. */
4920 if (emacs_close (desc) < 0)
4921 ok = 0, save_errno = errno;
4923 /* Discard the unwind protect for close_file_unwind. */
4924 specpdl_ptr = specpdl + count1;
4927 /* Some file systems have a bug where st_mtime is not updated
4928 properly after a write. For example, CIFS might not see the
4929 st_mtime change until after the file is opened again.
4931 Attempt to detect this file system bug, and update MODTIME to the
4932 newer st_mtime if the bug appears to be present. This introduces
4933 a race condition, so to avoid most instances of the race condition
4934 on non-buggy file systems, skip this check if the most recently
4935 encountered non-buggy file system was the current file system.
4937 A race condition can occur if some other process modifies the
4938 file between the fstat above and the fstat below, but the race is
4939 unlikely and a similar race between the last write and the fstat
4940 above cannot possibly be closed anyway. */
4942 if (timespec_valid_p (modtime)
4943 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
4945 int desc1 = emacs_open (fn, O_WRONLY, 0);
4946 if (desc1 >= 0)
4948 struct stat st1;
4949 if (fstat (desc1, &st1) == 0
4950 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
4952 /* Use the heuristic if it appears to be valid. With neither
4953 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4954 file, the time stamp won't change. Also, some non-POSIX
4955 systems don't update an empty file's time stamp when
4956 truncating it. Finally, file systems with 100 ns or worse
4957 resolution sometimes seem to have bugs: on a system with ns
4958 resolution, checking ns % 100 incorrectly avoids the heuristic
4959 1% of the time, but the problem should be temporary as we will
4960 try again on the next time stamp. */
4961 bool use_heuristic
4962 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
4963 && st.st_size != 0
4964 && modtime.tv_nsec % 100 != 0);
4966 struct timespec modtime1 = get_stat_mtime (&st1);
4967 if (use_heuristic
4968 && timespec_cmp (modtime, modtime1) == 0
4969 && st.st_size == st1.st_size)
4971 timestamp_file_system = st.st_dev;
4972 valid_timestamp_file_system = 1;
4974 else
4976 st.st_size = st1.st_size;
4977 modtime = modtime1;
4980 emacs_close (desc1);
4984 /* Call write-region-post-annotation-function. */
4985 while (CONSP (Vwrite_region_annotation_buffers))
4987 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
4988 if (!NILP (Fbuffer_live_p (buf)))
4990 Fset_buffer (buf);
4991 if (FUNCTIONP (Vwrite_region_post_annotation_function))
4992 call0 (Vwrite_region_post_annotation_function);
4994 Vwrite_region_annotation_buffers
4995 = XCDR (Vwrite_region_annotation_buffers);
4998 unbind_to (count, Qnil);
5000 if (file_locked)
5001 unlock_file (lockname);
5003 /* Do this before reporting IO error
5004 to avoid a "file has changed on disk" warning on
5005 next attempt to save. */
5006 if (timespec_valid_p (modtime))
5008 current_buffer->modtime = modtime;
5009 current_buffer->modtime_size = st.st_size;
5012 if (! ok)
5013 report_file_errno ("Write error", filename, save_errno);
5015 bool auto_saving_into_visited_file =
5016 auto_saving
5017 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5018 BVAR (current_buffer, auto_save_file_name)));
5019 if (visiting)
5021 SAVE_MODIFF = MODIFF;
5022 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5023 bset_filename (current_buffer, visit_file);
5024 update_mode_lines = 14;
5025 if (auto_saving_into_visited_file)
5026 unlock_file (lockname);
5028 else if (quietly)
5030 if (auto_saving_into_visited_file)
5032 SAVE_MODIFF = MODIFF;
5033 unlock_file (lockname);
5036 return Qnil;
5039 if (!auto_saving && !noninteractive)
5040 message_with_string ((NUMBERP (append)
5041 ? "Updated %s"
5042 : ! NILP (append)
5043 ? "Added to %s"
5044 : "Wrote %s"),
5045 visit_file, 1);
5047 return Qnil;
5050 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
5051 doc: /* Return t if (car A) is numerically less than (car B). */)
5052 (Lisp_Object a, Lisp_Object b)
5054 return arithcompare (Fcar (a), Fcar (b), ARITH_LESS);
5057 /* Build the complete list of annotations appropriate for writing out
5058 the text between START and END, by calling all the functions in
5059 write-region-annotate-functions and merging the lists they return.
5060 If one of these functions switches to a different buffer, we assume
5061 that buffer contains altered text. Therefore, the caller must
5062 make sure to restore the current buffer in all cases,
5063 as save-excursion would do. */
5065 static Lisp_Object
5066 build_annotations (Lisp_Object start, Lisp_Object end)
5068 Lisp_Object annotations;
5069 Lisp_Object p, res;
5070 Lisp_Object original_buffer;
5071 int i;
5072 bool used_global = false;
5074 XSETBUFFER (original_buffer, current_buffer);
5076 annotations = Qnil;
5077 p = Vwrite_region_annotate_functions;
5078 while (CONSP (p))
5080 struct buffer *given_buffer = current_buffer;
5081 if (EQ (Qt, XCAR (p)) && !used_global)
5082 { /* Use the global value of the hook. */
5083 used_global = true;
5084 p = CALLN (Fappend,
5085 Fdefault_value (Qwrite_region_annotate_functions),
5086 XCDR (p));
5087 continue;
5089 Vwrite_region_annotations_so_far = annotations;
5090 res = call2 (XCAR (p), start, end);
5091 /* If the function makes a different buffer current,
5092 assume that means this buffer contains altered text to be output.
5093 Reset START and END from the buffer bounds
5094 and discard all previous annotations because they should have
5095 been dealt with by this function. */
5096 if (current_buffer != given_buffer)
5098 Vwrite_region_annotation_buffers
5099 = Fcons (Fcurrent_buffer (),
5100 Vwrite_region_annotation_buffers);
5101 XSETFASTINT (start, BEGV);
5102 XSETFASTINT (end, ZV);
5103 annotations = Qnil;
5105 Flength (res); /* Check basic validity of return value */
5106 annotations = merge (annotations, res, Qcar_less_than_car);
5107 p = XCDR (p);
5110 /* Now do the same for annotation functions implied by the file-format */
5111 if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
5112 p = BVAR (current_buffer, auto_save_file_format);
5113 else
5114 p = BVAR (current_buffer, file_format);
5115 for (i = 0; CONSP (p); p = XCDR (p), ++i)
5117 struct buffer *given_buffer = current_buffer;
5119 Vwrite_region_annotations_so_far = annotations;
5121 /* Value is either a list of annotations or nil if the function
5122 has written annotations to a temporary buffer, which is now
5123 current. */
5124 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
5125 original_buffer, make_number (i));
5126 if (current_buffer != given_buffer)
5128 XSETFASTINT (start, BEGV);
5129 XSETFASTINT (end, ZV);
5130 annotations = Qnil;
5133 if (CONSP (res))
5134 annotations = merge (annotations, res, Qcar_less_than_car);
5137 return annotations;
5141 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5142 If STRING is nil, POS is the character position in the current buffer.
5143 Intersperse with them the annotations from *ANNOT
5144 which fall within the range of POS to POS + NCHARS,
5145 each at its appropriate position.
5147 We modify *ANNOT by discarding elements as we use them up.
5149 Return true if successful. */
5151 static bool
5152 a_write (int desc, Lisp_Object string, ptrdiff_t pos,
5153 ptrdiff_t nchars, Lisp_Object *annot,
5154 struct coding_system *coding)
5156 Lisp_Object tem;
5157 ptrdiff_t nextpos;
5158 ptrdiff_t lastpos = pos + nchars;
5160 while (NILP (*annot) || CONSP (*annot))
5162 tem = Fcar_safe (Fcar (*annot));
5163 nextpos = pos - 1;
5164 if (INTEGERP (tem))
5165 nextpos = XFASTINT (tem);
5167 /* If there are no more annotations in this range,
5168 output the rest of the range all at once. */
5169 if (! (nextpos >= pos && nextpos <= lastpos))
5170 return e_write (desc, string, pos, lastpos, coding);
5172 /* Output buffer text up to the next annotation's position. */
5173 if (nextpos > pos)
5175 if (!e_write (desc, string, pos, nextpos, coding))
5176 return 0;
5177 pos = nextpos;
5179 /* Output the annotation. */
5180 tem = Fcdr (Fcar (*annot));
5181 if (STRINGP (tem))
5183 if (!e_write (desc, tem, 0, SCHARS (tem), coding))
5184 return 0;
5186 *annot = Fcdr (*annot);
5188 return 1;
5191 /* Maximum number of characters that the next
5192 function encodes per one loop iteration. */
5194 enum { E_WRITE_MAX = 8 * 1024 * 1024 };
5196 /* Write text in the range START and END into descriptor DESC,
5197 encoding them with coding system CODING. If STRING is nil, START
5198 and END are character positions of the current buffer, else they
5199 are indexes to the string STRING. Return true if successful. */
5201 static bool
5202 e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5203 struct coding_system *coding)
5205 if (STRINGP (string))
5207 start = 0;
5208 end = SCHARS (string);
5211 /* We used to have a code for handling selective display here. But,
5212 now it is handled within encode_coding. */
5214 while (start < end)
5216 if (STRINGP (string))
5218 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5219 if (CODING_REQUIRE_ENCODING (coding))
5221 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5223 /* Avoid creating huge Lisp string in encode_coding_object. */
5224 if (nchars == E_WRITE_MAX)
5225 coding->raw_destination = 1;
5227 encode_coding_object
5228 (coding, string, start, string_char_to_byte (string, start),
5229 start + nchars, string_char_to_byte (string, start + nchars),
5230 Qt);
5232 else
5234 coding->dst_object = string;
5235 coding->consumed_char = SCHARS (string);
5236 coding->produced = SBYTES (string);
5239 else
5241 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
5242 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
5244 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5245 if (CODING_REQUIRE_ENCODING (coding))
5247 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5249 /* Likewise. */
5250 if (nchars == E_WRITE_MAX)
5251 coding->raw_destination = 1;
5253 encode_coding_object
5254 (coding, Fcurrent_buffer (), start, start_byte,
5255 start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
5257 else
5259 coding->dst_object = Qnil;
5260 coding->dst_pos_byte = start_byte;
5261 if (start >= GPT || end <= GPT)
5263 coding->consumed_char = end - start;
5264 coding->produced = end_byte - start_byte;
5266 else
5268 coding->consumed_char = GPT - start;
5269 coding->produced = GPT_BYTE - start_byte;
5274 if (coding->produced > 0)
5276 char *buf = (coding->raw_destination ? (char *) coding->destination
5277 : (STRINGP (coding->dst_object)
5278 ? SSDATA (coding->dst_object)
5279 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5280 coding->produced -= emacs_write_quit (desc, buf, coding->produced);
5282 if (coding->raw_destination)
5284 /* We're responsible for freeing this, see
5285 encode_coding_object to check why. */
5286 xfree (coding->destination);
5287 coding->raw_destination = 0;
5289 if (coding->produced)
5290 return 0;
5292 start += coding->consumed_char;
5295 return 1;
5298 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5299 Sverify_visited_file_modtime, 0, 1, 0,
5300 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
5301 This means that the file has not been changed since it was visited or saved.
5302 If BUF is omitted or nil, it defaults to the current buffer.
5303 See Info node `(elisp)Modification Time' for more details. */)
5304 (Lisp_Object buf)
5306 struct buffer *b = decode_buffer (buf);
5307 struct stat st;
5308 Lisp_Object handler;
5309 Lisp_Object filename;
5310 struct timespec mtime;
5312 if (!STRINGP (BVAR (b, filename))) return Qt;
5313 if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
5315 /* If the file name has special constructs in it,
5316 call the corresponding file handler. */
5317 handler = Ffind_file_name_handler (BVAR (b, filename),
5318 Qverify_visited_file_modtime);
5319 if (!NILP (handler))
5320 return call2 (handler, Qverify_visited_file_modtime, buf);
5322 filename = ENCODE_FILE (BVAR (b, filename));
5324 mtime = (stat (SSDATA (filename), &st) == 0
5325 ? get_stat_mtime (&st)
5326 : time_error_value (errno));
5327 if (timespec_cmp (mtime, b->modtime) == 0
5328 && (b->modtime_size < 0
5329 || st.st_size == b->modtime_size))
5330 return Qt;
5331 return Qnil;
5334 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
5335 Svisited_file_modtime, 0, 0, 0,
5336 doc: /* Return the current buffer's recorded visited file modification time.
5337 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5338 `file-attributes' returns. If the current buffer has no recorded file
5339 modification time, this function returns 0. If the visited file
5340 doesn't exist, return -1.
5341 See Info node `(elisp)Modification Time' for more details. */)
5342 (void)
5344 int ns = current_buffer->modtime.tv_nsec;
5345 if (ns < 0)
5346 return make_number (UNKNOWN_MODTIME_NSECS - ns);
5347 return make_lisp_time (current_buffer->modtime);
5350 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5351 Sset_visited_file_modtime, 0, 1, 0,
5352 doc: /* Update buffer's recorded modification time from the visited file's time.
5353 Useful if the buffer was not read from the file normally
5354 or if the file itself has been changed for some known benign reason.
5355 An argument specifies the modification time value to use
5356 \(instead of that of the visited file), in the form of a list
5357 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5358 `visited-file-modtime'. */)
5359 (Lisp_Object time_flag)
5361 if (!NILP (time_flag))
5363 struct timespec mtime;
5364 if (INTEGERP (time_flag))
5366 CHECK_RANGED_INTEGER (time_flag, -1, 0);
5367 mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
5369 else
5370 mtime = lisp_time_argument (time_flag);
5372 current_buffer->modtime = mtime;
5373 current_buffer->modtime_size = -1;
5375 else
5377 register Lisp_Object filename;
5378 struct stat st;
5379 Lisp_Object handler;
5381 filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
5383 /* If the file name has special constructs in it,
5384 call the corresponding file handler. */
5385 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5386 if (!NILP (handler))
5387 /* The handler can find the file name the same way we did. */
5388 return call2 (handler, Qset_visited_file_modtime, Qnil);
5390 filename = ENCODE_FILE (filename);
5392 if (stat (SSDATA (filename), &st) >= 0)
5394 current_buffer->modtime = get_stat_mtime (&st);
5395 current_buffer->modtime_size = st.st_size;
5399 return Qnil;
5402 static Lisp_Object
5403 auto_save_error (Lisp_Object error_val)
5405 auto_save_error_occurred = 1;
5407 ring_bell (XFRAME (selected_frame));
5409 AUTO_STRING (format, "Auto-saving %s: %s");
5410 Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name),
5411 Ferror_message_string (error_val));
5412 call3 (intern ("display-warning"),
5413 intern ("auto-save"), msg, intern ("error"));
5415 return Qnil;
5418 static Lisp_Object
5419 auto_save_1 (void)
5421 struct stat st;
5422 Lisp_Object modes;
5424 auto_save_mode_bits = 0666;
5426 /* Get visited file's mode to become the auto save file's mode. */
5427 if (! NILP (BVAR (current_buffer, filename)))
5429 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
5430 /* But make sure we can overwrite it later! */
5431 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
5432 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5433 INTEGERP (modes))
5434 /* Remote files don't cooperate with stat. */
5435 auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
5438 return
5439 Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
5440 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5441 Qnil, Qnil);
5444 struct auto_save_unwind
5446 FILE *stream;
5447 bool auto_raise;
5450 static void
5451 do_auto_save_unwind (void *arg)
5453 struct auto_save_unwind *p = arg;
5454 FILE *stream = p->stream;
5455 minibuffer_auto_raise = p->auto_raise;
5456 auto_saving = 0;
5457 if (stream != NULL)
5459 block_input ();
5460 fclose (stream);
5461 unblock_input ();
5465 static Lisp_Object
5466 do_auto_save_make_dir (Lisp_Object dir)
5468 Lisp_Object result;
5470 auto_saving_dir_umask = 077;
5471 result = call2 (Qmake_directory, dir, Qt);
5472 auto_saving_dir_umask = 0;
5473 return result;
5476 static Lisp_Object
5477 do_auto_save_eh (Lisp_Object ignore)
5479 auto_saving_dir_umask = 0;
5480 return Qnil;
5483 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5484 doc: /* Auto-save all buffers that need it.
5485 This is all buffers that have auto-saving enabled
5486 and are changed since last auto-saved.
5487 Auto-saving writes the buffer into a file
5488 so that your editing is not lost if the system crashes.
5489 This file is not the file you visited; that changes only when you save.
5490 Normally, run the normal hook `auto-save-hook' before saving.
5492 A non-nil NO-MESSAGE argument means do not print any message if successful.
5493 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5494 (Lisp_Object no_message, Lisp_Object current_only)
5496 struct buffer *old = current_buffer, *b;
5497 Lisp_Object tail, buf, hook;
5498 bool auto_saved = 0;
5499 int do_handled_files;
5500 Lisp_Object oquit;
5501 FILE *stream = NULL;
5502 ptrdiff_t count = SPECPDL_INDEX ();
5503 bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
5504 bool old_message_p = 0;
5505 struct auto_save_unwind auto_save_unwind;
5507 if (max_specpdl_size < specpdl_size + 40)
5508 max_specpdl_size = specpdl_size + 40;
5510 if (minibuf_level)
5511 no_message = Qt;
5513 if (NILP (no_message))
5515 old_message_p = push_message ();
5516 record_unwind_protect_void (pop_message_unwind);
5519 /* Ordinarily don't quit within this function,
5520 but don't make it impossible to quit (in case we get hung in I/O). */
5521 oquit = Vquit_flag;
5522 Vquit_flag = Qnil;
5524 hook = intern ("auto-save-hook");
5525 safe_run_hooks (hook);
5527 if (STRINGP (Vauto_save_list_file_name))
5529 Lisp_Object listfile;
5531 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5533 /* Don't try to create the directory when shutting down Emacs,
5534 because creating the directory might signal an error, and
5535 that would leave Emacs in a strange state. */
5536 if (!NILP (Vrun_hooks))
5538 Lisp_Object dir;
5539 dir = Ffile_name_directory (listfile);
5540 if (NILP (Ffile_directory_p (dir)))
5541 internal_condition_case_1 (do_auto_save_make_dir,
5542 dir, Qt,
5543 do_auto_save_eh);
5546 stream = emacs_fopen (SSDATA (listfile), "w");
5549 auto_save_unwind.stream = stream;
5550 auto_save_unwind.auto_raise = minibuffer_auto_raise;
5551 record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
5552 minibuffer_auto_raise = 0;
5553 auto_saving = 1;
5554 auto_save_error_occurred = 0;
5556 /* On first pass, save all files that don't have handlers.
5557 On second pass, save all files that do have handlers.
5559 If Emacs is crashing, the handlers may tweak what is causing
5560 Emacs to crash in the first place, and it would be a shame if
5561 Emacs failed to autosave perfectly ordinary files because it
5562 couldn't handle some ange-ftp'd file. */
5564 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
5565 FOR_EACH_LIVE_BUFFER (tail, buf)
5567 b = XBUFFER (buf);
5569 /* Record all the buffers that have auto save mode
5570 in the special file that lists them. For each of these buffers,
5571 Record visited name (if any) and auto save name. */
5572 if (STRINGP (BVAR (b, auto_save_file_name))
5573 && stream != NULL && do_handled_files == 0)
5575 block_input ();
5576 if (!NILP (BVAR (b, filename)))
5577 fwrite_unlocked (SDATA (BVAR (b, filename)), 1,
5578 SBYTES (BVAR (b, filename)), stream);
5579 putc_unlocked ('\n', stream);
5580 fwrite_unlocked (SDATA (BVAR (b, auto_save_file_name)), 1,
5581 SBYTES (BVAR (b, auto_save_file_name)), stream);
5582 putc_unlocked ('\n', stream);
5583 unblock_input ();
5586 if (!NILP (current_only)
5587 && b != current_buffer)
5588 continue;
5590 /* Don't auto-save indirect buffers.
5591 The base buffer takes care of it. */
5592 if (b->base_buffer)
5593 continue;
5595 /* Check for auto save enabled
5596 and file changed since last auto save
5597 and file changed since last real save. */
5598 if (STRINGP (BVAR (b, auto_save_file_name))
5599 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
5600 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
5601 /* -1 means we've turned off autosaving for a while--see below. */
5602 && XINT (BVAR (b, save_length)) >= 0
5603 && (do_handled_files
5604 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
5605 Qwrite_region))))
5607 struct timespec before_time = current_timespec ();
5608 struct timespec after_time;
5610 /* If we had a failure, don't try again for 20 minutes. */
5611 if (b->auto_save_failure_time > 0
5612 && before_time.tv_sec - b->auto_save_failure_time < 1200)
5613 continue;
5615 set_buffer_internal (b);
5616 if (NILP (Vauto_save_include_big_deletions)
5617 && (XFASTINT (BVAR (b, save_length)) * 10
5618 > (BUF_Z (b) - BUF_BEG (b)) * 13)
5619 /* A short file is likely to change a large fraction;
5620 spare the user annoying messages. */
5621 && XFASTINT (BVAR (b, save_length)) > 5000
5622 /* These messages are frequent and annoying for `*mail*'. */
5623 && !EQ (BVAR (b, filename), Qnil)
5624 && NILP (no_message))
5626 /* It has shrunk too much; turn off auto-saving here. */
5627 minibuffer_auto_raise = orig_minibuffer_auto_raise;
5628 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5629 BVAR (b, name), 1);
5630 minibuffer_auto_raise = 0;
5631 /* Turn off auto-saving until there's a real save,
5632 and prevent any more warnings. */
5633 XSETINT (BVAR (b, save_length), -1);
5634 Fsleep_for (make_number (1), Qnil);
5635 continue;
5637 if (!auto_saved && NILP (no_message))
5638 message1 ("Auto-saving...");
5639 internal_condition_case (auto_save_1, Qt, auto_save_error);
5640 auto_saved = 1;
5641 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
5642 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5643 set_buffer_internal (old);
5645 after_time = current_timespec ();
5647 /* If auto-save took more than 60 seconds,
5648 assume it was an NFS failure that got a timeout. */
5649 if (after_time.tv_sec - before_time.tv_sec > 60)
5650 b->auto_save_failure_time = after_time.tv_sec;
5654 /* Prevent another auto save till enough input events come in. */
5655 record_auto_save ();
5657 if (auto_saved && NILP (no_message))
5659 if (old_message_p)
5661 /* If we are going to restore an old message,
5662 give time to read ours. */
5663 sit_for (make_number (1), 0, 0);
5664 restore_message ();
5666 else if (!auto_save_error_occurred)
5667 /* Don't overwrite the error message if an error occurred.
5668 If we displayed a message and then restored a state
5669 with no message, leave a "done" message on the screen. */
5670 message1 ("Auto-saving...done");
5673 Vquit_flag = oquit;
5675 /* This restores the message-stack status. */
5676 unbind_to (count, Qnil);
5677 return Qnil;
5680 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5681 Sset_buffer_auto_saved, 0, 0, 0,
5682 doc: /* Mark current buffer as auto-saved with its current text.
5683 No auto-save file will be written until the buffer changes again. */)
5684 (void)
5686 /* FIXME: This should not be called in indirect buffers, since
5687 they're not autosaved. */
5688 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
5689 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5690 current_buffer->auto_save_failure_time = 0;
5691 return Qnil;
5694 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
5695 Sclear_buffer_auto_save_failure, 0, 0, 0,
5696 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5697 (void)
5699 current_buffer->auto_save_failure_time = 0;
5700 return Qnil;
5703 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5704 0, 0, 0,
5705 doc: /* Return t if current buffer has been auto-saved recently.
5706 More precisely, if it has been auto-saved since last read from or saved
5707 in the visited file. If the buffer has no visited file,
5708 then any auto-save counts as "recent". */)
5709 (void)
5711 /* FIXME: maybe we should return nil for indirect buffers since
5712 they're never autosaved. */
5713 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5716 /* Reading and completing file names. */
5718 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5719 Snext_read_file_uses_dialog_p, 0, 0, 0,
5720 doc: /* Return t if a call to `read-file-name' will use a dialog.
5721 The return value is only relevant for a call to `read-file-name' that happens
5722 before any other event (mouse or keypress) is handled. */)
5723 (void)
5725 #if (defined USE_GTK || defined USE_MOTIF \
5726 || defined HAVE_NS || defined HAVE_NTGUI)
5727 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5728 && use_dialog_box
5729 && use_file_dialog
5730 && window_system_available (SELECTED_FRAME ()))
5731 return Qt;
5732 #endif
5733 return Qnil;
5737 DEFUN ("set-binary-mode", Fset_binary_mode, Sset_binary_mode, 2, 2, 0,
5738 doc: /* Switch STREAM to binary I/O mode or text I/O mode.
5739 STREAM can be one of the symbols `stdin', `stdout', or `stderr'.
5740 If MODE is non-nil, switch STREAM to binary mode, otherwise switch
5741 it to text mode.
5743 As a side effect, this function flushes any pending STREAM's data.
5745 Value is the previous value of STREAM's I/O mode, nil for text mode,
5746 non-nil for binary mode.
5748 On MS-Windows and MS-DOS, binary mode is needed to read or write
5749 arbitrary binary data, and for disabling translation between CR-LF
5750 pairs and a single newline character. Examples include generation
5751 of text files with Unix-style end-of-line format using `princ' in
5752 batch mode, with standard output redirected to a file.
5754 On Posix systems, this function always returns non-nil, and has no
5755 effect except for flushing STREAM's data. */)
5756 (Lisp_Object stream, Lisp_Object mode)
5758 FILE *fp = NULL;
5759 int binmode;
5761 CHECK_SYMBOL (stream);
5762 if (EQ (stream, Qstdin))
5763 fp = stdin;
5764 else if (EQ (stream, Qstdout))
5765 fp = stdout;
5766 else if (EQ (stream, Qstderr))
5767 fp = stderr;
5768 else
5769 xsignal2 (Qerror, build_string ("unsupported stream"), stream);
5771 binmode = NILP (mode) ? O_TEXT : O_BINARY;
5772 if (fp != stdin)
5773 fflush_unlocked (fp);
5775 return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
5778 void
5779 init_fileio (void)
5781 realmask = umask (0);
5782 umask (realmask);
5784 valid_timestamp_file_system = 0;
5786 /* fsync can be a significant performance hit. Often it doesn't
5787 suffice to make the file-save operation survive a crash. For
5788 batch scripts, which are typically part of larger shell commands
5789 that don't fsync other files, its effect on performance can be
5790 significant so its utility is particularly questionable.
5791 Hence, for now by default fsync is used only when interactive.
5793 For more on why fsync often fails to work on today's hardware, see:
5794 Zheng M et al. Understanding the robustness of SSDs under power fault.
5795 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5796 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5798 For more on why fsync does not suffice even if it works properly, see:
5799 Roche X. Necessary step(s) to synchronize filename operations on disk.
5800 Austin Group Defect 672, 2013-03-19
5801 http://austingroupbugs.net/view.php?id=672 */
5802 write_region_inhibit_fsync = noninteractive;
5805 void
5806 syms_of_fileio (void)
5808 /* Property name of a file name handler,
5809 which gives a list of operations it handles. */
5810 DEFSYM (Qoperations, "operations");
5812 DEFSYM (Qexpand_file_name, "expand-file-name");
5813 DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
5814 DEFSYM (Qdirectory_file_name, "directory-file-name");
5815 DEFSYM (Qfile_name_directory, "file-name-directory");
5816 DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
5817 DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
5818 DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
5819 DEFSYM (Qcopy_file, "copy-file");
5820 DEFSYM (Qmake_directory_internal, "make-directory-internal");
5821 DEFSYM (Qmake_directory, "make-directory");
5822 DEFSYM (Qdelete_file, "delete-file");
5823 DEFSYM (Qfile_name_case_insensitive_p, "file-name-case-insensitive-p");
5824 DEFSYM (Qrename_file, "rename-file");
5825 DEFSYM (Qadd_name_to_file, "add-name-to-file");
5826 DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
5827 DEFSYM (Qfile_exists_p, "file-exists-p");
5828 DEFSYM (Qfile_executable_p, "file-executable-p");
5829 DEFSYM (Qfile_readable_p, "file-readable-p");
5830 DEFSYM (Qfile_writable_p, "file-writable-p");
5831 DEFSYM (Qfile_symlink_p, "file-symlink-p");
5832 DEFSYM (Qaccess_file, "access-file");
5833 DEFSYM (Qfile_directory_p, "file-directory-p");
5834 DEFSYM (Qfile_regular_p, "file-regular-p");
5835 DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
5836 DEFSYM (Qfile_modes, "file-modes");
5837 DEFSYM (Qset_file_modes, "set-file-modes");
5838 DEFSYM (Qset_file_times, "set-file-times");
5839 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5840 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
5841 DEFSYM (Qfile_acl, "file-acl");
5842 DEFSYM (Qset_file_acl, "set-file-acl");
5843 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5844 DEFSYM (Qinsert_file_contents, "insert-file-contents");
5845 DEFSYM (Qwrite_region, "write-region");
5846 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5847 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
5849 /* The symbol bound to coding-system-for-read when
5850 insert-file-contents is called for recovering a file. This is not
5851 an actual coding system name, but just an indicator to tell
5852 insert-file-contents to use `emacs-mule' with a special flag for
5853 auto saving and recovering a file. */
5854 DEFSYM (Qauto_save_coding, "auto-save-coding");
5856 DEFSYM (Qfile_name_history, "file-name-history");
5857 Fset (Qfile_name_history, Qnil);
5859 DEFSYM (Qfile_error, "file-error");
5860 DEFSYM (Qfile_already_exists, "file-already-exists");
5861 DEFSYM (Qfile_date_error, "file-date-error");
5862 DEFSYM (Qfile_missing, "file-missing");
5863 DEFSYM (Qfile_notify_error, "file-notify-error");
5864 DEFSYM (Qexcl, "excl");
5866 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
5867 doc: /* Coding system for encoding file names.
5868 If it is nil, `default-file-name-coding-system' (which see) is used.
5870 On MS-Windows, the value of this variable is largely ignored if
5871 `w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5872 behaves as if file names were encoded in `utf-8'. */);
5873 Vfile_name_coding_system = Qnil;
5875 DEFVAR_LISP ("default-file-name-coding-system",
5876 Vdefault_file_name_coding_system,
5877 doc: /* Default coding system for encoding file names.
5878 This variable is used only when `file-name-coding-system' is nil.
5880 This variable is set/changed by the command `set-language-environment'.
5881 User should not set this variable manually,
5882 instead use `file-name-coding-system' to get a constant encoding
5883 of file names regardless of the current language environment.
5885 On MS-Windows, the value of this variable is largely ignored if
5886 `w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5887 behaves as if file names were encoded in `utf-8'. */);
5888 Vdefault_file_name_coding_system = Qnil;
5890 /* Lisp functions for translating file formats. */
5891 DEFSYM (Qformat_decode, "format-decode");
5892 DEFSYM (Qformat_annotate_function, "format-annotate-function");
5894 /* Lisp function for setting buffer-file-coding-system and the
5895 multibyteness of the current buffer after inserting a file. */
5896 DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
5898 DEFSYM (Qcar_less_than_car, "car-less-than-car");
5900 Fput (Qfile_error, Qerror_conditions,
5901 Fpurecopy (list2 (Qfile_error, Qerror)));
5902 Fput (Qfile_error, Qerror_message,
5903 build_pure_c_string ("File error"));
5905 Fput (Qfile_already_exists, Qerror_conditions,
5906 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
5907 Fput (Qfile_already_exists, Qerror_message,
5908 build_pure_c_string ("File already exists"));
5910 Fput (Qfile_date_error, Qerror_conditions,
5911 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
5912 Fput (Qfile_date_error, Qerror_message,
5913 build_pure_c_string ("Cannot set file date"));
5915 Fput (Qfile_missing, Qerror_conditions,
5916 Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
5917 Fput (Qfile_missing, Qerror_message,
5918 build_pure_c_string ("File is missing"));
5920 Fput (Qfile_notify_error, Qerror_conditions,
5921 Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
5922 Fput (Qfile_notify_error, Qerror_message,
5923 build_pure_c_string ("File notification error"));
5925 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
5926 doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5927 If a file name matches REGEXP, all I/O on that file is done by calling
5928 HANDLER. If a file name matches more than one handler, the handler
5929 whose match starts last in the file name gets precedence. The
5930 function `find-file-name-handler' checks this list for a handler for
5931 its argument.
5933 HANDLER should be a function. The first argument given to it is the
5934 name of the I/O primitive to be handled; the remaining arguments are
5935 the arguments that were passed to that primitive. For example, if you
5936 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5937 HANDLER is called like this:
5939 (funcall HANDLER \\='file-exists-p FILENAME)
5941 Note that HANDLER must be able to handle all I/O primitives; if it has
5942 nothing special to do for a primitive, it should reinvoke the
5943 primitive to handle the operation \"the usual way\".
5944 See Info node `(elisp)Magic File Names' for more details. */);
5945 Vfile_name_handler_alist = Qnil;
5947 DEFVAR_LISP ("set-auto-coding-function",
5948 Vset_auto_coding_function,
5949 doc: /* If non-nil, a function to call to decide a coding system of file.
5950 Two arguments are passed to this function: the file name
5951 and the length of a file contents following the point.
5952 This function should return a coding system to decode the file contents.
5953 It should check the file name against `auto-coding-alist'.
5954 If no coding system is decided, it should check a coding system
5955 specified in the heading lines with the format:
5956 -*- ... coding: CODING-SYSTEM; ... -*-
5957 or local variable spec of the tailing lines with `coding:' tag. */);
5958 Vset_auto_coding_function = Qnil;
5960 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
5961 doc: /* A list of functions to be called at the end of `insert-file-contents'.
5962 Each is passed one argument, the number of characters inserted,
5963 with point at the start of the inserted text. Each function
5964 should leave point the same, and return the new character count.
5965 If `insert-file-contents' is intercepted by a handler from
5966 `file-name-handler-alist', that handler is responsible for calling the
5967 functions in `after-insert-file-functions' if appropriate. */);
5968 Vafter_insert_file_functions = Qnil;
5970 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
5971 doc: /* A list of functions to be called at the start of `write-region'.
5972 Each is passed two arguments, START and END as for `write-region'.
5973 These are usually two numbers but not always; see the documentation
5974 for `write-region'. The function should return a list of pairs
5975 of the form (POSITION . STRING), consisting of strings to be effectively
5976 inserted at the specified positions of the file being written (1 means to
5977 insert before the first byte written). The POSITIONs must be sorted into
5978 increasing order.
5980 If there are several annotation functions, the lists returned by these
5981 functions are merged destructively. As each annotation function runs,
5982 the variable `write-region-annotations-so-far' contains a list of all
5983 annotations returned by previous annotation functions.
5985 An annotation function can return with a different buffer current.
5986 Doing so removes the annotations returned by previous functions, and
5987 resets START and END to `point-min' and `point-max' of the new buffer.
5989 After `write-region' completes, Emacs calls the function stored in
5990 `write-region-post-annotation-function', once for each buffer that was
5991 current when building the annotations (i.e., at least once), with that
5992 buffer current. */);
5993 Vwrite_region_annotate_functions = Qnil;
5994 DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
5996 DEFVAR_LISP ("write-region-post-annotation-function",
5997 Vwrite_region_post_annotation_function,
5998 doc: /* Function to call after `write-region' completes.
5999 The function is called with no arguments. If one or more of the
6000 annotation functions in `write-region-annotate-functions' changed the
6001 current buffer, the function stored in this variable is called for
6002 each of those additional buffers as well, in addition to the original
6003 buffer. The relevant buffer is current during each function call. */);
6004 Vwrite_region_post_annotation_function = Qnil;
6005 staticpro (&Vwrite_region_annotation_buffers);
6007 DEFVAR_LISP ("write-region-annotations-so-far",
6008 Vwrite_region_annotations_so_far,
6009 doc: /* When an annotation function is called, this holds the previous annotations.
6010 These are the annotations made by other annotation functions
6011 that were already called. See also `write-region-annotate-functions'. */);
6012 Vwrite_region_annotations_so_far = Qnil;
6014 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
6015 doc: /* A list of file name handlers that temporarily should not be used.
6016 This applies only to the operation `inhibit-file-name-operation'. */);
6017 Vinhibit_file_name_handlers = Qnil;
6019 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
6020 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6021 Vinhibit_file_name_operation = Qnil;
6023 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
6024 doc: /* File name in which to write a list of all auto save file names.
6025 This variable is initialized automatically from `auto-save-list-file-prefix'
6026 shortly after Emacs reads your init file, if you have not yet given it
6027 a non-nil value. */);
6028 Vauto_save_list_file_name = Qnil;
6030 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
6031 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6032 Normally auto-save files are written under other names. */);
6033 Vauto_save_visited_file_name = Qnil;
6035 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
6036 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
6037 If nil, deleting a substantial portion of the text disables auto-save
6038 in the buffer; this is the default behavior, because the auto-save
6039 file is usually more useful if it contains the deleted text. */);
6040 Vauto_save_include_big_deletions = Qnil;
6042 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
6043 doc: /* Non-nil means don't call fsync in `write-region'.
6044 This variable affects calls to `write-region' as well as save commands.
6045 Setting this to nil may avoid data loss if the system loses power or
6046 the operating system crashes. By default, it is non-nil in batch mode. */);
6047 write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */
6049 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
6050 doc: /* Specifies whether to use the system's trash can.
6051 When non-nil, certain file deletion commands use the function
6052 `move-file-to-trash' instead of deleting files outright.
6053 This includes interactive calls to `delete-file' and
6054 `delete-directory' and the Dired deletion commands. */);
6055 delete_by_moving_to_trash = 0;
6056 DEFSYM (Qdelete_by_moving_to_trash, "delete-by-moving-to-trash");
6058 /* Lisp function for moving files to trash. */
6059 DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
6061 /* Lisp function for recursively copying directories. */
6062 DEFSYM (Qcopy_directory, "copy-directory");
6064 /* Lisp function for recursively deleting directories. */
6065 DEFSYM (Qdelete_directory, "delete-directory");
6067 DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
6068 DEFSYM (Qget_buffer_window_list, "get-buffer-window-list");
6070 DEFSYM (Qstdin, "stdin");
6071 DEFSYM (Qstdout, "stdout");
6072 DEFSYM (Qstderr, "stderr");
6074 defsubr (&Sfind_file_name_handler);
6075 defsubr (&Sfile_name_directory);
6076 defsubr (&Sfile_name_nondirectory);
6077 defsubr (&Sunhandled_file_name_directory);
6078 defsubr (&Sfile_name_as_directory);
6079 defsubr (&Sdirectory_name_p);
6080 defsubr (&Sdirectory_file_name);
6081 defsubr (&Smake_temp_file_internal);
6082 defsubr (&Smake_temp_name);
6083 defsubr (&Sexpand_file_name);
6084 defsubr (&Ssubstitute_in_file_name);
6085 defsubr (&Scopy_file);
6086 defsubr (&Smake_directory_internal);
6087 defsubr (&Sdelete_directory_internal);
6088 defsubr (&Sdelete_file);
6089 defsubr (&Sfile_name_case_insensitive_p);
6090 defsubr (&Srename_file);
6091 defsubr (&Sadd_name_to_file);
6092 defsubr (&Smake_symbolic_link);
6093 defsubr (&Sfile_name_absolute_p);
6094 defsubr (&Sfile_exists_p);
6095 defsubr (&Sfile_executable_p);
6096 defsubr (&Sfile_readable_p);
6097 defsubr (&Sfile_writable_p);
6098 defsubr (&Saccess_file);
6099 defsubr (&Sfile_symlink_p);
6100 defsubr (&Sfile_directory_p);
6101 defsubr (&Sfile_accessible_directory_p);
6102 defsubr (&Sfile_regular_p);
6103 defsubr (&Sfile_modes);
6104 defsubr (&Sset_file_modes);
6105 defsubr (&Sset_file_times);
6106 defsubr (&Sfile_selinux_context);
6107 defsubr (&Sfile_acl);
6108 defsubr (&Sset_file_acl);
6109 defsubr (&Sset_file_selinux_context);
6110 defsubr (&Sset_default_file_modes);
6111 defsubr (&Sdefault_file_modes);
6112 defsubr (&Sfile_newer_than_file_p);
6113 defsubr (&Sinsert_file_contents);
6114 defsubr (&Swrite_region);
6115 defsubr (&Scar_less_than_car);
6116 defsubr (&Sverify_visited_file_modtime);
6117 defsubr (&Svisited_file_modtime);
6118 defsubr (&Sset_visited_file_modtime);
6119 defsubr (&Sdo_auto_save);
6120 defsubr (&Sset_buffer_auto_saved);
6121 defsubr (&Sclear_buffer_auto_save_failure);
6122 defsubr (&Srecent_auto_save_p);
6124 defsubr (&Snext_read_file_uses_dialog_p);
6126 defsubr (&Sset_binary_mode);
6128 #ifdef HAVE_SYNC
6129 defsubr (&Sunix_sync);
6130 #endif