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/>. */
24 #include <sys/types.h>
38 #ifdef HAVE_LIBSELINUX
39 #include <selinux/selinux.h>
40 #include <selinux/context.h>
43 #if USE_ACL && defined HAVE_ACL_SET_FILE
50 #include "composite.h"
51 #include "character.h"
55 #include "blockinput.h"
56 #include "region-cache.h"
59 #ifdef HAVE_LINUX_FS_H
60 # include <sys/ioctl.h>
61 # include <linux/fs.h>
67 /* The redundant #ifdef is to avoid compiler warning about unused macro. */
73 #endif /* not WINDOWSNT */
77 #include <sys/param.h>
81 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
82 redirector allows the six letters between 'Z' and 'a' as well. */
84 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
87 #define IS_DRIVE(x) c_isalpha (x)
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)
97 #include <allocator.h>
98 #include <careadlinkat.h>
100 #include <stat-time.h>
101 #include <tempname.h>
103 #include <binary-io.h>
109 #include "commands.h"
111 /* True during writing of auto-save files. */
112 static bool auto_saving
;
114 /* Emacs's real umask. */
115 static mode_t realmask
;
117 /* Nonzero umask during creation of auto-save directories. */
118 static mode_t auto_saving_dir_umask
;
120 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
121 a new file with the same mode as the original. */
122 static mode_t auto_save_mode_bits
;
124 /* Set by auto_save_1 if an error occurred during the last auto-save. */
125 static bool auto_save_error_occurred
;
127 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
128 number of a file system where time stamps were observed to work. */
129 static bool valid_timestamp_file_system
;
130 static dev_t timestamp_file_system
;
132 /* Each time an annotation function changes the buffer, the new buffer
134 static Lisp_Object Vwrite_region_annotation_buffers
;
136 static bool a_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
137 Lisp_Object
*, struct coding_system
*);
138 static bool e_write (int, Lisp_Object
, ptrdiff_t, ptrdiff_t,
139 struct coding_system
*);
142 /* Return true if FILENAME exists. */
145 check_existing (const char *filename
)
147 return faccessat (AT_FDCWD
, filename
, F_OK
, AT_EACCESS
) == 0;
150 /* Return true if file FILENAME exists and can be executed. */
153 check_executable (char *filename
)
155 return faccessat (AT_FDCWD
, filename
, X_OK
, AT_EACCESS
) == 0;
158 /* Return true if file FILENAME exists and can be accessed
159 according to AMODE, which should include W_OK.
160 On failure, return false and set errno. */
163 check_writable (const char *filename
, int amode
)
166 /* FIXME: an faccessat implementation should be added to the
167 DOS/Windows ports and this #ifdef branch should be removed. */
169 if (stat (filename
, &st
) < 0)
172 return (st
.st_mode
& S_IWRITE
|| S_ISDIR (st
.st_mode
));
173 #else /* not MSDOS */
174 bool res
= faccessat (AT_FDCWD
, filename
, amode
, AT_EACCESS
) == 0;
176 /* faccessat may have returned failure because Cygwin couldn't
177 determine the file's UID or GID; if so, we return success. */
180 int faccessat_errno
= errno
;
182 if (stat (filename
, &st
) < 0)
184 res
= (st
.st_uid
== -1 || st
.st_gid
== -1);
185 errno
= faccessat_errno
;
189 #endif /* not MSDOS */
192 /* Signal a file-access failure. STRING describes the failure,
193 NAME the file involved, and ERRORNO the errno value.
195 If NAME is neither null nor a pair, package it up as a singleton
196 list before reporting it; this saves report_file_errno's caller the
197 trouble of preserving errno before calling list1. */
200 report_file_errno (char const *string
, Lisp_Object name
, int errorno
)
202 Lisp_Object data
= CONSP (name
) || NILP (name
) ? name
: list1 (name
);
203 char *str
= emacs_strerror (errorno
);
204 AUTO_STRING (unibyte_str
, str
);
205 Lisp_Object errstring
206 = code_convert_string_norecord (unibyte_str
, Vlocale_coding_system
, 0);
207 Lisp_Object errdata
= Fcons (errstring
, data
);
209 if (errorno
== EEXIST
)
210 xsignal (Qfile_already_exists
, errdata
);
212 xsignal (errorno
== ENOENT
? Qfile_missing
: Qfile_error
,
213 Fcons (build_string (string
), errdata
));
216 /* Signal a file-access failure that set errno. STRING describes the
217 failure, NAME the file involved. When invoking this function, take
218 care to not use arguments such as build_string ("foo") that involve
219 side effects that may set errno. */
222 report_file_error (char const *string
, Lisp_Object name
)
224 report_file_errno (string
, name
, errno
);
227 /* Like report_file_error, but reports a file-notify-error instead. */
230 report_file_notify_error (const char *string
, Lisp_Object name
)
232 char *str
= emacs_strerror (errno
);
233 AUTO_STRING (unibyte_str
, str
);
234 Lisp_Object errstring
235 = code_convert_string_norecord (unibyte_str
, Vlocale_coding_system
, 0);
236 Lisp_Object data
= CONSP (name
) || NILP (name
) ? name
: list1 (name
);
237 Lisp_Object errdata
= Fcons (errstring
, data
);
239 xsignal (Qfile_notify_error
, Fcons (build_string (string
), errdata
));
243 close_file_unwind (int fd
)
249 fclose_unwind (void *arg
)
255 /* Restore point, having saved it as a marker. */
258 restore_point_unwind (Lisp_Object location
)
260 Fgoto_char (location
);
261 unchain_marker (XMARKER (location
));
265 DEFUN ("find-file-name-handler", Ffind_file_name_handler
,
266 Sfind_file_name_handler
, 2, 2, 0,
267 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
268 Otherwise, return nil.
269 A file name is handled if one of the regular expressions in
270 `file-name-handler-alist' matches it.
272 If OPERATION equals `inhibit-file-name-operation', then ignore
273 any handlers that are members of `inhibit-file-name-handlers',
274 but still do run any other handlers. This lets handlers
275 use the standard functions without calling themselves recursively. */)
276 (Lisp_Object filename
, Lisp_Object operation
)
278 /* This function must not munge the match data. */
279 Lisp_Object chain
, inhibited_handlers
, result
;
283 CHECK_STRING (filename
);
285 if (EQ (operation
, Vinhibit_file_name_operation
))
286 inhibited_handlers
= Vinhibit_file_name_handlers
;
288 inhibited_handlers
= Qnil
;
290 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
291 chain
= XCDR (chain
))
297 Lisp_Object string
= XCAR (elt
);
299 Lisp_Object handler
= XCDR (elt
);
300 Lisp_Object operations
= Qnil
;
302 if (SYMBOLP (handler
))
303 operations
= Fget (handler
, Qoperations
);
306 && (match_pos
= fast_string_match (string
, filename
)) > pos
307 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
311 handler
= XCDR (elt
);
312 tem
= Fmemq (handler
, inhibited_handlers
);
326 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
328 doc
: /* Return the directory component in file name FILENAME.
329 Return nil if FILENAME does not include a directory.
330 Otherwise return a directory name.
331 Given a Unix syntax file name, returns a string ending in slash. */)
332 (Lisp_Object filename
)
336 CHECK_STRING (filename
);
338 /* If the file name has special constructs in it,
339 call the corresponding file handler. */
340 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
343 Lisp_Object handled_name
= call2 (handler
, Qfile_name_directory
,
345 return STRINGP (handled_name
) ? handled_name
: Qnil
;
348 char *beg
= SSDATA (filename
);
349 char const *p
= beg
+ SBYTES (filename
);
351 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
353 /* only recognize drive specifier at the beginning */
355 /* handle the "/:d:foo" and "/:foo" cases correctly */
356 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
357 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
364 /* Expansion of "c:" to drive and default directory. */
367 SAFE_ALLOCA_STRING (beg
, filename
);
368 p
= beg
+ (p
- SSDATA (filename
));
372 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
373 char *res
= alloca (MAXPATHLEN
+ 1);
376 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
378 memcpy (res
, beg
, 2);
383 if (getdefdir (c_toupper (*beg
) - 'A' + 1, r
))
385 size_t l
= strlen (res
);
387 if (l
> 3 || !IS_DIRECTORY_SEP (res
[l
- 1]))
390 p
= beg
+ strlen (beg
);
391 dostounix_filename (beg
);
392 tem_fn
= make_specified_string (beg
, -1, p
- beg
,
393 STRING_MULTIBYTE (filename
));
396 tem_fn
= make_specified_string (beg
- 2, -1, p
- beg
+ 2,
397 STRING_MULTIBYTE (filename
));
399 else if (STRING_MULTIBYTE (filename
))
401 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 1);
402 dostounix_filename (SSDATA (tem_fn
));
404 if (!NILP (Vw32_downcase_file_names
))
405 tem_fn
= Fdowncase (tem_fn
);
410 dostounix_filename (beg
);
411 tem_fn
= make_specified_string (beg
, -1, p
- beg
, 0);
416 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
420 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
421 Sfile_name_nondirectory
, 1, 1, 0,
422 doc
: /* Return file name FILENAME sans its directory.
423 For example, in a Unix-syntax file name,
424 this is everything after the last slash,
425 or the entire name if it contains no slash. */)
426 (Lisp_Object filename
)
428 register const char *beg
, *p
, *end
;
431 CHECK_STRING (filename
);
433 /* If the file name has special constructs in it,
434 call the corresponding file handler. */
435 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
438 Lisp_Object handled_name
= call2 (handler
, Qfile_name_nondirectory
,
440 if (STRINGP (handled_name
))
442 error ("Invalid handler in `file-name-handler-alist'");
445 beg
= SSDATA (filename
);
446 end
= p
= beg
+ SBYTES (filename
);
448 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
450 /* only recognize drive specifier at beginning */
452 /* handle the "/:d:foo" case correctly */
453 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
458 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
461 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
462 Sunhandled_file_name_directory
, 1, 1, 0,
463 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
464 A `directly usable' directory name is one that may be used without the
465 intervention of any file handler.
466 If FILENAME is a directly usable file itself, return
467 \(file-name-as-directory FILENAME).
468 If FILENAME refers to a file which is not accessible from a local process,
469 then this should return nil.
470 The `call-process' and `start-process' functions use this function to
471 get a current directory to run processes in. */)
472 (Lisp_Object filename
)
476 /* If the file name has special constructs in it,
477 call the corresponding file handler. */
478 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
481 Lisp_Object handled_name
= call2 (handler
, Qunhandled_file_name_directory
,
483 return STRINGP (handled_name
) ? handled_name
: Qnil
;
486 return Ffile_name_as_directory (filename
);
489 /* Maximum number of bytes that DST will be longer than SRC
490 in file_name_as_directory. This occurs when SRCLEN == 0. */
491 enum { file_name_as_directory_slop
= 2 };
493 /* Convert from file name SRC of length SRCLEN to directory name in
494 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
495 string. On UNIX, just make sure there is a terminating /. Return
496 the length of DST in bytes. */
499 file_name_as_directory (char *dst
, const char *src
, ptrdiff_t srclen
,
510 memcpy (dst
, src
, srclen
);
511 if (!IS_DIRECTORY_SEP (dst
[srclen
- 1]))
512 dst
[srclen
++] = DIRECTORY_SEP
;
515 dostounix_filename (dst
);
520 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
521 Sfile_name_as_directory
, 1, 1, 0,
522 doc
: /* Return a string representing the file name FILE interpreted as a directory.
523 This operation exists because a directory is also a file, but its name as
524 a directory is different from its name as a file.
525 The result can be used as the value of `default-directory'
526 or passed as second argument to `expand-file-name'.
527 For a Unix-syntax file name, just appends a slash unless a trailing slash
528 is already present. */)
533 Lisp_Object handler
, val
;
538 /* If the file name has special constructs in it,
539 call the corresponding file handler. */
540 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
543 Lisp_Object handled_name
= call2 (handler
, Qfile_name_as_directory
,
545 if (STRINGP (handled_name
))
547 error ("Invalid handler in `file-name-handler-alist'");
551 if (!NILP (Vw32_downcase_file_names
))
552 file
= Fdowncase (file
);
554 buf
= SAFE_ALLOCA (SBYTES (file
) + file_name_as_directory_slop
+ 1);
555 length
= file_name_as_directory (buf
, SSDATA (file
), SBYTES (file
),
556 STRING_MULTIBYTE (file
));
557 val
= make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (file
));
562 /* Convert from directory name SRC of length SRCLEN to file name in
563 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
564 string. On UNIX, just make sure there isn't a terminating /.
565 Return the length of DST in bytes. */
568 directory_file_name (char *dst
, char *src
, ptrdiff_t srclen
, bool multibyte
)
570 /* In Unix-like systems, just remove any final slashes. However, if
571 they are all slashes, leave "/" and "//" alone, and treat "///"
572 and longer as if they were "/". */
573 if (! (srclen
== 2 && IS_DIRECTORY_SEP (src
[0])))
576 && !(srclen
> 2 && IS_DEVICE_SEP (src
[srclen
- 2]))
578 && IS_DIRECTORY_SEP (src
[srclen
- 1]))
581 memcpy (dst
, src
, srclen
);
584 dostounix_filename (dst
);
589 DEFUN ("directory-name-p", Fdirectory_name_p
, Sdirectory_name_p
, 1, 1, 0,
590 doc
: /* Return non-nil if NAME ends with a directory separator character. */)
594 ptrdiff_t namelen
= SBYTES (name
);
595 unsigned char c
= namelen
? SREF (name
, namelen
- 1) : 0;
596 return IS_DIRECTORY_SEP (c
) ? Qt
: Qnil
;
599 /* Return the expansion of NEWNAME, except that if NEWNAME is a
600 directory name then return the expansion of FILE's basename under
601 NEWNAME. This resembles how 'cp FILE NEWNAME' works, except that
602 it requires NEWNAME to be a directory name (typically, by ending in
606 expand_cp_target (Lisp_Object file
, Lisp_Object newname
)
608 return (!NILP (Fdirectory_name_p (newname
))
609 ? Fexpand_file_name (Ffile_name_nondirectory (file
), newname
)
610 : Fexpand_file_name (newname
, Qnil
));
613 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
615 doc
: /* Returns the file name of the directory named DIRECTORY.
616 This is the name of the file that holds the data for the directory DIRECTORY.
617 This operation exists because a directory is also a file, but its name as
618 a directory is different from its name as a file.
619 In Unix-syntax, this function just removes the final slash. */)
620 (Lisp_Object directory
)
624 Lisp_Object handler
, val
;
627 CHECK_STRING (directory
);
629 /* If the file name has special constructs in it,
630 call the corresponding file handler. */
631 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
634 Lisp_Object handled_name
= call2 (handler
, Qdirectory_file_name
,
636 if (STRINGP (handled_name
))
638 error ("Invalid handler in `file-name-handler-alist'");
642 if (!NILP (Vw32_downcase_file_names
))
643 directory
= Fdowncase (directory
);
645 buf
= SAFE_ALLOCA (SBYTES (directory
) + 1);
646 length
= directory_file_name (buf
, SSDATA (directory
), SBYTES (directory
),
647 STRING_MULTIBYTE (directory
));
648 val
= make_specified_string (buf
, -1, length
, STRING_MULTIBYTE (directory
));
653 DEFUN ("make-temp-file-internal", Fmake_temp_file_internal
,
654 Smake_temp_file_internal
, 4, 4, 0,
655 doc
: /* Generate a new file whose name starts with PREFIX, a string.
656 Return the name of the generated file. If DIR-FLAG is zero, do not
657 create the file, just its name. Otherwise, if DIR-FLAG is non-nil,
658 create an empty directory. The file name should end in SUFFIX.
659 Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
660 working directory. If TEXT is a string, insert it into the newly
663 Signal an error if the file could not be created.
665 This function does not grok magic file names. */)
666 (Lisp_Object prefix
, Lisp_Object dir_flag
, Lisp_Object suffix
,
669 CHECK_STRING (prefix
);
670 CHECK_STRING (suffix
);
671 Lisp_Object encoded_prefix
= ENCODE_FILE (prefix
);
672 Lisp_Object encoded_suffix
= ENCODE_FILE (suffix
);
673 ptrdiff_t prefix_len
= SBYTES (encoded_prefix
);
674 ptrdiff_t suffix_len
= SBYTES (encoded_suffix
);
675 if (INT_MAX
< suffix_len
)
676 args_out_of_range (prefix
, suffix
);
678 Lisp_Object val
= make_uninit_string (prefix_len
+ nX
+ suffix_len
);
679 char *data
= SSDATA (val
);
680 memcpy (data
, SSDATA (encoded_prefix
), prefix_len
);
681 memset (data
+ prefix_len
, 'X', nX
);
682 memcpy (data
+ prefix_len
+ nX
, SSDATA (encoded_suffix
), suffix_len
);
683 int kind
= (NILP (dir_flag
) ? GT_FILE
684 : EQ (dir_flag
, make_number (0)) ? GT_NOCREATE
686 int fd
= gen_tempname (data
, suffix_len
, O_BINARY
| O_CLOEXEC
, kind
);
687 bool failed
= fd
< 0;
690 ptrdiff_t count
= SPECPDL_INDEX ();
691 record_unwind_protect_int (close_file_unwind
, fd
);
692 val
= DECODE_FILE (val
);
693 if (STRINGP (text
) && SBYTES (text
) != 0)
694 write_region (text
, Qnil
, val
, Qnil
, Qnil
, Qnil
, Qnil
, fd
);
695 failed
= NILP (dir_flag
) && emacs_close (fd
) != 0;
696 /* Discard the unwind protect. */
697 specpdl_ptr
= specpdl
+ count
;
701 static char const kind_message
[][32] =
703 [GT_FILE
] = "Creating file with prefix",
704 [GT_DIR
] = "Creating directory with prefix",
705 [GT_NOCREATE
] = "Creating file name with prefix"
707 report_file_error (kind_message
[kind
], prefix
);
713 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
714 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
716 This function tries to choose a name that has no existing file.
717 For this to work, PREFIX should be an absolute file name, and PREFIX
718 and the returned string should both be non-magic.
720 There is a race condition between calling `make-temp-name' and
721 later creating the file, which opens all kinds of security holes.
722 For that reason, you should normally use `make-temp-file' instead. */)
725 return Fmake_temp_file_internal (prefix
, make_number (0),
726 empty_unibyte_string
, Qnil
);
729 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
730 doc
: /* Convert filename NAME to absolute, and canonicalize it.
731 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
732 \(does not start with slash or tilde); both the directory name and
733 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
734 missing, the current buffer's value of `default-directory' is used.
735 NAME should be a string that is a valid file name for the underlying
737 File name components that are `.' are removed, and
738 so are file name components followed by `..', along with the `..' itself;
739 note that these simplifications are done without checking the resulting
740 file names in the file system.
741 Multiple consecutive slashes are collapsed into a single slash,
742 except at the beginning of the file name when they are significant (e.g.,
743 UNC file names on MS-Windows.)
744 An initial `~/' expands to your home directory.
745 An initial `~USER/' expands to USER's home directory.
746 See also the function `substitute-in-file-name'.
748 For technical reasons, this function can return correct but
749 non-intuitive results for the root directory; for instance,
750 \(expand-file-name ".." "/") returns "/..". For this reason, use
751 \(directory-file-name (file-name-directory dirname)) to traverse a
752 filesystem tree, not (expand-file-name ".." dirname). Note: make
753 sure DIRNAME in this example doesn't end in a slash, unless it's
754 the root directory. */)
755 (Lisp_Object name
, Lisp_Object default_directory
)
757 /* These point to SDATA and need to be careful with string-relocation
758 during GC (via DECODE_FILE). */
762 const char *newdirlim
;
763 /* This should only point to alloca'd data. */
770 bool collapse_newdir
= true;
773 ptrdiff_t length
, nbytes
;
774 Lisp_Object handler
, result
, handled_name
;
781 /* If the file name has special constructs in it,
782 call the corresponding file handler. */
783 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
786 handled_name
= call3 (handler
, Qexpand_file_name
,
787 name
, default_directory
);
788 if (STRINGP (handled_name
))
790 error ("Invalid handler in `file-name-handler-alist'");
794 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
795 if (NILP (default_directory
))
796 default_directory
= BVAR (current_buffer
, directory
);
797 if (! STRINGP (default_directory
))
800 /* "/" is not considered a root directory on DOS_NT, so using "/"
801 here causes an infinite recursion in, e.g., the following:
803 (let (default-directory)
804 (expand-file-name "a"))
806 To avoid this, we set default_directory to the root of the
808 default_directory
= build_string (emacs_root_dir ());
810 default_directory
= build_string ("/");
814 if (!NILP (default_directory
))
816 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
819 handled_name
= call3 (handler
, Qexpand_file_name
,
820 name
, default_directory
);
821 if (STRINGP (handled_name
))
823 error ("Invalid handler in `file-name-handler-alist'");
828 char *o
= SSDATA (default_directory
);
830 /* Make sure DEFAULT_DIRECTORY is properly expanded.
831 It would be better to do this down below where we actually use
832 default_directory. Unfortunately, calling Fexpand_file_name recursively
833 could invoke GC, and the strings might be relocated. This would
834 be annoying because we have pointers into strings lying around
835 that would need adjusting, and people would add new pointers to
836 the code and forget to adjust them, resulting in intermittent bugs.
837 Putting this call here avoids all that crud.
839 The EQ test avoids infinite recursion. */
840 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
841 /* Save time in some common cases - as long as default_directory
842 is not relative, it can be canonicalized with name below (if it
843 is needed at all) without requiring it to be expanded now. */
845 /* Detect MSDOS file names with drive specifiers. */
846 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
847 && IS_DIRECTORY_SEP (o
[2]))
848 /* Detect escaped file names without drive spec after "/:".
849 These should not be recursively expanded, to avoid
850 including the default directory twice in the expanded
852 && ! (o
[0] == '/' && o
[1] == ':')
854 /* Detect Windows file names in UNC format. */
855 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
857 #else /* not DOS_NT */
858 /* Detect Unix absolute file names (/... alone is not absolute on
860 && ! (IS_DIRECTORY_SEP (o
[0]))
861 #endif /* not DOS_NT */
864 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
867 multibyte
= STRING_MULTIBYTE (name
);
868 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
872 unsigned char *p
= SDATA (name
);
874 while (*p
&& ASCII_CHAR_P (*p
))
878 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
879 unibyte. Do not convert DEFAULT_DIRECTORY to
880 multibyte; instead, convert NAME to a unibyte string,
881 so that the result of this function is also a unibyte
882 string. This is needed during bootstrapping and
883 dumping, when Emacs cannot decode file names, because
884 the locale environment is not set up. */
885 name
= make_unibyte_string (SSDATA (name
), SBYTES (name
));
889 default_directory
= string_to_multibyte (default_directory
);
893 name
= string_to_multibyte (name
);
899 if (!NILP (Vw32_downcase_file_names
))
900 default_directory
= Fdowncase (default_directory
);
903 /* Make a local copy of NAME to protect it from GC in DECODE_FILE below. */
904 SAFE_ALLOCA_STRING (nm
, name
);
905 nmlim
= nm
+ SBYTES (name
);
908 /* Note if special escape prefix is present, but remove for now. */
909 if (nm
[0] == '/' && nm
[1] == ':')
915 /* Find and remove drive specifier if present; this makes nm absolute
916 even if the rest of the name appears to be relative. Only look for
917 drive specifier at the beginning. */
918 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
920 drive
= (unsigned char) nm
[0];
925 /* If we see "c://somedir", we want to strip the first slash after the
926 colon when stripping the drive letter. Otherwise, this expands to
928 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
931 /* Discard any previous drive specifier if nm is now in UNC format. */
932 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1])
933 && !IS_DIRECTORY_SEP (nm
[2]))
935 #endif /* WINDOWSNT */
938 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
939 none are found, we can probably return right away. We will avoid
940 allocating a new string if name is already fully expanded. */
942 IS_DIRECTORY_SEP (nm
[0])
944 && drive
&& !is_escaped
947 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
951 /* If it turns out that the filename we want to return is just a
952 suffix of FILENAME, we don't need to go through and edit
953 things; we just need to construct a new string using data
954 starting at the middle of FILENAME. If we set LOSE, that
955 means we've discovered that we can't do that cool trick. */
961 /* Since we know the name is absolute, we can assume that each
962 element starts with a "/". */
964 /* "." and ".." are hairy. */
965 if (IS_DIRECTORY_SEP (p
[0])
967 && (IS_DIRECTORY_SEP (p
[2])
969 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
972 /* Replace multiple slashes with a single one, except
973 leave leading "//" alone. */
974 else if (IS_DIRECTORY_SEP (p
[0])
975 && IS_DIRECTORY_SEP (p
[1])
976 && (p
!= nm
|| IS_DIRECTORY_SEP (p
[2])))
983 /* Make sure directories are all separated with /, but
984 avoid allocation of a new string when not required. */
985 dostounix_filename (nm
);
987 if (IS_DIRECTORY_SEP (nm
[1]))
989 if (strcmp (nm
, SSDATA (name
)) != 0)
990 name
= make_specified_string (nm
, -1, nmlim
- nm
, multibyte
);
994 /* Drive must be set, so this is okay. */
995 if (strcmp (nm
- 2, SSDATA (name
)) != 0)
997 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
998 char temp
[] = { DRIVE_LETTER (drive
), ':', 0 };
999 AUTO_STRING_WITH_LEN (drive_prefix
, temp
, 2);
1000 name
= concat2 (drive_prefix
, name
);
1003 if (!NILP (Vw32_downcase_file_names
))
1004 name
= Fdowncase (name
);
1006 #else /* not DOS_NT */
1007 if (strcmp (nm
, SSDATA (name
)) != 0)
1008 name
= make_specified_string (nm
, -1, nmlim
- nm
, multibyte
);
1009 #endif /* not DOS_NT */
1015 /* At this point, nm might or might not be an absolute file name. We
1016 need to expand ~ or ~user if present, otherwise prefix nm with
1017 default_directory if nm is not absolute, and finally collapse /./
1018 and /foo/../ sequences.
1020 We set newdir to be the appropriate prefix if one is needed:
1021 - the relevant user directory if nm starts with ~ or ~user
1022 - the specified drive's working dir (DOS/NT only) if nm does not
1024 - the value of default_directory.
1026 Note that these prefixes are not guaranteed to be absolute (except
1027 for the working dir of a drive). Therefore, to ensure we always
1028 return an absolute name, if the final prefix is not absolute we
1029 append it to the current working directory. */
1031 newdir
= newdirlim
= 0;
1033 if (nm
[0] == '~' /* prefix ~ */
1035 && !is_escaped
/* don't expand ~ in escaped file names */
1039 if (IS_DIRECTORY_SEP (nm
[1])
1040 || nm
[1] == 0) /* ~ by itself */
1044 if (!(newdir
= egetenv ("HOME")))
1045 newdir
= newdirlim
= "";
1050 char newdir_utf8
[MAX_UTF8_PATH
];
1052 filename_from_ansi (newdir
, newdir_utf8
);
1053 tem
= make_unibyte_string (newdir_utf8
, strlen (newdir_utf8
));
1054 newdir
= SSDATA (tem
);
1058 tem
= build_string (newdir
);
1059 newdirlim
= newdir
+ SBYTES (tem
);
1060 /* `egetenv' may return a unibyte string, which will bite us
1061 if we expect the directory to be multibyte. */
1062 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1064 hdir
= DECODE_FILE (tem
);
1065 newdir
= SSDATA (hdir
);
1066 newdirlim
= newdir
+ SBYTES (hdir
);
1069 collapse_newdir
= false;
1072 else /* ~user/filename */
1075 for (p
= nm
; *p
&& !IS_DIRECTORY_SEP (*p
); p
++)
1077 o
= SAFE_ALLOCA (p
- nm
+ 1);
1078 memcpy (o
, nm
, p
- nm
);
1082 pw
= getpwnam (o
+ 1);
1088 newdir
= pw
->pw_dir
;
1089 /* `getpwnam' may return a unibyte string, which will
1090 bite us when we expect the directory to be multibyte. */
1091 tem
= make_unibyte_string (newdir
, strlen (newdir
));
1092 newdirlim
= newdir
+ SBYTES (tem
);
1093 if (multibyte
&& !STRING_MULTIBYTE (tem
))
1095 hdir
= DECODE_FILE (tem
);
1096 newdir
= SSDATA (hdir
);
1097 newdirlim
= newdir
+ SBYTES (hdir
);
1101 collapse_newdir
= false;
1105 /* If we don't find a user of that name, leave the name
1106 unchanged; don't move nm forward to p. */
1111 /* On DOS and Windows, nm is absolute if a drive name was specified;
1112 use the drive's current directory as the prefix if needed. */
1113 if (!newdir
&& drive
)
1115 /* Get default directory if needed to make nm absolute. */
1117 if (!IS_DIRECTORY_SEP (nm
[0]))
1119 adir
= alloca (MAXPATHLEN
+ 1);
1120 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1124 Lisp_Object tem
= build_string (adir
);
1126 tem
= DECODE_FILE (tem
);
1127 newdirlim
= adir
+ SBYTES (tem
);
1128 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1131 newdirlim
= adir
+ strlen (adir
);
1135 /* Either nm starts with /, or drive isn't mounted. */
1137 adir
[0] = DRIVE_LETTER (drive
);
1141 newdirlim
= adir
+ 3;
1147 /* Finally, if no prefix has been specified and nm is not absolute,
1148 then it must be expanded relative to default_directory. */
1152 /* /... alone is not absolute on DOS and Windows. */
1153 && !IS_DIRECTORY_SEP (nm
[0])
1156 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1])
1157 && !IS_DIRECTORY_SEP (nm
[2]))
1161 newdir
= SSDATA (default_directory
);
1162 newdirlim
= newdir
+ SBYTES (default_directory
);
1164 /* Note if special escape prefix is present, but remove for now. */
1165 if (newdir
[0] == '/' && newdir
[1] == ':')
1176 /* First ensure newdir is an absolute name. */
1178 /* Detect MSDOS file names with drive specifiers. */
1179 ! (IS_DRIVE (newdir
[0])
1180 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1182 /* Detect Windows file names in UNC format. */
1183 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1])
1184 && !IS_DIRECTORY_SEP (newdir
[2]))
1188 /* Effectively, let newdir be (expand-file-name newdir cwd).
1189 Because of the admonition against calling expand-file-name
1190 when we have pointers into lisp strings, we accomplish this
1191 indirectly by prepending newdir to nm if necessary, and using
1192 cwd (or the wd of newdir's drive) as the new newdir. */
1195 const int adir_size
= MAX_UTF8_PATH
;
1197 const int adir_size
= MAXPATHLEN
+ 1;
1200 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1202 drive
= (unsigned char) newdir
[0];
1205 if (!IS_DIRECTORY_SEP (nm
[0]))
1207 ptrdiff_t nmlen
= nmlim
- nm
;
1208 ptrdiff_t newdirlen
= newdirlim
- newdir
;
1209 char *tmp
= alloca (newdirlen
+ file_name_as_directory_slop
1211 ptrdiff_t dlen
= file_name_as_directory (tmp
, newdir
, newdirlen
,
1213 memcpy (tmp
+ dlen
, nm
, nmlen
+ 1);
1215 nmlim
= nm
+ dlen
+ nmlen
;
1217 adir
= alloca (adir_size
);
1220 if (!getdefdir (c_toupper (drive
) - 'A' + 1, adir
))
1224 getcwd (adir
, adir_size
);
1227 Lisp_Object tem
= build_string (adir
);
1229 tem
= DECODE_FILE (tem
);
1230 newdirlim
= adir
+ SBYTES (tem
);
1231 memcpy (adir
, SSDATA (tem
), SBYTES (tem
) + 1);
1234 newdirlim
= adir
+ strlen (adir
);
1238 /* Strip off drive name from prefix, if present. */
1239 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1245 /* Keep only a prefix from newdir if nm starts with slash
1246 (//server/share for UNC, nothing otherwise). */
1247 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1250 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1])
1251 && !IS_DIRECTORY_SEP (newdir
[2]))
1253 char *adir
= strcpy (alloca (newdirlim
- newdir
+ 1), newdir
);
1255 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1257 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1260 newdirlim
= newdir
+ strlen (adir
);
1264 newdir
= newdirlim
= "";
1269 /* Ignore any slash at the end of newdir, unless newdir is
1270 just "/" or "//". */
1271 length
= newdirlim
- newdir
;
1272 while (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1273 && ! (length
== 2 && IS_DIRECTORY_SEP (newdir
[0])))
1276 /* Now concatenate the directory and name to new space in the stack frame. */
1277 tlen
= length
+ file_name_as_directory_slop
+ (nmlim
- nm
) + 1;
1278 eassert (tlen
> file_name_as_directory_slop
+ 1);
1280 /* Reserve space for drive specifier and escape prefix, since either
1281 or both may need to be inserted. (The Microsoft x86 compiler
1282 produces incorrect code if the following two lines are combined.) */
1283 target
= alloca (tlen
+ 4);
1285 #else /* not DOS_NT */
1286 target
= SAFE_ALLOCA (tlen
);
1287 #endif /* not DOS_NT */
1293 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1296 /* If newdir is effectively "C:/", then the drive letter will have
1297 been stripped and newdir will be "/". Concatenating with an
1298 absolute directory in nm produces "//", which will then be
1299 incorrectly treated as a network share. Ignore newdir in
1300 this case (keeping the drive letter). */
1301 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1302 && newdir
[1] == '\0'))
1305 memcpy (target
, newdir
, length
);
1311 nbytes
= file_name_as_directory (target
, newdir
, length
, multibyte
);
1314 memcpy (target
+ nbytes
, nm
, nmlim
- nm
+ 1);
1316 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1324 if (!IS_DIRECTORY_SEP (*p
))
1328 else if (p
[1] == '.'
1329 && (IS_DIRECTORY_SEP (p
[2])
1332 /* If "/." is the entire filename, keep the "/". Otherwise,
1333 just delete the whole "/.". */
1334 if (o
== target
&& p
[2] == '\0')
1338 else if (p
[1] == '.' && p
[2] == '.'
1339 /* `/../' is the "superroot" on certain file systems.
1340 Turned off on DOS_NT systems because they have no
1341 "superroot" and because this causes us to produce
1342 file names like "d:/../foo" which fail file-related
1343 functions of the underlying OS. (To reproduce, try a
1344 long series of "../../" in default_directory, longer
1345 than the number of levels from the root.) */
1349 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1354 while (o
!= target
&& (--o
, !IS_DIRECTORY_SEP (*o
)))
1357 /* Don't go below server level in UNC filenames. */
1358 if (o
== target
+ 1 && IS_DIRECTORY_SEP (*o
)
1359 && IS_DIRECTORY_SEP (*target
))
1363 /* Keep initial / only if this is the whole name. */
1364 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1368 else if (IS_DIRECTORY_SEP (p
[1])
1369 && (p
!= target
|| IS_DIRECTORY_SEP (p
[2])))
1370 /* Collapse multiple "/", except leave leading "//" alone. */
1379 /* At last, set drive name. */
1381 /* Except for network file name. */
1382 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1383 #endif /* WINDOWSNT */
1385 if (!drive
) emacs_abort ();
1387 target
[0] = DRIVE_LETTER (drive
);
1390 /* Reinsert the escape prefix if required. */
1397 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1398 dostounix_filename (SSDATA (result
));
1400 if (!NILP (Vw32_downcase_file_names
))
1401 result
= Fdowncase (result
);
1404 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1405 #endif /* !DOS_NT */
1408 /* Again look to see if the file name has special constructs in it
1409 and perhaps call the corresponding file handler. This is needed
1410 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1411 the ".." component gives us "/user@host:/bar/../baz" which needs
1412 to be expanded again. */
1413 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1414 if (!NILP (handler
))
1416 handled_name
= call3 (handler
, Qexpand_file_name
,
1417 result
, default_directory
);
1418 if (! STRINGP (handled_name
))
1419 error ("Invalid handler in `file-name-handler-alist'");
1420 result
= handled_name
;
1428 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1429 This is the old version of expand-file-name, before it was thoroughly
1430 rewritten for Emacs 10.31. We leave this version here commented-out,
1431 because the code is very complex and likely to have subtle bugs. If
1432 bugs _are_ found, it might be of interest to look at the old code and
1433 see what did it do in the relevant situation.
1435 Don't remove this code: it's true that it will be accessible
1436 from the repository, but a few years from deletion, people will
1437 forget it is there. */
1439 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1440 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1441 "Convert FILENAME to absolute, and canonicalize it.\n\
1442 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1443 \(does not start with slash); if DEFAULT is nil or missing,\n\
1444 the current buffer's value of default-directory is used.\n\
1445 Filenames containing `.' or `..' as components are simplified;\n\
1446 initial `~/' expands to your home directory.\n\
1447 See also the function `substitute-in-file-name'.")
1449 Lisp_Object name
, defalt
;
1453 register unsigned char *newdir
, *p
, *o
;
1455 unsigned char *target
;
1458 CHECK_STRING (name
);
1461 /* If nm is absolute, flush ...// and detect /./ and /../.
1462 If no /./ or /../ we can return right away. */
1469 if (p
[0] == '/' && p
[1] == '/')
1471 if (p
[0] == '/' && p
[1] == '~')
1472 nm
= p
+ 1, lose
= 1;
1473 if (p
[0] == '/' && p
[1] == '.'
1474 && (p
[2] == '/' || p
[2] == 0
1475 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1481 if (nm
== SDATA (name
))
1483 return build_string (nm
);
1487 /* Now determine directory to start with and put it in NEWDIR. */
1491 if (nm
[0] == '~') /* prefix ~ */
1492 if (nm
[1] == '/' || nm
[1] == 0)/* ~/filename */
1494 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1495 newdir
= (unsigned char *) "";
1498 else /* ~user/filename */
1500 /* Get past ~ to user. */
1501 unsigned char *user
= nm
+ 1;
1502 /* Find end of name. */
1503 unsigned char *ptr
= (unsigned char *) strchr (user
, '/');
1504 ptrdiff_t len
= ptr
? ptr
- user
: strlen (user
);
1505 /* Copy the user name into temp storage. */
1506 o
= alloca (len
+ 1);
1507 memcpy (o
, user
, len
);
1510 /* Look up the user name. */
1512 pw
= (struct passwd
*) getpwnam (o
+ 1);
1515 error ("\"%s\" isn't a registered user", o
+ 1);
1517 newdir
= (unsigned char *) pw
->pw_dir
;
1519 /* Discard the user name from NM. */
1523 if (nm
[0] != '/' && !newdir
)
1526 defalt
= current_buffer
->directory
;
1527 CHECK_STRING (defalt
);
1528 newdir
= SDATA (defalt
);
1531 /* Now concatenate the directory and name to new space in the stack frame. */
1533 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1534 target
= alloca (tlen
);
1539 if (nm
[0] == 0 || nm
[0] == '/')
1540 strcpy (target
, newdir
);
1542 file_name_as_directory (target
, newdir
);
1545 strcat (target
, nm
);
1547 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1558 else if (!strncmp (p
, "//", 2)
1564 else if (p
[0] == '/' && p
[1] == '.'
1565 && (p
[2] == '/' || p
[2] == 0))
1567 else if (!strncmp (p
, "/..", 3)
1568 /* `/../' is the "superroot" on certain file systems. */
1570 && (p
[3] == '/' || p
[3] == 0))
1572 while (o
!= target
&& *--o
!= '/')
1574 if (o
== target
&& *o
== '/')
1584 return make_string (target
, o
- target
);
1588 /* If /~ or // appears, discard everything through first slash. */
1590 file_name_absolute_p (const char *filename
)
1593 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
1595 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
1596 && IS_DIRECTORY_SEP (filename
[2]))
1602 search_embedded_absfilename (char *nm
, char *endp
)
1606 for (p
= nm
+ 1; p
< endp
; p
++)
1608 if (IS_DIRECTORY_SEP (p
[-1])
1609 && file_name_absolute_p (p
)
1610 #if defined (WINDOWSNT) || defined (CYGWIN)
1611 /* // at start of file name is meaningful in Apollo,
1612 WindowsNT and Cygwin systems. */
1613 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
1614 #endif /* not (WINDOWSNT || CYGWIN) */
1617 for (s
= p
; *s
&& !IS_DIRECTORY_SEP (*s
); s
++);
1618 if (p
[0] == '~' && s
> p
+ 1) /* We've got "/~something/". */
1621 char *o
= SAFE_ALLOCA (s
- p
+ 1);
1623 memcpy (o
, p
, s
- p
);
1626 /* If we have ~user and `user' exists, discard
1627 everything up to ~. But if `user' does not exist, leave
1628 ~user alone, it might be a literal file name. */
1630 pw
= getpwnam (o
+ 1);
1643 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1644 Ssubstitute_in_file_name
, 1, 1, 0,
1645 doc
: /* Substitute environment variables referred to in FILENAME.
1646 `$FOO' where FOO is an environment variable name means to substitute
1647 the value of that variable. The variable name should be terminated
1648 with a character not a letter, digit or underscore; otherwise, enclose
1649 the entire variable name in braces.
1651 If `/~' appears, all of FILENAME through that `/' is discarded.
1652 If `//' appears, everything up to and including the first of
1653 those `/' is discarded. */)
1654 (Lisp_Object filename
)
1656 char *nm
, *p
, *x
, *endp
;
1657 bool substituted
= false;
1660 Lisp_Object handler
;
1662 CHECK_STRING (filename
);
1664 multibyte
= STRING_MULTIBYTE (filename
);
1666 /* If the file name has special constructs in it,
1667 call the corresponding file handler. */
1668 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1669 if (!NILP (handler
))
1671 Lisp_Object handled_name
= call2 (handler
, Qsubstitute_in_file_name
,
1673 if (STRINGP (handled_name
))
1674 return handled_name
;
1675 error ("Invalid handler in `file-name-handler-alist'");
1678 /* Always work on a copy of the string, in case GC happens during
1679 decode of environment variables, causing the original Lisp_String
1680 data to be relocated. */
1682 SAFE_ALLOCA_STRING (nm
, filename
);
1685 dostounix_filename (nm
);
1686 substituted
= (memcmp (nm
, SDATA (filename
), SBYTES (filename
)) != 0);
1688 endp
= nm
+ SBYTES (filename
);
1690 /* If /~ or // appears, discard everything through first slash. */
1691 p
= search_embedded_absfilename (nm
, endp
);
1693 /* Start over with the new string, so we check the file-name-handler
1694 again. Important with filenames like "/home/foo//:/hello///there"
1695 which would substitute to "/:/hello///there" rather than "/there". */
1698 = (Fsubstitute_in_file_name
1699 (make_specified_string (p
, -1, endp
- p
, multibyte
)));
1704 /* See if any variables are substituted into the string. */
1706 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name
)))
1709 = (!substituted
? filename
1710 : make_specified_string (nm
, -1, endp
- nm
, multibyte
));
1711 Lisp_Object tmp
= call1 (Qsubstitute_env_in_file_name
, name
);
1713 if (!EQ (tmp
, name
))
1721 if (!NILP (Vw32_downcase_file_names
))
1722 filename
= Fdowncase (filename
);
1728 xnm
= SSDATA (filename
);
1729 x
= xnm
+ SBYTES (filename
);
1731 /* If /~ or // appears, discard everything through first slash. */
1732 while ((p
= search_embedded_absfilename (xnm
, x
)) != NULL
)
1733 /* This time we do not start over because we've already expanded envvars
1734 and replaced $$ with $. Maybe we should start over as well, but we'd
1735 need to quote some $ to $$ first. */
1739 if (!NILP (Vw32_downcase_file_names
))
1741 Lisp_Object xname
= make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1743 filename
= Fdowncase (xname
);
1747 if (xnm
!= SSDATA (filename
))
1748 filename
= make_specified_string (xnm
, -1, x
- xnm
, multibyte
);
1753 /* A slightly faster and more convenient way to get
1754 (directory-file-name (expand-file-name FOO)). */
1757 expand_and_dir_to_file (Lisp_Object filename
)
1759 Lisp_Object absname
= Fexpand_file_name (filename
, Qnil
);
1761 /* Remove final slash, if any (unless this is the root dir).
1762 stat behaves differently depending! */
1763 if (SCHARS (absname
) > 1
1764 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
1765 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
) - 2)))
1766 /* We cannot take shortcuts; they might be wrong for magic file names. */
1767 absname
= Fdirectory_file_name (absname
);
1771 /* Signal an error if the file ABSNAME already exists.
1772 If KNOWN_TO_EXIST, the file is known to exist.
1773 QUERYSTRING is a name for the action that is being considered
1775 If INTERACTIVE, ask the user whether to proceed,
1776 and bypass the error if the user says to go ahead.
1777 If QUICK, ask for y or n, not yes or no. */
1780 barf_or_query_if_file_exists (Lisp_Object absname
, bool known_to_exist
,
1781 const char *querystring
, bool interactive
,
1784 Lisp_Object tem
, encoded_filename
;
1785 struct stat statbuf
;
1787 encoded_filename
= ENCODE_FILE (absname
);
1789 if (! known_to_exist
&& lstat (SSDATA (encoded_filename
), &statbuf
) == 0)
1791 if (S_ISDIR (statbuf
.st_mode
))
1792 xsignal2 (Qfile_error
,
1793 build_string ("File is a directory"), absname
);
1794 known_to_exist
= true;
1800 xsignal2 (Qfile_already_exists
,
1801 build_string ("File already exists"), absname
);
1802 AUTO_STRING (format
, "File %s already exists; %s anyway? ");
1803 tem
= CALLN (Fformat
, format
, absname
, build_string (querystring
));
1805 tem
= call1 (intern ("y-or-n-p"), tem
);
1807 tem
= do_yes_or_no_p (tem
);
1809 xsignal2 (Qfile_already_exists
,
1810 build_string ("File already exists"), absname
);
1815 /* Copy data to DEST from SOURCE if possible. Return true if OK. */
1817 clone_file (int dest
, int source
)
1820 return ioctl (dest
, FICLONE
, source
) == 0;
1826 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
1827 "fCopy file: \nGCopy %s to file: \np\nP",
1828 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
1829 If NEWNAME is a directory name, copy FILE to a like-named file under
1832 This function always sets the file modes of the output file to match
1835 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1836 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil,
1837 signal a `file-already-exists' error without overwriting. If
1838 OK-IF-ALREADY-EXISTS is an integer, request confirmation from the user
1839 about overwriting; this is what happens in interactive use with M-x.
1840 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1843 Fourth arg KEEP-TIME non-nil means give the output file the same
1844 last-modified time as the old one. (This works on only some systems.)
1846 A prefix arg makes KEEP-TIME non-nil.
1848 If PRESERVE-UID-GID is non-nil, try to transfer the uid and gid of
1851 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1852 this includes the file modes, along with ACL entries and SELinux
1853 context if present. Otherwise, if NEWNAME is created its file
1854 permission bits are those of FILE, masked by the default file
1856 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
,
1857 Lisp_Object keep_time
, Lisp_Object preserve_uid_gid
,
1858 Lisp_Object preserve_permissions
)
1860 Lisp_Object handler
;
1861 ptrdiff_t count
= SPECPDL_INDEX ();
1862 Lisp_Object encoded_file
, encoded_newname
;
1864 security_context_t con
;
1870 bool already_exists
= false;
1876 file
= Fexpand_file_name (file
, Qnil
);
1877 newname
= expand_cp_target (file
, newname
);
1879 /* If the input file name has special constructs in it,
1880 call the corresponding file handler. */
1881 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1882 /* Likewise for output file name. */
1884 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1885 if (!NILP (handler
))
1886 return call7 (handler
, Qcopy_file
, file
, newname
,
1887 ok_if_already_exists
, keep_time
, preserve_uid_gid
,
1888 preserve_permissions
);
1890 encoded_file
= ENCODE_FILE (file
);
1891 encoded_newname
= ENCODE_FILE (newname
);
1894 if (NILP (ok_if_already_exists
)
1895 || INTEGERP (ok_if_already_exists
))
1896 barf_or_query_if_file_exists (newname
, false, "copy to it",
1897 INTEGERP (ok_if_already_exists
), false);
1899 result
= w32_copy_file (SSDATA (encoded_file
), SSDATA (encoded_newname
),
1900 !NILP (keep_time
), !NILP (preserve_uid_gid
),
1901 !NILP (preserve_permissions
));
1905 report_file_error ("Copying file", list2 (file
, newname
));
1907 report_file_error ("Copying permissions from", file
);
1909 xsignal2 (Qfile_date_error
,
1910 build_string ("Resetting file times"), newname
);
1912 report_file_error ("Copying permissions to", newname
);
1914 #else /* not WINDOWSNT */
1915 ifd
= emacs_open (SSDATA (encoded_file
), O_RDONLY
, 0);
1918 report_file_error ("Opening input file", file
);
1920 record_unwind_protect_int (close_file_unwind
, ifd
);
1922 if (fstat (ifd
, &st
) != 0)
1923 report_file_error ("Input file status", file
);
1925 if (!NILP (preserve_permissions
))
1928 if (is_selinux_enabled ())
1930 conlength
= fgetfilecon (ifd
, &con
);
1931 if (conlength
== -1)
1932 report_file_error ("Doing fgetfilecon", file
);
1937 /* We can copy only regular files. */
1938 if (!S_ISREG (st
.st_mode
))
1939 report_file_errno ("Non-regular file", file
,
1940 S_ISDIR (st
.st_mode
) ? EISDIR
: EINVAL
);
1943 new_mask
= st
.st_mode
& (!NILP (preserve_uid_gid
) ? 0700 : 0777);
1945 new_mask
= S_IREAD
| S_IWRITE
;
1948 ofd
= emacs_open (SSDATA (encoded_newname
), O_WRONLY
| O_CREAT
| O_EXCL
,
1950 if (ofd
< 0 && errno
== EEXIST
)
1952 if (NILP (ok_if_already_exists
) || INTEGERP (ok_if_already_exists
))
1953 barf_or_query_if_file_exists (newname
, true, "copy to it",
1954 INTEGERP (ok_if_already_exists
), false);
1955 already_exists
= true;
1956 ofd
= emacs_open (SSDATA (encoded_newname
), O_WRONLY
, 0);
1959 report_file_error ("Opening output file", newname
);
1961 record_unwind_protect_int (close_file_unwind
, ofd
);
1963 off_t oldsize
= 0, newsize
;
1968 if (fstat (ofd
, &out_st
) != 0)
1969 report_file_error ("Output file status", newname
);
1970 if (st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1971 report_file_errno ("Input and output files are the same",
1972 list2 (file
, newname
), 0);
1973 if (S_ISREG (out_st
.st_mode
))
1974 oldsize
= out_st
.st_size
;
1979 if (clone_file (ofd
, ifd
))
1980 newsize
= st
.st_size
;
1983 char buf
[MAX_ALLOCA
];
1985 for (newsize
= 0; 0 < (n
= emacs_read_quit (ifd
, buf
, sizeof buf
));
1987 if (emacs_write_quit (ofd
, buf
, n
) != n
)
1988 report_file_error ("Write error", newname
);
1990 report_file_error ("Read error", file
);
1993 /* Truncate any existing output file after writing the data. This
1994 is more likely to work than truncation before writing, if the
1995 file system is out of space or the user is over disk quota. */
1996 if (newsize
< oldsize
&& ftruncate (ofd
, newsize
) != 0)
1997 report_file_error ("Truncating output file", newname
);
2000 /* Preserve the original file permissions, and if requested, also its
2003 mode_t preserved_permissions
= st
.st_mode
& 07777;
2004 mode_t default_permissions
= st
.st_mode
& 0777 & ~realmask
;
2005 if (!NILP (preserve_uid_gid
))
2007 /* Attempt to change owner and group. If that doesn't work
2008 attempt to change just the group, as that is sometimes allowed.
2009 Adjust the mode mask to eliminate setuid or setgid bits
2010 or group permissions bits that are inappropriate if the
2011 owner or group are wrong. */
2012 if (fchown (ofd
, st
.st_uid
, st
.st_gid
) != 0)
2014 if (fchown (ofd
, -1, st
.st_gid
) == 0)
2015 preserved_permissions
&= ~04000;
2018 preserved_permissions
&= ~06000;
2020 /* Copy the other bits to the group bits, since the
2022 preserved_permissions
&= ~070;
2023 preserved_permissions
|= (preserved_permissions
& 7) << 3;
2024 default_permissions
&= ~070;
2025 default_permissions
|= (default_permissions
& 7) << 3;
2030 switch (!NILP (preserve_permissions
)
2031 ? qcopy_acl (SSDATA (encoded_file
), ifd
,
2032 SSDATA (encoded_newname
), ofd
,
2033 preserved_permissions
)
2035 || (new_mask
& ~realmask
) == default_permissions
)
2037 : fchmod (ofd
, default_permissions
))
2039 case -2: report_file_error ("Copying permissions from", file
);
2040 case -1: report_file_error ("Copying permissions to", newname
);
2043 #endif /* not MSDOS */
2048 /* Set the modified context back to the file. */
2049 bool fail
= fsetfilecon (ofd
, con
) != 0;
2050 /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
2051 if (fail
&& errno
!= ENOTSUP
)
2052 report_file_error ("Doing fsetfilecon", newname
);
2058 if (!NILP (keep_time
))
2060 struct timespec atime
= get_stat_atime (&st
);
2061 struct timespec mtime
= get_stat_mtime (&st
);
2062 if (set_file_times (ofd
, SSDATA (encoded_newname
), atime
, mtime
) != 0)
2063 xsignal2 (Qfile_date_error
,
2064 build_string ("Cannot set file date"), newname
);
2067 if (emacs_close (ofd
) < 0)
2068 report_file_error ("Write error", newname
);
2073 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2074 and if it can't, it tells so. Otherwise, under MSDOS we usually
2075 get only the READ bit, which will make the copied file read-only,
2076 so it's better not to chmod at all. */
2077 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2078 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2080 #endif /* not WINDOWSNT */
2082 /* Discard the unwind protects. */
2083 specpdl_ptr
= specpdl
+ count
;
2088 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2089 Smake_directory_internal
, 1, 1, 0,
2090 doc
: /* Create a new directory named DIRECTORY. */)
2091 (Lisp_Object directory
)
2094 Lisp_Object handler
;
2095 Lisp_Object encoded_dir
;
2097 CHECK_STRING (directory
);
2098 directory
= Fexpand_file_name (directory
, Qnil
);
2100 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2101 if (!NILP (handler
))
2102 return call2 (handler
, Qmake_directory_internal
, directory
);
2104 encoded_dir
= ENCODE_FILE (directory
);
2106 dir
= SSDATA (encoded_dir
);
2108 if (mkdir (dir
, 0777 & ~auto_saving_dir_umask
) != 0)
2109 report_file_error ("Creating directory", directory
);
2114 DEFUN ("delete-directory-internal", Fdelete_directory_internal
,
2115 Sdelete_directory_internal
, 1, 1, 0,
2116 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2117 (Lisp_Object directory
)
2120 Lisp_Object encoded_dir
;
2122 CHECK_STRING (directory
);
2123 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2124 encoded_dir
= ENCODE_FILE (directory
);
2125 dir
= SSDATA (encoded_dir
);
2127 if (rmdir (dir
) != 0)
2128 report_file_error ("Removing directory", directory
);
2133 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 2,
2134 "(list (read-file-name \
2135 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2136 \"Move file to trash: \" \"Delete file: \") \
2137 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2138 (null current-prefix-arg))",
2139 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2140 If file has multiple names, it continues to exist with the other names.
2141 TRASH non-nil means to trash the file instead of deleting, provided
2142 `delete-by-moving-to-trash' is non-nil.
2144 When called interactively, TRASH is t if no prefix argument is given.
2145 With a prefix argument, TRASH is nil. */)
2146 (Lisp_Object filename
, Lisp_Object trash
)
2148 Lisp_Object handler
;
2149 Lisp_Object encoded_file
;
2151 if (!NILP (Ffile_directory_p (filename
))
2152 && NILP (Ffile_symlink_p (filename
)))
2153 xsignal2 (Qfile_error
,
2154 build_string ("Removing old name: is a directory"),
2156 filename
= Fexpand_file_name (filename
, Qnil
);
2158 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2159 if (!NILP (handler
))
2160 return call3 (handler
, Qdelete_file
, filename
, trash
);
2162 if (delete_by_moving_to_trash
&& !NILP (trash
))
2163 return call1 (Qmove_file_to_trash
, filename
);
2165 encoded_file
= ENCODE_FILE (filename
);
2167 if (unlink (SSDATA (encoded_file
)) != 0 && errno
!= ENOENT
)
2168 report_file_error ("Removing old name", filename
);
2173 internal_delete_file_1 (Lisp_Object ignore
)
2178 /* Delete file FILENAME, returning true if successful.
2179 This ignores `delete-by-moving-to-trash'. */
2182 internal_delete_file (Lisp_Object filename
)
2186 tem
= internal_condition_case_2 (Fdelete_file
, filename
, Qnil
,
2187 Qt
, internal_delete_file_1
);
2191 /* Filesystems are case-sensitive on all supported systems except
2192 MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always
2193 case-insensitive on the first two, but they may or may not be
2194 case-insensitive on Cygwin and OS X. The following function
2195 attempts to provide a runtime test on those two systems. If the
2196 test is not conclusive, we assume case-insensitivity on Cygwin and
2197 case-sensitivity on Mac OS X.
2199 FIXME: Mounted filesystems on Posix hosts, like Samba shares or
2200 NFS-mounted Windows volumes, might be case-insensitive. Can we
2204 file_name_case_insensitive_p (const char *filename
)
2206 /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
2207 those flags are available. As of this writing (2017-05-20),
2208 Cygwin is the only platform known to support the former (starting
2209 with Cygwin-2.6.1), and macOS is the only platform known to
2210 support the latter. */
2212 #ifdef _PC_CASE_INSENSITIVE
2213 int res
= pathconf (filename
, _PC_CASE_INSENSITIVE
);
2216 #elif defined _PC_CASE_SENSITIVE
2217 int res
= pathconf (filename
, _PC_CASE_SENSITIVE
);
2222 #if defined CYGWIN || defined DOS_NT
2229 DEFUN ("file-name-case-insensitive-p", Ffile_name_case_insensitive_p
,
2230 Sfile_name_case_insensitive_p
, 1, 1, 0,
2231 doc
: /* Return t if file FILENAME is on a case-insensitive filesystem.
2232 The arg must be a string. */)
2233 (Lisp_Object filename
)
2235 Lisp_Object handler
;
2237 CHECK_STRING (filename
);
2238 filename
= Fexpand_file_name (filename
, Qnil
);
2240 /* If the file name has special constructs in it,
2241 call the corresponding file handler. */
2242 handler
= Ffind_file_name_handler (filename
, Qfile_name_case_insensitive_p
);
2243 if (!NILP (handler
))
2244 return call2 (handler
, Qfile_name_case_insensitive_p
, filename
);
2246 filename
= ENCODE_FILE (filename
);
2247 return file_name_case_insensitive_p (SSDATA (filename
)) ? Qt
: Qnil
;
2250 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2251 "fRename file: \nGRename %s to file: \np",
2252 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2253 If file has names other than FILE, it continues to have those names.
2254 If NEWNAME is a directory name, rename FILE to a like-named file under
2257 Signal a `file-already-exists' error if a file NEWNAME already exists
2258 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2259 An integer third arg means request confirmation if NEWNAME already exists.
2260 This is what happens in interactive use with M-x. */)
2261 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2263 Lisp_Object handler
;
2264 Lisp_Object encoded_file
, encoded_newname
;
2266 file
= Fexpand_file_name (file
, Qnil
);
2268 /* If the filesystem is case-insensitive and the file names are
2269 identical but for case, treat it as a change-case request, and do
2270 not worry whether NEWNAME exists or whether it is a directory, as
2271 it is already another name for FILE. */
2272 bool case_only_rename
= false;
2273 #if defined CYGWIN || defined DOS_NT
2274 if (!NILP (Ffile_name_case_insensitive_p (file
)))
2276 newname
= Fexpand_file_name (newname
, Qnil
);
2277 case_only_rename
= !NILP (Fstring_equal (Fdowncase (file
),
2278 Fdowncase (newname
)));
2282 if (!case_only_rename
)
2283 newname
= expand_cp_target (Fdirectory_file_name (file
), newname
);
2285 /* If the file name has special constructs in it,
2286 call the corresponding file handler. */
2287 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2289 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2290 if (!NILP (handler
))
2291 return call4 (handler
, Qrename_file
,
2292 file
, newname
, ok_if_already_exists
);
2294 encoded_file
= ENCODE_FILE (file
);
2295 encoded_newname
= ENCODE_FILE (newname
);
2297 bool plain_rename
= (case_only_rename
2298 || (!NILP (ok_if_already_exists
)
2299 && !INTEGERP (ok_if_already_exists
)));
2303 if (renameat_noreplace (AT_FDCWD
, SSDATA (encoded_file
),
2304 AT_FDCWD
, SSDATA (encoded_newname
))
2308 rename_errno
= errno
;
2309 switch (rename_errno
)
2311 case EEXIST
: case EINVAL
: case ENOSYS
:
2312 #if ENOSYS != ENOTSUP
2315 barf_or_query_if_file_exists (newname
, rename_errno
== EEXIST
,
2317 INTEGERP (ok_if_already_exists
),
2319 plain_rename
= true;
2326 if (rename (SSDATA (encoded_file
), SSDATA (encoded_newname
)) == 0)
2328 rename_errno
= errno
;
2329 /* Don't prompt again. */
2330 ok_if_already_exists
= Qt
;
2332 else if (!NILP (ok_if_already_exists
))
2333 ok_if_already_exists
= Qt
;
2335 if (rename_errno
!= EXDEV
)
2336 report_file_errno ("Renaming", list2 (file
, newname
), rename_errno
);
2338 struct stat file_st
;
2339 bool dirp
= !NILP (Fdirectory_name_p (file
));
2342 if (lstat (SSDATA (encoded_file
), &file_st
) != 0)
2343 report_file_error ("Renaming", list2 (file
, newname
));
2344 dirp
= S_ISDIR (file_st
.st_mode
) != 0;
2347 call4 (Qcopy_directory
, file
, newname
, Qt
, Qnil
);
2350 Lisp_Object symlink_target
2351 = (S_ISLNK (file_st
.st_mode
)
2352 ? emacs_readlinkat (AT_FDCWD
, SSDATA (encoded_file
))
2354 if (!NILP (symlink_target
))
2355 Fmake_symbolic_link (symlink_target
, newname
, ok_if_already_exists
);
2357 Fcopy_file (file
, newname
, ok_if_already_exists
, Qt
, Qt
, Qt
);
2360 ptrdiff_t count
= SPECPDL_INDEX ();
2361 specbind (Qdelete_by_moving_to_trash
, Qnil
);
2363 call2 (Qdelete_directory
, file
, Qt
);
2365 Fdelete_file (file
, Qnil
);
2366 return unbind_to (count
, Qnil
);
2369 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2370 "fAdd name to file: \nGName to add to %s: \np",
2371 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2372 If NEWNAME is a directory name, give FILE a like-named new name under
2375 Signal a `file-already-exists' error if a file NEWNAME already exists
2376 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2377 An integer third arg means request confirmation if NEWNAME already exists.
2378 This is what happens in interactive use with M-x. */)
2379 (Lisp_Object file
, Lisp_Object newname
, Lisp_Object ok_if_already_exists
)
2381 Lisp_Object handler
;
2382 Lisp_Object encoded_file
, encoded_newname
;
2384 file
= Fexpand_file_name (file
, Qnil
);
2385 newname
= expand_cp_target (file
, newname
);
2387 /* If the file name has special constructs in it,
2388 call the corresponding file handler. */
2389 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2390 if (!NILP (handler
))
2391 return call4 (handler
, Qadd_name_to_file
, file
,
2392 newname
, ok_if_already_exists
);
2394 /* If the new name has special constructs in it,
2395 call the corresponding file handler. */
2396 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2397 if (!NILP (handler
))
2398 return call4 (handler
, Qadd_name_to_file
, file
,
2399 newname
, ok_if_already_exists
);
2401 encoded_file
= ENCODE_FILE (file
);
2402 encoded_newname
= ENCODE_FILE (newname
);
2404 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) == 0)
2407 if (errno
== EEXIST
)
2409 if (NILP (ok_if_already_exists
)
2410 || INTEGERP (ok_if_already_exists
))
2411 barf_or_query_if_file_exists (newname
, true, "make it a new name",
2412 INTEGERP (ok_if_already_exists
), false);
2413 unlink (SSDATA (newname
));
2414 if (link (SSDATA (encoded_file
), SSDATA (encoded_newname
)) == 0)
2418 report_file_error ("Adding new name", list2 (file
, newname
));
2421 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2422 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2423 doc
: /* Make a symbolic link to TARGET, named NEWNAME.
2424 If NEWNAME is a directory name, make a like-named symbolic link under
2427 Signal a `file-already-exists' error if a file NEWNAME already exists
2428 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2429 An integer third arg means request confirmation if NEWNAME already
2430 exists, and expand leading "~" or strip leading "/:" in TARGET.
2431 This happens for interactive use with M-x. */)
2432 (Lisp_Object target
, Lisp_Object linkname
, Lisp_Object ok_if_already_exists
)
2434 Lisp_Object handler
;
2435 Lisp_Object encoded_target
, encoded_linkname
;
2437 CHECK_STRING (target
);
2438 if (INTEGERP (ok_if_already_exists
))
2440 if (SREF (target
, 0) == '~')
2441 target
= Fexpand_file_name (target
, Qnil
);
2442 else if (SREF (target
, 0) == '/' && SREF (target
, 1) == ':')
2443 target
= Fsubstring_no_properties (target
, make_number (2), Qnil
);
2445 linkname
= expand_cp_target (target
, linkname
);
2447 /* If the new link name has special constructs in it,
2448 call the corresponding file handler. */
2449 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2450 if (!NILP (handler
))
2451 return call4 (handler
, Qmake_symbolic_link
, target
,
2452 linkname
, ok_if_already_exists
);
2454 encoded_target
= ENCODE_FILE (target
);
2455 encoded_linkname
= ENCODE_FILE (linkname
);
2457 if (symlink (SSDATA (encoded_target
), SSDATA (encoded_linkname
)) == 0)
2460 if (errno
== ENOSYS
)
2461 xsignal1 (Qfile_error
,
2462 build_string ("Symbolic links are not supported"));
2464 if (errno
== EEXIST
)
2466 if (NILP (ok_if_already_exists
)
2467 || INTEGERP (ok_if_already_exists
))
2468 barf_or_query_if_file_exists (linkname
, true, "make it a link",
2469 INTEGERP (ok_if_already_exists
), false);
2470 unlink (SSDATA (encoded_linkname
));
2471 if (symlink (SSDATA (encoded_target
), SSDATA (encoded_linkname
)) == 0)
2475 report_file_error ("Making symbolic link", list2 (target
, linkname
));
2479 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2481 doc
: /* Return t if FILENAME is an absolute file name or starts with `~'.
2482 On Unix, absolute file names start with `/'. */)
2483 (Lisp_Object filename
)
2485 CHECK_STRING (filename
);
2486 return file_name_absolute_p (SSDATA (filename
)) ? Qt
: Qnil
;
2489 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2490 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
2491 See also `file-readable-p' and `file-attributes'.
2492 This returns nil for a symlink to a nonexistent file.
2493 Use `file-symlink-p' to test for such links. */)
2494 (Lisp_Object filename
)
2496 Lisp_Object absname
;
2497 Lisp_Object handler
;
2499 CHECK_STRING (filename
);
2500 absname
= Fexpand_file_name (filename
, Qnil
);
2502 /* If the file name has special constructs in it,
2503 call the corresponding file handler. */
2504 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2505 if (!NILP (handler
))
2507 Lisp_Object result
= call2 (handler
, Qfile_exists_p
, absname
);
2512 absname
= ENCODE_FILE (absname
);
2514 return check_existing (SSDATA (absname
)) ? Qt
: Qnil
;
2517 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2518 doc
: /* Return t if FILENAME can be executed by you.
2519 For a directory, this means you can access files in that directory.
2520 \(It is generally better to use `file-accessible-directory-p' for that
2521 purpose, though.) */)
2522 (Lisp_Object filename
)
2524 Lisp_Object absname
;
2525 Lisp_Object handler
;
2527 CHECK_STRING (filename
);
2528 absname
= Fexpand_file_name (filename
, Qnil
);
2530 /* If the file name has special constructs in it,
2531 call the corresponding file handler. */
2532 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2533 if (!NILP (handler
))
2534 return call2 (handler
, Qfile_executable_p
, absname
);
2536 absname
= ENCODE_FILE (absname
);
2538 return (check_executable (SSDATA (absname
)) ? Qt
: Qnil
);
2541 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2542 doc
: /* Return t if file FILENAME exists and you can read it.
2543 See also `file-exists-p' and `file-attributes'. */)
2544 (Lisp_Object filename
)
2546 Lisp_Object absname
;
2547 Lisp_Object handler
;
2549 CHECK_STRING (filename
);
2550 absname
= Fexpand_file_name (filename
, Qnil
);
2552 /* If the file name has special constructs in it,
2553 call the corresponding file handler. */
2554 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2555 if (!NILP (handler
))
2556 return call2 (handler
, Qfile_readable_p
, absname
);
2558 absname
= ENCODE_FILE (absname
);
2559 return (faccessat (AT_FDCWD
, SSDATA (absname
), R_OK
, AT_EACCESS
) == 0
2563 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2564 doc
: /* Return t if file FILENAME can be written or created by you. */)
2565 (Lisp_Object filename
)
2567 Lisp_Object absname
, dir
, encoded
;
2568 Lisp_Object handler
;
2570 CHECK_STRING (filename
);
2571 absname
= Fexpand_file_name (filename
, Qnil
);
2573 /* If the file name has special constructs in it,
2574 call the corresponding file handler. */
2575 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2576 if (!NILP (handler
))
2577 return call2 (handler
, Qfile_writable_p
, absname
);
2579 encoded
= ENCODE_FILE (absname
);
2580 if (check_writable (SSDATA (encoded
), W_OK
))
2582 if (errno
!= ENOENT
)
2585 dir
= Ffile_name_directory (absname
);
2586 eassert (!NILP (dir
));
2588 dir
= Fdirectory_file_name (dir
);
2591 dir
= ENCODE_FILE (dir
);
2593 /* The read-only attribute of the parent directory doesn't affect
2594 whether a file or directory can be created within it. Some day we
2595 should check ACLs though, which do affect this. */
2596 return file_directory_p (SSDATA (dir
)) ? Qt
: Qnil
;
2598 return check_writable (SSDATA (dir
), W_OK
| X_OK
) ? Qt
: Qnil
;
2602 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2603 doc
: /* Access file FILENAME, and get an error if that does not work.
2604 The second argument STRING is prepended to the error message.
2605 If there is no error, returns nil. */)
2606 (Lisp_Object filename
, Lisp_Object string
)
2608 Lisp_Object handler
, encoded_filename
, absname
;
2610 CHECK_STRING (filename
);
2611 absname
= Fexpand_file_name (filename
, Qnil
);
2613 CHECK_STRING (string
);
2615 /* If the file name has special constructs in it,
2616 call the corresponding file handler. */
2617 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
2618 if (!NILP (handler
))
2619 return call3 (handler
, Qaccess_file
, absname
, string
);
2621 encoded_filename
= ENCODE_FILE (absname
);
2623 if (faccessat (AT_FDCWD
, SSDATA (encoded_filename
), R_OK
, AT_EACCESS
) != 0)
2624 report_file_error (SSDATA (string
), filename
);
2629 /* Relative to directory FD, return the symbolic link value of FILENAME.
2630 On failure, return nil. */
2632 emacs_readlinkat (int fd
, char const *filename
)
2634 static struct allocator
const emacs_norealloc_allocator
=
2635 { xmalloc
, NULL
, xfree
, memory_full
};
2637 char readlink_buf
[1024];
2638 char *buf
= careadlinkat (fd
, filename
, readlink_buf
, sizeof readlink_buf
,
2639 &emacs_norealloc_allocator
, readlinkat
);
2643 val
= build_unibyte_string (buf
);
2644 if (buf
!= readlink_buf
)
2646 val
= DECODE_FILE (val
);
2650 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2651 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
2652 The value is the link target, as a string.
2653 Otherwise it returns nil.
2655 This function does not check whether the link target exists. */)
2656 (Lisp_Object filename
)
2658 Lisp_Object handler
;
2660 CHECK_STRING (filename
);
2661 filename
= Fexpand_file_name (filename
, Qnil
);
2663 /* If the file name has special constructs in it,
2664 call the corresponding file handler. */
2665 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2666 if (!NILP (handler
))
2667 return call2 (handler
, Qfile_symlink_p
, filename
);
2669 filename
= ENCODE_FILE (filename
);
2671 return emacs_readlinkat (AT_FDCWD
, SSDATA (filename
));
2674 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2675 doc
: /* Return t if FILENAME names an existing directory.
2676 Symbolic links to directories count as directories.
2677 See `file-symlink-p' to distinguish symlinks. */)
2678 (Lisp_Object filename
)
2680 Lisp_Object absname
= expand_and_dir_to_file (filename
);
2682 /* If the file name has special constructs in it,
2683 call the corresponding file handler. */
2684 Lisp_Object handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2685 if (!NILP (handler
))
2686 return call2 (handler
, Qfile_directory_p
, absname
);
2688 absname
= ENCODE_FILE (absname
);
2690 return file_directory_p (SSDATA (absname
)) ? Qt
: Qnil
;
2693 /* Return true if FILE is a directory or a symlink to a directory. */
2695 file_directory_p (char const *file
)
2698 /* This is cheaper than 'stat'. */
2699 return faccessat (AT_FDCWD
, file
, D_OK
, AT_EACCESS
) == 0;
2702 return stat (file
, &st
) == 0 && S_ISDIR (st
.st_mode
);
2706 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
,
2707 Sfile_accessible_directory_p
, 1, 1, 0,
2708 doc
: /* Return t if FILENAME names a directory you can open.
2709 For the value to be t, FILENAME must specify the name of a directory
2710 as a file, and the directory must allow you to open files in it. In
2711 order to use a directory as a buffer's current directory, this
2712 predicate must return true. A directory name spec may be given
2713 instead; then the value is t if the directory so specified exists and
2714 really is a readable and searchable directory. */)
2715 (Lisp_Object filename
)
2717 Lisp_Object absname
;
2718 Lisp_Object handler
;
2720 CHECK_STRING (filename
);
2721 absname
= Fexpand_file_name (filename
, Qnil
);
2723 /* If the file name has special constructs in it,
2724 call the corresponding file handler. */
2725 handler
= Ffind_file_name_handler (absname
, Qfile_accessible_directory_p
);
2726 if (!NILP (handler
))
2728 Lisp_Object r
= call2 (handler
, Qfile_accessible_directory_p
, absname
);
2730 /* Set errno in case the handler failed. EACCES might be a lie
2731 (e.g., the directory might not exist, or be a regular file),
2732 but at least it does TRT in the "usual" case of an existing
2733 directory that is not accessible by the current user, and
2734 avoids reporting "Success" for a failed operation. Perhaps
2735 someday we can fix this in a better way, by improving
2736 file-accessible-directory-p's API; see Bug#25419. */
2743 absname
= ENCODE_FILE (absname
);
2744 return file_accessible_directory_p (absname
) ? Qt
: Qnil
;
2747 /* If FILE is a searchable directory or a symlink to a
2748 searchable directory, return true. Otherwise return
2749 false and set errno to an error number. */
2751 file_accessible_directory_p (Lisp_Object file
)
2755 /* We need a special-purpose test because (a) NTFS security data is
2756 not reflected in Posix-style mode bits, and (b) the trick with
2757 accessing "DIR/.", used below on Posix hosts, doesn't work on
2758 Windows, because "DIR/." is normalized to just "DIR" before
2759 hitting the disk. */
2760 return (SBYTES (file
) == 0
2761 || w32_accessible_directory_p (SSDATA (file
), SBYTES (file
)));
2763 return file_directory_p (SSDATA (file
));
2766 /* On POSIXish platforms, use just one system call; this avoids a
2767 race and is typically faster. */
2768 const char *data
= SSDATA (file
);
2769 ptrdiff_t len
= SBYTES (file
);
2775 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2776 There are three exceptions: "", "/", and "//". Leave "" alone,
2777 as it's invalid. Append only "." to the other two exceptions as
2778 "/" and "//" are distinct on some platforms, whereas "/", "///",
2779 "////", etc. are all equivalent. */
2784 /* Just check for trailing '/' when deciding whether to append '/'.
2785 That's simpler than testing the two special cases "/" and "//",
2786 and it's a safe optimization here. */
2787 char *buf
= SAFE_ALLOCA (len
+ 3);
2788 memcpy (buf
, data
, len
);
2789 strcpy (buf
+ len
, &"/."[data
[len
- 1] == '/']);
2793 ok
= check_existing (dir
);
2794 saved_errno
= errno
;
2796 errno
= saved_errno
;
2798 #endif /* !DOS_NT */
2801 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2802 doc
: /* Return t if FILENAME names a regular file.
2803 This is the sort of file that holds an ordinary stream of data bytes.
2804 Symbolic links to regular files count as regular files.
2805 See `file-symlink-p' to distinguish symlinks. */)
2806 (Lisp_Object filename
)
2809 Lisp_Object absname
= expand_and_dir_to_file (filename
);
2811 /* If the file name has special constructs in it,
2812 call the corresponding file handler. */
2813 Lisp_Object handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2814 if (!NILP (handler
))
2815 return call2 (handler
, Qfile_regular_p
, absname
);
2817 absname
= ENCODE_FILE (absname
);
2822 Lisp_Object tem
= Vw32_get_true_file_attributes
;
2824 /* Tell stat to use expensive method to get accurate info. */
2825 Vw32_get_true_file_attributes
= Qt
;
2826 result
= stat (SSDATA (absname
), &st
);
2827 Vw32_get_true_file_attributes
= tem
;
2831 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2834 if (stat (SSDATA (absname
), &st
) < 0)
2836 return S_ISREG (st
.st_mode
) ? Qt
: Qnil
;
2840 DEFUN ("file-selinux-context", Ffile_selinux_context
,
2841 Sfile_selinux_context
, 1, 1, 0,
2842 doc
: /* Return SELinux context of file named FILENAME.
2843 The return value is a list (USER ROLE TYPE RANGE), where the list
2844 elements are strings naming the user, role, type, and range of the
2845 file's SELinux security context.
2847 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2848 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2849 (Lisp_Object filename
)
2851 Lisp_Object user
= Qnil
, role
= Qnil
, type
= Qnil
, range
= Qnil
;
2852 Lisp_Object absname
= expand_and_dir_to_file (filename
);
2854 /* If the file name has special constructs in it,
2855 call the corresponding file handler. */
2856 Lisp_Object handler
= Ffind_file_name_handler (absname
,
2857 Qfile_selinux_context
);
2858 if (!NILP (handler
))
2859 return call2 (handler
, Qfile_selinux_context
, absname
);
2861 absname
= ENCODE_FILE (absname
);
2864 if (is_selinux_enabled ())
2866 security_context_t con
;
2867 int conlength
= lgetfilecon (SSDATA (absname
), &con
);
2870 context_t context
= context_new (con
);
2871 if (context_user_get (context
))
2872 user
= build_string (context_user_get (context
));
2873 if (context_role_get (context
))
2874 role
= build_string (context_role_get (context
));
2875 if (context_type_get (context
))
2876 type
= build_string (context_type_get (context
));
2877 if (context_range_get (context
))
2878 range
= build_string (context_range_get (context
));
2879 context_free (context
);
2885 return list4 (user
, role
, type
, range
);
2888 DEFUN ("set-file-selinux-context", Fset_file_selinux_context
,
2889 Sset_file_selinux_context
, 2, 2, 0,
2890 doc
: /* Set SELinux context of file named FILENAME to CONTEXT.
2891 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2892 elements are strings naming the components of a SELinux context.
2894 Value is t if setting of SELinux context was successful, nil otherwise.
2896 This function does nothing and returns nil if SELinux is disabled,
2897 or if Emacs was not compiled with SELinux support. */)
2898 (Lisp_Object filename
, Lisp_Object context
)
2900 Lisp_Object absname
;
2901 Lisp_Object handler
;
2903 Lisp_Object encoded_absname
;
2904 Lisp_Object user
= CAR_SAFE (context
);
2905 Lisp_Object role
= CAR_SAFE (CDR_SAFE (context
));
2906 Lisp_Object type
= CAR_SAFE (CDR_SAFE (CDR_SAFE (context
)));
2907 Lisp_Object range
= CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context
))));
2908 security_context_t con
;
2911 context_t parsed_con
;
2914 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
2916 /* If the file name has special constructs in it,
2917 call the corresponding file handler. */
2918 handler
= Ffind_file_name_handler (absname
, Qset_file_selinux_context
);
2919 if (!NILP (handler
))
2920 return call3 (handler
, Qset_file_selinux_context
, absname
, context
);
2923 if (is_selinux_enabled ())
2925 /* Get current file context. */
2926 encoded_absname
= ENCODE_FILE (absname
);
2927 conlength
= lgetfilecon (SSDATA (encoded_absname
), &con
);
2930 parsed_con
= context_new (con
);
2931 /* Change the parts defined in the parameter.*/
2934 if (context_user_set (parsed_con
, SSDATA (user
)))
2935 error ("Doing context_user_set");
2939 if (context_role_set (parsed_con
, SSDATA (role
)))
2940 error ("Doing context_role_set");
2944 if (context_type_set (parsed_con
, SSDATA (type
)))
2945 error ("Doing context_type_set");
2947 if (STRINGP (range
))
2949 if (context_range_set (parsed_con
, SSDATA (range
)))
2950 error ("Doing context_range_set");
2953 /* Set the modified context back to the file. */
2954 fail
= (lsetfilecon (SSDATA (encoded_absname
),
2955 context_str (parsed_con
))
2957 /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
2958 if (fail
&& errno
!= ENOTSUP
)
2959 report_file_error ("Doing lsetfilecon", absname
);
2961 context_free (parsed_con
);
2963 return fail
? Qnil
: Qt
;
2966 report_file_error ("Doing lgetfilecon", absname
);
2973 DEFUN ("file-acl", Ffile_acl
, Sfile_acl
, 1, 1, 0,
2974 doc
: /* Return ACL entries of file named FILENAME.
2975 The entries are returned in a format suitable for use in `set-file-acl'
2976 but is otherwise undocumented and subject to change.
2977 Return nil if file does not exist or is not accessible, or if Emacs
2978 was unable to determine the ACL entries. */)
2979 (Lisp_Object filename
)
2981 Lisp_Object acl_string
= Qnil
;
2984 Lisp_Object absname
= expand_and_dir_to_file (filename
);
2986 /* If the file name has special constructs in it,
2987 call the corresponding file handler. */
2988 Lisp_Object handler
= Ffind_file_name_handler (absname
, Qfile_acl
);
2989 if (!NILP (handler
))
2990 return call2 (handler
, Qfile_acl
, absname
);
2992 # ifdef HAVE_ACL_SET_FILE
2993 absname
= ENCODE_FILE (absname
);
2995 # ifndef HAVE_ACL_TYPE_EXTENDED
2996 acl_type_t ACL_TYPE_EXTENDED
= ACL_TYPE_ACCESS
;
2998 acl_t acl
= acl_get_file (SSDATA (absname
), ACL_TYPE_EXTENDED
);
3002 char *str
= acl_to_text (acl
, NULL
);
3009 acl_string
= build_string (str
);
3018 DEFUN ("set-file-acl", Fset_file_acl
, Sset_file_acl
,
3020 doc
: /* Set ACL of file named FILENAME to ACL-STRING.
3021 ACL-STRING should contain the textual representation of the ACL
3022 entries in a format suitable for the platform.
3024 Value is t if setting of ACL was successful, nil otherwise.
3026 Setting ACL for local files requires Emacs to be built with ACL
3028 (Lisp_Object filename
, Lisp_Object acl_string
)
3031 Lisp_Object absname
;
3032 Lisp_Object handler
;
3033 # ifdef HAVE_ACL_SET_FILE
3034 Lisp_Object encoded_absname
;
3039 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3041 /* If the file name has special constructs in it,
3042 call the corresponding file handler. */
3043 handler
= Ffind_file_name_handler (absname
, Qset_file_acl
);
3044 if (!NILP (handler
))
3045 return call3 (handler
, Qset_file_acl
, absname
, acl_string
);
3047 # ifdef HAVE_ACL_SET_FILE
3048 if (STRINGP (acl_string
))
3050 acl
= acl_from_text (SSDATA (acl_string
));
3053 report_file_error ("Converting ACL", absname
);
3057 encoded_absname
= ENCODE_FILE (absname
);
3059 fail
= (acl_set_file (SSDATA (encoded_absname
), ACL_TYPE_ACCESS
,
3062 if (fail
&& acl_errno_valid (errno
))
3063 report_file_error ("Setting ACL", absname
);
3066 return fail
? Qnil
: Qt
;
3074 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3075 doc
: /* Return mode bits of file named FILENAME, as an integer.
3076 Return nil, if file does not exist or is not accessible. */)
3077 (Lisp_Object filename
)
3080 Lisp_Object absname
= expand_and_dir_to_file (filename
);
3082 /* If the file name has special constructs in it,
3083 call the corresponding file handler. */
3084 Lisp_Object handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3085 if (!NILP (handler
))
3086 return call2 (handler
, Qfile_modes
, absname
);
3088 absname
= ENCODE_FILE (absname
);
3090 if (stat (SSDATA (absname
), &st
) < 0)
3093 return make_number (st
.st_mode
& 07777);
3096 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3097 "(let ((file (read-file-name \"File: \"))) \
3098 (list file (read-file-modes nil file)))",
3099 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3100 Only the 12 low bits of MODE are used.
3102 Interactively, mode bits are read by `read-file-modes', which accepts
3103 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3104 (Lisp_Object filename
, Lisp_Object mode
)
3106 Lisp_Object absname
, encoded_absname
;
3107 Lisp_Object handler
;
3109 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3110 CHECK_NUMBER (mode
);
3112 /* If the file name has special constructs in it,
3113 call the corresponding file handler. */
3114 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3115 if (!NILP (handler
))
3116 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3118 encoded_absname
= ENCODE_FILE (absname
);
3120 if (chmod (SSDATA (encoded_absname
), XINT (mode
) & 07777) < 0)
3121 report_file_error ("Doing chmod", absname
);
3126 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3127 doc
: /* Set the file permission bits for newly created files.
3128 The argument MODE should be an integer; only the low 9 bits are used.
3129 This setting is inherited by subprocesses. */)
3132 mode_t oldrealmask
, oldumask
, newumask
;
3133 CHECK_NUMBER (mode
);
3134 oldrealmask
= realmask
;
3135 newumask
= ~ XINT (mode
) & 0777;
3138 realmask
= newumask
;
3139 oldumask
= umask (newumask
);
3142 eassert (oldumask
== oldrealmask
);
3146 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3147 doc
: /* Return the default file protection for created files.
3148 The value is an integer. */)
3152 XSETINT (value
, (~ realmask
) & 0777);
3157 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3158 doc
: /* Set times of file FILENAME to TIMESTAMP.
3159 Set both access and modification times.
3160 Return t on success, else nil.
3161 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3163 (Lisp_Object filename
, Lisp_Object timestamp
)
3165 Lisp_Object absname
, encoded_absname
;
3166 Lisp_Object handler
;
3167 struct timespec t
= lisp_time_argument (timestamp
);
3169 absname
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
3171 /* If the file name has special constructs in it,
3172 call the corresponding file handler. */
3173 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3174 if (!NILP (handler
))
3175 return call3 (handler
, Qset_file_times
, absname
, timestamp
);
3177 encoded_absname
= ENCODE_FILE (absname
);
3180 if (set_file_times (-1, SSDATA (encoded_absname
), t
, t
) != 0)
3183 /* Setting times on a directory always fails. */
3184 if (file_directory_p (SSDATA (encoded_absname
)))
3187 report_file_error ("Setting file times", absname
);
3195 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3196 doc
: /* Tell Unix to finish all pending disk updates. */)
3203 #endif /* HAVE_SYNC */
3205 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3206 doc
: /* Return t if file FILE1 is newer than file FILE2.
3207 If FILE1 does not exist, the answer is nil;
3208 otherwise, if FILE2 does not exist, the answer is t. */)
3209 (Lisp_Object file1
, Lisp_Object file2
)
3211 struct stat st1
, st2
;
3213 CHECK_STRING (file1
);
3214 CHECK_STRING (file2
);
3216 Lisp_Object absname1
= expand_and_dir_to_file (file1
);
3217 Lisp_Object absname2
= expand_and_dir_to_file (file2
);
3219 /* If the file name has special constructs in it,
3220 call the corresponding file handler. */
3221 Lisp_Object handler
= Ffind_file_name_handler (absname1
,
3222 Qfile_newer_than_file_p
);
3224 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3225 if (!NILP (handler
))
3226 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3228 absname1
= ENCODE_FILE (absname1
);
3229 absname2
= ENCODE_FILE (absname2
);
3231 if (stat (SSDATA (absname1
), &st1
) < 0)
3234 if (stat (SSDATA (absname2
), &st2
) < 0)
3237 return (timespec_cmp (get_stat_mtime (&st2
), get_stat_mtime (&st1
)) < 0
3241 enum { READ_BUF_SIZE
= MAX_ALLOCA
};
3243 /* This function is called after Lisp functions to decide a coding
3244 system are called, or when they cause an error. Before they are
3245 called, the current buffer is set unibyte and it contains only a
3246 newly inserted text (thus the buffer was empty before the
3249 The functions may set markers, overlays, text properties, or even
3250 alter the buffer contents, change the current buffer.
3252 Here, we reset all those changes by:
3253 o set back the current buffer.
3254 o move all markers and overlays to BEG.
3255 o remove all text properties.
3256 o set back the buffer multibyteness. */
3259 decide_coding_unwind (Lisp_Object unwind_data
)
3261 Lisp_Object multibyte
, undo_list
, buffer
;
3263 multibyte
= XCAR (unwind_data
);
3264 unwind_data
= XCDR (unwind_data
);
3265 undo_list
= XCAR (unwind_data
);
3266 buffer
= XCDR (unwind_data
);
3268 set_buffer_internal (XBUFFER (buffer
));
3269 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3270 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3271 set_buffer_intervals (current_buffer
, NULL
);
3272 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3274 /* Now we are safe to change the buffer's multibyteness directly. */
3275 bset_enable_multibyte_characters (current_buffer
, multibyte
);
3276 bset_undo_list (current_buffer
, undo_list
);
3279 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3280 object where slot 0 is the file descriptor, slot 1 specifies
3281 an offset to put the read bytes, and slot 2 is the maximum
3282 amount of bytes to read. Value is the number of bytes read. */
3285 read_non_regular (Lisp_Object state
)
3287 int nbytes
= emacs_read_quit (XSAVE_INTEGER (state
, 0),
3288 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
3289 + XSAVE_INTEGER (state
, 1)),
3290 XSAVE_INTEGER (state
, 2));
3291 /* Fast recycle this object for the likely next call. */
3293 return make_number (nbytes
);
3297 /* Condition-case handler used when reading from non-regular files
3298 in insert-file-contents. */
3301 read_non_regular_quit (Lisp_Object ignore
)
3306 /* Return the file offset that VAL represents, checking for type
3307 errors and overflow. */
3309 file_offset (Lisp_Object val
)
3311 if (RANGED_INTEGERP (0, val
, TYPE_MAXIMUM (off_t
)))
3316 double v
= XFLOAT_DATA (val
);
3317 if (0 <= v
&& v
< 1.0 + TYPE_MAXIMUM (off_t
))
3325 wrong_type_argument (intern ("file-offset"), val
);
3328 /* Return a special time value indicating the error number ERRNUM. */
3329 static struct timespec
3330 time_error_value (int errnum
)
3332 int ns
= (errnum
== ENOENT
|| errnum
== EACCES
|| errnum
== ENOTDIR
3333 ? NONEXISTENT_MODTIME_NSECS
3334 : UNKNOWN_MODTIME_NSECS
);
3335 return make_timespec (0, ns
);
3339 get_window_points_and_markers (void)
3341 Lisp_Object pt_marker
= Fpoint_marker ();
3343 = call3 (Qget_buffer_window_list
, Fcurrent_buffer (), Qnil
, Qt
);
3344 Lisp_Object window_markers
= windows
;
3345 /* Window markers (and point) are handled specially: rather than move to
3346 just before or just after the modified text, we try to keep the
3347 markers at the same distance (bug#19161).
3348 In general, this is wrong, but for window-markers, this should be harmless
3349 and is convenient for the end user when most of the file is unmodified,
3350 except for a few minor details near the beginning and near the end. */
3351 for (; CONSP (windows
); windows
= XCDR (windows
))
3352 if (WINDOWP (XCAR (windows
)))
3354 Lisp_Object window_marker
= XWINDOW (XCAR (windows
))->pointm
;
3356 Fcons (window_marker
, Fmarker_position (window_marker
)));
3358 return Fcons (Fcons (pt_marker
, Fpoint ()), window_markers
);
3362 restore_window_points (Lisp_Object window_markers
, ptrdiff_t inserted
,
3363 ptrdiff_t same_at_start
, ptrdiff_t same_at_end
)
3365 for (; CONSP (window_markers
); window_markers
= XCDR (window_markers
))
3366 if (CONSP (XCAR (window_markers
)))
3368 Lisp_Object car
= XCAR (window_markers
);
3369 Lisp_Object marker
= XCAR (car
);
3370 Lisp_Object oldpos
= XCDR (car
);
3371 if (MARKERP (marker
) && INTEGERP (oldpos
)
3372 && XINT (oldpos
) > same_at_start
3373 && XINT (oldpos
) < same_at_end
)
3375 ptrdiff_t oldsize
= same_at_end
- same_at_start
;
3376 ptrdiff_t newsize
= inserted
;
3377 double growth
= newsize
/ (double)oldsize
;
3379 = same_at_start
+ growth
* (XINT (oldpos
) - same_at_start
);
3380 Fset_marker (marker
, make_number (newpos
), Qnil
);
3385 /* Make sure the gap is at Z_BYTE. This is required to treat buffer
3386 text as a linear C char array. */
3388 maybe_move_gap (struct buffer
*b
)
3390 if (BUF_GPT_BYTE (b
) != BUF_Z_BYTE (b
))
3392 struct buffer
*cb
= current_buffer
;
3394 set_buffer_internal (b
);
3395 move_gap_both (Z
, Z_BYTE
);
3396 set_buffer_internal (cb
);
3400 /* FIXME: insert-file-contents should be split with the top-level moved to
3401 Elisp and only the core kept in C. */
3403 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3405 doc
: /* Insert contents of file FILENAME after point.
3406 Returns list of absolute file name and number of characters inserted.
3407 If second argument VISIT is non-nil, the buffer's visited filename and
3408 last save file modtime are set, and it is marked unmodified. If
3409 visiting and the file does not exist, visiting is completed before the
3412 The optional third and fourth arguments BEG and END specify what portion
3413 of the file to insert. These arguments count bytes in the file, not
3414 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3416 If optional fifth argument REPLACE is non-nil, replace the current
3417 buffer contents (in the accessible portion) with the file contents.
3418 This is better than simply deleting and inserting the whole thing
3419 because (1) it preserves some marker positions and (2) it puts less data
3420 in the undo list. When REPLACE is non-nil, the second return value is
3421 the number of characters that replace previous buffer contents.
3423 This function does code conversion according to the value of
3424 `coding-system-for-read' or `file-coding-system-alist', and sets the
3425 variable `last-coding-system-used' to the coding system actually used.
3427 In addition, this function decodes the inserted text from known formats
3428 by calling `format-decode', which see. */)
3429 (Lisp_Object filename
, Lisp_Object visit
, Lisp_Object beg
, Lisp_Object end
, Lisp_Object replace
)
3432 struct timespec mtime
;
3434 ptrdiff_t inserted
= 0;
3436 off_t beg_offset
, end_offset
;
3438 ptrdiff_t count
= SPECPDL_INDEX ();
3439 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3441 ptrdiff_t total
= 0;
3442 bool not_regular
= 0;
3444 char read_buf
[READ_BUF_SIZE
];
3445 struct coding_system coding
;
3446 bool replace_handled
= false;
3447 bool set_coding_system
= false;
3448 Lisp_Object coding_system
;
3449 bool read_quit
= false;
3450 /* If the undo log only contains the insertion, there's no point
3451 keeping it. It's typically when we first fill a file-buffer. */
3452 bool empty_undo_list_p
3453 = (!NILP (visit
) && NILP (BVAR (current_buffer
, undo_list
))
3455 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3456 bool we_locked_file
= false;
3458 Lisp_Object window_markers
= Qnil
;
3459 /* same_at_start and same_at_end count bytes, because file access counts
3460 bytes and BEG and END count bytes. */
3461 ptrdiff_t same_at_start
= BEGV_BYTE
;
3462 ptrdiff_t same_at_end
= ZV_BYTE
;
3463 /* SAME_AT_END_CHARPOS counts characters, because
3464 restore_window_points needs the old character count. */
3465 ptrdiff_t same_at_end_charpos
= ZV
;
3467 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3468 error ("Cannot do file visiting in an indirect buffer");
3470 if (!NILP (BVAR (current_buffer
, read_only
)))
3471 Fbarf_if_buffer_read_only (Qnil
);
3475 orig_filename
= Qnil
;
3478 CHECK_STRING (filename
);
3479 filename
= Fexpand_file_name (filename
, Qnil
);
3481 /* The value Qnil means that the coding system is not yet
3483 coding_system
= Qnil
;
3485 /* If the file name has special constructs in it,
3486 call the corresponding file handler. */
3487 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3488 if (!NILP (handler
))
3490 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3491 visit
, beg
, end
, replace
);
3492 if (CONSP (val
) && CONSP (XCDR (val
))
3493 && RANGED_INTEGERP (0, XCAR (XCDR (val
)), ZV
- PT
))
3494 inserted
= XINT (XCAR (XCDR (val
)));
3498 orig_filename
= filename
;
3499 filename
= ENCODE_FILE (filename
);
3501 fd
= emacs_open (SSDATA (filename
), O_RDONLY
, 0);
3506 report_file_error ("Opening input file", orig_filename
);
3507 mtime
= time_error_value (save_errno
);
3509 if (!NILP (Vcoding_system_for_read
))
3511 /* Don't let invalid values into buffer-file-coding-system. */
3512 CHECK_CODING_SYSTEM (Vcoding_system_for_read
);
3513 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3518 fd_index
= SPECPDL_INDEX ();
3519 record_unwind_protect_int (close_file_unwind
, fd
);
3521 /* Replacement should preserve point as it preserves markers. */
3522 if (!NILP (replace
))
3524 window_markers
= get_window_points_and_markers ();
3525 record_unwind_protect (restore_point_unwind
,
3526 XCAR (XCAR (window_markers
)));
3529 if (fstat (fd
, &st
) != 0)
3530 report_file_error ("Input file status", orig_filename
);
3531 mtime
= get_stat_mtime (&st
);
3533 /* This code will need to be changed in order to work on named
3534 pipes, and it's probably just not worth it. So we should at
3535 least signal an error. */
3536 if (!S_ISREG (st
.st_mode
))
3543 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3544 xsignal2 (Qfile_error
,
3545 build_string ("not a regular file"), orig_filename
);
3550 if (!NILP (beg
) || !NILP (end
))
3551 error ("Attempt to visit less than an entire file");
3552 if (BEG
< Z
&& NILP (replace
))
3553 error ("Cannot do file visiting in a non-empty buffer");
3557 beg_offset
= file_offset (beg
);
3562 end_offset
= file_offset (end
);
3566 end_offset
= TYPE_MAXIMUM (off_t
);
3569 end_offset
= st
.st_size
;
3571 /* A negative size can happen on a platform that allows file
3572 sizes greater than the maximum off_t value. */
3576 /* The file size returned from stat may be zero, but data
3577 may be readable nonetheless, for example when this is a
3578 file in the /proc filesystem. */
3579 if (end_offset
== 0)
3580 end_offset
= READ_BUF_SIZE
;
3584 /* Check now whether the buffer will become too large,
3585 in the likely case where the file's length is not changing.
3586 This saves a lot of needless work before a buffer overflow. */
3589 /* The likely offset where we will stop reading. We could read
3590 more (or less), if the file grows (or shrinks) as we read it. */
3591 off_t likely_end
= min (end_offset
, st
.st_size
);
3593 if (beg_offset
< likely_end
)
3596 = Z_BYTE
- (!NILP (replace
) ? ZV_BYTE
- BEGV_BYTE
: 0);
3597 ptrdiff_t buf_growth_max
= BUF_BYTES_MAX
- buf_bytes
;
3598 off_t likely_growth
= likely_end
- beg_offset
;
3599 if (buf_growth_max
< likely_growth
)
3604 /* Prevent redisplay optimizations. */
3605 current_buffer
->clip_changed
= true;
3607 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3609 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3610 setup_coding_system (coding_system
, &coding
);
3611 /* Ensure we set Vlast_coding_system_used. */
3612 set_coding_system
= true;
3616 /* Decide the coding system to use for reading the file now
3617 because we can't use an optimized method for handling
3618 `coding:' tag if the current buffer is not empty. */
3619 if (!NILP (Vcoding_system_for_read
))
3620 coding_system
= Vcoding_system_for_read
;
3623 /* Don't try looking inside a file for a coding system
3624 specification if it is not seekable. */
3625 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3627 /* Find a coding system specified in the heading two
3628 lines or in the tailing several lines of the file.
3629 We assume that the 1K-byte and 3K-byte for heading
3630 and tailing respectively are sufficient for this
3634 if (st
.st_size
<= (1024 * 4))
3635 nread
= emacs_read_quit (fd
, read_buf
, 1024 * 4);
3638 nread
= emacs_read_quit (fd
, read_buf
, 1024);
3642 if (lseek (fd
, - (1024 * 3), SEEK_END
) < 0)
3643 report_file_error ("Setting file position",
3645 ntail
= emacs_read_quit (fd
, read_buf
+ nread
, 1024 * 3);
3646 nread
= ntail
< 0 ? ntail
: nread
+ ntail
;
3651 report_file_error ("Read error", orig_filename
);
3654 AUTO_STRING (name
, " *code-converting-work*");
3655 struct buffer
*prev
= current_buffer
;
3656 Lisp_Object workbuf
;
3659 record_unwind_current_buffer ();
3661 workbuf
= Fget_buffer_create (name
);
3662 buf
= XBUFFER (workbuf
);
3664 delete_all_overlays (buf
);
3665 bset_directory (buf
, BVAR (current_buffer
, directory
));
3666 bset_read_only (buf
, Qnil
);
3667 bset_filename (buf
, Qnil
);
3668 bset_undo_list (buf
, Qt
);
3669 eassert (buf
->overlays_before
== NULL
);
3670 eassert (buf
->overlays_after
== NULL
);
3672 set_buffer_internal (buf
);
3674 bset_enable_multibyte_characters (buf
, Qnil
);
3676 insert_1_both ((char *) read_buf
, nread
, nread
, 0, 0, 0);
3677 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3678 coding_system
= call2 (Vset_auto_coding_function
,
3679 filename
, make_number (nread
));
3680 set_buffer_internal (prev
);
3682 /* Discard the unwind protect for recovering the
3686 /* Rewind the file for the actual read done later. */
3687 if (lseek (fd
, 0, SEEK_SET
) < 0)
3688 report_file_error ("Setting file position", orig_filename
);
3692 if (NILP (coding_system
))
3694 /* If we have not yet decided a coding system, check
3695 file-coding-system-alist. */
3696 coding_system
= CALLN (Ffind_operation_coding_system
,
3697 Qinsert_file_contents
, orig_filename
,
3698 visit
, beg
, end
, replace
);
3699 if (CONSP (coding_system
))
3700 coding_system
= XCAR (coding_system
);
3704 if (NILP (coding_system
))
3705 coding_system
= Qundecided
;
3707 CHECK_CODING_SYSTEM (coding_system
);
3709 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3710 /* We must suppress all character code conversion except for
3711 end-of-line conversion. */
3712 coding_system
= raw_text_coding_system (coding_system
);
3714 setup_coding_system (coding_system
, &coding
);
3715 /* Ensure we set Vlast_coding_system_used. */
3716 set_coding_system
= true;
3719 /* If requested, replace the accessible part of the buffer
3720 with the file contents. Avoid replacing text at the
3721 beginning or end of the buffer that matches the file contents;
3722 that preserves markers pointing to the unchanged parts.
3724 Here we implement this feature in an optimized way
3725 for the case where code conversion is NOT needed.
3726 The following if-statement handles the case of conversion
3727 in a less optimal way.
3729 If the code conversion is "automatic" then we try using this
3730 method and hope for the best.
3731 But if we discover the need for conversion, we give up on this method
3732 and let the following if-statement handle the replace job. */
3735 && (NILP (coding_system
)
3736 || ! CODING_REQUIRE_DECODING (&coding
)))
3739 /* There is still a possibility we will find the need to do code
3740 conversion. If that happens, set this variable to
3741 give up on handling REPLACE in the optimized way. */
3742 bool giveup_match_end
= false;
3744 if (beg_offset
!= 0)
3746 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3747 report_file_error ("Setting file position", orig_filename
);
3750 /* Count how many chars at the start of the file
3751 match the text at the beginning of the buffer. */
3754 int nread
= emacs_read_quit (fd
, read_buf
, sizeof read_buf
);
3756 report_file_error ("Read error", orig_filename
);
3757 else if (nread
== 0)
3760 if (CODING_REQUIRE_DETECTION (&coding
))
3762 coding_system
= detect_coding_system ((unsigned char *) read_buf
,
3765 setup_coding_system (coding_system
, &coding
);
3768 if (CODING_REQUIRE_DECODING (&coding
))
3769 /* We found that the file should be decoded somehow.
3770 Let's give up here. */
3772 giveup_match_end
= true;
3777 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3778 && FETCH_BYTE (same_at_start
) == read_buf
[bufpos
])
3779 same_at_start
++, bufpos
++;
3780 /* If we found a discrepancy, stop the scan.
3781 Otherwise loop around and scan the next bufferful. */
3782 if (bufpos
!= nread
)
3785 /* If the file matches the buffer completely,
3786 there's no need to replace anything. */
3787 if (same_at_start
- BEGV_BYTE
== end_offset
- beg_offset
)
3790 clear_unwind_protect (fd_index
);
3792 /* Truncate the buffer to the size of the file. */
3793 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3797 /* Count how many chars at the end of the file
3798 match the text at the end of the buffer. But, if we have
3799 already found that decoding is necessary, don't waste time. */
3800 while (!giveup_match_end
)
3802 int total_read
, nread
, bufpos
, trial
;
3805 /* At what file position are we now scanning? */
3806 curpos
= end_offset
- (ZV_BYTE
- same_at_end
);
3807 /* If the entire file matches the buffer tail, stop the scan. */
3810 /* How much can we scan in the next step? */
3811 trial
= min (curpos
, sizeof read_buf
);
3812 if (lseek (fd
, curpos
- trial
, SEEK_SET
) < 0)
3813 report_file_error ("Setting file position", orig_filename
);
3815 total_read
= nread
= 0;
3816 while (total_read
< trial
)
3818 nread
= emacs_read_quit (fd
, read_buf
+ total_read
,
3819 trial
- total_read
);
3821 report_file_error ("Read error", orig_filename
);
3822 else if (nread
== 0)
3824 total_read
+= nread
;
3827 /* Scan this bufferful from the end, comparing with
3828 the Emacs buffer. */
3829 bufpos
= total_read
;
3831 /* Compare with same_at_start to avoid counting some buffer text
3832 as matching both at the file's beginning and at the end. */
3833 while (bufpos
> 0 && same_at_end
> same_at_start
3834 && FETCH_BYTE (same_at_end
- 1) == read_buf
[bufpos
- 1])
3835 same_at_end
--, bufpos
--;
3837 /* If we found a discrepancy, stop the scan.
3838 Otherwise loop around and scan the preceding bufferful. */
3841 /* If this discrepancy is because of code conversion,
3842 we cannot use this method; giveup and try the other. */
3843 if (same_at_end
> same_at_start
3844 && FETCH_BYTE (same_at_end
- 1) >= 0200
3845 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3846 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3847 giveup_match_end
= true;
3855 if (! giveup_match_end
)
3858 ptrdiff_t this_count
= SPECPDL_INDEX ();
3860 /* We win! We can handle REPLACE the optimized way. */
3862 /* Extend the start of non-matching text area to multibyte
3863 character boundary. */
3864 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3865 while (same_at_start
> BEGV_BYTE
3866 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3869 /* Extend the end of non-matching text area to multibyte
3870 character boundary. */
3871 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3872 while (same_at_end
< ZV_BYTE
3873 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3876 /* Don't try to reuse the same piece of text twice. */
3877 overlap
= (same_at_start
- BEGV_BYTE
3879 + (! NILP (end
) ? end_offset
: st
.st_size
) - ZV_BYTE
));
3881 same_at_end
+= overlap
;
3882 same_at_end_charpos
= BYTE_TO_CHAR (same_at_end
);
3884 /* Arrange to read only the nonmatching middle part of the file. */
3885 beg_offset
+= same_at_start
- BEGV_BYTE
;
3886 end_offset
-= ZV_BYTE
- same_at_end
;
3888 /* This binding is to avoid ask-user-about-supersession-threat
3889 being called in insert_from_buffer or del_range_bytes (via
3890 prepare_to_modify_buffer).
3891 AFAICT we could avoid ask-user-about-supersession-threat by setting
3892 current_buffer->modtime earlier, but we could still end up calling
3893 ask-user-about-supersession-threat if the file is modified while
3894 we read it, so we bind buffer-file-name instead. */
3895 specbind (intern ("buffer-file-name"), Qnil
);
3896 del_range_byte (same_at_start
, same_at_end
);
3897 /* Insert from the file at the proper position. */
3898 temp
= BYTE_TO_CHAR (same_at_start
);
3899 SET_PT_BOTH (temp
, same_at_start
);
3900 unbind_to (this_count
, Qnil
);
3902 /* If display currently starts at beginning of line,
3903 keep it that way. */
3904 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
3905 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
3907 replace_handled
= true;
3911 /* If requested, replace the accessible part of the buffer
3912 with the file contents. Avoid replacing text at the
3913 beginning or end of the buffer that matches the file contents;
3914 that preserves markers pointing to the unchanged parts.
3916 Here we implement this feature for the case where code conversion
3917 is needed, in a simple way that needs a lot of memory.
3918 The preceding if-statement handles the case of no conversion
3919 in a more optimized way. */
3920 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3922 ptrdiff_t same_at_start_charpos
;
3923 ptrdiff_t inserted_chars
;
3926 unsigned char *decoded
;
3929 ptrdiff_t this_count
= SPECPDL_INDEX ();
3931 = ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3932 Lisp_Object conversion_buffer
;
3934 conversion_buffer
= code_conversion_save (1, multibyte
);
3936 /* First read the whole file, performing code conversion into
3937 CONVERSION_BUFFER. */
3939 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
3940 report_file_error ("Setting file position", orig_filename
);
3942 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3943 unprocessed
= 0; /* Bytes not processed in previous loop. */
3947 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3948 quitting while reading a huge file. */
3950 this = emacs_read_quit (fd
, read_buf
+ unprocessed
,
3951 READ_BUF_SIZE
- unprocessed
);
3955 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
3956 BUF_Z (XBUFFER (conversion_buffer
)));
3957 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3958 unprocessed
+ this, conversion_buffer
);
3959 unprocessed
= coding
.carryover_bytes
;
3960 if (coding
.carryover_bytes
> 0)
3961 memcpy (read_buf
, coding
.carryover
, unprocessed
);
3965 report_file_error ("Read error", orig_filename
);
3967 clear_unwind_protect (fd_index
);
3969 if (unprocessed
> 0)
3971 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3972 decode_coding_c_string (&coding
, (unsigned char *) read_buf
,
3973 unprocessed
, conversion_buffer
);
3974 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
3977 coding_system
= CODING_ID_NAME (coding
.id
);
3978 set_coding_system
= true;
3979 maybe_move_gap (XBUFFER (conversion_buffer
));
3980 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
3981 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
3982 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
3984 /* Compare the beginning of the converted string with the buffer
3988 while (bufpos
< inserted
&& same_at_start
< same_at_end
3989 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
3990 same_at_start
++, bufpos
++;
3992 /* If the file matches the head of buffer completely,
3993 there's no need to replace anything. */
3995 if (bufpos
== inserted
)
3997 /* Truncate the buffer to the size of the file. */
3998 if (same_at_start
!= same_at_end
)
4000 /* See previous specbind for the reason behind this. */
4001 specbind (intern ("buffer-file-name"), Qnil
);
4002 del_range_byte (same_at_start
, same_at_end
);
4006 unbind_to (this_count
, Qnil
);
4010 /* Extend the start of non-matching text area to the previous
4011 multibyte character boundary. */
4012 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4013 while (same_at_start
> BEGV_BYTE
4014 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4017 /* Scan this bufferful from the end, comparing with
4018 the Emacs buffer. */
4021 /* Compare with same_at_start to avoid counting some buffer text
4022 as matching both at the file's beginning and at the end. */
4023 while (bufpos
> 0 && same_at_end
> same_at_start
4024 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4025 same_at_end
--, bufpos
--;
4027 /* Extend the end of non-matching text area to the next
4028 multibyte character boundary. */
4029 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4030 while (same_at_end
< ZV_BYTE
4031 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4034 /* Don't try to reuse the same piece of text twice. */
4035 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4037 same_at_end
+= overlap
;
4038 same_at_end_charpos
= BYTE_TO_CHAR (same_at_end
);
4040 /* If display currently starts at beginning of line,
4041 keep it that way. */
4042 if (XBUFFER (XWINDOW (selected_window
)->contents
) == current_buffer
)
4043 XWINDOW (selected_window
)->start_at_line_beg
= !NILP (Fbolp ());
4045 /* Replace the chars that we need to replace,
4046 and update INSERTED to equal the number of bytes
4047 we are taking from the decoded string. */
4048 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4050 /* See previous specbind for the reason behind this. */
4051 specbind (intern ("buffer-file-name"), Qnil
);
4052 if (same_at_end
!= same_at_start
)
4054 del_range_byte (same_at_start
, same_at_end
);
4056 eassert (same_at_start
== GPT_BYTE
);
4057 same_at_start
= GPT_BYTE
;
4061 temp
= same_at_end_charpos
;
4063 /* Insert from the file at the proper position. */
4064 SET_PT_BOTH (temp
, same_at_start
);
4065 same_at_start_charpos
4066 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4067 same_at_start
- BEGV_BYTE
4068 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4069 eassert (same_at_start_charpos
== temp
- (BEGV
- BEG
));
4071 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4072 same_at_start
+ inserted
- BEGV_BYTE
4073 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4074 - same_at_start_charpos
);
4075 insert_from_buffer (XBUFFER (conversion_buffer
),
4076 same_at_start_charpos
, inserted_chars
, 0);
4077 /* Set `inserted' to the number of inserted characters. */
4078 inserted
= PT
- temp
;
4079 /* Set point before the inserted characters. */
4080 SET_PT_BOTH (temp
, same_at_start
);
4082 unbind_to (this_count
, Qnil
);
4088 total
= end_offset
- beg_offset
;
4090 /* For a special file, all we can do is guess. */
4091 total
= READ_BUF_SIZE
;
4093 if (NILP (visit
) && total
> 0)
4095 if (!NILP (BVAR (current_buffer
, file_truename
))
4096 /* Make binding buffer-file-name to nil effective. */
4097 && !NILP (BVAR (current_buffer
, filename
))
4098 && SAVE_MODIFF
>= MODIFF
)
4099 we_locked_file
= true;
4100 prepare_to_modify_buffer (PT
, PT
, NULL
);
4103 move_gap_both (PT
, PT_BYTE
);
4104 if (GAP_SIZE
< total
)
4105 make_gap (total
- GAP_SIZE
);
4107 if (beg_offset
!= 0 || !NILP (replace
))
4109 if (lseek (fd
, beg_offset
, SEEK_SET
) < 0)
4110 report_file_error ("Setting file position", orig_filename
);
4113 /* In the following loop, HOW_MUCH contains the total bytes read so
4114 far for a regular file, and not changed for a special file. But,
4115 before exiting the loop, it is set to a negative value if I/O
4119 /* Total bytes inserted. */
4122 /* Here, we don't do code conversion in the loop. It is done by
4123 decode_coding_gap after all data are read into the buffer. */
4125 ptrdiff_t gap_size
= GAP_SIZE
;
4127 while (how_much
< total
)
4129 /* `try' is reserved in some compilers (Microsoft C). */
4130 ptrdiff_t trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4137 /* Maybe make more room. */
4138 if (gap_size
< trytry
)
4140 make_gap (trytry
- gap_size
);
4141 gap_size
= GAP_SIZE
- inserted
;
4144 /* Read from the file, capturing `quit'. When an
4145 error occurs, end the loop, and arrange for a quit
4146 to be signaled after decoding the text we read. */
4147 nbytes
= internal_condition_case_1
4149 make_save_int_int_int (fd
, inserted
, trytry
),
4150 Qerror
, read_non_regular_quit
);
4158 this = XINT (nbytes
);
4162 /* Allow quitting out of the actual I/O. We don't make text
4163 part of the buffer until all the reading is done, so a C-g
4164 here doesn't do any harm. */
4165 this = emacs_read_quit (fd
,
4166 ((char *) BEG_ADDR
+ PT_BYTE
- BEG_BYTE
4179 /* For a regular file, where TOTAL is the real size,
4180 count HOW_MUCH to compare with it.
4181 For a special file, where TOTAL is just a buffer size,
4182 so don't bother counting in HOW_MUCH.
4183 (INSERTED is where we count the number of characters inserted.) */
4190 /* Now we have either read all the file data into the gap,
4191 or stop reading on I/O error or quit. If nothing was
4192 read, undo marking the buffer modified. */
4197 unlock_file (BVAR (current_buffer
, file_truename
));
4198 Vdeactivate_mark
= old_Vdeactivate_mark
;
4201 Fset (Qdeactivate_mark
, Qt
);
4204 clear_unwind_protect (fd_index
);
4207 report_file_error ("Read error", orig_filename
);
4209 /* Make the text read part of the buffer. */
4210 GAP_SIZE
-= inserted
;
4212 GPT_BYTE
+= inserted
;
4214 ZV_BYTE
+= inserted
;
4219 /* Put an anchor to ensure multi-byte form ends at gap. */
4224 if (NILP (coding_system
))
4226 /* The coding system is not yet decided. Decide it by an
4227 optimized method for handling `coding:' tag.
4229 Note that we can get here only if the buffer was empty
4230 before the insertion. */
4232 if (!NILP (Vcoding_system_for_read
))
4233 coding_system
= Vcoding_system_for_read
;
4236 /* Since we are sure that the current buffer was empty
4237 before the insertion, we can toggle
4238 enable-multibyte-characters directly here without taking
4239 care of marker adjustment. By this way, we can run Lisp
4240 program safely before decoding the inserted text. */
4241 Lisp_Object unwind_data
;
4242 ptrdiff_t count1
= SPECPDL_INDEX ();
4244 unwind_data
= Fcons (BVAR (current_buffer
, enable_multibyte_characters
),
4245 Fcons (BVAR (current_buffer
, undo_list
),
4246 Fcurrent_buffer ()));
4247 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4248 bset_undo_list (current_buffer
, Qt
);
4249 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4251 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4253 coding_system
= call2 (Vset_auto_coding_function
,
4254 filename
, make_number (inserted
));
4257 if (NILP (coding_system
))
4259 /* If the coding system is not yet decided, check
4260 file-coding-system-alist. */
4261 coding_system
= CALLN (Ffind_operation_coding_system
,
4262 Qinsert_file_contents
, orig_filename
,
4263 visit
, beg
, end
, Qnil
);
4264 if (CONSP (coding_system
))
4265 coding_system
= XCAR (coding_system
);
4267 unbind_to (count1
, Qnil
);
4268 inserted
= Z_BYTE
- BEG_BYTE
;
4271 if (NILP (coding_system
))
4272 coding_system
= Qundecided
;
4274 CHECK_CODING_SYSTEM (coding_system
);
4276 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4277 /* We must suppress all character code conversion except for
4278 end-of-line conversion. */
4279 coding_system
= raw_text_coding_system (coding_system
);
4280 setup_coding_system (coding_system
, &coding
);
4281 /* Ensure we set Vlast_coding_system_used. */
4282 set_coding_system
= true;
4287 /* When we visit a file by raw-text, we change the buffer to
4289 if (CODING_FOR_UNIBYTE (&coding
)
4290 /* Can't do this if part of the buffer might be preserved. */
4293 /* Visiting a file with these coding system makes the buffer
4296 bset_enable_multibyte_characters (current_buffer
, Qnil
);
4298 Fset_buffer_multibyte (Qnil
);
4302 coding
.dst_multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
4303 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4304 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4306 move_gap_both (PT
, PT_BYTE
);
4307 GAP_SIZE
+= inserted
;
4308 ZV_BYTE
-= inserted
;
4312 decode_coding_gap (&coding
, inserted
, inserted
);
4313 inserted
= coding
.produced_char
;
4314 coding_system
= CODING_ID_NAME (coding
.id
);
4316 else if (inserted
> 0)
4318 invalidate_buffer_caches (current_buffer
, PT
, PT
+ inserted
);
4319 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4323 /* Call after-change hooks for the inserted text, aside from the case
4324 of normal visiting (not with REPLACE), which is done in a new buffer
4325 "before" the buffer is changed. */
4326 if (inserted
> 0 && total
> 0
4327 && (NILP (visit
) || !NILP (replace
)))
4329 signal_after_change (PT
, 0, inserted
);
4330 update_compositions (PT
, PT
, CHECK_BORDER
);
4333 /* Now INSERTED is measured in characters. */
4338 restore_window_points (window_markers
, inserted
,
4339 BYTE_TO_CHAR (same_at_start
),
4340 same_at_end_charpos
);
4344 if (empty_undo_list_p
)
4345 bset_undo_list (current_buffer
, Qnil
);
4349 current_buffer
->modtime
= mtime
;
4350 current_buffer
->modtime_size
= st
.st_size
;
4351 bset_filename (current_buffer
, orig_filename
);
4354 SAVE_MODIFF
= MODIFF
;
4355 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
4356 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4359 if (!NILP (BVAR (current_buffer
, file_truename
)))
4360 unlock_file (BVAR (current_buffer
, file_truename
));
4361 unlock_file (filename
);
4364 xsignal2 (Qfile_error
,
4365 build_string ("not a regular file"), orig_filename
);
4368 if (set_coding_system
)
4369 Vlast_coding_system_used
= coding_system
;
4371 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4373 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4375 if (! NILP (insval
))
4377 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4378 wrong_type_argument (intern ("inserted-chars"), insval
);
4379 inserted
= XFASTINT (insval
);
4383 /* Decode file format. */
4386 /* Don't run point motion or modification hooks when decoding. */
4387 ptrdiff_t count1
= SPECPDL_INDEX ();
4388 ptrdiff_t old_inserted
= inserted
;
4389 specbind (Qinhibit_point_motion_hooks
, Qt
);
4390 specbind (Qinhibit_modification_hooks
, Qt
);
4392 /* Save old undo list and don't record undo for decoding. */
4393 old_undo
= BVAR (current_buffer
, undo_list
);
4394 bset_undo_list (current_buffer
, Qt
);
4398 insval
= call3 (Qformat_decode
,
4399 Qnil
, make_number (inserted
), visit
);
4400 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4401 wrong_type_argument (intern ("inserted-chars"), insval
);
4402 inserted
= XFASTINT (insval
);
4406 /* If REPLACE is non-nil and we succeeded in not replacing the
4407 beginning or end of the buffer text with the file's contents,
4408 call format-decode with `point' positioned at the beginning
4409 of the buffer and `inserted' equaling the number of
4410 characters in the buffer. Otherwise, format-decode might
4411 fail to correctly analyze the beginning or end of the buffer.
4412 Hence we temporarily save `point' and `inserted' here and
4413 restore `point' iff format-decode did not insert or delete
4414 any text. Otherwise we leave `point' at point-min. */
4415 ptrdiff_t opoint
= PT
;
4416 ptrdiff_t opoint_byte
= PT_BYTE
;
4417 ptrdiff_t oinserted
= ZV
- BEGV
;
4418 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4420 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4421 insval
= call3 (Qformat_decode
,
4422 Qnil
, make_number (oinserted
), visit
);
4423 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4424 wrong_type_argument (intern ("inserted-chars"), insval
);
4425 if (ochars_modiff
== CHARS_MODIFF
)
4426 /* format_decode didn't modify buffer's characters => move
4427 point back to position before inserted text and leave
4428 value of inserted alone. */
4429 SET_PT_BOTH (opoint
, opoint_byte
);
4431 /* format_decode modified buffer's characters => consider
4432 entire buffer changed and leave point at point-min. */
4433 inserted
= XFASTINT (insval
);
4436 /* For consistency with format-decode call these now iff inserted > 0
4437 (martin 2007-06-28). */
4438 p
= Vafter_insert_file_functions
;
4443 insval
= call1 (XCAR (p
), make_number (inserted
));
4446 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4447 wrong_type_argument (intern ("inserted-chars"), insval
);
4448 inserted
= XFASTINT (insval
);
4453 /* For the rationale of this see the comment on
4454 format-decode above. */
4455 ptrdiff_t opoint
= PT
;
4456 ptrdiff_t opoint_byte
= PT_BYTE
;
4457 ptrdiff_t oinserted
= ZV
- BEGV
;
4458 EMACS_INT ochars_modiff
= CHARS_MODIFF
;
4460 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4461 insval
= call1 (XCAR (p
), make_number (oinserted
));
4464 if (! RANGED_INTEGERP (0, insval
, ZV
- PT
))
4465 wrong_type_argument (intern ("inserted-chars"), insval
);
4466 if (ochars_modiff
== CHARS_MODIFF
)
4467 /* after_insert_file_functions didn't modify
4468 buffer's characters => move point back to
4469 position before inserted text and leave value of
4471 SET_PT_BOTH (opoint
, opoint_byte
);
4473 /* after_insert_file_functions did modify buffer's
4474 characters => consider entire buffer changed and
4475 leave point at point-min. */
4476 inserted
= XFASTINT (insval
);
4484 if (!empty_undo_list_p
)
4486 bset_undo_list (current_buffer
, old_undo
);
4487 if (CONSP (old_undo
) && inserted
!= old_inserted
)
4489 /* Adjust the last undo record for the size change during
4490 the format conversion. */
4491 Lisp_Object tem
= XCAR (old_undo
);
4492 if (CONSP (tem
) && INTEGERP (XCAR (tem
))
4493 && INTEGERP (XCDR (tem
))
4494 && XFASTINT (XCDR (tem
)) == PT
+ old_inserted
)
4495 XSETCDR (tem
, make_number (PT
+ inserted
));
4499 /* If undo_list was Qt before, keep it that way.
4500 Otherwise start with an empty undo_list. */
4501 bset_undo_list (current_buffer
, EQ (old_undo
, Qt
) ? Qt
: Qnil
);
4503 unbind_to (count1
, Qnil
);
4507 && current_buffer
->modtime
.tv_nsec
== NONEXISTENT_MODTIME_NSECS
)
4509 /* If visiting nonexistent file, return nil. */
4510 report_file_errno ("Opening input file", orig_filename
, save_errno
);
4513 /* We made a lot of deletions and insertions above, so invalidate
4514 the newline cache for the entire region of the inserted
4516 if (current_buffer
->base_buffer
&& current_buffer
->base_buffer
->newline_cache
)
4517 invalidate_region_cache (current_buffer
->base_buffer
,
4518 current_buffer
->base_buffer
->newline_cache
,
4519 PT
- BEG
, Z
- PT
- inserted
);
4520 else if (current_buffer
->newline_cache
)
4521 invalidate_region_cache (current_buffer
,
4522 current_buffer
->newline_cache
,
4523 PT
- BEG
, Z
- PT
- inserted
);
4528 /* Retval needs to be dealt with in all cases consistently. */
4530 val
= list2 (orig_filename
, make_number (inserted
));
4532 return unbind_to (count
, val
);
4535 static Lisp_Object
build_annotations (Lisp_Object
, Lisp_Object
);
4538 build_annotations_unwind (Lisp_Object arg
)
4540 Vwrite_region_annotation_buffers
= arg
;
4543 /* Decide the coding-system to encode the data with. */
4546 choose_write_coding_system (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4547 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4548 struct coding_system
*coding
)
4551 Lisp_Object eol_parent
= Qnil
;
4554 && NILP (Fstring_equal (BVAR (current_buffer
, filename
),
4555 BVAR (current_buffer
, auto_save_file_name
))))
4560 else if (!NILP (Vcoding_system_for_write
))
4562 val
= Vcoding_system_for_write
;
4563 if (coding_system_require_warning
4564 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4565 /* Confirm that VAL can surely encode the current region. */
4566 val
= call5 (Vselect_safe_coding_system_function
,
4567 start
, end
, list2 (Qt
, val
),
4572 /* If the variable `buffer-file-coding-system' is set locally,
4573 it means that the file was read with some kind of code
4574 conversion or the variable is explicitly set by users. We
4575 had better write it out with the same coding system even if
4576 `enable-multibyte-characters' is nil.
4578 If it is not set locally, we anyway have to convert EOL
4579 format if the default value of `buffer-file-coding-system'
4580 tells that it is not Unix-like (LF only) format. */
4581 bool using_default_coding
= 0;
4582 bool force_raw_text
= 0;
4584 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4586 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4589 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4595 /* Check file-coding-system-alist. */
4596 Lisp_Object coding_systems
4597 = CALLN (Ffind_operation_coding_system
, Qwrite_region
, start
, end
,
4598 filename
, append
, visit
, lockname
);
4599 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4600 val
= XCDR (coding_systems
);
4605 /* If we still have not decided a coding system, use the
4606 current buffer's value of buffer-file-coding-system. */
4607 val
= BVAR (current_buffer
, buffer_file_coding_system
);
4608 using_default_coding
= 1;
4611 if (! NILP (val
) && ! force_raw_text
)
4613 Lisp_Object spec
, attrs
;
4615 CHECK_CODING_SYSTEM (val
);
4616 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4617 attrs
= AREF (spec
, 0);
4618 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4623 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4625 /* Confirm that VAL can surely encode the current region. */
4626 val
= call5 (Vselect_safe_coding_system_function
,
4627 start
, end
, val
, Qnil
, filename
);
4628 /* As the function specified by select-safe-coding-system-function
4629 is out of our control, make sure we are not fed by bogus
4632 CHECK_CODING_SYSTEM (val
);
4635 /* If the decided coding-system doesn't specify end-of-line
4636 format, we use that of `buffer-file-coding-system'. */
4637 if (! using_default_coding
)
4639 Lisp_Object dflt
= BVAR (&buffer_defaults
, buffer_file_coding_system
);
4642 val
= coding_inherit_eol_type (val
, dflt
);
4645 /* If we decide not to encode text, use `raw-text' or one of its
4648 val
= raw_text_coding_system (val
);
4651 val
= coding_inherit_eol_type (val
, eol_parent
);
4652 setup_coding_system (val
, coding
);
4654 if (!STRINGP (start
) && !NILP (BVAR (current_buffer
, selective_display
)))
4655 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4659 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4660 "r\nFWrite region to file: \ni\ni\ni\np",
4661 doc
: /* Write current region into specified file.
4662 When called from a program, requires three arguments:
4663 START, END and FILENAME. START and END are normally buffer positions
4664 specifying the part of the buffer to write.
4665 If START is nil, that means to use the entire buffer contents; END is
4667 If START is a string, then output that string to the file
4668 instead of any buffer contents; END is ignored.
4670 Optional fourth argument APPEND if non-nil means
4671 append to existing file contents (if any). If it is a number,
4672 seek to that offset in the file before writing.
4673 Optional fifth argument VISIT, if t or a string, means
4674 set the last-save-file-modtime of buffer to this file's modtime
4675 and mark buffer not modified.
4676 If VISIT is a string, it is a second file name;
4677 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4678 VISIT is also the file name to lock and unlock for clash detection.
4679 If VISIT is neither t nor nil nor a string, or if Emacs is in batch mode,
4680 do not display the \"Wrote file\" message.
4681 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4682 use for locking and unlocking, overriding FILENAME and VISIT.
4683 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4684 for an existing file with the same name. If MUSTBENEW is `excl',
4685 that means to get an error if the file already exists; never overwrite.
4686 If MUSTBENEW is neither nil nor `excl', that means ask for
4687 confirmation before overwriting, but do go ahead and overwrite the file
4688 if the user confirms.
4690 This does code conversion according to the value of
4691 `coding-system-for-write', `buffer-file-coding-system', or
4692 `file-coding-system-alist', and sets the variable
4693 `last-coding-system-used' to the coding system actually used.
4695 This calls `write-region-annotate-functions' at the start, and
4696 `write-region-post-annotation-function' at the end. */)
4697 (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
, Lisp_Object append
,
4698 Lisp_Object visit
, Lisp_Object lockname
, Lisp_Object mustbenew
)
4700 return write_region (start
, end
, filename
, append
, visit
, lockname
, mustbenew
,
4704 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4705 descriptor for FILENAME, so do not open or close FILENAME. */
4708 write_region (Lisp_Object start
, Lisp_Object end
, Lisp_Object filename
,
4709 Lisp_Object append
, Lisp_Object visit
, Lisp_Object lockname
,
4710 Lisp_Object mustbenew
, int desc
)
4714 off_t offset UNINIT
;
4715 bool open_and_close_file
= desc
< 0;
4720 struct timespec modtime
;
4721 ptrdiff_t count
= SPECPDL_INDEX ();
4722 ptrdiff_t count1 UNINIT
;
4723 Lisp_Object handler
;
4724 Lisp_Object visit_file
;
4725 Lisp_Object annotations
;
4726 Lisp_Object encoded_filename
;
4727 bool visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4728 bool quietly
= !NILP (visit
);
4729 bool file_locked
= 0;
4730 struct buffer
*given_buffer
;
4731 struct coding_system coding
;
4733 if (current_buffer
->base_buffer
&& visiting
)
4734 error ("Cannot do file visiting in an indirect buffer");
4736 if (!NILP (start
) && !STRINGP (start
))
4737 validate_region (&start
, &end
);
4741 filename
= Fexpand_file_name (filename
, Qnil
);
4743 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4744 barf_or_query_if_file_exists (filename
, false, "overwrite", true, true);
4746 if (STRINGP (visit
))
4747 visit_file
= Fexpand_file_name (visit
, Qnil
);
4749 visit_file
= filename
;
4751 if (NILP (lockname
))
4752 lockname
= visit_file
;
4756 /* If the file name has special constructs in it,
4757 call the corresponding file handler. */
4758 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4759 /* If FILENAME has no handler, see if VISIT has one. */
4760 if (NILP (handler
) && STRINGP (visit
))
4761 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4763 if (!NILP (handler
))
4766 val
= call8 (handler
, Qwrite_region
, start
, end
,
4767 filename
, append
, visit
, lockname
, mustbenew
);
4771 SAVE_MODIFF
= MODIFF
;
4772 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
4773 bset_filename (current_buffer
, visit_file
);
4779 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4781 /* Special kludge to simplify auto-saving. */
4784 /* Do it later, so write-region-annotate-function can work differently
4785 if we save "the buffer" vs "a region".
4786 This is useful in tar-mode. --Stef
4787 XSETFASTINT (start, BEG);
4788 XSETFASTINT (end, Z); */
4792 record_unwind_protect (build_annotations_unwind
,
4793 Vwrite_region_annotation_buffers
);
4794 Vwrite_region_annotation_buffers
= list1 (Fcurrent_buffer ());
4796 given_buffer
= current_buffer
;
4798 if (!STRINGP (start
))
4800 annotations
= build_annotations (start
, end
);
4802 if (current_buffer
!= given_buffer
)
4804 XSETFASTINT (start
, BEGV
);
4805 XSETFASTINT (end
, ZV
);
4811 XSETFASTINT (start
, BEGV
);
4812 XSETFASTINT (end
, ZV
);
4815 /* Decide the coding-system to encode the data with.
4816 We used to make this choice before calling build_annotations, but that
4817 leads to problems when a write-annotate-function takes care of
4818 unsavable chars (as was the case with X-Symbol). */
4819 Vlast_coding_system_used
4820 = choose_write_coding_system (start
, end
, filename
,
4821 append
, visit
, lockname
, &coding
);
4823 if (open_and_close_file
&& !auto_saving
)
4825 lock_file (lockname
);
4829 encoded_filename
= ENCODE_FILE (filename
);
4830 fn
= SSDATA (encoded_filename
);
4831 open_flags
= O_WRONLY
| O_CREAT
;
4832 open_flags
|= EQ (mustbenew
, Qexcl
) ? O_EXCL
: !NILP (append
) ? 0 : O_TRUNC
;
4833 if (NUMBERP (append
))
4834 offset
= file_offset (append
);
4835 else if (!NILP (append
))
4836 open_flags
|= O_APPEND
;
4838 mode
= S_IREAD
| S_IWRITE
;
4840 mode
= auto_saving
? auto_save_mode_bits
: 0666;
4843 if (open_and_close_file
)
4845 desc
= emacs_open (fn
, open_flags
, mode
);
4848 int open_errno
= errno
;
4850 unlock_file (lockname
);
4851 report_file_errno ("Opening output file", filename
, open_errno
);
4854 count1
= SPECPDL_INDEX ();
4855 record_unwind_protect_int (close_file_unwind
, desc
);
4858 if (NUMBERP (append
))
4860 off_t ret
= lseek (desc
, offset
, SEEK_SET
);
4863 int lseek_errno
= errno
;
4865 unlock_file (lockname
);
4866 report_file_errno ("Lseek error", filename
, lseek_errno
);
4870 if (STRINGP (start
))
4871 ok
= a_write (desc
, start
, 0, SCHARS (start
), &annotations
, &coding
);
4872 else if (XINT (start
) != XINT (end
))
4873 ok
= a_write (desc
, Qnil
, XINT (start
), XINT (end
) - XINT (start
),
4874 &annotations
, &coding
);
4877 /* If file was empty, still need to write the annotations. */
4878 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4879 ok
= a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4883 if (ok
&& CODING_REQUIRE_FLUSHING (&coding
)
4884 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
))
4886 /* We have to flush out a data. */
4887 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4888 ok
= e_write (desc
, Qnil
, 1, 1, &coding
);
4892 /* fsync is not crucial for temporary files. Nor for auto-save
4893 files, since they might lose some work anyway. */
4894 if (open_and_close_file
&& !auto_saving
&& !write_region_inhibit_fsync
)
4896 /* Transfer data and metadata to disk, retrying if interrupted.
4897 fsync can report a write failure here, e.g., due to disk full
4898 under NFS. But ignore EINVAL, which means fsync is not
4899 supported on this file. */
4900 while (fsync (desc
) != 0)
4903 if (errno
!= EINVAL
)
4904 ok
= 0, save_errno
= errno
;
4909 modtime
= invalid_timespec ();
4912 if (fstat (desc
, &st
) == 0)
4913 modtime
= get_stat_mtime (&st
);
4915 ok
= 0, save_errno
= errno
;
4918 if (open_and_close_file
)
4920 /* NFS can report a write failure now. */
4921 if (emacs_close (desc
) < 0)
4922 ok
= 0, save_errno
= errno
;
4924 /* Discard the unwind protect for close_file_unwind. */
4925 specpdl_ptr
= specpdl
+ count1
;
4928 /* Some file systems have a bug where st_mtime is not updated
4929 properly after a write. For example, CIFS might not see the
4930 st_mtime change until after the file is opened again.
4932 Attempt to detect this file system bug, and update MODTIME to the
4933 newer st_mtime if the bug appears to be present. This introduces
4934 a race condition, so to avoid most instances of the race condition
4935 on non-buggy file systems, skip this check if the most recently
4936 encountered non-buggy file system was the current file system.
4938 A race condition can occur if some other process modifies the
4939 file between the fstat above and the fstat below, but the race is
4940 unlikely and a similar race between the last write and the fstat
4941 above cannot possibly be closed anyway. */
4943 if (timespec_valid_p (modtime
)
4944 && ! (valid_timestamp_file_system
&& st
.st_dev
== timestamp_file_system
))
4946 int desc1
= emacs_open (fn
, O_WRONLY
, 0);
4950 if (fstat (desc1
, &st1
) == 0
4951 && st
.st_dev
== st1
.st_dev
&& st
.st_ino
== st1
.st_ino
)
4953 /* Use the heuristic if it appears to be valid. With neither
4954 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4955 file, the time stamp won't change. Also, some non-POSIX
4956 systems don't update an empty file's time stamp when
4957 truncating it. Finally, file systems with 100 ns or worse
4958 resolution sometimes seem to have bugs: on a system with ns
4959 resolution, checking ns % 100 incorrectly avoids the heuristic
4960 1% of the time, but the problem should be temporary as we will
4961 try again on the next time stamp. */
4963 = ((open_flags
& (O_EXCL
| O_TRUNC
)) != 0
4965 && modtime
.tv_nsec
% 100 != 0);
4967 struct timespec modtime1
= get_stat_mtime (&st1
);
4969 && timespec_cmp (modtime
, modtime1
) == 0
4970 && st
.st_size
== st1
.st_size
)
4972 timestamp_file_system
= st
.st_dev
;
4973 valid_timestamp_file_system
= 1;
4977 st
.st_size
= st1
.st_size
;
4981 emacs_close (desc1
);
4985 /* Call write-region-post-annotation-function. */
4986 while (CONSP (Vwrite_region_annotation_buffers
))
4988 Lisp_Object buf
= XCAR (Vwrite_region_annotation_buffers
);
4989 if (!NILP (Fbuffer_live_p (buf
)))
4992 if (FUNCTIONP (Vwrite_region_post_annotation_function
))
4993 call0 (Vwrite_region_post_annotation_function
);
4995 Vwrite_region_annotation_buffers
4996 = XCDR (Vwrite_region_annotation_buffers
);
4999 unbind_to (count
, Qnil
);
5002 unlock_file (lockname
);
5004 /* Do this before reporting IO error
5005 to avoid a "file has changed on disk" warning on
5006 next attempt to save. */
5007 if (timespec_valid_p (modtime
))
5009 current_buffer
->modtime
= modtime
;
5010 current_buffer
->modtime_size
= st
.st_size
;
5014 report_file_errno ("Write error", filename
, save_errno
);
5016 bool auto_saving_into_visited_file
=
5018 && ! NILP (Fstring_equal (BVAR (current_buffer
, filename
),
5019 BVAR (current_buffer
, auto_save_file_name
)));
5022 SAVE_MODIFF
= MODIFF
;
5023 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5024 bset_filename (current_buffer
, visit_file
);
5025 update_mode_lines
= 14;
5026 if (auto_saving_into_visited_file
)
5027 unlock_file (lockname
);
5031 if (auto_saving_into_visited_file
)
5033 SAVE_MODIFF
= MODIFF
;
5034 unlock_file (lockname
);
5040 if (!auto_saving
&& !noninteractive
)
5041 message_with_string ((NUMBERP (append
)
5051 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5052 doc
: /* Return t if (car A) is numerically less than (car B). */)
5053 (Lisp_Object a
, Lisp_Object b
)
5055 return arithcompare (Fcar (a
), Fcar (b
), ARITH_LESS
);
5058 /* Build the complete list of annotations appropriate for writing out
5059 the text between START and END, by calling all the functions in
5060 write-region-annotate-functions and merging the lists they return.
5061 If one of these functions switches to a different buffer, we assume
5062 that buffer contains altered text. Therefore, the caller must
5063 make sure to restore the current buffer in all cases,
5064 as save-excursion would do. */
5067 build_annotations (Lisp_Object start
, Lisp_Object end
)
5069 Lisp_Object annotations
;
5071 Lisp_Object original_buffer
;
5073 bool used_global
= false;
5075 XSETBUFFER (original_buffer
, current_buffer
);
5078 p
= Vwrite_region_annotate_functions
;
5081 struct buffer
*given_buffer
= current_buffer
;
5082 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5083 { /* Use the global value of the hook. */
5086 Fdefault_value (Qwrite_region_annotate_functions
),
5090 Vwrite_region_annotations_so_far
= annotations
;
5091 res
= call2 (XCAR (p
), start
, end
);
5092 /* If the function makes a different buffer current,
5093 assume that means this buffer contains altered text to be output.
5094 Reset START and END from the buffer bounds
5095 and discard all previous annotations because they should have
5096 been dealt with by this function. */
5097 if (current_buffer
!= given_buffer
)
5099 Vwrite_region_annotation_buffers
5100 = Fcons (Fcurrent_buffer (),
5101 Vwrite_region_annotation_buffers
);
5102 XSETFASTINT (start
, BEGV
);
5103 XSETFASTINT (end
, ZV
);
5106 Flength (res
); /* Check basic validity of return value */
5107 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5111 /* Now do the same for annotation functions implied by the file-format */
5112 if (auto_saving
&& (!EQ (BVAR (current_buffer
, auto_save_file_format
), Qt
)))
5113 p
= BVAR (current_buffer
, auto_save_file_format
);
5115 p
= BVAR (current_buffer
, file_format
);
5116 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5118 struct buffer
*given_buffer
= current_buffer
;
5120 Vwrite_region_annotations_so_far
= annotations
;
5122 /* Value is either a list of annotations or nil if the function
5123 has written annotations to a temporary buffer, which is now
5125 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5126 original_buffer
, make_number (i
));
5127 if (current_buffer
!= given_buffer
)
5129 XSETFASTINT (start
, BEGV
);
5130 XSETFASTINT (end
, ZV
);
5135 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5142 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5143 If STRING is nil, POS is the character position in the current buffer.
5144 Intersperse with them the annotations from *ANNOT
5145 which fall within the range of POS to POS + NCHARS,
5146 each at its appropriate position.
5148 We modify *ANNOT by discarding elements as we use them up.
5150 Return true if successful. */
5153 a_write (int desc
, Lisp_Object string
, ptrdiff_t pos
,
5154 ptrdiff_t nchars
, Lisp_Object
*annot
,
5155 struct coding_system
*coding
)
5159 ptrdiff_t lastpos
= pos
+ nchars
;
5161 while (NILP (*annot
) || CONSP (*annot
))
5163 tem
= Fcar_safe (Fcar (*annot
));
5166 nextpos
= XFASTINT (tem
);
5168 /* If there are no more annotations in this range,
5169 output the rest of the range all at once. */
5170 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5171 return e_write (desc
, string
, pos
, lastpos
, coding
);
5173 /* Output buffer text up to the next annotation's position. */
5176 if (!e_write (desc
, string
, pos
, nextpos
, coding
))
5180 /* Output the annotation. */
5181 tem
= Fcdr (Fcar (*annot
));
5184 if (!e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5187 *annot
= Fcdr (*annot
);
5192 /* Maximum number of characters that the next
5193 function encodes per one loop iteration. */
5195 enum { E_WRITE_MAX
= 8 * 1024 * 1024 };
5197 /* Write text in the range START and END into descriptor DESC,
5198 encoding them with coding system CODING. If STRING is nil, START
5199 and END are character positions of the current buffer, else they
5200 are indexes to the string STRING. Return true if successful. */
5203 e_write (int desc
, Lisp_Object string
, ptrdiff_t start
, ptrdiff_t end
,
5204 struct coding_system
*coding
)
5206 if (STRINGP (string
))
5209 end
= SCHARS (string
);
5212 /* We used to have a code for handling selective display here. But,
5213 now it is handled within encode_coding. */
5217 if (STRINGP (string
))
5219 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5220 if (CODING_REQUIRE_ENCODING (coding
))
5222 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5224 /* Avoid creating huge Lisp string in encode_coding_object. */
5225 if (nchars
== E_WRITE_MAX
)
5226 coding
->raw_destination
= 1;
5228 encode_coding_object
5229 (coding
, string
, start
, string_char_to_byte (string
, start
),
5230 start
+ nchars
, string_char_to_byte (string
, start
+ nchars
),
5235 coding
->dst_object
= string
;
5236 coding
->consumed_char
= SCHARS (string
);
5237 coding
->produced
= SBYTES (string
);
5242 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
5243 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
5245 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5246 if (CODING_REQUIRE_ENCODING (coding
))
5248 ptrdiff_t nchars
= min (end
- start
, E_WRITE_MAX
);
5251 if (nchars
== E_WRITE_MAX
)
5252 coding
->raw_destination
= 1;
5254 encode_coding_object
5255 (coding
, Fcurrent_buffer (), start
, start_byte
,
5256 start
+ nchars
, CHAR_TO_BYTE (start
+ nchars
), Qt
);
5260 coding
->dst_object
= Qnil
;
5261 coding
->dst_pos_byte
= start_byte
;
5262 if (start
>= GPT
|| end
<= GPT
)
5264 coding
->consumed_char
= end
- start
;
5265 coding
->produced
= end_byte
- start_byte
;
5269 coding
->consumed_char
= GPT
- start
;
5270 coding
->produced
= GPT_BYTE
- start_byte
;
5275 if (coding
->produced
> 0)
5277 char *buf
= (coding
->raw_destination
? (char *) coding
->destination
5278 : (STRINGP (coding
->dst_object
)
5279 ? SSDATA (coding
->dst_object
)
5280 : (char *) BYTE_POS_ADDR (coding
->dst_pos_byte
)));
5281 coding
->produced
-= emacs_write_quit (desc
, buf
, coding
->produced
);
5283 if (coding
->raw_destination
)
5285 /* We're responsible for freeing this, see
5286 encode_coding_object to check why. */
5287 xfree (coding
->destination
);
5288 coding
->raw_destination
= 0;
5290 if (coding
->produced
)
5293 start
+= coding
->consumed_char
;
5299 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5300 Sverify_visited_file_modtime
, 0, 1, 0,
5301 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5302 This means that the file has not been changed since it was visited or saved.
5303 If BUF is omitted or nil, it defaults to the current buffer.
5304 See Info node `(elisp)Modification Time' for more details. */)
5307 struct buffer
*b
= decode_buffer (buf
);
5309 Lisp_Object handler
;
5310 Lisp_Object filename
;
5311 struct timespec mtime
;
5313 if (!STRINGP (BVAR (b
, filename
))) return Qt
;
5314 if (b
->modtime
.tv_nsec
== UNKNOWN_MODTIME_NSECS
) return Qt
;
5316 /* If the file name has special constructs in it,
5317 call the corresponding file handler. */
5318 handler
= Ffind_file_name_handler (BVAR (b
, filename
),
5319 Qverify_visited_file_modtime
);
5320 if (!NILP (handler
))
5321 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5323 filename
= ENCODE_FILE (BVAR (b
, filename
));
5325 mtime
= (stat (SSDATA (filename
), &st
) == 0
5326 ? get_stat_mtime (&st
)
5327 : time_error_value (errno
));
5328 if (timespec_cmp (mtime
, b
->modtime
) == 0
5329 && (b
->modtime_size
< 0
5330 || st
.st_size
== b
->modtime_size
))
5335 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5336 Svisited_file_modtime
, 0, 0, 0,
5337 doc
: /* Return the current buffer's recorded visited file modification time.
5338 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5339 `file-attributes' returns. If the current buffer has no recorded file
5340 modification time, this function returns 0. If the visited file
5341 doesn't exist, return -1.
5342 See Info node `(elisp)Modification Time' for more details. */)
5345 int ns
= current_buffer
->modtime
.tv_nsec
;
5347 return make_number (UNKNOWN_MODTIME_NSECS
- ns
);
5348 return make_lisp_time (current_buffer
->modtime
);
5351 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5352 Sset_visited_file_modtime
, 0, 1, 0,
5353 doc
: /* Update buffer's recorded modification time from the visited file's time.
5354 Useful if the buffer was not read from the file normally
5355 or if the file itself has been changed for some known benign reason.
5356 An argument specifies the modification time value to use
5357 \(instead of that of the visited file), in the form of a list
5358 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5359 `visited-file-modtime'. */)
5360 (Lisp_Object time_flag
)
5362 if (!NILP (time_flag
))
5364 struct timespec mtime
;
5365 if (INTEGERP (time_flag
))
5367 CHECK_RANGED_INTEGER (time_flag
, -1, 0);
5368 mtime
= make_timespec (0, UNKNOWN_MODTIME_NSECS
- XINT (time_flag
));
5371 mtime
= lisp_time_argument (time_flag
);
5373 current_buffer
->modtime
= mtime
;
5374 current_buffer
->modtime_size
= -1;
5378 register Lisp_Object filename
;
5380 Lisp_Object handler
;
5382 filename
= Fexpand_file_name (BVAR (current_buffer
, filename
), Qnil
);
5384 /* If the file name has special constructs in it,
5385 call the corresponding file handler. */
5386 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5387 if (!NILP (handler
))
5388 /* The handler can find the file name the same way we did. */
5389 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5391 filename
= ENCODE_FILE (filename
);
5393 if (stat (SSDATA (filename
), &st
) >= 0)
5395 current_buffer
->modtime
= get_stat_mtime (&st
);
5396 current_buffer
->modtime_size
= st
.st_size
;
5404 auto_save_error (Lisp_Object error_val
)
5406 auto_save_error_occurred
= 1;
5408 ring_bell (XFRAME (selected_frame
));
5410 AUTO_STRING (format
, "Auto-saving %s: %s");
5411 Lisp_Object msg
= CALLN (Fformat
, format
, BVAR (current_buffer
, name
),
5412 Ferror_message_string (error_val
));
5413 call3 (intern ("display-warning"),
5414 intern ("auto-save"), msg
, intern ("error"));
5425 auto_save_mode_bits
= 0666;
5427 /* Get visited file's mode to become the auto save file's mode. */
5428 if (! NILP (BVAR (current_buffer
, filename
)))
5430 if (stat (SSDATA (BVAR (current_buffer
, filename
)), &st
) >= 0)
5431 /* But make sure we can overwrite it later! */
5432 auto_save_mode_bits
= (st
.st_mode
| 0600) & 0777;
5433 else if (modes
= Ffile_modes (BVAR (current_buffer
, filename
)),
5435 /* Remote files don't cooperate with stat. */
5436 auto_save_mode_bits
= (XINT (modes
) | 0600) & 0777;
5440 Fwrite_region (Qnil
, Qnil
, BVAR (current_buffer
, auto_save_file_name
), Qnil
,
5441 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5445 struct auto_save_unwind
5452 do_auto_save_unwind (void *arg
)
5454 struct auto_save_unwind
*p
= arg
;
5455 FILE *stream
= p
->stream
;
5456 minibuffer_auto_raise
= p
->auto_raise
;
5467 do_auto_save_make_dir (Lisp_Object dir
)
5471 auto_saving_dir_umask
= 077;
5472 result
= call2 (Qmake_directory
, dir
, Qt
);
5473 auto_saving_dir_umask
= 0;
5478 do_auto_save_eh (Lisp_Object ignore
)
5480 auto_saving_dir_umask
= 0;
5484 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5485 doc
: /* Auto-save all buffers that need it.
5486 This is all buffers that have auto-saving enabled
5487 and are changed since last auto-saved.
5488 Auto-saving writes the buffer into a file
5489 so that your editing is not lost if the system crashes.
5490 This file is not the file you visited; that changes only when you save.
5491 Normally, run the normal hook `auto-save-hook' before saving.
5493 A non-nil NO-MESSAGE argument means do not print any message if successful.
5494 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5495 (Lisp_Object no_message
, Lisp_Object current_only
)
5497 struct buffer
*old
= current_buffer
, *b
;
5498 Lisp_Object tail
, buf
, hook
;
5499 bool auto_saved
= 0;
5500 int do_handled_files
;
5502 FILE *stream
= NULL
;
5503 ptrdiff_t count
= SPECPDL_INDEX ();
5504 bool orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5505 bool old_message_p
= 0;
5506 struct auto_save_unwind auto_save_unwind
;
5508 if (max_specpdl_size
< specpdl_size
+ 40)
5509 max_specpdl_size
= specpdl_size
+ 40;
5514 if (NILP (no_message
))
5516 old_message_p
= push_message ();
5517 record_unwind_protect_void (pop_message_unwind
);
5520 /* Ordinarily don't quit within this function,
5521 but don't make it impossible to quit (in case we get hung in I/O). */
5525 hook
= intern ("auto-save-hook");
5526 safe_run_hooks (hook
);
5528 if (STRINGP (Vauto_save_list_file_name
))
5530 Lisp_Object listfile
;
5532 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5534 /* Don't try to create the directory when shutting down Emacs,
5535 because creating the directory might signal an error, and
5536 that would leave Emacs in a strange state. */
5537 if (!NILP (Vrun_hooks
))
5540 dir
= Ffile_name_directory (listfile
);
5541 if (NILP (Ffile_directory_p (dir
)))
5542 internal_condition_case_1 (do_auto_save_make_dir
,
5547 stream
= emacs_fopen (SSDATA (listfile
), "w");
5550 auto_save_unwind
.stream
= stream
;
5551 auto_save_unwind
.auto_raise
= minibuffer_auto_raise
;
5552 record_unwind_protect_ptr (do_auto_save_unwind
, &auto_save_unwind
);
5553 minibuffer_auto_raise
= 0;
5555 auto_save_error_occurred
= 0;
5557 /* On first pass, save all files that don't have handlers.
5558 On second pass, save all files that do have handlers.
5560 If Emacs is crashing, the handlers may tweak what is causing
5561 Emacs to crash in the first place, and it would be a shame if
5562 Emacs failed to autosave perfectly ordinary files because it
5563 couldn't handle some ange-ftp'd file. */
5565 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5566 FOR_EACH_LIVE_BUFFER (tail
, buf
)
5570 /* Record all the buffers that have auto save mode
5571 in the special file that lists them. For each of these buffers,
5572 Record visited name (if any) and auto save name. */
5573 if (STRINGP (BVAR (b
, auto_save_file_name
))
5574 && stream
!= NULL
&& do_handled_files
== 0)
5577 if (!NILP (BVAR (b
, filename
)))
5578 fwrite_unlocked (SDATA (BVAR (b
, filename
)), 1,
5579 SBYTES (BVAR (b
, filename
)), stream
);
5580 putc_unlocked ('\n', stream
);
5581 fwrite_unlocked (SDATA (BVAR (b
, auto_save_file_name
)), 1,
5582 SBYTES (BVAR (b
, auto_save_file_name
)), stream
);
5583 putc_unlocked ('\n', stream
);
5587 if (!NILP (current_only
)
5588 && b
!= current_buffer
)
5591 /* Don't auto-save indirect buffers.
5592 The base buffer takes care of it. */
5596 /* Check for auto save enabled
5597 and file changed since last auto save
5598 and file changed since last real save. */
5599 if (STRINGP (BVAR (b
, auto_save_file_name
))
5600 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5601 && BUF_AUTOSAVE_MODIFF (b
) < BUF_MODIFF (b
)
5602 /* -1 means we've turned off autosaving for a while--see below. */
5603 && XINT (BVAR (b
, save_length
)) >= 0
5604 && (do_handled_files
5605 || NILP (Ffind_file_name_handler (BVAR (b
, auto_save_file_name
),
5608 struct timespec before_time
= current_timespec ();
5609 struct timespec after_time
;
5611 /* If we had a failure, don't try again for 20 minutes. */
5612 if (b
->auto_save_failure_time
> 0
5613 && before_time
.tv_sec
- b
->auto_save_failure_time
< 1200)
5616 set_buffer_internal (b
);
5617 if (NILP (Vauto_save_include_big_deletions
)
5618 && (XFASTINT (BVAR (b
, save_length
)) * 10
5619 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5620 /* A short file is likely to change a large fraction;
5621 spare the user annoying messages. */
5622 && XFASTINT (BVAR (b
, save_length
)) > 5000
5623 /* These messages are frequent and annoying for `*mail*'. */
5624 && !EQ (BVAR (b
, filename
), Qnil
)
5625 && NILP (no_message
))
5627 /* It has shrunk too much; turn off auto-saving here. */
5628 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5629 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5631 minibuffer_auto_raise
= 0;
5632 /* Turn off auto-saving until there's a real save,
5633 and prevent any more warnings. */
5634 XSETINT (BVAR (b
, save_length
), -1);
5635 Fsleep_for (make_number (1), Qnil
);
5638 if (!auto_saved
&& NILP (no_message
))
5639 message1 ("Auto-saving...");
5640 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5642 BUF_AUTOSAVE_MODIFF (b
) = BUF_MODIFF (b
);
5643 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5644 set_buffer_internal (old
);
5646 after_time
= current_timespec ();
5648 /* If auto-save took more than 60 seconds,
5649 assume it was an NFS failure that got a timeout. */
5650 if (after_time
.tv_sec
- before_time
.tv_sec
> 60)
5651 b
->auto_save_failure_time
= after_time
.tv_sec
;
5655 /* Prevent another auto save till enough input events come in. */
5656 record_auto_save ();
5658 if (auto_saved
&& NILP (no_message
))
5662 /* If we are going to restore an old message,
5663 give time to read ours. */
5664 sit_for (make_number (1), 0, 0);
5667 else if (!auto_save_error_occurred
)
5668 /* Don't overwrite the error message if an error occurred.
5669 If we displayed a message and then restored a state
5670 with no message, leave a "done" message on the screen. */
5671 message1 ("Auto-saving...done");
5676 /* This restores the message-stack status. */
5677 unbind_to (count
, Qnil
);
5681 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5682 Sset_buffer_auto_saved
, 0, 0, 0,
5683 doc
: /* Mark current buffer as auto-saved with its current text.
5684 No auto-save file will be written until the buffer changes again. */)
5687 /* FIXME: This should not be called in indirect buffers, since
5688 they're not autosaved. */
5689 BUF_AUTOSAVE_MODIFF (current_buffer
) = MODIFF
;
5690 XSETFASTINT (BVAR (current_buffer
, save_length
), Z
- BEG
);
5691 current_buffer
->auto_save_failure_time
= 0;
5695 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5696 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5697 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5700 current_buffer
->auto_save_failure_time
= 0;
5704 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5706 doc
: /* Return t if current buffer has been auto-saved recently.
5707 More precisely, if it has been auto-saved since last read from or saved
5708 in the visited file. If the buffer has no visited file,
5709 then any auto-save counts as "recent". */)
5712 /* FIXME: maybe we should return nil for indirect buffers since
5713 they're never autosaved. */
5714 return (SAVE_MODIFF
< BUF_AUTOSAVE_MODIFF (current_buffer
) ? Qt
: Qnil
);
5717 /* Reading and completing file names. */
5719 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
5720 Snext_read_file_uses_dialog_p
, 0, 0, 0,
5721 doc
: /* Return t if a call to `read-file-name' will use a dialog.
5722 The return value is only relevant for a call to `read-file-name' that happens
5723 before any other event (mouse or keypress) is handled. */)
5726 #if (defined USE_GTK || defined USE_MOTIF \
5727 || defined HAVE_NS || defined HAVE_NTGUI)
5728 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5731 && window_system_available (SELECTED_FRAME ()))
5738 DEFUN ("set-binary-mode", Fset_binary_mode
, Sset_binary_mode
, 2, 2, 0,
5739 doc
: /* Switch STREAM to binary I/O mode or text I/O mode.
5740 STREAM can be one of the symbols `stdin', `stdout', or `stderr'.
5741 If MODE is non-nil, switch STREAM to binary mode, otherwise switch
5744 As a side effect, this function flushes any pending STREAM's data.
5746 Value is the previous value of STREAM's I/O mode, nil for text mode,
5747 non-nil for binary mode.
5749 On MS-Windows and MS-DOS, binary mode is needed to read or write
5750 arbitrary binary data, and for disabling translation between CR-LF
5751 pairs and a single newline character. Examples include generation
5752 of text files with Unix-style end-of-line format using `princ' in
5753 batch mode, with standard output redirected to a file.
5755 On Posix systems, this function always returns non-nil, and has no
5756 effect except for flushing STREAM's data. */)
5757 (Lisp_Object stream
, Lisp_Object mode
)
5762 CHECK_SYMBOL (stream
);
5763 if (EQ (stream
, Qstdin
))
5765 else if (EQ (stream
, Qstdout
))
5767 else if (EQ (stream
, Qstderr
))
5770 xsignal2 (Qerror
, build_string ("unsupported stream"), stream
);
5772 binmode
= NILP (mode
) ? O_TEXT
: O_BINARY
;
5774 fflush_unlocked (fp
);
5776 return (set_binary_mode (fileno (fp
), binmode
) == O_BINARY
) ? Qt
: Qnil
;
5781 /* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with
5782 the result negated if NEGATE. */
5784 blocks_to_bytes (uintmax_t blocksize
, uintmax_t blocks
, bool negate
)
5786 /* On typical platforms the following code is accurate to 53 bits,
5787 which is close enough. BLOCKSIZE is invariably a power of 2, so
5788 converting it to double does not lose information. */
5789 double bs
= blocksize
;
5790 return make_float (negate
? -bs
* -blocks
: bs
* blocks
);
5793 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
5794 doc
: /* Return storage information about the file system FILENAME is on.
5795 Value is a list of numbers (TOTAL FREE AVAIL), where TOTAL is the total
5796 storage of the file system, FREE is the free storage, and AVAIL is the
5797 storage available to a non-superuser. All 3 numbers are in bytes.
5798 If the underlying system call fails, value is nil. */)
5799 (Lisp_Object filename
)
5801 Lisp_Object encoded
= ENCODE_FILE (Fexpand_file_name (filename
, Qnil
));
5803 /* If the file name has special constructs in it,
5804 call the corresponding file handler. */
5805 Lisp_Object handler
= Ffind_file_name_handler (encoded
, Qfile_system_info
);
5806 if (!NILP (handler
))
5808 Lisp_Object result
= call2 (handler
, Qfile_system_info
, encoded
);
5809 if (CONSP (result
) || NILP (result
))
5811 error ("Invalid handler in `file-name-handler-alist'");
5815 if (get_fs_usage (SSDATA (encoded
), NULL
, &u
) != 0)
5817 return list3 (blocks_to_bytes (u
.fsu_blocksize
, u
.fsu_blocks
, false),
5818 blocks_to_bytes (u
.fsu_blocksize
, u
.fsu_bfree
, false),
5819 blocks_to_bytes (u
.fsu_blocksize
, u
.fsu_bavail
,
5820 u
.fsu_bavail_top_bit_set
));
5823 #endif /* !DOS_NT */
5828 realmask
= umask (0);
5831 valid_timestamp_file_system
= 0;
5833 /* fsync can be a significant performance hit. Often it doesn't
5834 suffice to make the file-save operation survive a crash. For
5835 batch scripts, which are typically part of larger shell commands
5836 that don't fsync other files, its effect on performance can be
5837 significant so its utility is particularly questionable.
5838 Hence, for now by default fsync is used only when interactive.
5840 For more on why fsync often fails to work on today's hardware, see:
5841 Zheng M et al. Understanding the robustness of SSDs under power fault.
5842 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5843 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5845 For more on why fsync does not suffice even if it works properly, see:
5846 Roche X. Necessary step(s) to synchronize filename operations on disk.
5847 Austin Group Defect 672, 2013-03-19
5848 http://austingroupbugs.net/view.php?id=672 */
5849 write_region_inhibit_fsync
= noninteractive
;
5853 syms_of_fileio (void)
5855 /* Property name of a file name handler,
5856 which gives a list of operations it handles. */
5857 DEFSYM (Qoperations
, "operations");
5859 DEFSYM (Qexpand_file_name
, "expand-file-name");
5860 DEFSYM (Qsubstitute_in_file_name
, "substitute-in-file-name");
5861 DEFSYM (Qdirectory_file_name
, "directory-file-name");
5862 DEFSYM (Qfile_name_directory
, "file-name-directory");
5863 DEFSYM (Qfile_name_nondirectory
, "file-name-nondirectory");
5864 DEFSYM (Qunhandled_file_name_directory
, "unhandled-file-name-directory");
5865 DEFSYM (Qfile_name_as_directory
, "file-name-as-directory");
5866 DEFSYM (Qcopy_file
, "copy-file");
5867 DEFSYM (Qmake_directory_internal
, "make-directory-internal");
5868 DEFSYM (Qmake_directory
, "make-directory");
5869 DEFSYM (Qdelete_file
, "delete-file");
5870 DEFSYM (Qfile_name_case_insensitive_p
, "file-name-case-insensitive-p");
5871 DEFSYM (Qrename_file
, "rename-file");
5872 DEFSYM (Qadd_name_to_file
, "add-name-to-file");
5873 DEFSYM (Qmake_symbolic_link
, "make-symbolic-link");
5874 DEFSYM (Qfile_exists_p
, "file-exists-p");
5875 DEFSYM (Qfile_executable_p
, "file-executable-p");
5876 DEFSYM (Qfile_readable_p
, "file-readable-p");
5877 DEFSYM (Qfile_writable_p
, "file-writable-p");
5878 DEFSYM (Qfile_symlink_p
, "file-symlink-p");
5879 DEFSYM (Qaccess_file
, "access-file");
5880 DEFSYM (Qfile_directory_p
, "file-directory-p");
5881 DEFSYM (Qfile_regular_p
, "file-regular-p");
5882 DEFSYM (Qfile_accessible_directory_p
, "file-accessible-directory-p");
5883 DEFSYM (Qfile_modes
, "file-modes");
5884 DEFSYM (Qset_file_modes
, "set-file-modes");
5885 DEFSYM (Qset_file_times
, "set-file-times");
5886 DEFSYM (Qfile_selinux_context
, "file-selinux-context");
5887 DEFSYM (Qset_file_selinux_context
, "set-file-selinux-context");
5888 DEFSYM (Qfile_acl
, "file-acl");
5889 DEFSYM (Qset_file_acl
, "set-file-acl");
5890 DEFSYM (Qfile_newer_than_file_p
, "file-newer-than-file-p");
5891 DEFSYM (Qinsert_file_contents
, "insert-file-contents");
5892 DEFSYM (Qwrite_region
, "write-region");
5893 DEFSYM (Qverify_visited_file_modtime
, "verify-visited-file-modtime");
5894 DEFSYM (Qset_visited_file_modtime
, "set-visited-file-modtime");
5895 DEFSYM (Qfile_system_info
, "file-system-info");
5897 /* The symbol bound to coding-system-for-read when
5898 insert-file-contents is called for recovering a file. This is not
5899 an actual coding system name, but just an indicator to tell
5900 insert-file-contents to use `emacs-mule' with a special flag for
5901 auto saving and recovering a file. */
5902 DEFSYM (Qauto_save_coding
, "auto-save-coding");
5904 DEFSYM (Qfile_name_history
, "file-name-history");
5905 Fset (Qfile_name_history
, Qnil
);
5907 DEFSYM (Qfile_error
, "file-error");
5908 DEFSYM (Qfile_already_exists
, "file-already-exists");
5909 DEFSYM (Qfile_date_error
, "file-date-error");
5910 DEFSYM (Qfile_missing
, "file-missing");
5911 DEFSYM (Qfile_notify_error
, "file-notify-error");
5912 DEFSYM (Qexcl
, "excl");
5914 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system
,
5915 doc
: /* Coding system for encoding file names.
5916 If it is nil, `default-file-name-coding-system' (which see) is used.
5918 On MS-Windows, the value of this variable is largely ignored if
5919 `w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5920 behaves as if file names were encoded in `utf-8'. */);
5921 Vfile_name_coding_system
= Qnil
;
5923 DEFVAR_LISP ("default-file-name-coding-system",
5924 Vdefault_file_name_coding_system
,
5925 doc
: /* Default coding system for encoding file names.
5926 This variable is used only when `file-name-coding-system' is nil.
5928 This variable is set/changed by the command `set-language-environment'.
5929 User should not set this variable manually,
5930 instead use `file-name-coding-system' to get a constant encoding
5931 of file names regardless of the current language environment.
5933 On MS-Windows, the value of this variable is largely ignored if
5934 `w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5935 behaves as if file names were encoded in `utf-8'. */);
5936 Vdefault_file_name_coding_system
= Qnil
;
5938 /* Lisp functions for translating file formats. */
5939 DEFSYM (Qformat_decode
, "format-decode");
5940 DEFSYM (Qformat_annotate_function
, "format-annotate-function");
5942 /* Lisp function for setting buffer-file-coding-system and the
5943 multibyteness of the current buffer after inserting a file. */
5944 DEFSYM (Qafter_insert_file_set_coding
, "after-insert-file-set-coding");
5946 DEFSYM (Qcar_less_than_car
, "car-less-than-car");
5948 Fput (Qfile_error
, Qerror_conditions
,
5949 Fpurecopy (list2 (Qfile_error
, Qerror
)));
5950 Fput (Qfile_error
, Qerror_message
,
5951 build_pure_c_string ("File error"));
5953 Fput (Qfile_already_exists
, Qerror_conditions
,
5954 Fpurecopy (list3 (Qfile_already_exists
, Qfile_error
, Qerror
)));
5955 Fput (Qfile_already_exists
, Qerror_message
,
5956 build_pure_c_string ("File already exists"));
5958 Fput (Qfile_date_error
, Qerror_conditions
,
5959 Fpurecopy (list3 (Qfile_date_error
, Qfile_error
, Qerror
)));
5960 Fput (Qfile_date_error
, Qerror_message
,
5961 build_pure_c_string ("Cannot set file date"));
5963 Fput (Qfile_missing
, Qerror_conditions
,
5964 Fpurecopy (list3 (Qfile_missing
, Qfile_error
, Qerror
)));
5965 Fput (Qfile_missing
, Qerror_message
,
5966 build_pure_c_string ("File is missing"));
5968 Fput (Qfile_notify_error
, Qerror_conditions
,
5969 Fpurecopy (list3 (Qfile_notify_error
, Qfile_error
, Qerror
)));
5970 Fput (Qfile_notify_error
, Qerror_message
,
5971 build_pure_c_string ("File notification error"));
5973 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist
,
5974 doc
: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5975 If a file name matches REGEXP, all I/O on that file is done by calling
5976 HANDLER. If a file name matches more than one handler, the handler
5977 whose match starts last in the file name gets precedence. The
5978 function `find-file-name-handler' checks this list for a handler for
5981 HANDLER should be a function. The first argument given to it is the
5982 name of the I/O primitive to be handled; the remaining arguments are
5983 the arguments that were passed to that primitive. For example, if you
5984 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5985 HANDLER is called like this:
5987 (funcall HANDLER \\='file-exists-p FILENAME)
5989 Note that HANDLER must be able to handle all I/O primitives; if it has
5990 nothing special to do for a primitive, it should reinvoke the
5991 primitive to handle the operation \"the usual way\".
5992 See Info node `(elisp)Magic File Names' for more details. */);
5993 Vfile_name_handler_alist
= Qnil
;
5995 DEFVAR_LISP ("set-auto-coding-function",
5996 Vset_auto_coding_function
,
5997 doc
: /* If non-nil, a function to call to decide a coding system of file.
5998 Two arguments are passed to this function: the file name
5999 and the length of a file contents following the point.
6000 This function should return a coding system to decode the file contents.
6001 It should check the file name against `auto-coding-alist'.
6002 If no coding system is decided, it should check a coding system
6003 specified in the heading lines with the format:
6004 -*- ... coding: CODING-SYSTEM; ... -*-
6005 or local variable spec of the tailing lines with `coding:' tag. */);
6006 Vset_auto_coding_function
= Qnil
;
6008 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions
,
6009 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6010 Each is passed one argument, the number of characters inserted,
6011 with point at the start of the inserted text. Each function
6012 should leave point the same, and return the new character count.
6013 If `insert-file-contents' is intercepted by a handler from
6014 `file-name-handler-alist', that handler is responsible for calling the
6015 functions in `after-insert-file-functions' if appropriate. */);
6016 Vafter_insert_file_functions
= Qnil
;
6018 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions
,
6019 doc
: /* A list of functions to be called at the start of `write-region'.
6020 Each is passed two arguments, START and END as for `write-region'.
6021 These are usually two numbers but not always; see the documentation
6022 for `write-region'. The function should return a list of pairs
6023 of the form (POSITION . STRING), consisting of strings to be effectively
6024 inserted at the specified positions of the file being written (1 means to
6025 insert before the first byte written). The POSITIONs must be sorted into
6028 If there are several annotation functions, the lists returned by these
6029 functions are merged destructively. As each annotation function runs,
6030 the variable `write-region-annotations-so-far' contains a list of all
6031 annotations returned by previous annotation functions.
6033 An annotation function can return with a different buffer current.
6034 Doing so removes the annotations returned by previous functions, and
6035 resets START and END to `point-min' and `point-max' of the new buffer.
6037 After `write-region' completes, Emacs calls the function stored in
6038 `write-region-post-annotation-function', once for each buffer that was
6039 current when building the annotations (i.e., at least once), with that
6040 buffer current. */);
6041 Vwrite_region_annotate_functions
= Qnil
;
6042 DEFSYM (Qwrite_region_annotate_functions
, "write-region-annotate-functions");
6044 DEFVAR_LISP ("write-region-post-annotation-function",
6045 Vwrite_region_post_annotation_function
,
6046 doc
: /* Function to call after `write-region' completes.
6047 The function is called with no arguments. If one or more of the
6048 annotation functions in `write-region-annotate-functions' changed the
6049 current buffer, the function stored in this variable is called for
6050 each of those additional buffers as well, in addition to the original
6051 buffer. The relevant buffer is current during each function call. */);
6052 Vwrite_region_post_annotation_function
= Qnil
;
6053 staticpro (&Vwrite_region_annotation_buffers
);
6055 DEFVAR_LISP ("write-region-annotations-so-far",
6056 Vwrite_region_annotations_so_far
,
6057 doc
: /* When an annotation function is called, this holds the previous annotations.
6058 These are the annotations made by other annotation functions
6059 that were already called. See also `write-region-annotate-functions'. */);
6060 Vwrite_region_annotations_so_far
= Qnil
;
6062 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers
,
6063 doc
: /* A list of file name handlers that temporarily should not be used.
6064 This applies only to the operation `inhibit-file-name-operation'. */);
6065 Vinhibit_file_name_handlers
= Qnil
;
6067 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation
,
6068 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6069 Vinhibit_file_name_operation
= Qnil
;
6071 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name
,
6072 doc
: /* File name in which to write a list of all auto save file names.
6073 This variable is initialized automatically from `auto-save-list-file-prefix'
6074 shortly after Emacs reads your init file, if you have not yet given it
6075 a non-nil value. */);
6076 Vauto_save_list_file_name
= Qnil
;
6078 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name
,
6079 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6080 Normally auto-save files are written under other names. */);
6081 Vauto_save_visited_file_name
= Qnil
;
6083 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions
,
6084 doc
: /* If non-nil, auto-save even if a large part of the text is deleted.
6085 If nil, deleting a substantial portion of the text disables auto-save
6086 in the buffer; this is the default behavior, because the auto-save
6087 file is usually more useful if it contains the deleted text. */);
6088 Vauto_save_include_big_deletions
= Qnil
;
6090 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync
,
6091 doc
: /* Non-nil means don't call fsync in `write-region'.
6092 This variable affects calls to `write-region' as well as save commands.
6093 Setting this to nil may avoid data loss if the system loses power or
6094 the operating system crashes. By default, it is non-nil in batch mode. */);
6095 write_region_inhibit_fsync
= 0; /* See also `init_fileio' above. */
6097 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash
,
6098 doc
: /* Specifies whether to use the system's trash can.
6099 When non-nil, certain file deletion commands use the function
6100 `move-file-to-trash' instead of deleting files outright.
6101 This includes interactive calls to `delete-file' and
6102 `delete-directory' and the Dired deletion commands. */);
6103 delete_by_moving_to_trash
= 0;
6104 DEFSYM (Qdelete_by_moving_to_trash
, "delete-by-moving-to-trash");
6106 /* Lisp function for moving files to trash. */
6107 DEFSYM (Qmove_file_to_trash
, "move-file-to-trash");
6109 /* Lisp function for recursively copying directories. */
6110 DEFSYM (Qcopy_directory
, "copy-directory");
6112 /* Lisp function for recursively deleting directories. */
6113 DEFSYM (Qdelete_directory
, "delete-directory");
6115 DEFSYM (Qsubstitute_env_in_file_name
, "substitute-env-in-file-name");
6116 DEFSYM (Qget_buffer_window_list
, "get-buffer-window-list");
6118 DEFSYM (Qstdin
, "stdin");
6119 DEFSYM (Qstdout
, "stdout");
6120 DEFSYM (Qstderr
, "stderr");
6122 defsubr (&Sfind_file_name_handler
);
6123 defsubr (&Sfile_name_directory
);
6124 defsubr (&Sfile_name_nondirectory
);
6125 defsubr (&Sunhandled_file_name_directory
);
6126 defsubr (&Sfile_name_as_directory
);
6127 defsubr (&Sdirectory_name_p
);
6128 defsubr (&Sdirectory_file_name
);
6129 defsubr (&Smake_temp_file_internal
);
6130 defsubr (&Smake_temp_name
);
6131 defsubr (&Sexpand_file_name
);
6132 defsubr (&Ssubstitute_in_file_name
);
6133 defsubr (&Scopy_file
);
6134 defsubr (&Smake_directory_internal
);
6135 defsubr (&Sdelete_directory_internal
);
6136 defsubr (&Sdelete_file
);
6137 defsubr (&Sfile_name_case_insensitive_p
);
6138 defsubr (&Srename_file
);
6139 defsubr (&Sadd_name_to_file
);
6140 defsubr (&Smake_symbolic_link
);
6141 defsubr (&Sfile_name_absolute_p
);
6142 defsubr (&Sfile_exists_p
);
6143 defsubr (&Sfile_executable_p
);
6144 defsubr (&Sfile_readable_p
);
6145 defsubr (&Sfile_writable_p
);
6146 defsubr (&Saccess_file
);
6147 defsubr (&Sfile_symlink_p
);
6148 defsubr (&Sfile_directory_p
);
6149 defsubr (&Sfile_accessible_directory_p
);
6150 defsubr (&Sfile_regular_p
);
6151 defsubr (&Sfile_modes
);
6152 defsubr (&Sset_file_modes
);
6153 defsubr (&Sset_file_times
);
6154 defsubr (&Sfile_selinux_context
);
6155 defsubr (&Sfile_acl
);
6156 defsubr (&Sset_file_acl
);
6157 defsubr (&Sset_file_selinux_context
);
6158 defsubr (&Sset_default_file_modes
);
6159 defsubr (&Sdefault_file_modes
);
6160 defsubr (&Sfile_newer_than_file_p
);
6161 defsubr (&Sinsert_file_contents
);
6162 defsubr (&Swrite_region
);
6163 defsubr (&Scar_less_than_car
);
6164 defsubr (&Sverify_visited_file_modtime
);
6165 defsubr (&Svisited_file_modtime
);
6166 defsubr (&Sset_visited_file_modtime
);
6167 defsubr (&Sdo_auto_save
);
6168 defsubr (&Sset_buffer_auto_saved
);
6169 defsubr (&Sclear_buffer_auto_save_failure
);
6170 defsubr (&Srecent_auto_save_p
);
6172 defsubr (&Snext_read_file_uses_dialog_p
);
6174 defsubr (&Sset_binary_mode
);
6177 defsubr (&Sfile_system_info
);
6181 defsubr (&Sunix_sync
);